⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dxribbonformcaptionhelper.pas

📁 胜天进销存源码,国产优秀的进销存
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{*******************************************************************}
{                                                                   }
{       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 dxRibbonFormCaptionHelper;      

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms,
  cxClasses, cxGraphics, cxControls, dxRibbonSkins;

type
  TdxTrackedBorderIcon = (tbiNone, tbiSystemMenu, tbiMinimize, tbiMaximize, tbiHelp);
  TdxBorderIconBounds = array[TBorderIcon] of TRect;
  TdxRibbonFormRegion = (rfrWindow, rfrClient, rfrNCHitTest);

  IdxRibbonFormNonClientPainter = interface
  ['{2F024903-3552-4859-961F-F778ED5E1DB6}']
    procedure DrawRibbonFormCaption(ACanvas: TcxCanvas;
      const ABounds: TRect; const ACaption: string; const AData: TdxRibbonFormData);
    procedure DrawRibbonFormBorders(ACanvas: TcxCanvas;
      const AData: TdxRibbonFormData; const ABordersWidth: TRect);
    procedure DrawRibbonFormBorderIcon(ACanvas: TcxCanvas; const ABounds: TRect;
      AIcon: TdxBorderDrawIcon; AState: TdxBorderIconState);
    function GetRibbonApplicationButtonRegion: HRGN;
    function GetRibbonFormCaptionHeight: Integer;
    function GetRibbonFormColor: TColor;
    function GetRibbonLoadedHeight: Integer;
    function GetTaskBarCaption: TCaption;
    function GetWindowBordersWidth: TRect;
    function HasStatusBar: Boolean;
    procedure RibbonFormCaptionChanged;
    procedure RibbonFormResized;
    procedure UpdateNonClientArea;
  end;

  IdxFormKeyPreviewListener = interface
    ['{7192BF84-F80D-4DB0-A53B-06F6703B1A97}']
    procedure FormKeyDown(var Key: Word; Shift: TShiftState);
  end;

  TdxRibbonFormCaptionHelper = class
  private
    FBitmap: TcxBitmap;
    FBorderIcons: TBorderIcons;
    FBorderIconsArea: TRect;
    FFormCaptionDrawBounds: TRect;
    FFormCaptionRegions: array[TdxRibbonFormRegion] of HRGN;
    FHotBorderIcon: TdxTrackedBorderIcon;
    FIsClientDrawing: Boolean;
    FFormData: TdxRibbonFormData;
    FMouseTimer: TTimer;
    FOldWndProc: TWndMethod;
    FOwner: TcxControl;
    FPressedBorderIcon: TdxTrackedBorderIcon;
    FSysMenuBounds: TRect;
    FWasCapture: Boolean;
    IRibbonFormNonClientDraw: IdxRibbonFormNonClientPainter;
    procedure CalculateFormCaption;
    function CanProcessFormCaptionHitTest(X, Y: Integer): Boolean;
    procedure DestroyCaptionRegions;
    procedure DrawBorderIcons(ACanvas: TcxCanvas);
    procedure ExcludeCaptionRgn(DC: HDC);
    function GetBorderIconState(AIcon: TBorderIcon): TdxBorderIconState;
    function GetButtonFromPos(const P: TPoint): TBorderIcon;
    function GetClientRect: TRect;
    function GetClientCaptionBounds: TRect;
    function GetClientCaptionRegion: HRGN;
    function GetFormCaptionDrawBounds: TRect;
    function GetNCHitTestRegion: HRGN;
    function GetDrawIconFromBorderIcon(AIcon: TBorderIcon): TdxBorderDrawIcon;
    function GetForm: TCustomForm;
    function GetFormCaptionRegionsForDC(DC: HDC; ARegionKind: TdxRibbonFormRegion): HRGN;
    function GetHandle: THandle;
    function GetIsValid: Boolean;
    function IsBorderIconMouseEvent(const P: TPoint; out CP: TPoint;
      ACheckComposition: Boolean = True): Boolean;
    procedure RepaintBorderIcons;
    procedure StartMouseTimer;
    procedure StopMouseTimer;
    function TestWinStyle(AStyle : DWORD) : Boolean;
    procedure MouseTimerHandler(Sender: TObject);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);
    procedure WMNCHitTest(var Message: TWMNCHitTest);
    procedure WMPaint(var Message: TWMPaint);
    procedure WMSize(var Message: TWMSize);
    procedure WMShowWindow(var Message: TMessage);
  protected
    FBorderIconBounds: TdxBorderIconBounds;
    FSysMenuIconBounds: TRect;
    FTextBounds: TRect;
    procedure CalculateBorderIcons; virtual;
    procedure CalculateSysMenuIconBounds; virtual;
    procedure CalculateTextBounds; virtual;
    procedure BufferedDrawCaption(ADestCanvas: TcxCanvas; const ACaption: TCaption);
    procedure DrawWindowBorderIcon(ACanvas: TcxCanvas; const ABounds: TRect;
      AIcon: TBorderIcon; AState: TdxBorderIconState);
    function GetApplicationButtonRegion: HRGN; virtual;
    function GetWindowCaptionBounds: TRect; virtual;
    function GetWindowCaptionRegion: HRGN; virtual;
    function IsRoundedBottomCorners: Boolean;
    procedure OriginalWndProc(var Message);
    procedure WndProc(var Message: TMessage); virtual;

    property Control: TcxControl read FOwner;
    property Form: TCustomForm read GetForm;

    property FormCaptionDrawBounds: TRect read FFormCaptionDrawBounds;
    property FormData: TdxRibbonFormData read FFormData;
    property Handle: THandle read GetHandle;
    property Valid: Boolean read GetIsValid;
  public
    constructor Create(AOwner: TcxControl);
    destructor Destroy; override;
    procedure Calculate;
    procedure CancelMode;
    procedure CaptionChanged;
    procedure CheckWindowStates(const AFormData: TdxRibbonFormData);
    procedure DrawWindowBorders(ACanvas: TcxCanvas);
    procedure DrawWindowCaption(ACanvas: TcxCanvas; const ACaption: TCaption);
    procedure GetDesignInfo(out ALoadedHeight, ACurrentHeight: Integer);
    function GetTaskBarCaption: TCaption; virtual;
    function GetWindowBordersWidth: TRect; virtual;
    function GetWindowCaptionHeight: Integer; virtual;
    procedure GetWindowCaptionHitTest(var Message: TWMNCHitTest); virtual;
    function GetWindowColor: TColor;
    function GetWindowRegion: HRGN; virtual;
    procedure InitWindowBorderIcons(const AIcons: TBorderIcons);
    function IsInCaptionArea(X, Y: Integer): Boolean; virtual;
    function MouseDown(const P: TPoint; AButton: TMouseButton): Boolean; virtual;
    function MouseUp(const P: TPoint; AButton: TMouseButton): Boolean; virtual;
    procedure Resize;
    procedure ShowSystemMenu(const P: TPoint);
    procedure UpdateCaptionArea(ACanvas: TcxCanvas = nil);
    procedure UpdateNonClientArea;

    property SysMenuIconBounds: TRect read FSysMenuIconBounds;
    property TextBounds: TRect read FTextBounds;
  end;

