home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk14 / doc.pak / CONTROLS.INT < prev    next >
Encoding:
Text File  |  1995-08-24  |  15.6 KB  |  463 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Controls;
  10.  
  11. {$P+,S-,W-,R-}
  12. {$C PRELOAD}
  13.  
  14. interface
  15.  
  16. {$R CONTROLS}
  17.  
  18. uses WinTypes, WinProcs, Messages, Classes, SysUtils, Graphics, Menus;
  19.  
  20. { VCL control message IDs }
  21.  
  22. const
  23.   CM_BASE                   = $0F00;
  24.   CM_ACTIVATE               = CM_BASE + 0;
  25.   CM_DEACTIVATE             = CM_BASE + 1;
  26.   CM_GOTFOCUS               = CM_BASE + 2;
  27.   CM_LOSTFOCUS              = CM_BASE + 3;
  28.   CM_CANCELMODE             = CM_BASE + 4;
  29.   CM_DIALOGKEY              = CM_BASE + 5;
  30.   CM_DIALOGCHAR             = CM_BASE + 6;
  31.   CM_FOCUSCHANGED           = CM_BASE + 7;
  32.   CM_PARENTFONTCHANGED      = CM_BASE + 8;
  33.   CM_PARENTCOLORCHANGED     = CM_BASE + 9;
  34.   CM_HITTEST                = CM_BASE + 10;
  35.   CM_VISIBLECHANGED         = CM_BASE + 11;
  36.   CM_ENABLEDCHANGED         = CM_BASE + 12;
  37.   CM_COLORCHANGED           = CM_BASE + 13;
  38.   CM_FONTCHANGED            = CM_BASE + 14;
  39.   CM_CURSORCHANGED          = CM_BASE + 15;
  40.   CM_CTL3DCHANGED           = CM_BASE + 16;
  41.   CM_PARENTCTL3DCHANGED     = CM_BASE + 17;
  42.   CM_TEXTCHANGED            = CM_BASE + 18;
  43.   CM_MOUSEENTER             = CM_BASE + 19;
  44.   CM_MOUSELEAVE             = CM_BASE + 20;
  45.   CM_MENUCHANGED            = CM_BASE + 21;
  46.   CM_APPKEYDOWN             = CM_BASE + 22;
  47.   CM_APPSYSCOMMAND          = CM_BASE + 23;
  48.   CM_BUTTONPRESSED          = CM_BASE + 24;
  49.   CM_SHOWINGCHANGED         = CM_BASE + 25;
  50.   CM_ENTER                  = CM_BASE + 26;
  51.   CM_EXIT                   = CM_BASE + 27;
  52.   CM_DESIGNHITTEST          = CM_BASE + 28;
  53.   CM_ICONCHANGED            = CM_BASE + 29;
  54.   CM_WANTSPECIALKEY         = CM_BASE + 30;
  55.   CM_INVOKEHELP             = CM_BASE + 31;
  56.   CM_WINDOWHOOK             = CM_BASE + 32;
  57.   CM_RELEASE                = CM_BASE + 33;
  58.   CM_SHOWHINTCHANGED        = CM_BASE + 34;
  59.   CM_PARENTSHOWHINTCHANGED  = CM_BASE + 35;
  60.   CM_SYSCOLORCHANGE         = CM_BASE + 36;
  61.   CM_WININICHANGE           = CM_BASE + 37;
  62.   CM_FONTCHANGE             = CM_BASE + 38;
  63.   CM_TIMECHANGE             = CM_BASE + 39;
  64.  
  65. { VCL control notification IDs }
  66.  
  67. const
  68.   CN_BASE         = $2000;
  69.   CN_CHARTOITEM   = CN_BASE + WM_CHARTOITEM;
  70.   CN_COMMAND      = CN_BASE + WM_COMMAND;
  71.   CN_COMPAREITEM  = CN_BASE + WM_COMPAREITEM;
  72.   CN_CTLCOLOR     = CN_BASE + WM_CTLCOLOR;
  73.   CN_DELETEITEM   = CN_BASE + WM_DELETEITEM;
  74.   CN_DRAWITEM     = CN_BASE + WM_DRAWITEM;
  75.   CN_HSCROLL      = CN_BASE + WM_HSCROLL;
  76.   CN_MEASUREITEM  = CN_BASE + WM_MEASUREITEM;
  77.   CN_PARENTNOTIFY = CN_BASE + WM_PARENTNOTIFY;
  78.   CN_VKEYTOITEM   = CN_BASE + WM_VKEYTOITEM;
  79.   CN_VSCROLL      = CN_BASE + WM_VSCROLL;
  80.   CN_KEYDOWN      = CN_BASE + WM_KEYDOWN;
  81.   CN_KEYUP        = CN_BASE + WM_KEYUP;
  82.   CN_CHAR         = CN_BASE + WM_CHAR;
  83.   CN_SYSKEYDOWN   = CN_BASE + WM_SYSKEYDOWN;
  84.   CN_SYSCHAR      = CN_BASE + WM_SYSCHAR;
  85.  
  86.  
  87. { TModalResult values }
  88.  
  89. const
  90.   mrNone   = 0;
  91.   mrOk     = idOk;
  92.   mrCancel = idCancel;
  93.   mrAbort  = idAbort;
  94.   mrRetry  = idRetry;
  95.   mrIgnore = idIgnore;
  96.   mrYes    = idYes;
  97.   mrNo     = idNo;
  98.   mrAll    = mrNo + 1;
  99.  
  100. { Cursor identifiers }
  101.  
  102. const
  103.   crDefault     = 0;
  104.   crNone        = -1;
  105.   crArrow       = -2;
  106.   crCross       = -3;
  107.   crIBeam       = -4;
  108.   crSize        = -5;
  109.   crSizeNESW    = -6;
  110.   crSizeNS      = -7;
  111.   crSizeNWSE    = -8;
  112.   crSizeWE      = -9;
  113.   crUpArrow     = -10;
  114.   crHourGlass   = -11;
  115.   crDrag        = -12;
  116.   crNoDrop      = -13;
  117.   crHSplit      = -14;
  118.   crVSplit      = -15;
  119.   crMultiDrag   = -16;
  120.   crSQLWait     = -17;
  121.  
  122. type
  123.  
  124. { Forward declarations }
  125.  
  126.   TControl = class;
  127.   TWinControl = class;
  128.  
  129. { VCL control message records }
  130.  
  131.   TCMActivate = TWMNoParams;
  132.   TCMDeactivate = TWMNoParams;
  133.   TCMGotFocus = TWMNoParams;
  134.   TCMLostFocus = TWMNoParams;
  135.   TCMDialogKey = TWMKeyDown;
  136.   TCMDialogChar = TWMSysChar;
  137.   TCMHitTest = TWMNCHitTest;
  138.   TCMEnter = TWMNoParams;
  139.   TCMExit = TWMNoParams;
  140.   TCMDesignHitTest = TWMMouse;
  141.   TCMWantSpecialKey = TWMKey;
  142.  
  143.   TCMCancelMode = record
  144.     Msg: Cardinal;
  145.     Unused: Integer;
  146.     Sender: TControl;
  147.     Result: Longint;
  148.   end;
  149.  
  150.   TCMFocusChanged = record
  151.     Msg: Cardinal;
  152.     Unused: Integer;
  153.     Sender: TWinControl;
  154.     Result: Longint;
  155.   end;
  156.  
  157. { Exception classes }
  158.  
  159.   EOutOfResources = class(EOutOfMemory);
  160.   EInvalidObject = class(Exception);
  161.   EInvalidOperation = class(Exception);
  162.  
  163. { Cursor type }
  164.  
  165.   TCursor = -32768..32767;
  166.  
  167. { Controls }
  168.  
  169.   TControlCanvas = class(TCanvas)
  170.   protected
  171.     procedure CreateHandle; override;
  172.   public
  173.     destructor Destroy; override;
  174.     procedure FreeHandle;
  175.     property Control: TControl;
  176.   end;
  177.  
  178.   TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient);
  179.  
  180.   TControlState = set of (csLButtonDown, csClicked, csPalette,
  181.     csReadingState, csAlignmentNeeded, csFocusing, csCreating);
  182.  
  183.   TControlStyle = set of (csAcceptsControls, csCaptureMouse,
  184.     csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
  185.     csDoubleClicks, csFixedWidth, csFixedHeight);
  186.  
  187.   TMouseButton = (mbLeft, mbRight, mbMiddle);
  188.  
  189.   TDragMode = (dmManual, dmAutomatic);
  190.  
  191.   TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
  192.  
  193.   TTabOrder = -1..32767;
  194.  
  195.   TCaption = string[255];
  196.  
  197.   TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
  198.     Shift: TShiftState; X, Y: Integer) of object;
  199.   TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
  200.     X, Y: Integer) of object;
  201.   TKeyEvent = procedure(Sender: TObject; var Key: Word;
  202.     Shift: TShiftState) of object;
  203.   TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of object;
  204.   TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer;
  205.     State: TDragState; var Accept: Boolean) of object;
  206.   TDragDropEvent = procedure(Sender, Source: TObject;
  207.     X, Y: Integer) of object;
  208.   TEndDragEvent = procedure(Sender, Target: TObject;
  209.     X, Y: Integer) of object;
  210.  
  211.   TControl = class(TComponent)
  212.   protected
  213.     procedure ChangeScale(M, D: Integer); dynamic;
  214.     procedure Click; dynamic;
  215.     procedure DblClick; dynamic;
  216.     procedure DefaultHandler(var Message); override;
  217.     procedure DefineProperties(Filer: TFiler); override;
  218.     procedure DragCanceled; dynamic;
  219.     function GetClientOrigin: TPoint; virtual;
  220.     function GetClientRect: TRect; virtual;
  221.     function GetDeviceContext(var WindowHandle: HWnd): HDC; virtual;
  222.     function GetPalette: HPALETTE; dynamic;
  223.     function HasParent: Boolean; override;
  224.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  225.       X, Y: Integer); dynamic;
  226.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  227.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  228.       X, Y: Integer); dynamic;
  229.     procedure Notification(AComponent: TComponent;
  230.       Operation: TOperation); override;
  231.     function PaletteChanged(Foreground: Boolean): Boolean; dynamic;
  232.     procedure ReadState(Reader: TReader); override;
  233.     procedure SetParent(AParent: TWinControl); virtual;
  234.     procedure SetName(const Value: TComponentName); override;
  235.     procedure SetZOrder(TopMost: Boolean); dynamic;
  236.     procedure UpdateBoundsRect(const R: TRect);
  237.     procedure VisibleChanging; dynamic;
  238.     procedure WndProc(var Message: TMessage); virtual;
  239.     property Caption: TCaption;
  240.     property Color: TColor default clWindow;
  241.     property DragCursor: TCursor default crDrag;
  242.     property DragMode: TDragMode default dmManual;
  243.     property Font: TFont;
  244.     property IsControl: Boolean;
  245.     property MouseCapture: Boolean;
  246.     property ParentColor: Boolean default True;
  247.     property ParentFont: Boolean default True;
  248.     property ParentShowHint: Boolean default True;
  249.     property PopupMenu: TPopupMenu;
  250.     property Text: TCaption;
  251.     property WindowText: PChar;
  252.     property OnClick: TNotifyEvent;
  253.     property OnDblClick: TNotifyEvent;
  254.     property OnDragDrop: TDragDropEvent;
  255.     property OnDragOver: TDragOverEvent;
  256.     property OnEndDrag: TEndDragEvent;
  257.     property OnMouseDown: TMouseEvent;
  258.     property OnMouseMove: TMouseMoveEvent;
  259.     property OnMouseUp: TMouseEvent;
  260.   public
  261.     constructor Create(AOwner: TComponent); override;
  262.     destructor Destroy; override;
  263.     procedure BeginDrag(Immediate: Boolean);
  264.     procedure BringToFront;
  265.     function ClientToScreen(const Point: TPoint): TPoint;
  266.     function Dragging: Boolean;
  267.     procedure DragDrop(DragObject: TObject; X, Y: Integer); dynamic;
  268.     procedure EndDrag(Drop: Boolean);
  269.     function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  270.     function GetTextLen: Integer;
  271.     procedure Hide;
  272.     procedure Invalidate; virtual;
  273.     function Perform(Msg, WParam: Word; LParam: Longint): Longint;
  274.     procedure Refresh;
  275.     procedure Repaint; virtual;
  276.     function ScreenToClient(const Point: TPoint): TPoint;
  277.     procedure SendToBack;
  278.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
  279.     procedure SetTextBuf(Buffer: PChar);
  280.     procedure Show;
  281.     procedure Update; virtual;
  282.     property Align: TAlign default alNone;
  283.     property BoundsRect: TRect;
  284.     property ClientHeight: Integer;
  285.     property ClientOrigin: TPoint;
  286.     property ClientRect: TRect;
  287.     property ClientWidth: Integer;
  288.     property ControlState: TControlState;
  289.     property ControlStyle: TControlStyle;
  290.     property Parent: TWinControl;
  291.     property ShowHint: Boolean;
  292.     property Visible: Boolean default True;
  293.     property Enabled: Boolean default True;
  294.   published
  295.     property Left: Integer;
  296.     property Top: Integer;
  297.     property Width: Integer;
  298.     property Height: Integer;
  299.     property Cursor: TCursor default crDefault;
  300.     property Hint: string;
  301.   end;
  302.  
  303.   TControlClass = class of TControl;
  304.  
  305.   TCreateParams = record
  306.     Caption: PChar;
  307.     Style: Longint;
  308.     ExStyle: Longint;
  309.     X, Y: Integer;
  310.     Width, Height: Integer;
  311.     WndParent: HWnd;
  312.     Param: Pointer;
  313.     WindowClass: TWndClass;
  314.     WinClassName: array[0..63] of Char;
  315.   end;
  316.  
  317.   TWinControl = class(TControl)
  318.   protected
  319.     procedure ChangeScale(M, D: Integer); override;
  320.     procedure CreateHandle; virtual;
  321.     procedure CreateParams(var Params: TCreateParams); virtual;
  322.     procedure CreateSubClass(var Params: TCreateParams;
  323.       ControlClassName: PChar);
  324.     procedure CreateWindowHandle(const Params: TCreateParams); virtual;
  325.     procedure CreateWnd; virtual;
  326.     procedure DefaultHandler(var Message); override;
  327.     procedure DestroyHandle;
  328.     procedure DestroyWindowHandle; virtual;
  329.     procedure DestroyWnd; virtual;
  330.     function DoKeyDown(var Message: TWMKey): Boolean;
  331.     function DoKeyPress(var Message: TWMKey): Boolean;
  332.     function DoKeyUp(var Message: TWMKey): Boolean;
  333.     procedure AlignControls(AControl: TControl; var Rect: TRect); virtual;
  334.     function IsControlMouseMsg(var Message: TWMMouse): Boolean;
  335.     function FindNextControl(CurControl: TWinControl;
  336.       GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
  337.     function GetClientOrigin: TPoint; override;
  338.     function GetClientRect: TRect; override;
  339.     function GetDeviceContext(var WindowHandle: HWnd): HDC; override;
  340.     procedure DoEnter; dynamic;
  341.     procedure DoExit; dynamic;
  342.     procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
  343.     procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;
  344.     procedure KeyPress(var Key: Char); dynamic;
  345.     procedure MainWndProc(var Message: TMessage);
  346.     procedure NotifyControls(Msg: Word);
  347.     procedure PaintControls(DC: HDC; First: TControl);
  348.     procedure PaintHandler(var Message: TWMPaint);
  349.     procedure PaintWindow(DC: HDC); virtual;
  350.     function PaletteChanged(Foreground: Boolean): Boolean; override;
  351.     procedure ReadState(Reader: TReader); override;
  352.     procedure RecreateWnd;
  353.     procedure ScaleControls(M, D: Integer);
  354.     procedure SelectFirst;
  355.     procedure SelectNext(CurControl: TWinControl;
  356.       GoForward, CheckTabStop: Boolean);
  357.     procedure SetZOrder(TopMost: Boolean); override;
  358.     procedure ShowControl(AControl: TControl); virtual;
  359.     procedure WndProc(var Message: TMessage); override;
  360.     procedure WriteComponents(Writer: TWriter); override;
  361.     property Ctl3D: Boolean;
  362.     property DefWndProc: Pointer;
  363.     property ParentCtl3D: Boolean default True;
  364.     property WindowHandle: HWnd;
  365.     property OnEnter: TNotifyEvent;
  366.     property OnExit: TNotifyEvent;
  367.     property OnKeyDown: TKeyEvent;
  368.     property OnKeyPress: TKeyPressEvent;
  369.     property OnKeyUp: TKeyEvent;
  370.   public
  371.     constructor Create(AOwner: TComponent); override;
  372.     destructor Destroy; override;
  373.     procedure Broadcast(var Message);
  374.     function CanFocus: Boolean;
  375.     function ContainsControl(Control: TControl): Boolean;
  376.     function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  377.     procedure DisableAlign;
  378.     procedure EnableAlign;
  379.     function Focused: Boolean;
  380.     procedure GetTabOrderList(List: TList);
  381.     function HandleAllocated: Boolean;
  382.     procedure HandleNeeded;
  383.     procedure InsertControl(AControl: TControl);
  384.     procedure Invalidate; override;
  385.     procedure RemoveControl(AControl: TControl);
  386.     procedure Realign;
  387.     procedure Repaint; override;
  388.     procedure ScaleBy(M, D: Integer);
  389.     procedure ScrollBy(DeltaX, DeltaY: Integer);
  390.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  391.     procedure SetFocus; virtual;
  392.     procedure Update; override;
  393.     property Brush: TBrush;
  394.     property Controls[Index: Integer]: TControl;
  395.     property ControlCount: Integer;
  396.     property Handle: HWnd;
  397.     property Showing: Boolean;
  398.     property TabOrder: TTabOrder default -1;
  399.     property TabStop: Boolean default False;
  400.   published
  401.     property HelpContext: THelpContext default 0;
  402.   end;
  403.  
  404.   TGraphicControl = class(TControl)
  405.   protected
  406.     procedure Paint; virtual;
  407.     property Canvas: TCanvas;
  408.   public
  409.     constructor Create(AOwner: TComponent); override;
  410.     destructor Destroy; override;
  411.   end;
  412.  
  413.   TCustomControl = class(TWinControl)
  414.   protected
  415.     procedure Paint; virtual;
  416.     procedure PaintWindow(DC: HDC); override;
  417.     property Canvas: TCanvas;
  418.   public
  419.     constructor Create(AOwner: TComponent); override;
  420.     destructor Destroy; override;
  421.   end;
  422.  
  423.   THintWindow = class(TCustomControl)
  424.   protected
  425.     procedure CreateParams(var Params: TCreateParams); override;
  426.     procedure Paint; override;
  427.   public
  428.     constructor Create(AOwner: TComponent); override;
  429.     procedure ActivateHint(Rect: TRect; const AHint: string); virtual;
  430.     function IsHintMsg(var Msg: TMsg): Boolean; virtual;
  431.     procedure ReleaseHandle;
  432.     property Caption;
  433.     property Color;
  434.     property Canvas;
  435.   end;
  436.  
  437.   THintWindowClass = class of THintWindow;
  438.  
  439. function FindControl(Handle: HWnd): TWinControl;
  440. function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  441. function GetCaptureControl: TControl;
  442. procedure SetCaptureControl(Control: TControl);
  443.  
  444. function CursorToString(Cursor: TCursor): string;
  445. function StringToCursor(S: string): TCursor;
  446. procedure GetCursorValues(Proc: TGetStrProc);
  447. function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
  448. function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
  449.  
  450. function GetShortHint(const Hint: string): string;
  451. function GetLongHint(const Hint: string): string;
  452.  
  453. procedure DragMouseMsg(var Message: TWMMouse);
  454.  
  455. const
  456.   VBXHook: TVBXHook = nil;
  457.   VBXPropMsg: Word = $FFFF;
  458.  
  459. var
  460.   NewStyleControls: Boolean;
  461.  
  462. implementation
  463.