david
0e3448cd2f
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@25 05c56307-c608-d34a-929d-697000501d7a
1402 lines
41 KiB
ObjectPascal
1402 lines
41 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressBars components }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
|
|
{ CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxRibbonForm;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ExtCtrls, ImgList, cxClasses, cxGraphics, cxControls,
|
|
dxRibbonSkins, dxRibbonFormCaptionHelper, cxDWMApi;
|
|
|
|
type
|
|
|
|
{ TdxCustomRibbonForm }
|
|
|
|
TdxCustomRibbonForm = class(TForm)
|
|
private
|
|
FAutoScroll: Boolean;
|
|
FCaption: TCaption;
|
|
FCornerRegions: array[0..3] of HRGN;
|
|
FData: TdxRibbonFormData;
|
|
FDisableAero: Boolean;
|
|
FExtendFrameAtTopHeight: Integer;
|
|
FFakeClientHandle: HWND;
|
|
FZoomedBoundsOffsets: TRect;
|
|
FIsActive: Boolean;
|
|
FSizingBorders: TSize;
|
|
FSizingLoop: Boolean;
|
|
FUseSkin: Boolean;
|
|
FUseSkinColor: Boolean;
|
|
FVisibleChanging: Boolean;
|
|
FDefClientProc: TFarProc;
|
|
FNewClientInstance: TFarProc;
|
|
FRibbonNonClientHelper: TdxRibbonFormCaptionHelper;
|
|
procedure CalculateCornerRegions;
|
|
procedure CalculateZoomedOffsets;
|
|
procedure CheckExtendFrame(AZoomed: Boolean);
|
|
procedure CheckResizingNCHitTest(var AHitTest: Integer; const P: TPoint);
|
|
procedure CorrectZoomedBounds(var R: TRect);
|
|
procedure CreateCornerRegions;
|
|
procedure DestroyCornerRegions;
|
|
procedure ExcludeRibbonPaintArea(DC: HDC);
|
|
procedure ForceUpdateWindowSizeForVista;
|
|
function GetCurrentBordersWidth: TRect;
|
|
function GetUseSkin: Boolean;
|
|
procedure InvalidateFrame(AWnd: HWND; AUpdate: Boolean = False);
|
|
function IsNeedCorrectForAutoHideTaskBar: Boolean;
|
|
function IsNormalWindowState: Boolean;
|
|
procedure NewClientWndProc(var Message: TMessage);
|
|
procedure SetAutoScroll(const Value: Boolean);
|
|
procedure SetDisableAero(const Value: Boolean);
|
|
procedure SetRibbonNonClientHelper(const Value: TdxRibbonFormCaptionHelper);
|
|
procedure SetUseSkinColor(const Value: Boolean);
|
|
procedure UpdateSystemMenu;
|
|
//messages
|
|
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
|
|
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
|
|
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
|
|
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
|
|
procedure WMShowWindow(var Message: TMessage); message WM_SHOWWINDOW;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
|
|
procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
|
|
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
|
|
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP;
|
|
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
|
|
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
|
|
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
|
|
//vista support
|
|
procedure WMDWMCompositionChanged(var Message: TMessage); message WM_DWMCOMPOSITIONCHANGED;
|
|
//caption
|
|
procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
|
|
procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
|
|
procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
|
|
protected
|
|
procedure AdjustClientRect(var Rect: TRect); override;
|
|
procedure AdjustSize; override;
|
|
procedure CallDWMWindowProc(var Message);
|
|
procedure CaptionChanged;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWindowHandle; override;
|
|
procedure DrawNonClientArea(ADrawCaption: Boolean; AUpdateRegion: HRGN = 1);
|
|
procedure ExtendFrameIntoClientAreaAtTop(AHeight: Integer);
|
|
function GetFormBorderIcons: TBorderIcons; virtual;
|
|
function HandleWithHelper(ADown: Boolean; AButton: TMouseButton): Boolean; virtual;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure UpdateWindowStates;
|
|
procedure UpdateNonClientArea;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
|
|
property DisableAero: Boolean read FDisableAero write SetDisableAero default False;
|
|
property UseSkin: Boolean read GetUseSkin;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
|
|
destructor Destroy; override;
|
|
procedure Invalidate; override;
|
|
function IsUseAeroNCPaint: Boolean;
|
|
|
|
property RibbonNonClientHelper: TdxRibbonFormCaptionHelper
|
|
read FRibbonNonClientHelper write SetRibbonNonClientHelper;
|
|
property IsActive: Boolean read FIsActive;
|
|
published
|
|
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default False;
|
|
property KeyPreview default True;
|
|
property UseSkinColor: Boolean read FUseSkinColor write SetUseSkinColor default True;
|
|
end;
|
|
|
|
{ TdxRibbonForm }
|
|
|
|
TdxRibbonForm = class(TdxCustomRibbonForm);
|
|
|
|
procedure SetWindowTextWithoutRedraw(AWnd: HWND; const AText: string);
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DELPHI6}
|
|
Types,
|
|
{$ENDIF}
|
|
dxBar, cxGeometry, Math, dxOffice11, dxUxTheme, MultiMon, ShellAPI, dxRibbon,
|
|
dxStatusBar;
|
|
|
|
const
|
|
{$IFNDEF DELPHI7}
|
|
WM_NCMOUSELEAVE = $02A2;
|
|
{$ENDIF}
|
|
WM_NCUAHDRAWCAPTION = $00AE;
|
|
WM_NCUAHDRAWFRAME = $00AF;
|
|
WM_SYNCPAINT = $0088;
|
|
|
|
dxGlassMaximizedNonClientHeight = 4;
|
|
|
|
procedure SetWindowTextWithoutRedraw(AWnd: HWND; const AText: string);
|
|
var
|
|
AFlags: Cardinal;
|
|
begin
|
|
AFlags := GetWindowLong(AWnd, GWL_STYLE);
|
|
SetWindowLong(AWnd, GWL_STYLE, AFlags and not WS_VISIBLE);
|
|
DefWindowProc(AWnd, WM_SETTEXT, 0, LongInt(PChar(AText)));
|
|
SetWindowLong(AWnd, GWL_STYLE, AFlags);
|
|
end;
|
|
|
|
{ TdxCustomRibbonForm }
|
|
|
|
constructor TdxCustomRibbonForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner); //CBUILDER workaround
|
|
end;
|
|
|
|
constructor TdxCustomRibbonForm.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
|
|
begin
|
|
inherited CreateNew(AOwner, Dummy);
|
|
FAutoScroll := False;
|
|
FUseSkinColor := True;
|
|
AutoScroll := False;
|
|
KeyPreview := True;
|
|
CreateCornerRegions;
|
|
end;
|
|
|
|
destructor TdxCustomRibbonForm.Destroy;
|
|
begin
|
|
DestroyCornerRegions;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.Invalidate;
|
|
begin
|
|
if HandleAllocated and not IsIconic(Handle) then
|
|
CheckExtendFrame(IsZoomed(Handle));
|
|
inherited Invalidate;
|
|
if ClientHandle <> 0 then
|
|
InvalidateRect(ClientHandle, nil, True);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CreateWnd;
|
|
var
|
|
ClientCreateStruct: TClientCreateStruct;
|
|
begin
|
|
FExtendFrameAtTopHeight := -1;
|
|
inherited CreateWnd;
|
|
if not (csDesigning in ComponentState) and (FormStyle = fsMDIForm) then
|
|
begin
|
|
with ClientCreateStruct do
|
|
begin
|
|
idFirstChild := $FF00; //check
|
|
hWindowMenu := 0;
|
|
end;
|
|
FFakeClientHandle := Windows.CreateWindowEx(WS_EX_CLIENTEDGE, 'MDICLIENT',
|
|
nil, WS_CHILD or WS_VISIBLE or WS_GROUP or WS_TABSTOP or
|
|
WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
|
|
MDIS_ALLCHILDSTYLES, 0, 0, ClientWidth, ClientHeight, Handle, 0,
|
|
HInstance, @ClientCreateStruct);
|
|
SetWindowPos(FFakeClientHandle, 0, -20, -20, 10, 10, SWP_NOACTIVATE or SWP_NOZORDER);
|
|
FDefClientProc := Pointer(GetWindowLong(FFakeClientHandle, GWL_WNDPROC));
|
|
FNewClientInstance := {$IFDEF DELPHI6}Classes.{$ENDIF}MakeObjectInstance(NewClientWndProc);
|
|
SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FNewClientInstance));
|
|
if ClientHandle <> 0 then
|
|
begin
|
|
SetWindowLong(ClientHandle, GWL_EXSTYLE,
|
|
GetWindowLong(ClientHandle, GWL_EXSTYLE) and not WS_EX_CLIENTEDGE);
|
|
InvalidateFrame(ClientHandle);
|
|
end;
|
|
end;
|
|
UpdateSystemMenu;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.DestroyWindowHandle;
|
|
begin
|
|
inherited;
|
|
if csDestroying in ComponentState then
|
|
RibbonNonClientHelper := nil;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.AdjustClientRect(var Rect: TRect);
|
|
begin
|
|
inherited;
|
|
if IsUseAeroNCPaint and IsZoomed(Handle) then
|
|
Inc(Rect.Top, dxGlassMaximizedNonClientHeight);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.AdjustSize;
|
|
{$IFDEF DELPHI11}
|
|
var
|
|
AFlags: Cardinal;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF DELPHI11}
|
|
if not (csLoading in ComponentState) and HandleAllocated then
|
|
begin
|
|
AFlags := SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOZORDER;
|
|
if IsZoomed(Handle) then
|
|
AFlags := AFlags or SWP_NOSIZE;
|
|
SetWindowPos(Handle, 0, 0, 0, Width, Height, AFlags);
|
|
RequestAlign;
|
|
end;
|
|
{$ELSE}
|
|
inherited AdjustSize;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CallDWMWindowProc(var Message);
|
|
begin
|
|
DwmDefWindowProc(Handle, TMessage(Message).Msg, TMessage(Message).WParam,
|
|
TMessage(Message).LParam, Integer(@TMessage(Message).Result));
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CaptionChanged;
|
|
begin
|
|
UpdateWindowStates;
|
|
RibbonNonClientHelper.CaptionChanged;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.NewClientWndProc(var Message: TMessage);
|
|
|
|
procedure Default;
|
|
begin
|
|
with Message do
|
|
Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam);
|
|
end;
|
|
|
|
function MaximizedChildren: Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to MDIChildCount - 1 do
|
|
if MDIChildren[I].WindowState = wsMaximized then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
DC: HDC;
|
|
PS: TPaintStruct;
|
|
R: TRect;
|
|
// F: TForm;
|
|
AColor: TColor;
|
|
begin
|
|
if not UseSkin then
|
|
begin
|
|
Default;
|
|
Exit;
|
|
end;
|
|
with Message do
|
|
case Msg of
|
|
WM_KEYDOWN:
|
|
begin
|
|
KeyDown(WParamLo, KeyDataToShiftState(LParam));
|
|
if WParamLo = 0 then Exit;
|
|
Default;
|
|
end;
|
|
WM_NCHITTEST:
|
|
begin
|
|
Default;
|
|
if Result = HTCLIENT then Result := HTTRANSPARENT;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
begin
|
|
AColor := RibbonNonClientHelper.GetWindowColor;
|
|
FillRectByColor(TWMEraseBkGnd(Message).DC, ClientRect, AColor);
|
|
// Erase the background at the location of an MDI client window
|
|
if (FormStyle = fsMDIForm) and (ClientHandle <> 0) then
|
|
begin
|
|
Windows.GetClientRect(ClientHandle, R);
|
|
FillRectByColor(TWMEraseBkGnd(Message).DC, R, AColor);
|
|
end;
|
|
Result := 1;
|
|
end;
|
|
WM_NCCALCSIZE:;
|
|
WM_NCPAINT:;
|
|
WM_MDIREFRESHMENU:
|
|
Result := 0;
|
|
WM_NCACTIVATE:
|
|
Message.Result := 1;
|
|
{
|
|
$3F://!
|
|
begin
|
|
Default;
|
|
F := ActiveMDIChild;
|
|
if (F <> nil) and MaximizedChildren then
|
|
begin
|
|
//correct maximized bounds
|
|
GetWindowRect(ClientHandle, R);
|
|
R.Right := R.Right - R.Left + (F.Width - F.ClientWidth);
|
|
R.Bottom := R.Bottom - R.Top + (F.Height - F.ClientHeight);
|
|
if (F is TdxCustomRibbonForm) and TdxCustomRibbonForm(F).UseSkin then
|
|
Inc(R.Bottom, TdxCustomRibbonForm(F).RibbonNonClientHelper.GetWindowCaptionHeight);
|
|
SetWindowPos(F.Handle, 0, 0, 0, R.Right, R.Bottom,
|
|
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOZORDER);
|
|
end;
|
|
end;
|
|
}
|
|
WM_PAINT:
|
|
begin
|
|
DC := TWMPaint(Message).DC;
|
|
if DC = 0 then
|
|
TWMPaint(Message).DC := BeginPaint(ClientHandle, PS);
|
|
try
|
|
if DC = 0 then
|
|
begin
|
|
GetWindowRect(ClientHandle, R);
|
|
R.TopLeft := ScreenToClient(R.TopLeft);
|
|
MoveWindowOrg(TWMPaint(Message).DC, -R.Left, -R.Top);
|
|
end;
|
|
PaintHandler(TWMPaint(Message));
|
|
finally
|
|
if DC = 0 then
|
|
EndPaint(ClientHandle, PS);
|
|
end;
|
|
end;
|
|
else
|
|
Default;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.DrawNonClientArea(ADrawCaption: Boolean; AUpdateRegion: HRGN = 1);
|
|
var
|
|
DC: HDC;
|
|
AFlags: Integer;
|
|
ARgn: HRGN;
|
|
AZoomed: Boolean;
|
|
begin
|
|
if IsUseAeroNCPaint then Exit;
|
|
UpdateWindowStates;
|
|
AFlags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE;
|
|
if AUpdateRegion <> 1 then
|
|
begin
|
|
ARgn := CreateRectRgnIndirect(cxEmptyRect);
|
|
CombineRgn(ARgn, AUpdateRegion, 0, RGN_COPY);
|
|
DC := GetDCEx(Handle, ARgn, AFlags or DCX_INTERSECTRGN);
|
|
end
|
|
else
|
|
DC := GetDCEx(Handle, 0, AFlags);
|
|
BarCanvas.BeginPaint(DC);
|
|
BarCanvas.Canvas.Lock;
|
|
try
|
|
if IsIconic(Handle) then
|
|
RibbonNonClientHelper.DrawWindowCaption(BarCanvas, Caption)
|
|
else
|
|
begin
|
|
AZoomed := IsZoomed(Handle);
|
|
if not AZoomed then
|
|
RibbonNonClientHelper.DrawWindowBorders(BarCanvas);
|
|
if ADrawCaption then
|
|
RibbonNonClientHelper.DrawWindowCaption(nil, Caption);
|
|
end;
|
|
finally
|
|
BarCanvas.Canvas.Unlock;
|
|
BarCanvas.EndPaint;
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.HandleWithHelper(ADown: Boolean;
|
|
AButton: TMouseButton): Boolean;
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
Result := UseSkin;
|
|
if Result then
|
|
begin
|
|
P := GetMouseCursorPos;
|
|
if RibbonNonClientHelper.IsInCaptionArea(P.X, P.Y) then
|
|
begin
|
|
if ADown then
|
|
Result := RibbonNonClientHelper.MouseDown(P, AButton)
|
|
else
|
|
Result := RibbonNonClientHelper.MouseUp(P, AButton);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
I: Integer;
|
|
AIntf: IdxFormKeyPreviewListener;
|
|
AForm: TForm;
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if KeyPreview then
|
|
begin
|
|
if FormStyle = fsMDIChild then
|
|
AForm := Application.MainForm
|
|
else
|
|
AForm := Self;
|
|
for I := 0 to AForm.ControlCount - 1 do
|
|
if Supports(TObject(AForm.Controls[I]), IdxFormKeyPreviewListener, AIntf) then
|
|
begin
|
|
AIntf.FormKeyDown(Key, Shift);
|
|
AIntf := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CalculateCornerRegions;
|
|
|
|
procedure CalculateRegion(ACornerRgn: HRGN; DX, DY: Integer; const ACornerRect: TRect);
|
|
var
|
|
R1, R2: HRGN;
|
|
begin
|
|
R1 := CreateRectRgnIndirect(cxEmptyRect);
|
|
GetWindowRgn(Handle, ACornerRgn);
|
|
GetWindowRgn(Handle, R1);
|
|
OffsetRgn(R1, DX, DY);
|
|
CombineRgn(ACornerRgn, ACornerRgn, R1, RGN_DIFF);
|
|
R2 := CreateRectRgnIndirect(ACornerRect);
|
|
CombineRgn(ACornerRgn, ACornerRgn, R2, RGN_AND);
|
|
DeleteObject(R1);
|
|
DeleteObject(R2);
|
|
end;
|
|
|
|
var
|
|
H: Integer;
|
|
begin
|
|
H := GetSystemMetrics(SM_CYCAPTION);
|
|
CalculateRegion(FCornerRegions[0], FSizingBorders.cx, FSizingBorders.cy,
|
|
cxRect(0, 0, H, H));
|
|
CalculateRegion(FCornerRegions[1], -FSizingBorders.cx, FSizingBorders.cy,
|
|
cxRect(Width - H, 0, Width, H));
|
|
CalculateRegion(FCornerRegions[2], -FSizingBorders.cx, -FSizingBorders.cy,
|
|
cxRect(Width - H, Height - H, Width, Height));
|
|
CalculateRegion(FCornerRegions[3], FSizingBorders.cx, -FSizingBorders.cy,
|
|
cxRect(0, Height - H, H, Height));
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CalculateZoomedOffsets;
|
|
var
|
|
ABData: TAppBarData;
|
|
begin
|
|
FZoomedBoundsOffsets := cxEmptyRect;
|
|
if IsNeedCorrectForAutoHideTaskBar then
|
|
begin
|
|
FillChar(ABData, sizeof(ABData), 0);
|
|
ABData.cbSize := sizeof(ABData);
|
|
ABData.hWnd := Handle;
|
|
SHAppBarMessage(ABM_GETTASKBARPOS, ABData);
|
|
if ABData.uEdge = ABE_LEFT then
|
|
FZoomedBoundsOffsets.Left := 1
|
|
else if (ABData.uEdge = ABE_TOP) and not IsUseAeroNCPaint then
|
|
FZoomedBoundsOffsets.Top := 1
|
|
else if ABData.uEdge = ABE_RIGHT then
|
|
FZoomedBoundsOffsets.Right := 1 + Ord(IsUseAeroNCPaint)
|
|
else if ABData.uEdge = ABE_BOTTOM then
|
|
FZoomedBoundsOffsets.Bottom := 1;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CheckExtendFrame(AZoomed: Boolean);
|
|
var
|
|
ANonClientHeight: Integer;
|
|
begin
|
|
if UseSkin and HandleAllocated and IsUseAeroNCPaint then
|
|
begin
|
|
ANonClientHeight := RibbonNonClientHelper.GetWindowCaptionHeight;
|
|
//prevent client area rendering beyond the screen if maximized
|
|
if AZoomed and (ANonClientHeight > 0) then
|
|
Inc(ANonClientHeight, dxGlassMaximizedNonClientHeight);
|
|
ExtendFrameIntoClientAreaAtTop(ANonClientHeight);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TdxCustomRibbonForm.GetUseSkin: Boolean;
|
|
begin
|
|
Result := FUseSkin //and (FormStyle <> fsMDIChild);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.InvalidateFrame(AWnd: HWND; AUpdate: Boolean = False);
|
|
begin
|
|
SetWindowPos(AWnd, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or
|
|
SWP_NOZORDER or SWP_NOACTIVATE or SWP_DRAWFRAME);
|
|
if AUpdate then
|
|
UpdateWindow(AWnd);
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.IsNeedCorrectForAutoHideTaskBar: Boolean;
|
|
var
|
|
ABData : TAppBarData;
|
|
begin
|
|
FillChar(ABData, sizeof(ABData), 0);
|
|
ABData.cbSize := sizeof(ABData);
|
|
Result := ((SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0) and
|
|
(MonitorFromWindow(FindWindow('Shell_TrayWnd', nil), MONITOR_DEFAULTTONEAREST) = Monitor.Handle);
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.IsNormalWindowState: Boolean;
|
|
begin
|
|
Result := not (IsIconic(Handle) or IsZoomed(Handle));
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.SetAutoScroll(const Value: Boolean);
|
|
begin
|
|
//don't change
|
|
inherited AutoScroll := False;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.SetDisableAero(const Value: Boolean);
|
|
begin
|
|
if FDisableAero <> Value then
|
|
begin
|
|
FDisableAero := Value;
|
|
UpdateWindowStates;
|
|
if UseSkin and HandleAllocated and IsCompositionEnabled and IsWindowVisible(Handle) then
|
|
begin
|
|
SetWindowRgn(Handle, 0, False);
|
|
FExtendFrameAtTopHeight := -1;
|
|
ForceUpdateWindowSizeForVista;
|
|
FExtendFrameAtTopHeight := -1;
|
|
RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or
|
|
RDW_ALLCHILDREN{ or RDW_UPDATENOW or RDW_ERASENOW});
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.SetRibbonNonClientHelper(const Value: TdxRibbonFormCaptionHelper);
|
|
begin
|
|
if FRibbonNonClientHelper <> Value then
|
|
begin
|
|
FRibbonNonClientHelper := Value;
|
|
FUseSkin := (Value <> nil) and (FRibbonNonClientHelper <> nil);
|
|
FExtendFrameAtTopHeight := -1;
|
|
if csDestroying in ComponentState then
|
|
FUseSkin := False
|
|
else
|
|
begin
|
|
UpdateWindowStates;
|
|
if HandleAllocated then
|
|
begin
|
|
if dxWMSetSkinnedMessage > 0 then
|
|
SendMessage(Handle, dxWMSetSkinnedMessage, Integer(FUseSkin), 0);
|
|
DisableAlign;
|
|
SetWindowRgn(Handle, 0, False);
|
|
if IsCompositionEnabled and not UseSkin then
|
|
ExtendFrameIntoClientAreaAtTop(0);
|
|
SetWindowPos(Handle, 0, 0, 0, Width, Height, SWP_NOMOVE or
|
|
SWP_NOZORDER or SWP_NOACTIVATE or SWP_DRAWFRAME);
|
|
if IsWindowVisible(Handle) then
|
|
RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or RDW_ALLCHILDREN);
|
|
EnableAlign;
|
|
UpdateSystemMenu;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.SetUseSkinColor(const Value: Boolean);
|
|
begin
|
|
if FUseSkinColor <> Value then
|
|
begin
|
|
FUseSkinColor := Value;
|
|
if HandleAllocated then
|
|
InvalidateRect(Handle, nil, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.UpdateSystemMenu;
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
if not IsUseAeroNCPaint then
|
|
GetSystemMenu(Handle, True); //W2k painting bug workaround
|
|
RibbonNonClientHelper.InitWindowBorderIcons(GetFormBorderIcons);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CMColorChanged(var Message: TMessage);
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
if (FormStyle = fsMDIForm) and (ClientHandle <> 0) then
|
|
Windows.InvalidateRect(ClientHandle, nil, True);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CMShowingChanged(var Message: TMessage);
|
|
|
|
procedure UpdateRibbonControls(var ARibbon, AStatusBar: TWinControl);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to ControlCount - 1 do
|
|
begin
|
|
if Controls[I] is TdxCustomRibbon then
|
|
ARibbon := TWinControl(Controls[I])
|
|
else if Controls[I] is TdxCustomStatusBar then
|
|
AStatusBar := TWinControl(Controls[I]);
|
|
if (ARibbon <> nil) and (AStatusBar <> nil) then Break;
|
|
end;
|
|
end;
|
|
|
|
procedure CheckHideRibbonControl(var AControl: TWinControl);
|
|
begin
|
|
if (AControl <> nil) and AControl.HandleAllocated and AControl.Visible then
|
|
ShowWindow(AControl.Handle, SW_HIDE)
|
|
else
|
|
AControl := nil;
|
|
end;
|
|
|
|
procedure ShowRibbonControl(AControl: TWinControl);
|
|
begin
|
|
if AControl <> nil then
|
|
begin
|
|
ShowWindow(AControl.Handle, SW_SHOWNA);
|
|
UpdateWindow(AControl.Handle);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ANeedHideRibbonControls: Boolean;
|
|
ARibbon, AStatusBar: TWinControl;
|
|
begin
|
|
ARibbon := nil; //remove warnings
|
|
AStatusBar := nil;
|
|
ANeedHideRibbonControls := Visible and FVisibleChanging;
|
|
try
|
|
if ANeedHideRibbonControls then
|
|
begin
|
|
UpdateRibbonControls(ARibbon, AStatusBar);
|
|
CheckHideRibbonControl(ARibbon);
|
|
CheckHideRibbonControl(AStatusBar);
|
|
end;
|
|
inherited;
|
|
finally
|
|
if ANeedHideRibbonControls then
|
|
begin
|
|
ShowRibbonControl(ARibbon);
|
|
ShowRibbonControl(AStatusBar);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CMVisibleChanged(var Message: TMessage);
|
|
begin
|
|
FVisibleChanging := True;
|
|
try
|
|
inherited;
|
|
finally
|
|
FVisibleChanging := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMCancelMode(var Message: TWMCancelMode);
|
|
begin
|
|
if UseSkin then
|
|
RibbonNonClientHelper.CancelMode;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
if UseSkin and (THandle(Message.LParam) <> Handle) then
|
|
begin
|
|
FSizingLoop := False;
|
|
RibbonNonClientHelper.CancelMode;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
|
|
function GetBkgColor: TColor;
|
|
begin
|
|
if FUseSkinColor then
|
|
Result := RibbonNonClientHelper.GetWindowColor
|
|
else
|
|
Result := Color;
|
|
end;
|
|
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if UseSkin and (IsUseAeroNCPaint or not DoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam)) then
|
|
begin
|
|
R := ClientRect;
|
|
//reduce flickering
|
|
if IsUseAeroNCPaint then
|
|
Inc(R.Top, FExtendFrameAtTopHeight);
|
|
if not cxRectIsEmpty(R) then
|
|
FillRectByColor(Message.DC, R, GetBkgColor);
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMLButtonDown(var Message: TWMLButtonDown);
|
|
begin
|
|
if HandleWithHelper(True, mbLeft) then
|
|
UpdateNonClientArea
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMLButtonUp(var Message: TWMLButtonUp);
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
if HandleWithHelper(False, mbLeft) then
|
|
Message.Result := 0
|
|
else
|
|
begin
|
|
RibbonNonClientHelper.CancelMode;
|
|
inherited;
|
|
end;
|
|
end
|
|
else inherited
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMRButtonDown(var Message: TWMRButtonDown);
|
|
begin
|
|
if HandleWithHelper(True, mbRight) then
|
|
Message.Result := 0
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMRButtonUp(var Message: TWMRButtonUp);
|
|
begin
|
|
if HandleWithHelper(False, mbRight) then
|
|
Message.Result := 0
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMNCRButtonUp(var Message: TWMNCRButtonUp);
|
|
begin
|
|
if HandleWithHelper(False, mbRight) then
|
|
Message.Result := 0
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMNCActivate(var Message: TWMNCActivate);
|
|
var
|
|
AFlags: Cardinal;
|
|
begin
|
|
FIsActive := Message.Active;
|
|
if UseSkin then
|
|
begin
|
|
UpdateWindowStates;
|
|
if (FormStyle = fsMDIChild) or IsUseAeroNCPaint then // AB15017 only on XP
|
|
begin // Aero required to call a default method
|
|
AFlags := GetWindowLong(Handle, GWL_STYLE);
|
|
SetWindowLong(Handle, GWL_STYLE, AFlags and not WS_VISIBLE);
|
|
Message.Result := DefWindowProc(Handle, WM_NCACTIVATE, TMessage(Message).WParam, 0);
|
|
SetWindowLong(Handle, GWL_STYLE, AFlags);
|
|
end
|
|
else
|
|
Message.Result := 1; //B20794
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
if not FIsActive then
|
|
RibbonNonClientHelper.CancelMode;
|
|
UpdateNonClientArea
|
|
end;
|
|
if (FormStyle = fsMDIForm) and (ActiveMDIChild <> nil) then
|
|
ActiveMDIChild.Perform(WM_NCACTIVATE, Ord(IsActive), 0);
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
var
|
|
R, SaveR0: TRect;
|
|
T: Integer;
|
|
AIsZoomed: Boolean;
|
|
begin
|
|
if not (UseSkin and Visible and not IsIconic(Handle) and not (csReading in ComponentState)) then
|
|
inherited
|
|
else
|
|
begin
|
|
if Message.CalcValidRects then
|
|
begin
|
|
AIsZoomed := IsZoomed(Handle);
|
|
if IsUseAeroNCPaint then
|
|
begin
|
|
T := Message.CalcSize_Params^.rgrc[0].Top;
|
|
if AIsZoomed and GetWindowRect(Handle, R) and not cxRectIsEqual(R, Message.CalcSize_Params^.rgrc[0]) then
|
|
Realign;
|
|
inherited;
|
|
SaveR0 := Message.CalcSize_Params^.rgrc[0];
|
|
SaveR0.Top := T;
|
|
end
|
|
else
|
|
begin
|
|
R := GetCurrentBordersWidth;
|
|
SaveR0 := Message.CalcSize_Params^.rgrc[0];
|
|
with Message.CalcSize_Params^.rgrc[0] do
|
|
begin
|
|
Inc(SaveR0.Top, R.Top);
|
|
Dec(SaveR0.Bottom, R.Bottom);
|
|
Inc(SaveR0.Left, R.Left);
|
|
Dec(SaveR0.Right, R.Right);
|
|
end;
|
|
end;
|
|
if AIsZoomed then
|
|
begin
|
|
if FormStyle = fsMDIChild then //check for the OS version
|
|
begin
|
|
if IsCompositionEnabled then
|
|
Inc(SaveR0.Top, 2)
|
|
else
|
|
Dec(SaveR0.Top, 2);
|
|
end
|
|
else
|
|
CorrectZoomedBounds(SaveR0);
|
|
end;
|
|
Message.CalcSize_Params^.rgrc[0] := SaveR0;
|
|
end
|
|
else
|
|
inherited;
|
|
Message.Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMNCHitTest(var Message: TWMNCHitTest);
|
|
var
|
|
R: TRect;
|
|
P: TPoint;
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
Message.Result := HTNOWHERE;
|
|
if IsUseAeroNCPaint then
|
|
begin
|
|
CallDWMWindowProc(Message);
|
|
if Message.Result = HTNOWHERE then
|
|
inherited;
|
|
if not ((Message.Result = HTCAPTION) or (Message.Result = HTCLIENT)) then
|
|
Exit;
|
|
Message.Result := HTNOWHERE;
|
|
end;
|
|
GetWindowRect(Handle, R);
|
|
P := cxPoint(Message.XPos - R.Left, Message.YPos - R.Top);
|
|
if (BorderStyle in [bsSizeable, bsSizeToolWin]) then
|
|
CheckResizingNCHitTest(Message.Result, P);
|
|
if (Message.Result = HTNOWHERE) and RibbonNonClientHelper.IsInCaptionArea(Message.XPos, Message.YPos) then
|
|
RibbonNonClientHelper.GetWindowCaptionHitTest(Message);
|
|
if Message.Result = HTNOWHERE then
|
|
Message.Result := HTCLIENT;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMShowWindow(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if WordBool(Message.WParam) and UseSkin and IsNormalWindowState then
|
|
begin
|
|
//for a showing MDIChild on vista without DWM
|
|
//make sure for WM_SIZE & WM_NCCALCSIZE
|
|
SetWindowPos(Handle, 0, 0, 0, Width, Height, SWP_NOZORDER or SWP_NOACTIVATE or
|
|
SWP_NOMOVE or SWP_FRAMECHANGED);
|
|
|
|
RibbonNonClientHelper.InitWindowBorderIcons(GetFormBorderIcons);
|
|
CaptionChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMNCPaint(var Message: TMessage);
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
if IsUseAeroNCPaint then
|
|
inherited;
|
|
DrawNonClientArea(False, Message.WParam);
|
|
Message.Result := 0;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMPaint(var Message: TWMPaint);
|
|
begin
|
|
if UseSkin then
|
|
begin
|
|
UpdateWindowStates;
|
|
if IsUseAeroNCPaint then
|
|
ExcludeRibbonPaintArea(Message.DC);
|
|
inherited;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMSize(var Message: TWMSize);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if UseSkin and not (csReading in ComponentState) then
|
|
begin
|
|
UpdateWindowStates;
|
|
RibbonNonClientHelper.Resize;
|
|
FSizingBorders.cx := GetSystemMetrics(SM_CXSIZEFRAME);
|
|
FSizingBorders.cy := GetSystemMetrics(SM_CYSIZEFRAME);
|
|
if IsUseAeroNCPaint then
|
|
begin
|
|
if Message.SizeType = SIZE_MAXIMIZED then
|
|
SetWindowRgn(Handle, 0, False);
|
|
CheckExtendFrame(Message.SizeType = SIZE_MAXIMIZED);
|
|
end
|
|
else
|
|
begin
|
|
// RibbonNonClientHelper.Resize;
|
|
if Message.SizeType = SIZE_MAXIMIZED then
|
|
begin
|
|
//clip borders
|
|
GetWindowRect(Handle, R);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
with GetDefaultWindowBordersWidth(Handle) do
|
|
R := cxRectInflate(R, -Left, -Top, -Right, -Bottom);
|
|
SetWindowRgn(Handle, CreateRectRgnIndirect(R), True);
|
|
end
|
|
else
|
|
begin
|
|
SetWindowRgn(Handle, RibbonNonClientHelper.GetWindowRegion, True);
|
|
CalculateCornerRegions;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMSysCommand(var Message: TWMSysCommand);
|
|
begin
|
|
if Message.CmdType and $FFF0 = SC_MAXIMIZE then
|
|
CalculateZoomedOffsets;
|
|
inherited;
|
|
if UseSkin then
|
|
begin
|
|
case (Message.CmdType and $FFF0) of
|
|
SC_MAXIMIZE, SC_RESTORE:
|
|
UpdateNonClientArea;
|
|
else
|
|
UpdateWindowStates;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMWindowPosChanged(var Message: TWMWindowPosChanged);
|
|
begin
|
|
UpdateWindowStates;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMDWMCompositionChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if UseSkin then
|
|
begin
|
|
RecreateWnd;
|
|
UpdateNonClientArea;
|
|
InvalidateFrame(Handle);
|
|
Invalidate;
|
|
Message.Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WndProc(var Message: TMessage);
|
|
begin
|
|
if not UseSkin then
|
|
inherited WndProc(Message)
|
|
else
|
|
with Message do
|
|
begin
|
|
case Msg of
|
|
WM_ENTERSIZEMOVE:
|
|
begin
|
|
FSizingLoop := True;
|
|
inherited WndProc(Message);
|
|
end;
|
|
WM_EXITSIZEMOVE:
|
|
begin
|
|
FSizingLoop := False;
|
|
inherited WndProc(Message);
|
|
UpdateNonClientArea;
|
|
end;
|
|
WM_NCUAHDRAWCAPTION,
|
|
WM_NCUAHDRAWFRAME:
|
|
begin
|
|
if IsUseAeroNCPaint then
|
|
CallDWMWindowProc(Message);
|
|
DrawNonClientArea(True);
|
|
Message.Result := 0;
|
|
end;
|
|
WM_MOUSEACTIVATE, WM_SYNCPAINT:
|
|
begin
|
|
inherited WndProc(Message);
|
|
DrawNonClientArea(True);
|
|
end;
|
|
WM_NCLBUTTONDOWN:
|
|
begin
|
|
if not IsUseAeroNCPaint then
|
|
UpdateWindow(Handle);
|
|
inherited WndProc(Message);
|
|
if IsIconic(Handle) then
|
|
begin
|
|
DrawNonClientArea(True);
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
WM_NCMOUSELEAVE:
|
|
begin
|
|
if IsUseAeroNCPaint then
|
|
CallDWMWindowProc(Message)
|
|
else
|
|
inherited;
|
|
end;
|
|
WM_LBUTTONDOWN:
|
|
begin
|
|
//dmAutomatic suppress a dispatching
|
|
if (DragMode = dmAutomatic) and not IsUseAeroNCPaint then
|
|
if HandleWithHelper(True, mbLeft) then
|
|
Exit;
|
|
inherited;
|
|
end;
|
|
else
|
|
if (dxWMGetSkinnedMessage <> 0) and (Msg = dxWMGetSkinnedMessage) then
|
|
begin
|
|
Result := Ord(UseSkin);
|
|
Exit;
|
|
end;
|
|
inherited;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.UpdateWindowStates;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if UseSkin and not (csDestroying in ComponentState) then
|
|
begin
|
|
FillChar(FData, SizeOf(TdxRibbonFormData), 0);
|
|
if HandleAllocated then
|
|
begin
|
|
FData.Handle := Handle;
|
|
if GetWindowRect(Handle, R) then
|
|
OffsetRect(R, -R.Left, -R.Top)
|
|
else
|
|
R := cxEmptyRect;
|
|
FData.Bounds := R;
|
|
if IsIconic(Handle) then
|
|
FData.State := wsMinimized
|
|
else if IsZoomed(Handle) then
|
|
FData.State := wsMaximized
|
|
else
|
|
FData.State := wsNormal;
|
|
end;
|
|
FData.Active := FIsActive;
|
|
FData.Border := BorderStyle;
|
|
FData.Style := FormStyle;
|
|
FData.DontUseAero := DisableAero;
|
|
RibbonNonClientHelper.CheckWindowStates(FData);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.UpdateNonClientArea;
|
|
begin
|
|
UpdateWindowStates;
|
|
if UseSkin and IsWindowVisible(Handle) then
|
|
begin
|
|
DrawNonClientArea(False);
|
|
RibbonNonClientHelper.UpdateNonClientArea;
|
|
end;
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.IsUseAeroNCPaint: Boolean;
|
|
begin
|
|
Result := UseAeroNCPaint(FData);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CheckResizingNCHitTest(var AHitTest: Integer; const P: TPoint);
|
|
const
|
|
CornerHitTests: array[0..3] of DWORD = (HTTOPLEFT, HTTOPRIGHT, HTBOTTOMRIGHT, HTBOTTOMLEFT);
|
|
var
|
|
I: Integer;
|
|
R, RW: TRect;
|
|
begin
|
|
if not IsNormalWindowState then Exit;
|
|
for I := 0 to 3 do
|
|
if PtInRegion(FCornerRegions[I], P.X, P.Y) then
|
|
begin
|
|
AHitTest := CornerHitTests[I];
|
|
Break;
|
|
end;
|
|
if AHitTest = HTNOWHERE then
|
|
begin
|
|
GetWindowRect(Handle, RW);
|
|
OffsetRect(RW, -RW.Left, -RW.Top);
|
|
R := RW;
|
|
R.Bottom := R.Top + FSizingBorders.cy;
|
|
if cxRectPtIn(R, P) then
|
|
AHitTest := HTTOP
|
|
else
|
|
if not IsUseAeroNCPaint then
|
|
begin
|
|
R := RW;
|
|
R.Left := R.Right - FSizingBorders.cx;
|
|
if cxRectPtIn(R, P) then
|
|
AHitTest := HTRIGHT
|
|
else
|
|
begin
|
|
R := RW;
|
|
R.Top := R.Bottom - FSizingBorders.cy;
|
|
if cxRectPtIn(R, P) then
|
|
AHitTest := HTBOTTOM
|
|
else
|
|
begin
|
|
R := RW;
|
|
R.Right := R.Left + FSizingBorders.cx;
|
|
if cxRectPtIn(R, P) then
|
|
AHitTest := HTLEFT;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CreateCornerRegions;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to 3 do
|
|
FCornerRegions[I] := CreateRectRgnIndirect(cxEmptyRect);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.DestroyCornerRegions;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to 3 do
|
|
DeleteObject(FCornerRegions[I]);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.ExcludeRibbonPaintArea(DC: HDC);
|
|
var
|
|
R, CR: HRGN;
|
|
ARibbonRect: TRect;
|
|
begin
|
|
if FExtendFrameAtTopHeight = 0 then Exit;
|
|
R := GetClipRegion(DC);
|
|
ARibbonRect := cxRect(0, 0, ClientWidth, FExtendFrameAtTopHeight);
|
|
CR := CreateRectRgnIndirect(ARibbonRect);
|
|
SelectClipRgn(DC, CR);
|
|
FillRect(DC, ARibbonRect, GetStockObject(BLACK_BRUSH));
|
|
CombineRgn(R, R, CR, RGN_DIFF);
|
|
SelectClipRgn(DC, R);
|
|
DeleteObject(R);
|
|
DeleteObject(CR);
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.ForceUpdateWindowSizeForVista;
|
|
const
|
|
Flags = {SWP_FRAMECHANGED or SWP_NOCOPYBITS or SWP_NOREDRAW or}
|
|
SWP_NOMOVE or SWP_NOZORDER or SWP_NOOWNERZORDER;
|
|
var
|
|
WP: Cardinal;
|
|
begin
|
|
if UseSkin and IsUseAeroNCPaint then
|
|
begin
|
|
WP := BeginDeferWindowPos(2);
|
|
try
|
|
DeferWindowPos(WP, Handle, 0, 0, 0, Width - 1, Height - 1, Flags);
|
|
DeferWindowPos(WP, Handle, 0, 0, 0, Width + 1, Height + 1, Flags);
|
|
finally
|
|
EndDeferWindowPos(WP);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.ExtendFrameIntoClientAreaAtTop(AHeight: Integer);
|
|
var
|
|
M: TdxMargins;
|
|
DC: HDC;
|
|
R: TRect;
|
|
begin
|
|
if FExtendFrameAtTopHeight <> AHeight then
|
|
begin
|
|
if AHeight > FExtendFrameAtTopHeight then
|
|
begin
|
|
R := cxRect(0, FExtendFrameAtTopHeight, Width, AHeight);
|
|
if not FVisibleChanging then
|
|
Inc(R.Left, 100);
|
|
if not cxRectIsEmpty(R) then
|
|
begin
|
|
DC := GetWindowDC(Handle);
|
|
FillRect(DC, R, GetStockObject(BLACK_BRUSH));
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
end;
|
|
FExtendFrameAtTopHeight := AHeight;
|
|
M.cxLeftWidth := 0;
|
|
M.cxRightWidth := 0;
|
|
M.cyBottomHeight := 0;
|
|
M.cyTopHeight := AHeight;
|
|
DwmExtendFrameIntoClientArea(Handle, @M);
|
|
end;
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.GetFormBorderIcons: TBorderIcons;
|
|
var
|
|
ABorderStyle: TFormBorderStyle;
|
|
begin
|
|
ABorderStyle := BorderStyle;
|
|
if (FormStyle = fsMDIChild) and (ABorderStyle in [bsNone, bsDialog]) then
|
|
ABorderStyle := bsSizeable;
|
|
Result := BorderIcons;
|
|
case ABorderStyle of
|
|
bsNone: Result := [];
|
|
bsDialog: Result := (Result * [biSystemMenu, biHelp]) - [biMaximize];
|
|
bsToolWindow,
|
|
bsSizeToolWin: Result := Result * [biSystemMenu];
|
|
end;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.CorrectZoomedBounds(var R: TRect);
|
|
begin
|
|
Inc(R.Left, FZoomedBoundsOffsets.Left);
|
|
Inc(R.Top, FZoomedBoundsOffsets.Top);
|
|
Dec(R.Right, FZoomedBoundsOffsets.Right);
|
|
Dec(R.Bottom, FZoomedBoundsOffsets.Bottom);
|
|
end;
|
|
|
|
function TdxCustomRibbonForm.GetCurrentBordersWidth: TRect;
|
|
begin
|
|
if IsZoomed(Handle) then
|
|
begin
|
|
Result := GetDefaultWindowBordersWidth(Handle);
|
|
if FormStyle = fsMDIChild then
|
|
Result.Top := 0;
|
|
end
|
|
else
|
|
Result := RibbonNonClientHelper.GetWindowBordersWidth;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMGetText(var Message: TWMGetText);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
if (csLoading in ComponentState) or UseSkin then
|
|
begin
|
|
L := Length(FCaption);
|
|
FillChar(Pointer(Message.Text)^, Message.TextMax, #0);
|
|
if Message.TextMax - 1 < L then
|
|
L := Message.TextMax - 1;
|
|
if L > 0 then
|
|
Move(FCaption[1], Pointer(Message.Text)^, L);
|
|
Message.Result := L;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMGetTextLength(var Message: TWMGetTextLength);
|
|
begin
|
|
if (csLoading in ComponentState) or UseSkin then
|
|
Message.Result := Length(FCaption)
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxCustomRibbonForm.WMSetText(var Message: TWMSetText);
|
|
|
|
procedure UpdateMDIForm;
|
|
var
|
|
AForm: TdxCustomRibbonForm;
|
|
begin
|
|
if (FormStyle = fsMDIChild) and IsZoomed(Handle) and
|
|
(Application.MainForm is TdxCustomRibbonForm) then
|
|
begin
|
|
AForm := TdxCustomRibbonForm(Application.MainForm);
|
|
if AForm.UseSkin then
|
|
AForm.CaptionChanged;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (csLoading in ComponentState) or UseSkin then
|
|
begin
|
|
FCaption := Message.Text;
|
|
if UseSkin then
|
|
begin
|
|
CaptionChanged;
|
|
UpdateMDIForm;
|
|
Perform(CM_TEXTCHANGED, 0, 0);
|
|
if GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_APPWINDOW = WS_EX_APPWINDOW then
|
|
SetWindowTextWithoutRedraw(Handle, RibbonNonClientHelper.GetTaskBarCaption);
|
|
end
|
|
else
|
|
begin
|
|
inherited;
|
|
UpdateMDIForm;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
inherited;
|
|
UpdateMDIForm;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
if Win32MajorVersion >= 6 then
|
|
BufferedPaintInit;
|
|
|
|
finalization
|
|
if Win32MajorVersion >= 6 then
|
|
BufferedPaintUnInit;
|
|
|
|
end.
|
|
|