controls.pas

Delphi DLL Form 与 TDxDockSite

  TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop, dmDragCancel,
    dmFindTarget);

  PDragRec = ^TDragRec;
  TDragRec = record
    Pos: TPoint;
    Source: TDragObject;
    Target: Pointer;
    Docking: Boolean;
  end;

  TCMDrag = packed record
    Msg: Cardinal;
    DragMessage: TDragMessage;
    Reserved1: Byte;
    Reserved2: Word;
    DragRec: PDragRec;
    Result: Longint;
  end;

  TDragDockObject = class;

  TCMDockClient = packed record
    Msg: Cardinal;
    DockSource: TDragDockObject;
    MousePos: TSmallPoint;
    Result: Integer;
  end;

  TCMUnDockClient = packed record
    Msg: Cardinal;
    NewTarget: TControl;
    Client: TControl;
    Result: Integer;
  end;

  TCMFloat = packed record
    Msg: Cardinal;
    Reserved: Integer;
    DockSource: TDragDockObject;
    Result: Integer;
  end;

  PDockNotifyRec = ^TDockNotifyRec;
  TDockNotifyRec = record
    ClientMsg: Cardinal;
    MsgWParam: Integer;
    MsgLParam: Integer;
  end;

  TCMDockNotification = packed record
    Msg: Cardinal;
    Client: TControl;
    NotifyRec: PDockNotifyRec;
    Result: Integer;
  end;

  PPopupFormInfo = ^TPopupFormInfo;
  TPopupFormInfo = record
    PopupID: Integer;
    PopupWnd: HWND;
    IsPopup: Boolean;
  end;

  TCMPopupHWndDestroy = packed record
    Msg: Cardinal;
    PopupFormInfo: PPopupFormInfo;
    PopupControlWnd: HWND;
    Result: Integer;
  end;

  TCMCreatePopup = packed record
    Msg: Cardinal;
    PopupID: Integer;
    OwnerWnd: HWND;
    Result: Integer;
  end;

  TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom);

  TAlignSet = set of TAlign;

{ Dragging objects }

  TDragObject = class(TObject)
  private
    FAlwaysShowDragImages: Boolean;
    FCancelling: Boolean;
    FDragTarget: Pointer;
    FDragHandle: HWND;
    FDragPos: TPoint;
    FDragTargetPos: TPoint;
    FDropped: Boolean;
    FMouseDeltaX: Double;
    FMouseDeltaY: Double;
    FRightClickCancels: Boolean;
    function Capture: HWND;
    procedure ReleaseCapture(Handle: HWND);
  protected
    procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
    function GetDragImages: TDragImageList; virtual;
    procedure WndProc(var Msg: TMessage); virtual;
    procedure MainWndProc(var Message: TMessage);
  public
    procedure AfterConstruction; override;
    procedure Assign(Source: TDragObject); virtual;
    procedure BeforeDestruction; override;
    function GetName: string; virtual;
    procedure HideDragImage; virtual;
    function Instance: THandle; virtual;
    procedure ShowDragImage; virtual;
    property AlwaysShowDragImages: Boolean read FAlwaysShowDragImages write FAlwaysShowDragImages;
    property Cancelling: Boolean read FCancelling write FCancelling;
    property DragHandle: HWND read FDragHandle write FDragHandle;
    property DragPos: TPoint read FDragPos write FDragPos;
    property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
    property DragTarget: Pointer read FDragTarget write FDragTarget;
    property Dropped: Boolean read FDropped;
    property MouseDeltaX: Double read FMouseDeltaX;
    property MouseDeltaY: Double read FMouseDeltaY;
    property RightClickCancels: Boolean read FRightClickCancels write FRightClickCancels;
  end;

  TDragObjectClass = class of TDragObject;
  
  TDragObjectEx = class(TDragObject)
  public
    procedure BeforeDestruction; override;
  end;

  TBaseDragControlObject = class(TDragObject)
  private
    FControl: TControl;
  protected
    procedure EndDrag(Target: TObject; X, Y: Integer); virtual;
    procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); override;
  public
    constructor Create(AControl: TControl); virtual;
    procedure Assign(Source: TDragObject); override;
    property Control: TControl read FControl write FControl;
  end;

  TDragControlObject = class(TBaseDragControlObject)
  protected
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
    function GetDragImages: TDragImageList; override;
  public
    procedure HideDragImage; override;
    procedure ShowDragImage; override;
  end;

  TDragControlObjectEx = class(TDragControlObject)
  public
    procedure BeforeDestruction; override;
  end;

  TDragDockObject = class(TBaseDragControlObject)
  private
    FBrush: TBrush;
    FDockRect: TRect;
    FDropAlign: TAlign;
    FDropOnControl: TControl;
    FEraseDockRect: TRect;
    FFloating: Boolean;
    procedure SetBrush(Value: TBrush);
  protected
    procedure AdjustDockRect(ARect: TRect); virtual;
    procedure DrawDragDockImage; virtual;
    procedure EndDrag(Target: TObject; X, Y: Integer); override;
    procedure EraseDragDockImage; virtual;
    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
    function GetFrameWidth: Integer; virtual;
    function GetEraseWhenMoving: Boolean; virtual;
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;
    procedure Assign(Source: TDragObject); override;
    property Brush: TBrush read FBrush write SetBrush;
    property DockRect: TRect read FDockRect write FDockRect;
    property DropAlign: TAlign read FDropAlign;
    property DropOnControl: TControl read FDropOnControl;
    property EraseDockRect: TRect read FEraseDockRect write FEraseDockRect;
    property EraseWhenMoving: Boolean read GetEraseWhenMoving;
    property Floating: Boolean read FFloating write FFloating;
    property FrameWidth: Integer read GetFrameWidth;
  end;

  TDragDockObjectEx = class(TDragDockObject)
  public
    procedure BeforeDestruction; override;
  end;