function GetClipRegion(DC: HDC): HRGN;
function GetDefaultWindowBordersWidth(H: THandle): TRect;
function UseAeroNCPaint(const AData: TdxRibbonFormData): Boolean;

implementation

uses
  cxGeometry, Math, cxDWMApi, dxBar;

const
  crClient = True;
  crForm   = False;

  BorderIconsMap: array[TBorderIcon] of TdxTrackedBorderIcon =
    (tbiSystemMenu, tbiMinimize, tbiMaximize, tbiHelp);

  BorderIconOrder: array[TBorderIcon] of TBorderIcon =
    (biSystemMenu, biHelp, biMaximize, biMinimize);

function GetClipRegion(DC: HDC): HRGN;
begin
  Result := CreateRectRgn(0, 0, 0, 0);
  if GetClipRgn(DC, Result) = 0 then
    SetRectRgn(Result, 0, 0, 30000, 30000);
end;

function GetDefaultWindowBordersWidth(H: THandle): TRect;
var
  SizeParams: TNCCalcSizeParams;
  WP: TWindowPos;
begin
  if IsIconic(H) then
  begin
    Result := cxEmptyRect;
    Exit;
  end;
  SizeParams.rgrc[0] := cxRect(0, 0, 500, 500);
  SizeParams.rgrc[1] := cxNullRect;
  SizeParams.rgrc[2] := cxNullRect;
  SizeParams.lppos := @WP;
  WP.hwnd := H;
  WP.hwndInsertAfter := 0;
  WP.x  := 0;
  WP.y  := 0;
  WP.cx := 0;
  WP.cy := 0;
  WP.flags := SWP_NOACTIVATE or SWP_NOCOPYBITS or SWP_NOMOVE or SWP_NOOWNERZORDER or
    SWP_NOREDRAW or SWP_NOSENDCHANGING or SWP_NOSIZE or SWP_NOZORDER;
  DefWindowProc(H, WM_NCCALCSIZE, 1, Integer(@SizeParams));
  with SizeParams.rgrc[0] do
    Result := cxRect(Left, Top - GetSystemMetrics(SM_CYCAPTION), 500 - Right, 500 - Bottom);
end;

function UseAeroNCPaint(const AData: TdxRibbonFormData): Boolean;
begin
  Result := not AData.DontUseAero and (AData.Style <> fsMDIChild) and
    (AData.Handle <> 0) and IsCompositionEnabled;
end;

{ TdxRibbonFormCaptionHelper }

