controls.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

    procedure FixupTabList;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetClientOrigin: TPoint; override;
    function GetClientRect: TRect; override;
    function GetControlExtents: TRect; virtual;
    function GetDeviceContext(var WindowHandle: HWnd): HDC; override;
    function GetParentHandle: HWnd;
    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
      MousePos: TPoint; var CanDock: Boolean); dynamic;
    function GetTopParentHandle: HWnd;
    function IsControlMouseMsg(var Message: TWMMouse): Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
    procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;
    procedure KeyPress(var Key: Char); dynamic;
    procedure MainWndProc(var Message: TMessage);
    procedure NotifyControls(Msg: Word);
    procedure PaintControls(DC: HDC; First: TControl);
    procedure PaintHandler(var Message: TWMPaint);
    procedure PaintWindow(DC: HDC); virtual;
    function PaletteChanged(Foreground: Boolean): Boolean; override;
    procedure ReadState(Reader: TReader); override;
    procedure RecreateWnd;
    procedure ReloadDockedControl(const AControlName: string;
      var AControl: TControl); dynamic;
    procedure ResetIme;
    function ResetImeComposition(Action: DWORD): Boolean;
    procedure ScaleControls(M, D: Integer);
    procedure SelectFirst;
    procedure SelectNext(CurControl: TWinControl;
      GoForward, CheckTabStop: Boolean);
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure SetIme;
    function SetImeCompositionWindow(Font: TFont; XPos, YPos: Integer): Boolean;
    procedure SetZOrder(TopMost: Boolean); override;
    procedure ShowControl(AControl: TControl); virtual;
    procedure WndProc(var Message: TMessage); override;
    property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [beLeft, beTop, beRight, beBottom];
    property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised;
    property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered;
    property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone;
    property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
    property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
    property Ctl3D: Boolean read FCtl3D write SetCtl3D stored IsCtl3DStored;
    property DefWndProc: Pointer read FDefWndProc write FDefWndProc;
    property DockSite: Boolean read FDockSite write SetDockSite default False;
    property DockManager: IDockManager read FDockManager write FDockManager;
    property ImeMode: TImeMode read FImeMode write FImeMode default imDontCare;
    property ImeName: TImeName read FImeName write FImeName;
    property ParentCtl3D: Boolean read FParentCtl3D write SetParentCtl3D default True;
    property UseDockManager: Boolean read FUseDockManager write SetUseDockManager
      default False;
    property WindowHandle: HWnd read FHandle write FHandle;
    property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop;
    property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateParented(ParentWindow: HWnd);
    class function CreateParentedControl(ParentWindow: HWnd): TWinControl;
    destructor Destroy; override;
    procedure Broadcast(var Message);
    function CanFocus: Boolean; dynamic;
    function ContainsControl(Control: TControl): Boolean;
    function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
      AllowWinControls: Boolean = False): TControl;
    procedure DefaultHandler(var Message); override;
    procedure DisableAlign;
    property DockClientCount: Integer read GetDockClientCount;
    property DockClients[Index: Integer]: TControl read GetDockClients;
    procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic;
    property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered;
    procedure EnableAlign;
    function FindChildControl(const ControlName: string): TControl;
    procedure FlipChildren(AllLevels: Boolean); dynamic;
    function Focused: Boolean; dynamic;
    procedure GetTabOrderList(List: TList); dynamic;
    function HandleAllocated: Boolean;
    procedure HandleNeeded;
    procedure InsertControl(AControl: TControl);
    procedure Invalidate; override;
    procedure PaintTo(DC: HDC; X, Y: Integer); overload;
    procedure PaintTo(Canvas: TCanvas; X, Y: Integer); overload;
    procedure RemoveControl(AControl: TControl);
    procedure Realign;
    procedure Repaint; override;
    procedure ScaleBy(M, D: Integer);
    procedure ScrollBy(DeltaX, DeltaY: Integer);
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure SetFocus; virtual;
    procedure Update; override;
    procedure UpdateControlState;
    property AlignDisabled: Boolean read GetAlignDisabled;
    property VisibleDockClientCount: Integer read GetVisibleDockClientCount;
    property Brush: TBrush read FBrush;
    property Controls[Index: Integer]: TControl read GetControl;
    property ControlCount: Integer read GetControlCount;
    property Handle: HWnd read GetHandle;
    property ParentWindow: HWnd read FParentWindow write SetParentWindow;
    property Showing: Boolean read FShowing;
    property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
    property TabStop: Boolean read FTabStop write SetTabStop default False;
  published
  end;

  TGraphicControl = class(TControl)
  private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint; virtual;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TCustomControl = class(TWinControl)
  private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint; virtual;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  THintWindow = class(TCustomControl)
  private
    FActivating: Boolean;
    FLastActive: Cardinal;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure NCPaint(DC: HDC); virtual;
    procedure Paint; override;
    procedure WMPrint(var Message: TMessage); message WM_PRINT;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(Rect: TRect; const AHint: string); virtual;
    procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); virtual;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
      AData: Pointer): TRect; virtual;
    function IsHintMsg(var Msg: TMsg): Boolean; virtual;
    procedure ReleaseHandle;
    property BiDiMode;
    property Caption;
    property Color;
    property Canvas;
    property Font;
  end;

  THintWindowClass = class of THintWindow;