{ Controls }

  TControlCanvas = class(TCanvas)
  private
    FControl: TControl;
    FDeviceContext: HDC;
    FWindowHandle: HWnd;
    procedure SetControl(AControl: TControl);
  protected
    procedure CreateHandle; override;
  public
    destructor Destroy; override;
    procedure FreeHandle;
    procedure UpdateTextFlags;
    property Control: TControl read FControl write SetControl;
  end;

{ TControlAction }

  TCustomControlAction = class(TCustomAction)
  private
    FDropdownMenu: TPopupMenu;
    FPopupMenu: TPopupMenu;
    FEnableDropdown: Boolean;
    procedure SetDropdownMenu(Value: TPopupMenu);
    procedure SetEnableDropdown(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
  public
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
    property EnableDropdown: Boolean read FEnableDropdown write SetEnableDropdown default False;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  end;

{ TControlAction }

  TControlAction = class(TCustomControlAction)
  published
    property AutoCheck;
    property Caption;
    property Checked;
    property DropdownMenu;
    property Enabled;
    property EnableDropdown;
    property GroupIndex;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property PopupMenu;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnExecute;
    property OnHint;
    property OnUpdate;
  end;

{ TControlActionLink }

  TControlActionLink = class(TActionLink)
  protected
    FClient: TControl;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsDropdownMenuLinked: Boolean; virtual;
    function IsEnabledLinked: Boolean; override;
    function IsEnableDropdownLinked: Boolean; virtual;
    function IsHelpLinked: Boolean;  override;
    function IsHintLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    function IsPopupMenuLinked: Boolean; virtual;
    function DoShowHint(var HintStr: string): Boolean; virtual;
    procedure SetCaption(const Value: string); override;
    procedure SetDropdownMenu(Value: TPopupMenu); virtual;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetEnableDropdown(Value: Boolean); virtual;
    procedure SetHint(const Value: string); override;
    procedure SetHelpContext(Value: THelpContext); override;
    procedure SetHelpKeyword(const Value: string); override;
    procedure SetHelpType(Value: THelpType); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    procedure SetPopupMenu(Value: TPopupMenu); virtual;
  end;

  TControlActionLinkClass = class of TControlActionLink;

{ TControl }

  TControlState = set of (csLButtonDown, csClicked, csPalette,
    csReadingState, csAlignmentNeeded, csFocusing, csCreating,
    csPaintCopy, csCustomPaint, csDestroyingHandle, csDocking,
    csDesignerHide, csPanning, csRecreating, csAligning);


  { New TControlStyles: csNeedsBorderPaint and csParentBackground.

    These two ControlStyles are only applicable when Themes are Enabled
    in applications on Windows XP. csNeedsBorderPaint causes the
    ThemeServices to paint the border of a control with the current theme.
    csParentBackground causes the parent to draw its background into the
    Control's background; this is useful for controls which need to show their
    parent's theme elements, such as a TPanel or TFrame that appear on a
    TPageControl. TWinControl introduces a protected ParentBackground
    property which includes/excludes the csParentBackground control style.
  }