home *** CD-ROM | disk | FTP | other *** search
Text File | 1999-08-11 | 41.7 KB | 1,132 lines |
-
- {*******************************************************}
- { }
- { Borland Delphi Visual Component Library }
- { }
- { Copyright (c) 1995,99 Inprise Corporation }
- { }
- {*******************************************************}
-
- unit Controls;
-
- {$P+,S-,W-,R-,T-,H+,X+}
- {$C PRELOAD}
-
- interface
-
- {$R CONTROLS}
-
- { CommCtrl.hpp is not required in Controls.hpp }
- (*$NOINCLUDE CommCtrl *)
- uses Messages, Windows, MultiMon, Classes, Sysutils, Graphics, Menus, CommCtrl, Imm,
- ImgList, ActnList;
-
- { VCL control message IDs }
-
- const
- CM_BASE = $B000;
- CM_ACTIVATE = CM_BASE + 0;
- CM_DEACTIVATE = CM_BASE + 1;
- CM_GOTFOCUS = CM_BASE + 2;
- CM_LOSTFOCUS = CM_BASE + 3;
- CM_CANCELMODE = CM_BASE + 4;
- CM_DIALOGKEY = CM_BASE + 5;
- CM_DIALOGCHAR = CM_BASE + 6;
- CM_FOCUSCHANGED = CM_BASE + 7;
- CM_PARENTFONTCHANGED = CM_BASE + 8;
- CM_PARENTCOLORCHANGED = CM_BASE + 9;
- CM_HITTEST = CM_BASE + 10;
- CM_VISIBLECHANGED = CM_BASE + 11;
- CM_ENABLEDCHANGED = CM_BASE + 12;
- CM_COLORCHANGED = CM_BASE + 13;
- CM_FONTCHANGED = CM_BASE + 14;
- CM_CURSORCHANGED = CM_BASE + 15;
- CM_CTL3DCHANGED = CM_BASE + 16;
- CM_PARENTCTL3DCHANGED = CM_BASE + 17;
- CM_TEXTCHANGED = CM_BASE + 18;
- CM_MOUSEENTER = CM_BASE + 19;
- CM_MOUSELEAVE = CM_BASE + 20;
- CM_MENUCHANGED = CM_BASE + 21;
- CM_APPKEYDOWN = CM_BASE + 22;
- CM_APPSYSCOMMAND = CM_BASE + 23;
- CM_BUTTONPRESSED = CM_BASE + 24;
- CM_SHOWINGCHANGED = CM_BASE + 25;
- CM_ENTER = CM_BASE + 26;
- CM_EXIT = CM_BASE + 27;
- CM_DESIGNHITTEST = CM_BASE + 28;
- CM_ICONCHANGED = CM_BASE + 29;
- CM_WANTSPECIALKEY = CM_BASE + 30;
- CM_INVOKEHELP = CM_BASE + 31;
- CM_WINDOWHOOK = CM_BASE + 32;
- CM_RELEASE = CM_BASE + 33;
- CM_SHOWHINTCHANGED = CM_BASE + 34;
- CM_PARENTSHOWHINTCHANGED = CM_BASE + 35;
- CM_SYSCOLORCHANGE = CM_BASE + 36;
- CM_WININICHANGE = CM_BASE + 37;
- CM_FONTCHANGE = CM_BASE + 38;
- CM_TIMECHANGE = CM_BASE + 39;
- CM_TABSTOPCHANGED = CM_BASE + 40;
- CM_UIACTIVATE = CM_BASE + 41;
- CM_UIDEACTIVATE = CM_BASE + 42;
- CM_DOCWINDOWACTIVATE = CM_BASE + 43;
- CM_CONTROLLISTCHANGE = CM_BASE + 44;
- CM_GETDATALINK = CM_BASE + 45;
- CM_CHILDKEY = CM_BASE + 46;
- CM_DRAG = CM_BASE + 47;
- CM_HINTSHOW = CM_BASE + 48;
- CM_DIALOGHANDLE = CM_BASE + 49;
- CM_ISTOOLCONTROL = CM_BASE + 50;
- CM_RECREATEWND = CM_BASE + 51;
- CM_INVALIDATE = CM_BASE + 52;
- CM_SYSFONTCHANGED = CM_BASE + 53;
- CM_CONTROLCHANGE = CM_BASE + 54;
- CM_CHANGED = CM_BASE + 55;
- CM_DOCKCLIENT = CM_BASE + 56;
- CM_UNDOCKCLIENT = CM_BASE + 57;
- CM_FLOAT = CM_BASE + 58;
- CM_BORDERCHANGED = CM_BASE + 59;
- CM_BIDIMODECHANGED = CM_BASE + 60;
- CM_PARENTBIDIMODECHANGED = CM_BASE + 61;
- CM_ALLCHILDRENFLIPPED = CM_BASE + 62;
- CM_ACTIONUPDATE = CM_BASE + 63;
- CM_ACTIONEXECUTE = CM_BASE + 64;
- CM_HINTSHOWPAUSE = CM_BASE + 65;
- CM_DOCKNOTIFICATION = CM_BASE + 66;
- CM_MOUSEWHEEL = CM_BASE + 67;
-
- { VCL control notification IDs }
-
- const
- CN_BASE = $BC00;
- CN_CHARTOITEM = CN_BASE + WM_CHARTOITEM;
- CN_COMMAND = CN_BASE + WM_COMMAND;
- CN_COMPAREITEM = CN_BASE + WM_COMPAREITEM;
- CN_CTLCOLORBTN = CN_BASE + WM_CTLCOLORBTN;
- CN_CTLCOLORDLG = CN_BASE + WM_CTLCOLORDLG;
- CN_CTLCOLOREDIT = CN_BASE + WM_CTLCOLOREDIT;
- CN_CTLCOLORLISTBOX = CN_BASE + WM_CTLCOLORLISTBOX;
- CN_CTLCOLORMSGBOX = CN_BASE + WM_CTLCOLORMSGBOX;
- CN_CTLCOLORSCROLLBAR = CN_BASE + WM_CTLCOLORSCROLLBAR;
- CN_CTLCOLORSTATIC = CN_BASE + WM_CTLCOLORSTATIC;
- CN_DELETEITEM = CN_BASE + WM_DELETEITEM;
- CN_DRAWITEM = CN_BASE + WM_DRAWITEM;
- CN_HSCROLL = CN_BASE + WM_HSCROLL;
- CN_MEASUREITEM = CN_BASE + WM_MEASUREITEM;
- CN_PARENTNOTIFY = CN_BASE + WM_PARENTNOTIFY;
- CN_VKEYTOITEM = CN_BASE + WM_VKEYTOITEM;
- CN_VSCROLL = CN_BASE + WM_VSCROLL;
- CN_KEYDOWN = CN_BASE + WM_KEYDOWN;
- CN_KEYUP = CN_BASE + WM_KEYUP;
- CN_CHAR = CN_BASE + WM_CHAR;
- CN_SYSKEYDOWN = CN_BASE + WM_SYSKEYDOWN;
- CN_SYSCHAR = CN_BASE + WM_SYSCHAR;
- CN_NOTIFY = CN_BASE + WM_NOTIFY;
-
- { TModalResult values }
-
- const
- mrNone = 0;
- mrOk = idOk;
- mrCancel = idCancel;
- mrAbort = idAbort;
- mrRetry = idRetry;
- mrIgnore = idIgnore;
- mrYes = idYes;
- mrNo = idNo;
- mrAll = mrNo + 1;
- mrNoToAll = mrAll + 1;
- mrYesToAll = mrNoToAll + 1;
-
- { Cursor identifiers }
-
- type
- TCursor = -32768..32767;
- {$NODEFINE TCursor}
-
- (*$HPPEMIT 'namespace Controls'}*)
- (*$HPPEMIT '{'}*)
- (*$HPPEMIT '#pragma option -b-'*)
- (*$HPPEMIT ' enum TCursor {crMin=-32768, crMax=32767};'}*)
- (*$HPPEMIT '#pragma option -b.'*)
- (*$HPPEMIT '}'*)
-
- const
- crDefault = TCursor(0);
- crNone = TCursor(-1);
- crArrow = TCursor(-2);
- crCross = TCursor(-3);
- crIBeam = TCursor(-4);
- crSize = TCursor(-22);
- crSizeNESW = TCursor(-6);
- crSizeNS = TCursor(-7);
- crSizeNWSE = TCursor(-8);
- crSizeWE = TCursor(-9);
- crUpArrow = TCursor(-10);
- crHourGlass = TCursor(-11);
- crDrag = TCursor(-12);
- crNoDrop = TCursor(-13);
- crHSplit = TCursor(-14);
- crVSplit = TCursor(-15);
- crMultiDrag = TCursor(-16);
- crSQLWait = TCursor(-17);
- crNo = TCursor(-18);
- crAppStart = TCursor(-19);
- crHelp = TCursor(-20);
- crHandPoint = TCursor(-21);
- crSizeAll = TCursor(-22);
-
- type
-
- { Forward declarations }
-
- TDragObject = class;
- TControl = class;
- TWinControl = class;
- TDragImageList = class;
-
- TWinControlClass = class of TWinControl;
-
- { VCL control message records }
-
- TCMActivate = TWMNoParams;
- TCMDeactivate = TWMNoParams;
- TCMGotFocus = TWMNoParams;
- TCMLostFocus = TWMNoParams;
- TCMDialogKey = TWMKey;
- TCMDialogChar = TWMKey;
- TCMHitTest = TWMNCHitTest;
- TCMEnter = TWMNoParams;
- TCMExit = TWMNoParams;
- TCMDesignHitTest = TWMMouse;
- TCMWantSpecialKey = TWMKey;
-
- TCMMouseWheel = record
- Msg: Cardinal;
- ShiftState: TShiftState;
- Unused: Byte;
- WheelDelta: SmallInt;
- case Integer of
- 0: (
- XPos: Smallint;
- YPos: Smallint);
- 1: (
- Pos: TSmallPoint;
- Result: Longint);
- end;
-
- TCMCancelMode = record
- Msg: Cardinal;
- Unused: Integer;
- Sender: TControl;
- Result: Longint;
- end;
-
- TCMFocusChanged = record
- Msg: Cardinal;
- Unused: Integer;
- Sender: TWinControl;
- Result: Longint;
- end;
-
- TCMControlListChange = record
- Msg: Cardinal;
- Control: TControl;
- Inserting: LongBool;
- Result: Longint;
- end;
-
- TCMChildKey = record
- Msg: Cardinal;
- CharCode: Word;
- Unused: Word;
- Sender: TWinControl;
- Result: Longint;
- end;
-
- TCMControlChange = record
- Msg: Cardinal;
- Control: TControl;
- Inserting: LongBool;
- Result: Longint;
- end;
-
- TCMChanged = record
- Msg: Cardinal;
- Unused: Longint;
- Child: TControl;
- Result: Longint;
- end;
-
- 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;
-
- TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient);
-
- TAlignSet = set of TAlign;
-
- { Dragging objects }
-
- TDragObject = class(TObject)
- protected
- procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
- function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
- function GetDragImages: TDragImageList; virtual;
- public
- procedure Assign(Source: TDragObject); virtual;
- function GetName: string; virtual;
- procedure HideDragImage; virtual;
- function Instance: THandle; virtual;
- procedure ShowDragImage; virtual;
- property Cancelling: Boolean;
- property DragHandle: HWND;
- property DragPos: TPoint;
- property DragTargetPos: TPoint;
- property DragTarget: Pointer;
- property MouseDeltaX: Double;
- property MouseDeltaY: Double;
- end;
-
- TBaseDragControlObject = class(TDragObject)
- 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;
- 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;
-
- TDragDockObject = class(TBaseDragControlObject)
- 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;
- public
- constructor Create(AControl: TControl); override;
- destructor Destroy; override;
- procedure Assign(Source: TDragObject); override;
- property Brush: TBrush;
- property DockRect: TRect;
- property DropAlign: TAlign;
- property DropOnControl: TControl;
- property Floating: Boolean;
- property FrameWidth: Integer;
- end;
-
- { Controls }
-
- TControlCanvas = class(TCanvas)
- protected
- procedure CreateHandle; override;
- public
- destructor Destroy; override;
- procedure FreeHandle;
- procedure UpdateTextFlags;
- property Control: TControl;
- end;
-
- { TControlActionLink }
-
- TControlActionLink = class(TActionLink)
- protected
- FClient: TControl;
- procedure AssignClient(AClient: TObject); override;
- function IsCaptionLinked: Boolean; override;
- function IsEnabledLinked: Boolean; override;
- function IsHintLinked: Boolean; override;
- function IsVisibleLinked: Boolean; override;
- function IsOnExecuteLinked: Boolean; override;
- function DoShowHint(var HintStr: string): Boolean; virtual;
- procedure SetCaption(const Value: string); override;
- procedure SetEnabled(Value: Boolean); override;
- procedure SetHint(const Value: string); override;
- procedure SetVisible(Value: Boolean); override;
- procedure SetOnExecute(Value: TNotifyEvent); override;
- end;
-
- TControlActionLinkClass = class of TControlActionLink;
-
- { TControl }
-
- TControlState = set of (csLButtonDown, csClicked, csPalette,
- csReadingState, csAlignmentNeeded, csFocusing, csCreating,
- csPaintCopy, csCustomPaint, csDestroyingHandle, csDocking);
-
- TControlStyle = set of (csAcceptsControls, csCaptureMouse,
- csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
- csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible,
- csReplicatable, csNoStdEvents, csDisplayDragImage, csReflector,
- csActionClient, csMenuEvents);
-
- TMouseButton = (mbLeft, mbRight, mbMiddle);
-
- TDragMode = (dmManual, dmAutomatic);
-
- TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
-
- TDragKind = (dkDrag, dkDock);
-
- TTabOrder = -1..32767;
-
- TCaption = type string;
-
- TDate = type TDateTime;
-
- TTime = type TDateTime;
- {$EXTERNALSYM TDate}
- {$EXTERNALSYM TTime}
- (*$HPPEMIT 'namespace Controls'*)
- (*$HPPEMIT '{'*)
- (*$HPPEMIT ' typedef System::TDateTime TDate;'*)
- (*$HPPEMIT ' typedef System::TDateTime TTime;'*)
- (*$HPPEMIT '}'*)
-
-
- TScalingFlags = set of (sfLeft, sfTop, sfWidth, sfHeight, sfFont);
-
- TAnchorKind = (akLeft, akTop, akRight, akBottom);
- TAnchors = set of TAnchorKind;
-
- TConstraintSize = 0..MaxInt;
-
- TSizeConstraints = class(TPersistent)
- protected
- procedure Change; dynamic;
- procedure AssignTo(Dest: TPersistent); override;
- property Control: TControl;
- public
- constructor Create(Control: TControl); virtual;
- property OnChange: TNotifyEvent;
- published
- property MaxHeight: TConstraintSize index 0 default 0;
- property MaxWidth: TConstraintSize index 1 default 0;
- property MinHeight: TConstraintSize index 2 default 0;
- property MinWidth: TConstraintSize index 3 default 0;
- end;
-
- TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer) of object;
- TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
- X, Y: Integer) of object;
- TKeyEvent = procedure(Sender: TObject; var Key: Word;
- Shift: TShiftState) of object;
- TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of object;
- TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean) of object;
- TDragDropEvent = procedure(Sender, Source: TObject;
- X, Y: Integer) of object;
- TStartDragEvent = procedure(Sender: TObject;
- var DragObject: TDragObject) of object;
- TEndDragEvent = procedure(Sender, Target: TObject;
- X, Y: Integer) of object;
- TDockDropEvent = procedure(Sender: TObject; Source: TDragDockObject;
- X, Y: Integer) of object;
- TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject;
- X, Y: Integer; State: TDragState; var Accept: Boolean) of object;
- TUnDockEvent = procedure(Sender: TObject; Client: TControl;
- NewTarget: TWinControl; var Allow: Boolean) of object;
- TStartDockEvent = procedure(Sender: TObject;
- var DragObject: TDragDockObject) of object;
- TGetSiteInfoEvent = procedure(Sender: TObject; DockClient: TControl;
- var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean) of object;
- TCanResizeEvent = procedure(Sender: TObject; var NewWidth, NewHeight: Integer;
- var Resize: Boolean) of object;
- TConstrainedResizeEvent = procedure(Sender: TObject; var MinWidth, MinHeight,
- MaxWidth, MaxHeight: Integer) of object;
- TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of object;
- TMouseWheelUpDownEvent = procedure(Sender: TObject; Shift: TShiftState;
- MousePos: TPoint; var Handled: Boolean) of object;
- TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint; var Handled: Boolean) of object;
-
- TWndMethod = procedure(var Message: TMessage) of object;
-
- // TDockOrientation indicates how a zone's child zones are arranged.
- // doNoOrient means a zone contains a TControl and not child zones.
- // doHorizontal means a zone's children are stacked top-to-bottom.
- // doVertical means a zone's children are arranged left-to-right.
- TDockOrientation = (doNoOrient, doHorizontal, doVertical);
-
- TControl = class(TComponent)
- protected
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
- procedure AdjustSize; dynamic;
- procedure AssignTo(Dest: TPersistent); override;
- procedure BeginAutoDrag; dynamic;
- function CanResize(var NewWidth, NewHeight: Integer): Boolean; virtual;
- function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
- procedure Changed;
- procedure ChangeScale(M, D: Integer); dynamic;
- procedure Click; dynamic;
- procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); virtual;
- procedure DblClick; dynamic;
- procedure DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean); dynamic;
- procedure DefineProperties(Filer: TFiler); override;
- procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); dynamic;
- procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); dynamic;
- procedure DoEndDock(Target: TObject; X, Y: Integer); dynamic;
- procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); dynamic;
- procedure DoStartDock(var DragObject: TDragObject); dynamic;
- procedure DragCanceled; dynamic;
- procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
- var Accept: Boolean); dynamic;
- procedure DoEndDrag(Target: TObject; X, Y: Integer); dynamic;
- procedure DoStartDrag(var DragObject: TDragObject); dynamic;
- procedure DrawDragDockImage(DragDockObject: TDragDockObject); dynamic;
- procedure EraseDragDockImage(DragDockObject: TDragDockObject); dynamic;
- function GetActionLinkClass: TControlActionLinkClass; dynamic;
- function GetClientOrigin: TPoint; virtual;
- function GetClientRect: TRect; virtual;
- function GetDeviceContext(var WindowHandle: HWnd): HDC; virtual;
- function GetDockEdge(MousePos: TPoint): TAlign; dynamic;
- function GetDragImages: TDragImageList; virtual;
- function GetEnabled: Boolean; virtual;
- function GetFloating: Boolean; virtual;
- function GetFloatingDockSiteClass: TWinControlClass; virtual;
- function GetPalette: HPALETTE; dynamic;
- function GetPopupMenu: TPopupMenu; dynamic;
- procedure Loaded; override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); dynamic;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); dynamic;
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- procedure PositionDockRect(DragDockObject: TDragDockObject); dynamic;
- function PaletteChanged(Foreground: Boolean): Boolean; dynamic;
- procedure ReadState(Reader: TReader); override;
- procedure RequestAlign; dynamic;
- procedure Resize; dynamic;
- procedure SendCancelMode(Sender: TControl);
- procedure SendDockNotification(Msg: Cardinal; WParam, LParam: Integer);
- procedure SetDragMode(Value: TDragMode); virtual;
- procedure SetEnabled(Value: Boolean); virtual;
- procedure SetName(const Value: TComponentName); override;
- procedure SetParent(AParent: TWinControl); virtual;
- procedure SetParentComponent(Value: TComponent); override;
- procedure SetParentBiDiMode(Value: Boolean); virtual;
- procedure SetBiDiMode(Value: TBiDiMode); virtual;
- procedure SetZOrder(TopMost: Boolean); dynamic;
- procedure UpdateBoundsRect(const R: TRect);
- procedure VisibleChanging; dynamic;
- procedure WndProc(var Message: TMessage); virtual;
- property ActionLink: TControlActionLink;
- property AutoSize: Boolean default False;
- property Caption: TCaption;
- property Color: TColor default clWindow;
- property DesktopFont: Boolean default False;
- property DragKind: TDragKind default dkDrag;
- property DragCursor: TCursor default crDrag;
- property DragMode: TDragMode default dmManual;
- property Font: TFont;
- property IsControl: Boolean;
- property MouseCapture: Boolean;
- property ParentBiDiMode: Boolean default True;
- property ParentColor: Boolean default True;
- property ParentFont: Boolean default True;
- property ParentShowHint: Boolean default True;
- property PopupMenu: TPopupMenu;
- property ScalingFlags: TScalingFlags;
- property Text: TCaption;
- property WindowText: PChar;
- property OnCanResize: TCanResizeEvent;
- property OnClick: TNotifyEvent;
- property OnConstrainedResize: TConstrainedResizeEvent;
- property OnContextPopup: TContextPopupEvent;
- property OnDblClick: TNotifyEvent;
- property OnDragDrop: TDragDropEvent;
- property OnDragOver: TDragOverEvent;
- property OnEndDock: TEndDragEvent;
- property OnEndDrag: TEndDragEvent;
- property OnMouseDown: TMouseEvent;
- property OnMouseMove: TMouseMoveEvent;
- property OnMouseUp: TMouseEvent;
- property OnResize: TNotifyEvent;
- property OnStartDock: TStartDockEvent;
- property OnStartDrag: TStartDragEvent;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);
- procedure BringToFront;
- function ClientToScreen(const Point: TPoint): TPoint;
- procedure Dock(NewDockSite: TWinControl; ARect: TRect); dynamic;
- procedure DefaultHandler(var Message); override;
- function Dragging: Boolean;
- procedure DragDrop(Source: TObject; X, Y: Integer); dynamic;
- function DrawTextBiDiModeFlags(Flags: Longint): Longint;
- function DrawTextBiDiModeFlagsReadingOnly: Longint;
- property Enabled: Boolean default True;
- procedure EndDrag(Drop: Boolean);
- function GetControlsAlignment: TAlignment; dynamic;
- function GetParentComponent: TComponent; override;
- function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
- function GetTextLen: Integer;
- function HasParent: Boolean; override;
- procedure Hide;
- procedure InitiateAction; virtual;
- procedure Invalidate; virtual;
- function IsRightToLeft: Boolean;
- function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil;
- ControlSide: TAlign = alNone): Boolean;
- function ManualFloat(ScreenPos: TRect): Boolean;
- function Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
- procedure Refresh;
- procedure Repaint; virtual;
- function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl;
- DropControl: TControl; ControlSide: TAlign): Boolean;
- function ScreenToClient(const Point: TPoint): TPoint;
- procedure SendToBack;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
- procedure SetTextBuf(Buffer: PChar);
- procedure Show;
- procedure Update; virtual;
- function UseRightToLeftAlignment: Boolean; dynamic;
- function UseRightToLeftReading: Boolean;
- function UseRightToLeftScrollBar: Boolean;
- property Action: TBasicAction;
- property Align: TAlign default alNone;
- property Anchors: TAnchors default [akLeft, akTop];
- property BiDiMode: TBiDiMode;
- property BoundsRect: TRect;
- property ClientHeight: Integer;
- property ClientOrigin: TPoint;
- property ClientRect: TRect;
- property ClientWidth: Integer;
- property Constraints: TSizeConstraints;
- property ControlState: TControlState;
- property ControlStyle: TControlStyle;
- property DockOrientation: TDockOrientation;
- property Floating: Boolean;
- property FloatingDockSiteClass: TWinControlClass;
- property HostDockSite: TWinControl;
- property LRDockWidth: Integer;
- property Parent: TWinControl;
- property ShowHint: Boolean;
- property TBDockHeight: Integer;
- property UndockHeight: Integer;
- property UndockWidth: Integer;
- property Visible: Boolean default True;
- property WindowProc: TWndMethod;
- published
- property Left: Integer;
- property Top: Integer;
- property Width: Integer;
- property Height: Integer;
- property Cursor: TCursor default crDefault;
- property Hint: string;
- end;
-
- TControlClass = class of TControl;
-
- TCreateParams = record
- Caption: PChar;
- Style: DWORD;
- ExStyle: DWORD;
- X, Y: Integer;
- Width, Height: Integer;
- WndParent: HWnd;
- Param: Pointer;
- WindowClass: TWndClass;
- WinClassName: array[0..63] of Char;
- end;
-
- { TWinControlActionLink }
-
- TWinControlActionLink = class(TControlActionLink)
- protected
- FClient: TWinControl;
- procedure AssignClient(AClient: TObject); override;
- function IsHelpContextLinked: Boolean; override;
- procedure SetHelpContext(Value: THelpContext); override;
- end;
-
- TWinControlActionLinkClass = class of TWinControlActionLink;
-
- { TWinControl }
-
- TImeMode = (imDisable, imClose, imOpen, imDontCare,
- imSAlpha, imAlpha, imHira, imSKata, imKata,
- imChinese, imSHanguel, imHanguel);
- TImeName = type string;
-
- TBorderWidth = 0..MaxInt;
-
- TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace);
- TBevelEdge = (beLeft, beTop, beRight, beBottom);
- TBevelEdges = set of TBevelEdge;
- TBevelKind = (bkNone, bkTile, bkSoft, bkFlat);
- TBevelWidth = 1..MaxInt;
-
- // IDockManager defines an interface for managing a dock site's docked
- // controls. The default VCL implementation of IDockManager is TDockTree.
- IDockManager = interface
- ['{8619FD79-C281-11D1-AA60-00C04FA370E8}']
- procedure BeginUpdate;
- procedure EndUpdate;
- procedure GetControlBounds(Control: TControl; out CtlBounds: TRect);
- procedure InsertControl(Control: TControl; InsertAt: TAlign;
- DropCtl: TControl);
- procedure LoadFromStream(Stream: TStream);
- procedure PaintSite(DC: HDC);
- procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
- var DockRect: TRect);
- procedure RemoveControl(Control: TControl);
- procedure ResetBounds(Force: Boolean);
- procedure SaveToStream(Stream: TStream);
- procedure SetReplacingControl(Control: TControl);
- end;
-
- TWinControl = class(TControl)
- protected
- FDoubleBuffered: Boolean;
- FInImeComposition: Boolean;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure AddBiDiModeExStyle(var ExStyle: DWORD);
- procedure AssignTo(Dest: TPersistent); override;
- procedure AdjustClientRect(var Rect: TRect); virtual;
- procedure AdjustSize; override;
- procedure AlignControls(AControl: TControl; var Rect: TRect); virtual;
- function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
- function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
- procedure ChangeScale(M, D: Integer); override;
- procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
- MaxHeight: Integer); override;
- function CreateDockManager: IDockManager; dynamic;
- procedure CreateHandle; virtual;
- procedure CreateParams(var Params: TCreateParams); virtual;
- procedure CreateSubClass(var Params: TCreateParams;
- ControlClassName: PChar);
- procedure CreateWindowHandle(const Params: TCreateParams); virtual;
- procedure CreateWnd; virtual;
- procedure DestroyHandle;
- procedure DestroyWindowHandle; virtual;
- procedure DestroyWnd; virtual;
- procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic;
- procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState;
- var Accept: Boolean); dynamic;
- procedure DoDockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState;
- var Accept: Boolean); dynamic;
- procedure DoEnter; dynamic;
- procedure DoExit; dynamic;
- procedure DoFlipChildren; dynamic;
- function DoKeyDown(var Message: TWMKey): Boolean;
- function DoKeyPress(var Message: TWMKey): Boolean;
- function DoKeyUp(var Message: TWMKey): Boolean;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; dynamic;
- function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic;
- function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic;
- procedure DoRemoveDockClient(Client: TControl); dynamic;
- function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; dynamic;
- function FindNextControl(CurControl: TWinControl;
- GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
- 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 default [beLeft, beTop, beRight, beBottom];
- property BevelInner: TBevelCut index 0 default bvRaised;
- property BevelOuter: TBevelCut index 1 default bvLowered;
- property BevelKind: TBevelKind default bkNone;
- property BevelWidth: TBevelWidth default 1;
- property BorderWidth: TBorderWidth default 0;
- property Ctl3D: Boolean;
- property DefWndProc: Pointer;
- property DockSite: Boolean default False;
- property DockManager: IDockManager;
- property ImeMode: TImeMode default imDontCare;
- property ImeName: TImeName;
- property ParentCtl3D: Boolean default True;
- property UseDockManager: Boolean default False;
- property WheelAccumulator: Integer;
- property WindowHandle: HWnd;
- property OnDockDrop: TDockDropEvent;
- property OnDockOver: TDockOverEvent;
- property OnEnter: TNotifyEvent;
- property OnExit: TNotifyEvent;
- property OnGetSiteInfo: TGetSiteInfoEvent;
- property OnKeyDown: TKeyEvent;
- property OnKeyPress: TKeyPressEvent;
- property OnKeyUp: TKeyEvent;
- property OnMouseWheel: TMouseWheelEvent;
- property OnMouseWheelDown: TMouseWheelUpDownEvent;
- property OnMouseWheelUp: TMouseWheelUpDownEvent;
- property OnUnDock: TUnDockEvent;
- 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;
- property DockClients[Index: Integer]: TControl;
- procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic;
- property DoubleBuffered: Boolean;
- 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 MouseWheelHandler(var Message: TMessage); dynamic;
- procedure PaintTo(DC: HDC; X, Y: Integer);
- 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 VisibleDockClientCount: Integer;
- property Brush: TBrush;
- property Controls[Index: Integer]: TControl;
- property ControlCount: Integer;
- property Handle: HWnd;
- property ParentWindow: HWnd;
- property Showing: Boolean;
- property TabOrder: TTabOrder default -1;
- property TabStop: Boolean default False;
- published
- property HelpContext: THelpContext default 0;
- end;
-
- TGraphicControl = class(TControl)
- protected
- procedure Paint; virtual;
- property Canvas: TCanvas;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- end;
-
- TCustomControl = class(TWinControl)
- protected
- procedure Paint; virtual;
- procedure PaintWindow(DC: HDC); override;
- property Canvas: TCanvas;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- end;
-
- THintWindow = class(TCustomControl)
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- procedure Paint; override;
- 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)
- 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;
- property Dragging: Boolean;
- 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
- public
- constructor Create(Tree: TDockTree);
- procedure ResetChildren;
- procedure Update;
- property ChildCount: Integer;
- property Height: Integer index Ord(doHorizontal);
- property Left: Integer index Ord(doVertical);
- property LimitBegin: Integer;
- property LimitSize: Integer;
- property Top: Integer index Ord(doHorizontal);
- property Width: Integer index Ord(doVertical);
- 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)
- protected
- procedure AdjustDockRect(Control: TControl; var ARect: TRect); virtual;
- procedure BeginUpdate;
- procedure EndUpdate;
- procedure GetControlBounds(Control: TControl; out CtlBounds: TRect);
- function HitTest(const MousePos: TPoint; out HTFlag: Integer): TControl; virtual;
- procedure InsertControl(Control: TControl; InsertAt: TAlign;
- DropCtl: TControl); virtual;
- procedure LoadFromStream(Stream: TStream); virtual;
- procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
- const ARect: TRect); virtual;
- procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
- var DockRect: TRect); virtual;
- procedure RemoveControl(Control: TControl); virtual;
- procedure SaveToStream(Stream: TStream); virtual;
- procedure SetReplacingControl(Control: TControl);
- procedure ResetBounds(Force: Boolean); virtual;
- procedure UpdateAll;
- property DockSite: TWinControl;
- public
- constructor Create(DockSite: TWinControl); virtual;
- destructor Destroy; override;
- procedure PaintSite(DC: HDC); virtual;
- end;
-
- { Mouse support }
-
- TMouse = class
- public
- constructor Create;
- destructor Destroy; override;
- procedure SettingChanged(Setting: Integer);
- property Capture: HWND;
- property CursorPos: TPoint;
- property DragImmediate: Boolean default True;
- property DragThreshold: Integer default 5;
- property MousePresent: Boolean;
- property RegWheelMessage: UINT;
- property WheelPresent: Boolean;
- property WheelScrollLines: Integer;
- end;
-
- var
- Mouse: TMouse;
-
- { Drag stuff }
-
- function IsDragObject(Sender: TObject): Boolean;
- function FindControl(Handle: HWnd): TWinControl;
- function FindVCLWindow(const Pos: TPoint): TWinControl;
- function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
- function GetCaptureControl: TControl;
- procedure SetCaptureControl(Control: TControl);
- procedure CancelDrag;
-
- { Misc }
-
- function CursorToString(Cursor: TCursor): string;
- function StringToCursor(const S: string): TCursor;
- procedure GetCursorValues(Proc: TGetStrProc);
- function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
- function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
-
- function GetShortHint(const Hint: string): string;
- function GetLongHint(const Hint: string): string;
-
- var
- CreationControl: TWinControl = nil;
- DefaultDockTreeClass: TDockTreeClass = TDockTree;
-
- function InitWndProc(HWindow: HWnd; Message, WParam: Longint;
- LParam: Longint): Longint; stdcall;
-
- const
- CTL3D_ALL = $FFFF;
- NullDockSite = TWinControl($FFFFFFFF);
- AnchorAlign: array[TAlign] of TAnchors = (
- { alNone }
- [akLeft, akTop],
- { alTop }
- [akLeft, akTop, akRight],
- { alBottom }
- [akLeft, akRight, akBottom],
- { alLeft }
- [akLeft, akTop, akBottom],
- { alRight }
- [akRight, akTop, akBottom],
- { alClient }
- [akLeft, akTop, akRight, akBottom]);
-
- var
- NewStyleControls: Boolean;
-
- procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
-
- function SendAppMessage(Msg: Cardinal; WParam, LParam: Longint): Longint;
- procedure MoveWindowOrg(DC: HDC; DX, DY: Integer);
-
- procedure SetImeMode(hWnd: HWND; Mode: TImeMode);
- procedure SetImeName(Name: TImeName);
- function Win32NLSEnableIME(hWnd: HWND; Enable: Boolean): Boolean;
- function Imm32GetContext(hWnd: HWND): HIMC;
- function Imm32ReleaseContext(hWnd: HWND; hImc: HIMC): Boolean;
- function Imm32GetConversionStatus(hImc: HIMC; var Conversion, Sentence: DWORD): Boolean;
- function Imm32SetConversionStatus(hImc: HIMC; Conversion, Sentence: DWORD): Boolean;
- function Imm32SetOpenStatus(hImc: HIMC; fOpen: Boolean): Boolean;
- function Imm32SetCompositionWindow(hImc: HIMC; lpCompForm: PCOMPOSITIONFORM): Boolean;
- function Imm32SetCompositionFont(hImc: HIMC; lpLogfont: PLOGFONTA): Boolean;
- function Imm32GetCompositionString(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint;
- function Imm32IsIME(hKl: HKL): Boolean;
- function Imm32NotifyIME(hImc: HIMC; dwAction, dwIndex, dwValue: DWORD): Boolean;
-
- implementation
-