{ TDragImageList }

  TDragImageList = class(TCustomImageList)
  private
    FDragCursor: TCursor;
    FDragging: Boolean;
    FDragHandle: HWND;
    FDragHotspot: TPoint;
    FDragIndex: Integer;
    procedure CombineDragCursor;
    procedure SetDragCursor(Value: TCursor);
  protected
    procedure Initialize; override;
  public
    function BeginDrag(Window: HWND; X, Y: Integer): Boolean;
    function DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
    function DragMove(X, Y: Integer): Boolean;
    procedure DragUnlock;
    function EndDrag: Boolean;
    function GetHotSpot: TPoint; override;
    procedure HideDragImage;
    function SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
    procedure ShowDragImage;
    property DragCursor: TCursor read FDragCursor write SetDragCursor;
    property Dragging: Boolean read FDragging;
  end;

{ TImageList }

  TImageList = class(TDragImageList)
  published
    property BlendColor;
    property BkColor;
    property AllocBy;
    property DrawingStyle;
    property Height;
    property ImageType;
    property Masked;
    property OnChange;
    property ShareImages;
    property Width;
  end;

{ TDockZone }

  TDockTree = class;

  // TDockZone encapsulates a region into which other zones are contained.
  // A TDockZone can be a parent to other zones (when FChildZones <> nil) or
  // can contain only a control (when FChildControl <> nil).  A TDockZone also
  // stores pointers to previous and next siblings and its parent.  Parents
  // store a pointer to only the first child in a doubly-linked list of child
  // zones, though each child maintains a pointer to its parent.  Thus, the
  // data structure of relating TDockZones works out to a kind of a
  // doubly-linked list tree.  The FZoneLimit field of TDockZone represents
  // the coordinate of either the left or bottom of the zone, depending on
  // whether its parent zone's orientation is doVertical or doHorizontal.

  TDockZone = class
  private
    FChildControl: TControl;
    FChildZones: TDockZone;
    FNextSibling: TDockZone;
    FOrientation: TDockOrientation;
    FParentZone: TDockZone;
    FPrevSibling: TDockZone;
    FTree: TDockTree;
    FZoneLimit: Integer;
    FOldSize: Integer;
    function GetChildCount: Integer;
    function GetControlName: string;
    function GetLimitBegin: Integer;
    function GetLimitSize: Integer;
    function GetTopLeft(Orient: Integer{TDockOrientation}): Integer;
    function GetHeightWidth(Orient: Integer{TDockOrientation}): Integer;
    function GetVisible: Boolean;
    function GetVisibleChildCount: Integer;
    function GetZoneLimit: Integer;
    function SetControlName(const Value: string): Boolean;
    procedure SetZoneLimit(const Value: Integer);
  public
    constructor Create(Tree: TDockTree);
    procedure ExpandZoneLimit(NewLimit: Integer);
    function FirstVisibleChild: TDockZone;
    function NextVisible: TDockZone;
    function PrevVisible: TDockZone;
    procedure ResetChildren;
    procedure ResetZoneLimits;
    procedure Update;
    property ChildCount: Integer read GetChildCount;
    property Height: Integer index Ord(doHorizontal) read GetHeightWidth;
    property Left: Integer index Ord(doVertical) read GetTopLeft;
    property LimitBegin: Integer read GetLimitBegin;
    property LimitSize: Integer read GetLimitSize;
    property Top: Integer index Ord(doHorizontal) read GetTopLeft;
    property Visible: Boolean read GetVisible;
    property VisibleChildCount: Integer read GetVisibleChildCount;
    property Width: Integer index Ord(doVertical) read GetHeightWidth;
    property ZoneLimit: Integer read GetZoneLimit write SetZoneLimit;
  end;

{ TDockTree }

  TForEachZoneProc = procedure(Zone: TDockZone) of object;

  TDockTreeClass = class of TDockTree;

  // TDockTree serves as a manager for a tree of TDockZones.  It is responsible
  // for inserting and removing controls (and thus zones) from the tree and
  // associated housekeeping, such as orientation, zone limits, parent zone
  // creation, and painting of controls into zone bounds.
  TDockTree = class(TInterfacedObject, IDockManager)
  private
    FBorderWidth: Integer;
    FBrush: TBrush;
    FDockSite: TWinControl;
    FGrabberSize: Integer;
    FGrabbersOnTop: Boolean;
    FOldRect: TRect;
    FOldWndProc: TWndMethod;
    FReplacementZone: TDockZone;
    FScaleBy: Double;
    FShiftScaleOrient: TDockOrientation;
    FShiftBy: Integer;
    FSizePos: TPoint;
    FSizingDC: HDC;
    FSizingWnd: HWND;
    FSizingZone: TDockZone;
    FTopZone: TDockZone;
    FTopXYLimit: Integer;
    FUpdateCount: Integer;
    FVersion: Integer;
    procedur