constructor TdxRibbonFormCaptionHelper.Create(AOwner: TcxControl);
begin
  inherited Create;
  Supports(TObject(AOwner), IdxRibbonFormNonClientPainter, IRibbonFormNonClientDraw);
  FOwner := AOwner;
  FBitmap := TcxBitmap.Create;
  FOldWndProc := Control.WindowProc;
  Control.WindowProc := WndProc;
end;

destructor TdxRibbonFormCaptionHelper.Destroy;
begin
  StopMouseTimer;
  Control.WindowProc := FOldWndProc;
  DestroyCaptionRegions;
  FBitmap.Free;
  inherited Destroy;
end;

procedure TdxRibbonFormCaptionHelper.Calculate;
begin
  CalculateFormCaption;
  CalculateBorderIcons;
  CalculateSysMenuIconBounds;
  CalculateTextBounds;
end;

procedure TdxRibbonFormCaptionHelper.CancelMode;
begin
  FWasCapture := False;
  if FPressedBorderIcon <> tbiNone then
  begin
    FPressedBorderIcon := tbiNone;
    RepaintBorderIcons;
  end;
end;

procedure TdxRibbonFormCaptionHelper.CaptionChanged;
begin
  IRibbonFormNonClientDraw.RibbonFormCaptionChanged;
end;

procedure TdxRibbonFormCaptionHelper.CheckWindowStates(
  const AFormData: TdxRibbonFormData);
begin
  if not CompareMem(@AFormData, @FFormData, SizeOf(TdxRibbonFormData)) then
  begin
    FFormData := AFormData;
    if FFormData.Handle <> 0 then
      Calculate;
  end;
end;

procedure TdxRibbonFormCaptionHelper.DrawWindowBorderIcon(ACanvas: TcxCanvas;
  const ABounds: TRect; AIcon: TBorderIcon; AState: TdxBorderIconState);
begin
  IRibbonFormNonClientDraw.DrawRibbonFormBorderIcon(ACanvas, ABounds,
    GetDrawIconFromBorderIcon(AIcon), AState);
end;

function TdxRibbonFormCaptionHelper.GetTaskBarCaption: TCaption;
begin
  Result := IRibbonFormNonClientDraw.GetTaskBarCaption;
end;

function TdxRibbonFormCaptionHelper.GetWindowBordersWidth: TRect;
begin
  Result := IRibbonFormNonClientDraw.GetWindowBordersWidth;
end;

procedure TdxRibbonFormCaptionHelper.GetWindowCaptionHitTest(var Message: TWMNCHitTest);
var
  I: TBorderIcon;
  P: TPoint;
begin
  Message.Result := HTCAPTION;
  P := Control.ScreenToClient(cxPoint(Message.XPos, Message.YPos));
  if cxRectPtIn(FBorderIconsArea, P) then
  begin
    StartMouseTimer;
    for I := Low(TBorderIcon) to High(TBorderIcon) do
      if (I in FBorderIcons) and cxRectPtIn(FBorderIconBounds[I], P) then
      begin
        if FHotBorderIcon <> BorderIconsMap[I] then
        begin
          FHotBorderIcon := BorderIconsMap[I];
          RepaintBorderIcons;
        end;
        Message.Result := HTNOWHERE;
        Exit;
      end;
  end;
  if cxRectPtIn(FSysMenuBounds, P) then
    Message.Result := HTSYSMENU;
  if FHotBorderIcon <> tbiNone then
  begin
    FHotBorderIcon := tbiNone;
    RepaintBorderIcons;
  end;
end;

function TdxRibbonFormCaptionHelper.GetWindowColor: TColor;
var
  AForm: TCustomForm;
begin
  if IRibbonFormNonClientDraw <> nil then
    Result := IRibbonFormNonClientDraw.GetRibbonFormColor
  else
  begin
    AForm := Form;
    if AForm <> nil then
      Result := AForm.Color
    else
      Result := clBtnFace;
  end;
end;

function TdxRibbonFormCaptionHelper.GetWindowRegion: HRGN;
const
  Radius = 9;
var
  F: TCustomForm;
  R: HRGN;
  RW: TRect;
  AWidth, AHeight: Integer;
begin
  Result := 0;
  F := Form;
  if (F = nil) or not F.HandleAllocated or not GetWindowRect(F.Handle, RW) then Exit;
  AWidth  := RW.Right  - RW.Left;
  AHeight := RW.Bottom - RW.Top;
  if not IsRoundedBottomCorners then
  begin
    Result := CreateRoundRectRgn(0, 0, AWidth + 1, Radius * 2, Radius, Radius);
    R := CreateRectRgn(0, Radius, AWidth + 1, AHeight + 1);
    CombineRgn(Result, Result, R, RGN_OR);
    DeleteObject(R);
  end
  else
    Result := CreateRoundRectRgn(0, 0, AWidth + 1, AHeight + 1, Radius, Radius);
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -