home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / STDCTRLS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  116.5 KB  |  4,197 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit StdCtrls;
  11.  
  12. {$R-,T-,H+,X+}
  13.  
  14. interface
  15.  
  16. uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics;
  17.  
  18. type
  19.   TCustomGroupBox = class(TCustomControl)
  20.   private
  21.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  22.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  23.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  24.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  25.   protected
  26.     procedure AdjustClientRect(var Rect: TRect); override;
  27.     procedure CreateParams(var Params: TCreateParams); override;
  28.     procedure Paint; override;
  29.   public
  30.     constructor Create(AOwner: TComponent); override;
  31.   end;
  32.  
  33.   TGroupBox = class(TCustomGroupBox)
  34.   published
  35.     property Align;
  36.     property Anchors;
  37.     property BiDiMode;
  38.     property Caption;
  39.     property Color;
  40.     property Constraints;
  41.     property Ctl3D;
  42.     property DockSite;
  43.     property DragCursor;
  44.     property DragKind;
  45.     property DragMode;
  46.     property Enabled;
  47.     property Font;
  48.     property ParentBiDiMode;
  49.     property ParentColor;
  50.     property ParentCtl3D;
  51.     property ParentFont;
  52.     property ParentShowHint;
  53.     property PopupMenu;
  54.     property ShowHint;
  55.     property TabOrder;
  56.     property TabStop;
  57.     property Visible;
  58.     property OnClick;
  59.     property OnContextPopup;
  60.     property OnDblClick;
  61.     property OnDragDrop;
  62.     property OnDockDrop;
  63.     property OnDockOver;
  64.     property OnDragOver;
  65.     property OnEndDock;
  66.     property OnEndDrag;
  67.     property OnEnter;
  68.     property OnExit;
  69.     property OnGetSiteInfo;
  70.     property OnMouseDown;
  71.     property OnMouseMove;
  72.     property OnMouseUp;
  73.     property OnStartDock;
  74.     property OnStartDrag;
  75.     property OnUnDock;
  76.   end;
  77.  
  78.   TTextLayout = (tlTop, tlCenter, tlBottom);
  79.  
  80.   TCustomLabel = class(TGraphicControl)
  81.   private
  82.     FFocusControl: TWinControl;
  83.     FAlignment: TAlignment;
  84.     FAutoSize: Boolean;
  85.     FLayout: TTextLayout;
  86.     FWordWrap: Boolean;
  87.     FShowAccelChar: Boolean;
  88.     function GetTransparent: Boolean;
  89.     procedure SetAlignment(Value: TAlignment);
  90.     procedure SetFocusControl(Value: TWinControl);
  91.     procedure SetShowAccelChar(Value: Boolean);
  92.     procedure SetTransparent(Value: Boolean);
  93.     procedure SetLayout(Value: TTextLayout);
  94.     procedure SetWordWrap(Value: Boolean);
  95.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  96.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  97.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  98.   protected
  99.     procedure AdjustBounds; dynamic;
  100.     procedure DoDrawText(var Rect: TRect; Flags: Longint); dynamic;
  101.     function GetLabelText: string; virtual;
  102.     procedure Loaded; override;
  103.     procedure Notification(AComponent: TComponent;
  104.       Operation: TOperation); override;
  105.     procedure Paint; override;
  106.     procedure SetAutoSize(Value: Boolean); virtual;
  107.     property Alignment: TAlignment read FAlignment write SetAlignment
  108.       default taLeftJustify;
  109.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  110.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  111.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  112.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  113.     property Layout: TTextLayout read FLayout write SetLayout default tlTop;
  114.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  115.   public
  116.     constructor Create(AOwner: TComponent); override;
  117.     property Canvas;
  118.   end;
  119.  
  120.   TLabel = class(TCustomLabel)
  121.   published
  122.     property Align;
  123.     property Alignment;
  124.     property Anchors;
  125.     property AutoSize;
  126.     property BiDiMode;
  127.     property Caption;
  128.     property Color;
  129.     property Constraints;
  130.     property DragCursor;
  131.     property DragKind;
  132.     property DragMode;
  133.     property Enabled;
  134.     property FocusControl;
  135.     property Font;
  136.     property ParentBiDiMode;
  137.     property ParentColor;
  138.     property ParentFont;
  139.     property ParentShowHint;
  140.     property PopupMenu;
  141.     property ShowAccelChar;
  142.     property ShowHint;
  143.     property Transparent;
  144.     property Layout;
  145.     property Visible;
  146.     property WordWrap;
  147.     property OnClick;
  148.     property OnContextPopup;
  149.     property OnDblClick;
  150.     property OnDragDrop;
  151.     property OnDragOver;
  152.     property OnEndDock;
  153.     property OnEndDrag;
  154.     property OnMouseDown;
  155.     property OnMouseMove;
  156.     property OnMouseUp;
  157.     property OnStartDock;
  158.     property OnStartDrag;
  159.   end;
  160.  
  161.   TEditCharCase = (ecNormal, ecUpperCase, ecLowerCase);
  162.  
  163.   TCustomEdit = class(TWinControl)
  164.   private
  165.     FMaxLength: Integer;
  166.     FBorderStyle: TBorderStyle;
  167.     FPasswordChar: Char;
  168.     FReadOnly: Boolean;
  169.     FAutoSize: Boolean;
  170.     FAutoSelect: Boolean;
  171.     FHideSelection: Boolean;
  172.     FOEMConvert: Boolean;
  173.     FCharCase: TEditCharCase;
  174.     FCreating: Boolean;
  175.     FModified: Boolean;
  176.     FOnChange: TNotifyEvent;
  177.     procedure AdjustHeight;
  178.     function GetModified: Boolean;
  179.     function GetCanUndo: Boolean;
  180.     procedure SetAutoSize(Value: Boolean);
  181.     procedure SetBorderStyle(Value: TBorderStyle);
  182.     procedure SetCharCase(Value: TEditCharCase);
  183.     procedure SetHideSelection(Value: Boolean);
  184.     procedure SetMaxLength(Value: Integer);
  185.     procedure SetModified(Value: Boolean);
  186.     procedure SetOEMConvert(Value: Boolean);
  187.     procedure SetPasswordChar(Value: Char);
  188.     procedure SetReadOnly(Value: Boolean);
  189.     procedure SetSelText(const Value: string);
  190.     procedure UpdateHeight;
  191.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  192.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  193.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  194.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  195.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  196.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  197.   protected
  198.     procedure Change; dynamic;
  199.     procedure CreateParams(var Params: TCreateParams); override;
  200.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  201.     procedure CreateWnd; override;
  202.     procedure DestroyWnd; override;
  203.     procedure DoSetMaxLength(Value: Integer); virtual;
  204.     function GetSelLength: Integer; virtual;
  205.     function GetSelStart: Integer; virtual;
  206.     function GetSelText: string; virtual;
  207.     procedure SetSelLength(Value: Integer); virtual;
  208.     procedure SetSelStart(Value: Integer); virtual;
  209.     property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
  210.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  211.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  212.     property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
  213.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  214.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  215.     property OEMConvert: Boolean read FOEMConvert write SetOEMConvert default False;
  216.     property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
  217.     property ParentColor default False;
  218.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  219.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  220.   public
  221.     constructor Create(AOwner: TComponent); override;
  222.     procedure Clear; virtual;
  223.     procedure ClearSelection;
  224.     procedure CopyToClipboard;
  225.     procedure CutToClipboard;
  226.     procedure DefaultHandler(var Message); override;
  227.     procedure PasteFromClipboard;
  228.     procedure Undo;
  229.     procedure ClearUndo;
  230.     function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
  231.     procedure SelectAll;
  232.     procedure SetSelTextBuf(Buffer: PChar);
  233.     property CanUndo: Boolean read GetCanUndo;
  234.     property Modified: Boolean read GetModified write SetModified;
  235.     property SelLength: Integer read GetSelLength write SetSelLength;
  236.     property SelStart: Integer read GetSelStart write SetSelStart;
  237.     property SelText: string read GetSelText write SetSelText;
  238.     property Text;
  239.   published
  240.     property TabStop default True;
  241.   end;
  242.  
  243.   TEdit = class(TCustomEdit)
  244.   published
  245.     property Anchors;
  246.     property AutoSelect;
  247.     property AutoSize;
  248.     property BiDiMode;
  249.     property BorderStyle;
  250.     property CharCase;
  251.     property Color;
  252.     property Constraints;
  253.     property Ctl3D;
  254.     property DragCursor;
  255.     property DragKind;
  256.     property DragMode;
  257.     property Enabled;
  258.     property Font;
  259.     property HideSelection;
  260.     property ImeMode;
  261.     property ImeName;
  262.     property MaxLength;
  263.     property OEMConvert;
  264.     property ParentBiDiMode;
  265.     property ParentColor;
  266.     property ParentCtl3D;
  267.     property ParentFont;
  268.     property ParentShowHint;
  269.     property PasswordChar;
  270.     property PopupMenu;
  271.     property ReadOnly;
  272.     property ShowHint;
  273.     property TabOrder;
  274.     property TabStop;
  275.     property Text;
  276.     property Visible;
  277.     property OnChange;
  278.     property OnClick;
  279.     property OnContextPopup;
  280.     property OnDblClick;
  281.     property OnDragDrop;
  282.     property OnDragOver;
  283.     property OnEndDock;
  284.     property OnEndDrag;
  285.     property OnEnter;
  286.     property OnExit;
  287.     property OnKeyDown;
  288.     property OnKeyPress;
  289.     property OnKeyUp;
  290.     property OnMouseDown;
  291.     property OnMouseMove;
  292.     property OnMouseUp;
  293.     property OnStartDock;
  294.     property OnStartDrag;
  295.   end;
  296.  
  297.   TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);
  298.  
  299.   TCustomMemo = class(TCustomEdit)
  300.   private
  301.     FLines: TStrings;
  302.     FAlignment: TAlignment;
  303.     FScrollBars: TScrollStyle;
  304.     FWordWrap: Boolean;
  305.     FWantReturns: Boolean;
  306.     FWantTabs: Boolean;
  307.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  308.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  309.   protected
  310.     function GetCaretPos: TPoint; virtual;
  311.     procedure CreateParams(var Params: TCreateParams); override;
  312.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  313.     procedure KeyPress(var Key: Char); override;
  314.     procedure Loaded; override;
  315.     procedure SetAlignment(Value: TAlignment);
  316.     procedure SetLines(Value: TStrings);
  317.     procedure SetScrollBars(Value: TScrollStyle);
  318.     procedure SetWordWrap(Value: Boolean);
  319.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  320.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
  321.     property WantReturns: Boolean read FWantReturns write FWantReturns default True;
  322.     property WantTabs: Boolean read FWantTabs write FWantTabs default False;
  323.     property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  324.   public
  325.     constructor Create(AOwner: TComponent); override;
  326.     destructor Destroy; override;
  327.     function GetControlsAlignment: TAlignment; override;
  328.     property CaretPos: TPoint read GetCaretPos;
  329.     property Lines: TStrings read FLines write SetLines;
  330.   end;
  331.  
  332.   TMemo = class(TCustomMemo)
  333.   published
  334.     property Align;
  335.     property Alignment;
  336.     property Anchors;
  337.     property BiDiMode;
  338.     property BorderStyle;
  339.     property Color;
  340.     property Constraints;
  341.     property Ctl3D;
  342.     property DragCursor;
  343.     property DragKind;
  344.     property DragMode;
  345.     property Enabled;
  346.     property Font;
  347.     property HideSelection;
  348.     property ImeMode;
  349.     property ImeName;
  350.     property Lines;
  351.     property MaxLength;
  352.     property OEMConvert;
  353.     property ParentBiDiMode;
  354.     property ParentColor;
  355.     property ParentCtl3D;
  356.     property ParentFont;
  357.     property ParentShowHint;
  358.     property PopupMenu;
  359.     property ReadOnly;
  360.     property ScrollBars;
  361.     property ShowHint;
  362.     property TabOrder;
  363.     property TabStop;
  364.     property Visible;
  365.     property WantReturns;
  366.     property WantTabs;
  367.     property WordWrap;
  368.     property OnChange;
  369.     property OnClick;
  370.     property OnContextPopup;
  371.     property OnDblClick;
  372.     property OnDragDrop;
  373.     property OnDragOver;
  374.     property OnEndDock;
  375.     property OnEndDrag;
  376.     property OnEnter;
  377.     property OnExit;
  378.     property OnKeyDown;
  379.     property OnKeyPress;
  380.     property OnKeyUp;
  381.     property OnMouseDown;
  382.     property OnMouseMove;
  383.     property OnMouseUp;
  384.     property OnStartDock;
  385.     property OnStartDrag;
  386.   end;
  387.  
  388.   TComboBoxStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,
  389.     csOwnerDrawVariable);
  390.   TOwnerDrawState = Windows.TOwnerDrawState;
  391.   {$NODEFINE TOwnerDrawState}
  392.  
  393.   TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
  394.     Rect: TRect; State: TOwnerDrawState) of object;
  395.  
  396.   TMeasureItemEvent = procedure(Control: TWinControl; Index: Integer;
  397.     var Height: Integer) of object;
  398.  
  399.   TCustomComboBox = class(TWinControl)
  400.   private
  401.     FItems: TStrings;
  402.     FCanvas: TCanvas;
  403.     FCharCase: TEditCharCase;
  404.     FSorted: Boolean;
  405.     FStyle: TComboBoxStyle;
  406.     FItemHeight: Integer;
  407.     FMaxLength: Integer;
  408.     FDropDownCount: Integer;
  409.     FEditHandle: HWnd;
  410.     FListHandle: HWnd;
  411.     FEditInstance: Pointer;
  412.     FListInstance: Pointer;
  413.     FDefEditProc: Pointer;
  414.     FDefListProc: Pointer;
  415.     FIsFocused: Boolean;
  416.     FFocusChanged: Boolean;
  417.     FSaveItems: TStringList;
  418.     FSaveIndex: Integer;
  419.     FDroppingDown: Boolean;
  420.     FOnChange: TNotifyEvent;
  421.     FOnDropDown: TNotifyEvent;
  422.     FOnDrawItem: TDrawItemEvent;
  423.     FOnMeasureItem: TMeasureItemEvent;
  424.     procedure AdjustDropDown;
  425.     procedure EditWndProc(var Message: TMessage);
  426.     function GetDroppedDown: Boolean;
  427.     function GetItemIndex: Integer;
  428.     function GetSelLength: Integer;
  429.     function GetSelStart: Integer;
  430.     function GetSelText: string;
  431.     procedure ListWndProc(var Message: TMessage);
  432.     procedure SetCharCase(Value: TEditCharCase);
  433.     procedure SetDroppedDown(Value: Boolean);
  434.     procedure SetItems(Value: TStrings);
  435.     procedure SetItemIndex(Value: Integer);
  436.     procedure SetSelLength(Value: Integer);
  437.     procedure SetSelStart(Value: Integer);
  438.     procedure SetSelText(const Value: string);
  439.     procedure SetSorted(Value: Boolean);
  440.     function  GetItemHeight: Integer;
  441.     procedure SetItemHeight(Value: Integer);
  442.     procedure SetMaxLength(Value: Integer);
  443.     procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
  444.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  445.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  446.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  447.     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  448.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  449.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  450.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  451.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  452.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  453.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  454.     procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
  455.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  456.   protected
  457.     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  458.       ComboProc: Pointer); virtual;
  459.     procedure WndProc(var Message: TMessage); override;
  460.     procedure CreateParams(var Params: TCreateParams); override;
  461.     procedure CreateWnd; override;
  462.     procedure DestroyWnd; override;
  463.     procedure DrawItem(Index: Integer; Rect: TRect;
  464.       State: TOwnerDrawState); virtual;
  465.     function GetComboControl: HWND; virtual;
  466.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  467.     procedure Change; dynamic;
  468.     procedure DropDown; dynamic;
  469.     procedure SetStyle(Value: TComboBoxStyle); virtual;
  470.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
  471.     property EditHandle: HWnd read FEditHandle;
  472.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  473.     property ListHandle: HWnd read FListHandle;
  474.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  475.     property ParentColor default False;
  476.     property Sorted: Boolean read FSorted write SetSorted default False;
  477.     property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown;
  478.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  479.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  480.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  481.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  482.   public
  483.     constructor Create(AOwner: TComponent); override;
  484.     destructor Destroy; override;
  485.     procedure Clear;
  486.     function Focused: Boolean; override;
  487.     procedure SelectAll;
  488.     property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
  489.     property Canvas: TCanvas read FCanvas;
  490.     property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown;
  491.     property Items: TStrings read FItems write SetItems;
  492.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  493.     property SelLength: Integer read GetSelLength write SetSelLength;
  494.     property SelStart: Integer read GetSelStart write SetSelStart;
  495.     property SelText: string read GetSelText write SetSelText;
  496.   published
  497.     property TabStop default True;
  498.   end;
  499.  
  500.   TComboBox = class(TCustomComboBox)
  501.   published
  502.     property Style; {Must be published before Items}
  503.     property Anchors;
  504.     property BiDiMode;
  505.     property Color;
  506.     property Constraints;
  507.     property Ctl3D;
  508.     property DragCursor;
  509.     property DragKind;
  510.     property DragMode;
  511.     property DropDownCount;
  512.     property Enabled;
  513.     property Font;
  514.     property ImeMode;
  515.     property ImeName;
  516.     property ItemHeight;
  517.     property MaxLength;
  518.     property ParentBiDiMode;
  519.     property ParentColor;
  520.     property ParentCtl3D;
  521.     property ParentFont;
  522.     property ParentShowHint;
  523.     property PopupMenu;
  524.     property ShowHint;
  525.     property Sorted;
  526.     property TabOrder;
  527.     property TabStop;
  528.     property Text;
  529.     property Visible;
  530.     property OnChange;
  531.     property OnClick;
  532.     property OnContextPopup;
  533.     property OnDblClick;
  534.     property OnDragDrop;
  535.     property OnDragOver;
  536.     property OnDrawItem;
  537.     property OnDropDown;
  538.     property OnEndDock;
  539.     property OnEndDrag;
  540.     property OnEnter;
  541.     property OnExit;
  542.     property OnKeyDown;
  543.     property OnKeyPress;
  544.     property OnKeyUp;
  545.     property OnMeasureItem;
  546.     property OnStartDock;
  547.     property OnStartDrag;
  548.     property Items; { Must be published after OnMeasureItem }
  549.   end;
  550.  
  551. { TButtonControl }
  552.  
  553.   TButtonControl = class;
  554.  
  555.   TButtonActionLink = class(TWinControlActionLink)
  556.   protected
  557.     FClient: TButtonControl;
  558.     procedure AssignClient(AClient: TObject); override;
  559.     function IsCheckedLinked: Boolean; override;
  560.     procedure SetChecked(Value: Boolean); override;
  561.   end;
  562.  
  563.   TButtonActionLinkClass = class of TButtonActionLink;
  564.  
  565.   TButtonControl = class(TWinControl)
  566.   private
  567.     FClicksDisabled: Boolean;
  568.     function IsCheckedStored: Boolean;
  569.   protected
  570.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  571.     function GetActionLinkClass: TControlActionLinkClass; override;
  572.     function GetChecked: Boolean; virtual;
  573.     procedure SetChecked(Value: Boolean); virtual;
  574.     procedure WndProc(var Message: TMessage); override;
  575.     property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
  576.     property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;
  577.   public
  578.     constructor Create(AOwner: TComponent); override;
  579.   end;
  580.  
  581.   TButton = class(TButtonControl)
  582.   private
  583.     FDefault: Boolean;
  584.     FCancel: Boolean;
  585.     FActive: Boolean;
  586.     FModalResult: TModalResult;
  587.     procedure SetDefault(Value: Boolean);
  588.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  589.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  590.     procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  591.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  592.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  593.   protected
  594.     procedure CreateParams(var Params: TCreateParams); override;
  595.     procedure CreateWnd; override;
  596.     procedure SetButtonStyle(ADefault: Boolean); virtual;
  597.   public
  598.     constructor Create(AOwner: TComponent); override;
  599.     procedure Click; override;
  600.     function UseRightToLeftAlignment: Boolean; override;
  601.   published
  602.     property Action;
  603.     property Anchors;
  604.     property BiDiMode;
  605.     property Cancel: Boolean read FCancel write FCancel default False;
  606.     property Caption;
  607.     property Constraints;
  608.     property Default: Boolean read FDefault write SetDefault default False;
  609.     property DragCursor;
  610.     property DragKind;
  611.     property DragMode;
  612.     property Enabled;
  613.     property Font;
  614.     property ModalResult: TModalResult read FModalResult write FModalResult default 0;
  615.     property ParentBiDiMode;
  616.     property ParentFont;
  617.     property ParentShowHint;
  618.     property PopupMenu;
  619.     property ShowHint;
  620.     property TabOrder;
  621.     property TabStop default True;
  622.     property Visible;
  623.     property OnClick;
  624.     property OnContextPopup;
  625.     property OnDragDrop;
  626.     property OnDragOver;
  627.     property OnEndDock;
  628.     property OnEndDrag;
  629.     property OnEnter;
  630.     property OnExit;
  631.     property OnKeyDown;
  632.     property OnKeyPress;
  633.     property OnKeyUp;
  634.     property OnMouseDown;
  635.     property OnMouseMove;
  636.     property OnMouseUp;
  637.     property OnStartDock;
  638.     property OnStartDrag;
  639.   end;
  640.  
  641.   TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
  642.  
  643.   TCustomCheckBox = class(TButtonControl)
  644.   private
  645.     FAlignment: TLeftRight;
  646.     FAllowGrayed: Boolean;
  647.     FState: TCheckBoxState;
  648.     procedure SetAlignment(Value: TLeftRight);
  649.     procedure SetState(Value: TCheckBoxState);
  650.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  651.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  652.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  653.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  654.   protected
  655.     procedure Toggle; virtual;
  656.     procedure Click; override;
  657.     procedure CreateParams(var Params: TCreateParams); override;
  658.     procedure CreateWnd; override;
  659.     function GetChecked: Boolean; override;
  660.     procedure SetChecked(Value: Boolean); override;
  661.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  662.     property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
  663.     property State: TCheckBoxState read FState write SetState default cbUnchecked;
  664.   public
  665.     constructor Create(AOwner: TComponent); override;
  666.     function GetControlsAlignment: TAlignment; override;
  667.   published
  668.     property TabStop default True;
  669.   end;
  670.  
  671.   TCheckBox = class(TCustomCheckBox)
  672.   published
  673.     property Action;
  674.     property Alignment;
  675.     property AllowGrayed;
  676.     property Anchors;
  677.     property BiDiMode;
  678.     property Caption;
  679.     property Checked;
  680.     property Color;
  681.     property Constraints;
  682.     property Ctl3D;
  683.     property DragCursor;
  684.     property DragKind;
  685.     property DragMode;
  686.     property Enabled;
  687.     property Font;
  688.     property ParentBiDiMode;
  689.     property ParentColor;
  690.     property ParentCtl3D;
  691.     property ParentFont;
  692.     property ParentShowHint;
  693.     property PopupMenu;
  694.     property ShowHint;
  695.     property State;
  696.     property TabOrder;
  697.     property TabStop;
  698.     property Visible;
  699.     property OnClick;
  700.     property OnContextPopup;
  701.     property OnDragDrop;
  702.     property OnDragOver;
  703.     property OnEndDock;
  704.     property OnEndDrag;
  705.     property OnEnter;
  706.     property OnExit;
  707.     property OnKeyDown;
  708.     property OnKeyPress;
  709.     property OnKeyUp;
  710.     property OnMouseDown;
  711.     property OnMouseMove;
  712.     property OnMouseUp;
  713.     property OnStartDock;
  714.     property OnStartDrag;
  715.   end;
  716.  
  717.   TRadioButton = class(TButtonControl)
  718.   private
  719.     FAlignment: TLeftRight;
  720.     FChecked: Boolean;
  721.     procedure SetAlignment(Value: TLeftRight);
  722.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  723.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  724.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  725.   protected
  726.     function GetChecked: Boolean; override;
  727.     procedure SetChecked(Value: Boolean); override;
  728.     procedure CreateParams(var Params: TCreateParams); override;
  729.     procedure CreateWnd; override;
  730.   public
  731.     constructor Create(AOwner: TComponent); override;
  732.     function GetControlsAlignment: TAlignment; override;
  733.   published
  734.     property Action;
  735.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  736.     property Anchors;
  737.     property BiDiMode;
  738.     property Caption;
  739.     property Checked;
  740.     property Color;
  741.     property Constraints;
  742.     property Ctl3D;
  743.     property DragCursor;
  744.     property DragKind;
  745.     property DragMode;
  746.     property Enabled;
  747.     property Font;
  748.     property ParentBiDiMode;
  749.     property ParentColor;
  750.     property ParentCtl3D;
  751.     property ParentFont;
  752.     property ParentShowHint;
  753.     property PopupMenu;
  754.     property ShowHint;
  755.     property TabOrder;
  756.     property TabStop;
  757.     property Visible;
  758.     property OnClick;
  759.     property OnContextPopup;
  760.     property OnDblClick;
  761.     property OnDragDrop;
  762.     property OnDragOver;
  763.     property OnEndDock;
  764.     property OnEndDrag;
  765.     property OnEnter;
  766.     property OnExit;
  767.     property OnKeyDown;
  768.     property OnKeyPress;
  769.     property OnKeyUp;
  770.     property OnMouseDown;
  771.     property OnMouseMove;
  772.     property OnMouseUp;
  773.     property OnStartDock;
  774.     property OnStartDrag;
  775.   end;
  776.  
  777.   TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable);
  778.  
  779.   TCustomListBox = class(TWinControl)
  780.   private
  781.     FItems: TStrings;
  782.     FBorderStyle: TBorderStyle;
  783.     FCanvas: TCanvas;
  784.     FColumns: Integer;
  785.     FItemHeight: Integer;
  786.     FStyle: TListBoxStyle;
  787.     FIntegralHeight: Boolean;
  788.     FMultiSelect: Boolean;
  789.     FSorted: Boolean;
  790.     FExtendedSelect: Boolean;
  791.     FTabWidth: Integer;
  792.     FSaveItems: TStringList;
  793.     FSaveTopIndex: Integer;
  794.     FSaveItemIndex: Integer;
  795.     FOnDrawItem: TDrawItemEvent;
  796.     FOnMeasureItem: TMeasureItemEvent;
  797.     function GetItemHeight: Integer;
  798.     function GetItemIndex: Integer;
  799.     function GetSelCount: Integer;
  800.     function GetSelected(Index: Integer): Boolean;
  801.     function GetTopIndex: Integer;
  802.     procedure SetBorderStyle(Value: TBorderStyle);
  803.     procedure SetColumnWidth;
  804.     procedure SetColumns(Value: Integer);
  805.     procedure SetExtendedSelect(Value: Boolean);
  806.     procedure SetIntegralHeight(Value: Boolean);
  807.     procedure SetItemHeight(Value: Integer);
  808.     procedure SetItems(Value: TStrings);
  809.     procedure SetItemIndex(Value: Integer);
  810.     procedure SetMultiSelect(Value: Boolean);
  811.     procedure SetSelected(Index: Integer; Value: Boolean);
  812.     procedure SetSorted(Value: Boolean);
  813.     procedure SetStyle(Value: TListBoxStyle);
  814.     procedure SetTabWidth(Value: Integer);
  815.     procedure SetTopIndex(Value: Integer);
  816.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  817.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  818.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  819.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  820.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  821.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  822.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  823.   protected
  824.     FMoving: Boolean;
  825.     procedure CreateParams(var Params: TCreateParams); override;
  826.     procedure CreateWnd; override;
  827.     procedure DestroyWnd; override;
  828.     procedure WndProc(var Message: TMessage); override;
  829.     procedure DragCanceled; override;
  830.     procedure DrawItem(Index: Integer; Rect: TRect;
  831.       State: TOwnerDrawState); virtual;
  832.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  833.     function InternalGetItemData(Index: Integer): Longint; dynamic;
  834.     procedure InternalSetItemData(Index: Integer; AData: Longint); dynamic;
  835.     function GetItemData(Index: Integer): LongInt; dynamic;
  836.     procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
  837.     procedure ResetContent; dynamic;
  838.     procedure DeleteString(Index: Integer); dynamic;
  839.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  840.     property Columns: Integer read FColumns write SetColumns default 0;
  841.     property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
  842.     property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
  843.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  844.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
  845.     property ParentColor default False;
  846.     property Sorted: Boolean read FSorted write SetSorted default False;
  847.     property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
  848.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  849.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  850.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  851.   public
  852.     constructor Create(AOwner: TComponent); override;
  853.     destructor Destroy; override;
  854.     procedure Clear;
  855.     function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  856.     function ItemRect(Index: Integer): TRect;
  857.     property Canvas: TCanvas read FCanvas;
  858.     property Items: TStrings read FItems write SetItems;
  859.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  860.     property SelCount: Integer read GetSelCount;
  861.     property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
  862.     property TopIndex: Integer read GetTopIndex write SetTopIndex;
  863.   published
  864.     property TabStop default True;
  865.   end;
  866.  
  867.   TListBox = class(TCustomListBox)
  868.   published
  869.     property Align;
  870.     property Anchors;
  871.     property BiDiMode;
  872.     property BorderStyle;
  873.     property Color;
  874.     property Columns;
  875.     property Constraints;
  876.     property Ctl3D;
  877.     property DragCursor;
  878.     property DragKind;
  879.     property DragMode;
  880.     property Enabled;
  881.     property ExtendedSelect;
  882.     property Font;
  883.     property ImeMode;
  884.     property ImeName;
  885.     property IntegralHeight;
  886.     property ItemHeight;
  887.     property Items;
  888.     property MultiSelect;
  889.     property ParentBiDiMode;
  890.     property ParentColor;
  891.     property ParentCtl3D;
  892.     property ParentFont;
  893.     property ParentShowHint;
  894.     property PopupMenu;
  895.     property ShowHint;
  896.     property Sorted;
  897.     property Style;
  898.     property TabOrder;
  899.     property TabStop;
  900.     property TabWidth;
  901.     property Visible;
  902.     property OnClick;
  903.     property OnContextPopup;
  904.     property OnDblClick;
  905.     property OnDragDrop;
  906.     property OnDragOver;
  907.     property OnDrawItem;
  908.     property OnEndDock;
  909.     property OnEndDrag;
  910.     property OnEnter;
  911.     property OnExit;
  912.     property OnKeyDown;
  913.     property OnKeyPress;
  914.     property OnKeyUp;
  915.     property OnMeasureItem;
  916.     property OnMouseDown;
  917.     property OnMouseMove;
  918.     property OnMouseUp;
  919.     property OnStartDock;
  920.     property OnStartDrag;
  921.   end;
  922.  
  923.   TScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
  924.     scTrack, scTop, scBottom, scEndScroll);
  925.  
  926.   TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode;
  927.     var ScrollPos: Integer) of object;
  928.  
  929.   TScrollBar = class(TWinControl)
  930.   private
  931.     FKind: TScrollBarKind;
  932.     FPosition: Integer;
  933.     FMin: Integer;
  934.     FMax: Integer;
  935.     FPageSize: Integer;
  936.     FRTLFactor: Integer;
  937.     FSmallChange: TScrollBarInc;
  938.     FLargeChange: TScrollBarInc;
  939.     FOnChange: TNotifyEvent;
  940.     FOnScroll: TScrollEvent;
  941.     procedure DoScroll(var Message: TWMScroll);
  942.     function NotRightToLeft: Boolean;
  943.     procedure SetKind(Value: TScrollBarKind);
  944.     procedure SetMax(Value: Integer);
  945.     procedure SetMin(Value: Integer);
  946.     procedure SetPosition(Value: Integer);
  947.     procedure SetPageSize(Value: Integer);
  948.     procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  949.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  950.     procedure CNCtlColorScrollBar(var Message: TMessage); message CN_CTLCOLORSCROLLBAR;
  951.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  952.   protected
  953.     procedure CreateParams(var Params: TCreateParams); override;
  954.     procedure CreateWnd; override;
  955.     procedure Change; dynamic;
  956.     procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
  957.   public
  958.     constructor Create(AOwner: TComponent); override;
  959.     procedure SetParams(APosition, AMin, AMax: Integer);
  960.   published
  961.     property Align;
  962.     property Anchors;
  963.     property BiDiMode;
  964.     property Constraints;
  965.     property Ctl3D;
  966.     property DragCursor;
  967.     property DragKind;
  968.     property DragMode;
  969.     property Enabled;
  970.     property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
  971.     property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
  972.     property Max: Integer read FMax write SetMax default 100;
  973.     property Min: Integer read FMin write SetMin default 0;
  974.     property PageSize: Integer read FPageSize write SetPageSize;
  975.     property ParentBiDiMode;
  976.     property ParentCtl3D;
  977.     property ParentShowHint;
  978.     property PopupMenu;
  979.     property Position: Integer read FPosition write SetPosition default 0;
  980.     property ShowHint;
  981.     property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
  982.     property TabOrder;
  983.     property TabStop default True;
  984.     property Visible;
  985.     property OnContextPopup;
  986.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  987.     property OnDragDrop;
  988.     property OnDragOver;
  989.     property OnEndDock;
  990.     property OnEndDrag;
  991.     property OnEnter;
  992.     property OnExit;
  993.     property OnKeyDown;
  994.     property OnKeyPress;
  995.     property OnKeyUp;
  996.     property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
  997.     property OnStartDock;
  998.     property OnStartDrag;
  999.   end;
  1000.  
  1001.   TStaticBorderStyle = (sbsNone, sbsSingle, sbsSunken);
  1002.  
  1003.   TCustomStaticText = class(TWinControl)
  1004.   private
  1005.     FAlignment: TAlignment;
  1006.     FAutoSize: Boolean;
  1007.     FBorderStyle: TStaticBorderStyle;
  1008.     FFocusControl: TWinControl;
  1009.     FShowAccelChar: Boolean;
  1010.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  1011.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  1012.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  1013.     procedure AdjustBounds;
  1014.     procedure SetAlignment(Value: TAlignment);
  1015.     procedure SetAutoSize(Value: Boolean);
  1016.     procedure SetBorderStyle(Value: TStaticBorderStyle);
  1017.     procedure SetFocusControl(Value: TWinControl);
  1018.     procedure SetShowAccelChar(Value: Boolean);
  1019.   protected
  1020.     procedure CreateParams(var Params: TCreateParams); override;
  1021.     procedure Loaded; override;
  1022.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1023.     property Alignment: TAlignment read FAlignment write SetAlignment
  1024.       default taLeftJustify;
  1025.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  1026.     property BorderStyle: TStaticBorderStyle read FBorderStyle
  1027.       write SetBorderStyle default sbsNone;
  1028.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  1029.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar
  1030.       default True;
  1031.   public
  1032.     constructor Create(AOwner: TComponent); override;
  1033.   end;
  1034.  
  1035.   TStaticText = class(TCustomStaticText)
  1036.   published
  1037.     property Align;
  1038.     property Alignment;
  1039.     property Anchors;
  1040.     property AutoSize;
  1041.     property BiDiMode;
  1042.     property BorderStyle;
  1043.     property Caption;
  1044.     property Color;
  1045.     property Constraints;
  1046.     property DragCursor;
  1047.     property DragKind;
  1048.     property DragMode;
  1049.     property Enabled;
  1050.     property FocusControl;
  1051.     property Font;
  1052.     property ParentBiDiMode;
  1053.     property ParentColor;
  1054.     property ParentFont;
  1055.     property ParentShowHint;
  1056.     property PopupMenu;
  1057.     property ShowAccelChar;
  1058.     property ShowHint;
  1059.     property TabOrder;
  1060.     property TabStop;
  1061.     property Visible;
  1062.     property OnClick;
  1063.     property OnContextPopup;
  1064.     property OnDblClick;
  1065.     property OnDragDrop;
  1066.     property OnDragOver;
  1067.     property OnEndDock;
  1068.     property OnEndDrag;
  1069.     property OnMouseDown;
  1070.     property OnMouseMove;
  1071.     property OnMouseUp;
  1072.     property OnStartDock;
  1073.     property OnStartDrag;
  1074.   end;
  1075.  
  1076. implementation
  1077.  
  1078. uses Consts, ActnList;
  1079.  
  1080. function HasPopup(Control: TControl): Boolean;
  1081. begin
  1082.   Result := True;
  1083.   while Control <> nil do
  1084.     if TCustomEdit(Control).PopupMenu <> nil then Exit else Control := Control.Parent;
  1085.   Result := False;
  1086. end;
  1087.  
  1088. type
  1089.   TSelection = record
  1090.     StartPos, EndPos: Integer;
  1091.   end;
  1092.  
  1093.   TMemoStrings = class(TStrings)
  1094.   private
  1095.     Memo: TCustomMemo;
  1096.   protected
  1097.     function Get(Index: Integer): string; override;
  1098.     function GetCount: Integer; override;
  1099.     function GetTextStr: string; override;
  1100.     procedure Put(Index: Integer; const S: string); override;
  1101.     procedure SetTextStr(const Value: string); override;
  1102.     procedure SetUpdateState(Updating: Boolean); override;
  1103.   public
  1104.     procedure Clear; override;
  1105.     procedure Delete(Index: Integer); override;
  1106.     procedure Insert(Index: Integer; const S: string); override;
  1107.   end;
  1108.  
  1109.   TComboBoxStrings = class(TStrings)
  1110.   private
  1111.     ComboBox: TCustomComboBox;
  1112.   protected
  1113.     function Get(Index: Integer): string; override;
  1114.     function GetCount: Integer; override;
  1115.     function GetObject(Index: Integer): TObject; override;
  1116.     procedure PutObject(Index: Integer; AObject: TObject); override;
  1117.     procedure SetUpdateState(Updating: Boolean); override;
  1118.   public
  1119.     function Add(const S: string): Integer; override;
  1120.     procedure Clear; override;
  1121.     procedure Delete(Index: Integer); override;
  1122.     function IndexOf(const S: string): Integer; override;
  1123.     procedure Insert(Index: Integer; const S: string); override;
  1124.   end;
  1125.  
  1126.   TListBoxStrings = class(TStrings)
  1127.   private
  1128.     ListBox: TCustomListBox;
  1129.   protected
  1130.     procedure Put(Index: Integer; const S: string); override;
  1131.     function Get(Index: Integer): string; override;
  1132.     function GetCount: Integer; override;
  1133.     function GetObject(Index: Integer): TObject; override;
  1134.     procedure PutObject(Index: Integer; AObject: TObject); override;
  1135.     procedure SetUpdateState(Updating: Boolean); override;
  1136.   public
  1137.     function Add(const S: string): Integer; override;
  1138.     procedure Clear; override;
  1139.     procedure Delete(Index: Integer); override;
  1140.     procedure Exchange(Index1, Index2: Integer); override;
  1141.     function IndexOf(const S: string): Integer; override;
  1142.     procedure Insert(Index: Integer; const S: string); override;
  1143.     procedure Move(CurIndex, NewIndex: Integer); override;
  1144.   end;
  1145.  
  1146. const
  1147.   BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  1148.  
  1149. { TCustomGroupBox }
  1150.  
  1151. constructor TCustomGroupBox.Create(AOwner: TComponent);
  1152. begin
  1153.   inherited Create(AOwner);
  1154.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  1155.     csSetCaption, csDoubleClicks, csReplicatable];
  1156.   Width := 185;
  1157.   Height := 105;
  1158. end;
  1159.  
  1160. procedure TCustomGroupBox.AdjustClientRect(var Rect: TRect);
  1161. begin
  1162.   inherited AdjustClientRect(Rect);
  1163.   Canvas.Font := Font;
  1164.   Inc(Rect.Top, Canvas.TextHeight('0'));
  1165.   InflateRect(Rect, -1, -1);
  1166.   if Ctl3d then InflateRect(Rect, -1, -1);
  1167. end;
  1168.  
  1169. procedure TCustomGroupBox.CreateParams(var Params: TCreateParams);
  1170. begin
  1171.   inherited CreateParams(Params);
  1172.   with Params.WindowClass do
  1173.     style := style and not (CS_HREDRAW or CS_VREDRAW);
  1174. end;
  1175.  
  1176. procedure TCustomGroupBox.Paint;
  1177. var
  1178.   H: Integer;
  1179.   R: TRect;
  1180.   Flags: Longint;
  1181. begin
  1182.   with Canvas do
  1183.   begin
  1184.     Font := Self.Font;
  1185.     H := TextHeight('0');
  1186.     R := Rect(0, H div 2 - 1, Width, Height);
  1187.     if Ctl3D then
  1188.     begin
  1189.       Inc(R.Left);
  1190.       Inc(R.Top);
  1191.       Brush.Color := clBtnHighlight;
  1192.       FrameRect(R);
  1193.       OffsetRect(R, -1, -1);
  1194.       Brush.Color := clBtnShadow;
  1195.     end else
  1196.       Brush.Color := clWindowFrame;
  1197.     FrameRect(R);
  1198.     if Text <> '' then
  1199.     begin
  1200.       if not UseRightToLeftAlignment then
  1201.         R := Rect(8, 0, 0, H)
  1202.       else                         
  1203.         R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
  1204.       Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
  1205.       DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
  1206.       Brush.Color := Color;
  1207.       DrawText(Handle, PChar(Text), Length(Text), R, Flags);
  1208.     end;
  1209.   end;
  1210. end;
  1211.  
  1212. procedure TCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
  1213. begin
  1214.   with Message do
  1215.     if IsAccel(CharCode, Caption) and CanFocus then
  1216.     begin
  1217.       SelectFirst;
  1218.       Result := 1;
  1219.     end else
  1220.       inherited;
  1221. end;
  1222.  
  1223. procedure TCustomGroupBox.CMTextChanged(var Message: TMessage);
  1224. begin
  1225.   Invalidate;
  1226.   Realign;
  1227. end;
  1228.  
  1229. procedure TCustomGroupBox.CMCtl3DChanged(var Message: TMessage);
  1230. begin
  1231.   inherited;
  1232.   Invalidate;
  1233.   Realign;
  1234. end;
  1235.  
  1236. procedure TCustomGroupBox.WMSize(var Message: TMessage);
  1237. begin
  1238.   inherited;
  1239.   Invalidate;
  1240. end;
  1241.  
  1242. { TCustomLabel }
  1243.  
  1244. constructor TCustomLabel.Create(AOwner: TComponent);
  1245. begin
  1246.   inherited Create(AOwner);
  1247.   ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  1248.   Width := 65;
  1249.   Height := 17;
  1250.   FAutoSize := True;
  1251.   FShowAccelChar := True;
  1252. end;
  1253.  
  1254. function TCustomLabel.GetLabelText: string;
  1255. begin
  1256.   Result := Caption;
  1257. end;
  1258.  
  1259. procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);
  1260. var
  1261.   Text: string;
  1262. begin
  1263.   Text := GetLabelText;
  1264.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
  1265.     (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  1266.   if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
  1267.   Flags := DrawTextBiDiModeFlags(Flags);
  1268.   Canvas.Font := Font;
  1269.   if not Enabled then
  1270.   begin
  1271.     OffsetRect(Rect, 1, 1);
  1272.     Canvas.Font.Color := clBtnHighlight;
  1273.     DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  1274.     OffsetRect(Rect, -1, -1);
  1275.     Canvas.Font.Color := clBtnShadow;
  1276.     DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  1277.   end
  1278.   else
  1279.     DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  1280. end;
  1281.  
  1282. procedure TCustomLabel.Paint;
  1283. const
  1284.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  1285.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1286. var
  1287.   Rect, CalcRect: TRect;
  1288.   DrawStyle: Longint;
  1289. begin
  1290.   with Canvas do
  1291.   begin
  1292.     if not Transparent then
  1293.     begin
  1294.       Brush.Color := Self.Color;
  1295.       Brush.Style := bsSolid;
  1296.       FillRect(ClientRect);
  1297.     end;
  1298.     Brush.Style := bsClear;
  1299.     Rect := ClientRect;
  1300.     { DoDrawText takes care of BiDi alignments }
  1301.     DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
  1302.     { Calculate vertical layout }
  1303.     if FLayout <> tlTop then
  1304.     begin
  1305.       CalcRect := Rect;
  1306.       DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
  1307.       if FLayout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
  1308.       else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
  1309.     end;
  1310.     DoDrawText(Rect, DrawStyle);
  1311.   end;
  1312. end;
  1313.  
  1314. procedure TCustomLabel.Loaded;
  1315. begin
  1316.   inherited Loaded;
  1317.   AdjustBounds;
  1318. end;
  1319.  
  1320. procedure TCustomLabel.AdjustBounds;
  1321. const
  1322.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1323. var
  1324.   DC: HDC;
  1325.   X: Integer;
  1326.   Rect: TRect;
  1327.   AAlignment: TAlignment;
  1328. begin
  1329.   if not (csReading in ComponentState) and FAutoSize then
  1330.   begin
  1331.     Rect := ClientRect;
  1332.     DC := GetDC(0);
  1333.     Canvas.Handle := DC;
  1334.     DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  1335.     Canvas.Handle := 0;
  1336.     ReleaseDC(0, DC);
  1337.     X := Left;
  1338.     AAlignment := FAlignment;
  1339.     if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  1340.     if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
  1341.     SetBounds(X, Top, Rect.Right, Rect.Bottom);
  1342.   end;
  1343. end;
  1344.  
  1345. procedure TCustomLabel.SetAlignment(Value: TAlignment);
  1346. begin
  1347.   if FAlignment <> Value then
  1348.   begin
  1349.     FAlignment := Value;
  1350.     Invalidate;
  1351.   end;
  1352. end;
  1353.  
  1354. procedure TCustomLabel.SetAutoSize(Value: Boolean);
  1355. begin
  1356.   if FAutoSize <> Value then
  1357.   begin
  1358.     FAutoSize := Value;
  1359.     AdjustBounds;
  1360.   end;
  1361. end;
  1362.  
  1363. function TCustomLabel.GetTransparent: Boolean;
  1364. begin
  1365.   Result := not (csOpaque in ControlStyle);
  1366. end;
  1367.  
  1368. procedure TCustomLabel.SetFocusControl(Value: TWinControl);
  1369. begin
  1370.   FFocusControl := Value;
  1371.   if Value <> nil then Value.FreeNotification(Self);
  1372. end;
  1373.  
  1374. procedure TCustomLabel.SetShowAccelChar(Value: Boolean);
  1375. begin
  1376.   if FShowAccelChar <> Value then
  1377.   begin
  1378.     FShowAccelChar := Value;
  1379.     Invalidate;
  1380.   end;
  1381. end;
  1382.  
  1383. procedure TCustomLabel.SetTransparent(Value: Boolean);
  1384. begin
  1385.   if Transparent <> Value then
  1386.   begin
  1387.     if Value then
  1388.       ControlStyle := ControlStyle - [csOpaque] else
  1389.       ControlStyle := ControlStyle + [csOpaque];
  1390.     Invalidate;
  1391.   end;
  1392. end;
  1393.  
  1394. procedure TCustomLabel.SetLayout(Value: TTextLayout);
  1395. begin
  1396.   if FLayout <> Value then
  1397.   begin
  1398.     FLayout := Value;
  1399.     Invalidate;
  1400.   end;
  1401. end;
  1402.  
  1403. procedure TCustomLabel.SetWordWrap(Value: Boolean);
  1404. begin
  1405.   if FWordWrap <> Value then
  1406.   begin
  1407.     FWordWrap := Value;
  1408.     AdjustBounds;
  1409.     Invalidate;
  1410.   end;
  1411. end;
  1412.  
  1413. procedure TCustomLabel.Notification(AComponent: TComponent;
  1414.   Operation: TOperation);
  1415. begin
  1416.   inherited Notification(AComponent, Operation);
  1417.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  1418.     FFocusControl := nil;
  1419. end;
  1420.  
  1421. procedure TCustomLabel.CMTextChanged(var Message: TMessage);
  1422. begin
  1423.   Invalidate;
  1424.   AdjustBounds;
  1425. end;
  1426.  
  1427. procedure TCustomLabel.CMFontChanged(var Message: TMessage);
  1428. begin
  1429.   inherited;
  1430.   AdjustBounds;
  1431. end;
  1432.  
  1433. procedure TCustomLabel.CMDialogChar(var Message: TCMDialogChar);
  1434. begin
  1435.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  1436.     IsAccel(Message.CharCode, Caption) then
  1437.     with FFocusControl do
  1438.       if CanFocus then
  1439.       begin
  1440.         SetFocus;
  1441.         Message.Result := 1;
  1442.       end;
  1443. end;
  1444.  
  1445. { TCustomEdit }
  1446.  
  1447. constructor TCustomEdit.Create(AOwner: TComponent);
  1448. const
  1449.   EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
  1450. begin
  1451.   inherited Create(AOwner);
  1452.   if NewStyleControls then
  1453.     ControlStyle := EditStyle else
  1454.     ControlStyle := EditStyle + [csFramed];
  1455.   Width := 121;
  1456.   Height := 25;
  1457.   TabStop := True;
  1458.   ParentColor := False;
  1459.   FBorderStyle := bsSingle;
  1460.   FAutoSize := True;
  1461.   FAutoSelect := True;
  1462.   FHideSelection := True;
  1463.   AdjustHeight;
  1464. end;
  1465.  
  1466. procedure TCustomEdit.DoSetMaxLength(Value: Integer);
  1467. begin
  1468.   SendMessage(Handle, EM_LIMITTEXT, Value, 0)
  1469. end;
  1470.  
  1471. procedure TCustomEdit.SetAutoSize(Value: Boolean);
  1472. begin
  1473.   if FAutoSize <> Value then
  1474.   begin
  1475.     FAutoSize := Value;
  1476.     UpdateHeight;
  1477.   end;
  1478. end;
  1479.  
  1480. procedure TCustomEdit.SetBorderStyle(Value: TBorderStyle);
  1481. begin
  1482.   if FBorderStyle <> Value then
  1483.   begin
  1484.     FBorderStyle := Value;
  1485.     UpdateHeight;
  1486.     RecreateWnd;
  1487.   end;
  1488. end;
  1489.  
  1490. procedure TCustomEdit.SetCharCase(Value: TEditCharCase);
  1491. begin
  1492.   if FCharCase <> Value then
  1493.   begin
  1494.     FCharCase := Value;
  1495.     RecreateWnd;
  1496.   end;
  1497. end;
  1498.  
  1499. procedure TCustomEdit.SetHideSelection(Value: Boolean);
  1500. begin
  1501.   if FHideSelection <> Value then
  1502.   begin
  1503.     FHideSelection := Value;
  1504.     RecreateWnd;
  1505.   end;
  1506. end;
  1507.  
  1508. procedure TCustomEdit.SetMaxLength(Value: Integer);
  1509. begin
  1510.   if FMaxLength <> Value then
  1511.   begin
  1512.     FMaxLength := Value;
  1513.     if HandleAllocated then DoSetMaxLength(Value);
  1514.   end;
  1515. end;
  1516.  
  1517. procedure TCustomEdit.SetOEMConvert(Value: Boolean);
  1518. begin
  1519.   if FOEMConvert <> Value then
  1520.   begin
  1521.     FOEMConvert := Value;
  1522.     RecreateWnd;
  1523.   end;
  1524. end;
  1525.  
  1526. function TCustomEdit.GetModified: Boolean;
  1527. begin
  1528.   Result := FModified;
  1529.   if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0;
  1530. end;
  1531.  
  1532. function TCustomEdit.GetCanUndo: Boolean;
  1533. begin
  1534.   Result := False;
  1535.   if HandleAllocated then Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
  1536. end;
  1537.  
  1538. procedure TCustomEdit.SetModified(Value: Boolean);
  1539. begin
  1540.   if HandleAllocated then
  1541.     SendMessage(Handle, EM_SETMODIFY, Byte(Value), 0) else
  1542.     FModified := Value;
  1543. end;
  1544.  
  1545. procedure TCustomEdit.SetPasswordChar(Value: Char);
  1546. begin
  1547.   if FPasswordChar <> Value then
  1548.   begin
  1549.     FPasswordChar := Value;
  1550.     if HandleAllocated then
  1551.     begin
  1552.       SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1553.       SetTextBuf(PChar(Text));
  1554.     end;
  1555.   end;
  1556. end;
  1557.  
  1558. procedure TCustomEdit.SetReadOnly(Value: Boolean);
  1559. begin
  1560.   if FReadOnly <> Value then
  1561.   begin
  1562.     FReadOnly := Value;
  1563.     if HandleAllocated then
  1564.       SendMessage(Handle, EM_SETREADONLY, Ord(Value), 0);
  1565.   end;
  1566. end;
  1567.  
  1568. function TCustomEdit.GetSelStart: Integer;
  1569. begin
  1570.   SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
  1571. end;
  1572.  
  1573. procedure TCustomEdit.SetSelStart(Value: Integer);
  1574. begin
  1575.   SendMessage(Handle, EM_SETSEL, Value, Value);
  1576. end;
  1577.  
  1578. function TCustomEdit.GetSelLength: Integer;
  1579. var
  1580.   Selection: TSelection;
  1581. begin
  1582.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1583.   Result := Selection.EndPos - Selection.StartPos;
  1584. end;
  1585.  
  1586. procedure TCustomEdit.SetSelLength(Value: Integer);
  1587. var
  1588.   Selection: TSelection;
  1589. begin
  1590.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1591.   Selection.EndPos := Selection.StartPos + Value;
  1592.   SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  1593.   SendMessage(Handle, EM_SCROLLCARET, 0,0);
  1594. end;
  1595.  
  1596. procedure TCustomEdit.Clear;
  1597. begin
  1598.   SetWindowText(Handle, '');
  1599. end;
  1600.  
  1601. procedure TCustomEdit.ClearSelection;
  1602. begin
  1603.   SendMessage(Handle, WM_CLEAR, 0, 0);
  1604. end;
  1605.  
  1606. procedure TCustomEdit.CopyToClipboard;
  1607. begin
  1608.   SendMessage(Handle, WM_COPY, 0, 0);
  1609. end;
  1610.  
  1611. procedure TCustomEdit.CutToClipboard;
  1612. begin
  1613.   SendMessage(Handle, WM_CUT, 0, 0);
  1614. end;
  1615.  
  1616. procedure TCustomEdit.PasteFromClipboard;
  1617. begin
  1618.   SendMessage(Handle, WM_PASTE, 0, 0);
  1619. end;
  1620.  
  1621. procedure TCustomEdit.Undo;
  1622. begin
  1623.   SendMessage(Handle, WM_UNDO, 0, 0);
  1624. end;
  1625.  
  1626. procedure TCustomEdit.ClearUndo;
  1627. begin
  1628.   SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
  1629. end;
  1630.  
  1631. procedure TCustomEdit.SelectAll;
  1632. begin
  1633.   SendMessage(Handle, EM_SETSEL, 0, -1);
  1634. end;
  1635.  
  1636. function TCustomEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  1637. var
  1638.   P: PChar;
  1639.   StartPos: Integer;
  1640. begin
  1641.   StartPos := GetSelStart;
  1642.   Result := GetSelLength;
  1643.   P := StrAlloc(GetTextLen + 1);
  1644.   try
  1645.     GetTextBuf(P, StrBufSize(P));
  1646.     if Result >= BufSize then Result := BufSize - 1;
  1647.     StrLCopy(Buffer, P + StartPos, Result);
  1648.   finally
  1649.     StrDispose(P);
  1650.   end;
  1651. end;
  1652.  
  1653. procedure TCustomEdit.SetSelTextBuf(Buffer: PChar);
  1654. begin
  1655.   SendMessage(Handle, EM_REPLACESEL, 0, LongInt(Buffer));
  1656. end;
  1657.  
  1658. function TCustomEdit.GetSelText: string;
  1659. var
  1660.   P: PChar;
  1661.   SelStart, Len: Integer;
  1662. begin
  1663.   SelStart := GetSelStart;
  1664.   Len := GetSelLength;
  1665.   SetString(Result, PChar(nil), Len);
  1666.   if Len <> 0 then
  1667.   begin
  1668.     P := StrAlloc(GetTextLen + 1);
  1669.     try
  1670.       GetTextBuf(P, StrBufSize(P));
  1671.       Move(P[SelStart], Pointer(Result)^, Len);
  1672.     finally
  1673.       StrDispose(P);
  1674.     end;
  1675.   end;
  1676. end;
  1677.  
  1678. procedure TCustomEdit.SetSelText(const Value: String);
  1679. begin
  1680.   SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  1681. end;
  1682.  
  1683. procedure TCustomEdit.CreateParams(var Params: TCreateParams);
  1684. const
  1685.   Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
  1686.   ReadOnlys: array[Boolean] of DWORD = (0, ES_READONLY);
  1687.   CharCases: array[TEditCharCase] of DWORD = (0, ES_UPPERCASE, ES_LOWERCASE);
  1688.   HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  1689.   OEMConverts: array[Boolean] of DWORD = (0, ES_OEMCONVERT);
  1690. begin
  1691.   inherited CreateParams(Params);
  1692.   CreateSubClass(Params, 'EDIT');
  1693.   with Params do
  1694.   begin
  1695.     Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
  1696.       BorderStyles[FBorderStyle] or Passwords[FPasswordChar <> #0] or
  1697.       ReadOnlys[FReadOnly] or CharCases[FCharCase] or
  1698.       HideSelections[FHideSelection] or OEMConverts[FOEMConvert];
  1699.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  1700.     begin
  1701.       Style := Style and not WS_BORDER;
  1702.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  1703.     end;
  1704.   end;
  1705. end;
  1706.  
  1707. procedure TCustomEdit.CreateWindowHandle(const Params: TCreateParams);
  1708. var
  1709.   P: TCreateParams;
  1710. begin
  1711.   if SysLocale.FarEast and (Win32Platform <> VER_PLATFORM_WIN32_NT) and
  1712.     ((Params.Style and ES_READONLY) <> 0) then
  1713.   begin
  1714.     // Work around Far East Win95 API/IME bug.
  1715.     P := Params;
  1716.     P.Style := P.Style and (not ES_READONLY);
  1717.     inherited CreateWindowHandle(P);
  1718.     if WindowHandle <> 0 then
  1719.       SendMessage(WindowHandle, EM_SETREADONLY, Ord(True), 0);
  1720.   end
  1721.   else
  1722.     inherited CreateWindowHandle(Params);
  1723. end;
  1724.  
  1725. procedure TCustomEdit.CreateWnd;
  1726. begin
  1727.   FCreating := True;
  1728.   try
  1729.     inherited CreateWnd;
  1730.   finally
  1731.     FCreating := False;
  1732.   end;
  1733.   DoSetMaxLength(FMaxLength);
  1734.   Modified := FModified;
  1735.   if FPasswordChar <> #0 then
  1736.     SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1737.   UpdateHeight;
  1738. end;
  1739.  
  1740. procedure TCustomEdit.DestroyWnd;
  1741. begin
  1742.   FModified := Modified;
  1743.   inherited DestroyWnd;
  1744. end;
  1745.  
  1746. procedure TCustomEdit.UpdateHeight;
  1747. begin
  1748.   if FAutoSize and (BorderStyle = bsSingle) then
  1749.   begin
  1750.     ControlStyle := ControlStyle + [csFixedHeight];
  1751.     AdjustHeight;
  1752.   end else
  1753.     ControlStyle := ControlStyle - [csFixedHeight];
  1754. end;
  1755.  
  1756. procedure TCustomEdit.AdjustHeight;
  1757. var
  1758.   DC: HDC;
  1759.   SaveFont: HFont;
  1760.   I: Integer;
  1761.   SysMetrics, Metrics: TTextMetric;
  1762. begin
  1763.   DC := GetDC(0);
  1764.   GetTextMetrics(DC, SysMetrics);
  1765.   SaveFont := SelectObject(DC, Font.Handle);
  1766.   GetTextMetrics(DC, Metrics);
  1767.   SelectObject(DC, SaveFont);
  1768.   ReleaseDC(0, DC);
  1769.   if NewStyleControls then
  1770.   begin
  1771.     if Ctl3D then I := 8 else I := 6;
  1772.     I := GetSystemMetrics(SM_CYBORDER) * I;
  1773.   end else
  1774.   begin
  1775.     I := SysMetrics.tmHeight;
  1776.     if I > Metrics.tmHeight then I := Metrics.tmHeight;
  1777.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  1778.   end;
  1779.   Height := Metrics.tmHeight + I;
  1780. end;
  1781.  
  1782. procedure TCustomEdit.Change;
  1783. begin
  1784.   inherited Changed;
  1785.   if Assigned(FOnChange) then FOnChange(Self);
  1786. end;
  1787.  
  1788. procedure TCustomEdit.DefaultHandler(var Message);
  1789. begin
  1790.   case TMessage(Message).Msg of
  1791.     WM_SETFOCUS:
  1792.       if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  1793.         not IsWindow(TWMSetFocus(Message).FocusedWnd) then
  1794.         TWMSetFocus(Message).FocusedWnd := 0;
  1795.   end;
  1796.   inherited;
  1797. end;
  1798.  
  1799. procedure TCustomEdit.WMSetFont(var Message: TWMSetFont);
  1800. begin
  1801.   inherited;
  1802.   if NewStyleControls and
  1803.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then
  1804.     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  1805. end;
  1806.  
  1807. procedure TCustomEdit.CMCtl3DChanged(var Message: TMessage);
  1808. begin
  1809.   if NewStyleControls and (FBorderStyle = bsSingle) then
  1810.   begin
  1811.     UpdateHeight;
  1812.     RecreateWnd;
  1813.   end;
  1814.   inherited;
  1815. end;
  1816.  
  1817. procedure TCustomEdit.CMFontChanged(var Message: TMessage);
  1818. begin
  1819.   inherited;
  1820.   if (csFixedHeight in ControlStyle) and not ((csDesigning in
  1821.     ComponentState) and (csLoading in ComponentState)) then AdjustHeight;
  1822. end;
  1823.  
  1824. procedure TCustomEdit.CNCommand(var Message: TWMCommand);
  1825. begin
  1826.   if (Message.NotifyCode = EN_CHANGE) and not FCreating then Change;
  1827. end;
  1828.  
  1829. procedure TCustomEdit.CMEnter(var Message: TCMGotFocus);
  1830. begin
  1831.   if FAutoSelect and not (csLButtonDown in ControlState) and
  1832.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then SelectAll;
  1833.   inherited;
  1834. end;
  1835.  
  1836. procedure TCustomEdit.CMTextChanged(var Message: TMessage);
  1837. begin
  1838.   inherited;
  1839.   if not HandleAllocated or (GetWindowLong(Handle, GWL_STYLE) and
  1840.     ES_MULTILINE <> 0) then Change;
  1841. end;
  1842.  
  1843. { TMemoStrings }
  1844.  
  1845. function TMemoStrings.GetCount: Integer;
  1846. begin
  1847.   Result := 0;
  1848.   if Memo.HandleAllocated then
  1849.   begin
  1850.     Result := SendMessage(Memo.Handle, EM_GETLINECOUNT, 0, 0);
  1851.     if SendMessage(Memo.Handle, EM_LINELENGTH, SendMessage(Memo.Handle,
  1852.       EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  1853.   end;
  1854. end;
  1855.  
  1856. function TMemoStrings.Get(Index: Integer): string;
  1857. var
  1858.   Text: array[0..4095] of Char;
  1859. begin
  1860.   Word((@Text)^) := SizeOf(Text);
  1861.   SetString(Result, Text, SendMessage(Memo.Handle, EM_GETLINE, Index,
  1862.     Longint(@Text)));
  1863. end;
  1864.  
  1865. procedure TMemoStrings.Put(Index: Integer; const S: string);
  1866. var
  1867.   SelStart: Integer;
  1868. begin
  1869.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1870.   if SelStart >= 0 then
  1871.   begin
  1872.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart +
  1873.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0));
  1874.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  1875.   end;
  1876. end;
  1877.  
  1878. procedure TMemoStrings.Insert(Index: Integer; const S: string);
  1879. var
  1880.   SelStart, LineLen: Integer;
  1881.   Line: string;
  1882. begin
  1883.   if Index >= 0 then
  1884.   begin
  1885.     SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1886.     if SelStart >= 0 then Line := S + #13#10 else
  1887.     begin
  1888.       SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index - 1, 0);
  1889.       if SelStart < 0 then Exit;
  1890.       LineLen := SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1891.       if LineLen = 0 then Exit;
  1892.       Inc(SelStart, LineLen);
  1893.       Line := #13#10 + s;
  1894.     end;
  1895.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart);
  1896.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
  1897.   end;
  1898. end;
  1899.  
  1900. procedure TMemoStrings.Delete(Index: Integer);
  1901. const
  1902.   Empty: PChar = '';
  1903. var
  1904.   SelStart, SelEnd: Integer;
  1905. begin
  1906.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1907.   if SelStart >= 0 then
  1908.   begin
  1909.     SelEnd := SendMessage(Memo.Handle, EM_LINEINDEX, Index + 1, 0);
  1910.     if SelEnd < 0 then SelEnd := SelStart +
  1911.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1912.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelEnd);
  1913.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(Empty));
  1914.   end;
  1915. end;
  1916.  
  1917. procedure TMemoStrings.Clear;
  1918. begin
  1919.   Memo.Clear;
  1920. end;
  1921.  
  1922. procedure TMemoStrings.SetUpdateState(Updating: Boolean);
  1923. begin
  1924.   if Memo.HandleAllocated then
  1925.   begin
  1926.     SendMessage(Memo.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1927.     if not Updating then
  1928.     begin   // WM_SETREDRAW causes visibility side effects in memo controls
  1929.       Memo.Perform(CM_SHOWINGCHANGED,0,0); // This reasserts the visibility we want
  1930.       Memo.Refresh;
  1931.     end;
  1932.   end;
  1933. end;
  1934.  
  1935. function TMemoStrings.GetTextStr: string;
  1936. begin
  1937.   Result := Memo.Text;
  1938. end;
  1939.  
  1940. procedure TMemoStrings.SetTextStr(const Value: string);
  1941. var
  1942.   NewText: string;
  1943. begin
  1944.   NewText := AdjustLineBreaks(Value);
  1945.   if (Length(NewText) <> Memo.GetTextLen) or (NewText <> Memo.Text) then
  1946.   begin
  1947.     if SendMessage(Memo.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
  1948.       raise EInvalidOperation.Create(SInvalidMemoSize);
  1949.     Memo.Perform(CM_TEXTCHANGED, 0, 0);
  1950.   end;
  1951. end;
  1952.  
  1953. { TCustomMemo }
  1954.  
  1955. constructor TCustomMemo.Create(AOwner: TComponent);
  1956. begin
  1957.   inherited Create(AOwner);
  1958.   Width := 185;
  1959.   Height := 89;
  1960.   AutoSize := False;
  1961.   FWordWrap := True;
  1962.   FWantReturns := True;
  1963.   FLines := TMemoStrings.Create;
  1964.   TMemoStrings(FLines).Memo := Self;
  1965. end;
  1966.  
  1967. destructor TCustomMemo.Destroy;
  1968. begin
  1969.   FLines.Free;
  1970.   inherited Destroy;
  1971. end;
  1972.  
  1973. procedure TCustomMemo.CreateParams(var Params: TCreateParams);
  1974. const
  1975.   Alignments: array[Boolean, TAlignment] of DWORD =
  1976.     ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
  1977.   ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
  1978.     WS_HSCROLL or WS_VSCROLL);
  1979.   WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
  1980. begin
  1981.   inherited CreateParams(Params);
  1982.   with Params do
  1983.   begin
  1984.     Style := Style and not WordWraps[FWordWrap] or ES_MULTILINE or
  1985.       Alignments[UseRightToLeftAlignment, FAlignment] or ScrollBar[FScrollBars];
  1986.   end;
  1987. end;
  1988.  
  1989. procedure TCustomMemo.CreateWindowHandle(const Params: TCreateParams);
  1990. begin
  1991.   with Params do
  1992.   begin
  1993.     if SysLocale.FarEast and (Win32Platform <> VER_PLATFORM_WIN32_NT) and
  1994.       ((Style and ES_READONLY) <> 0) then
  1995.     begin
  1996.       // Work around Far East Win95 API/IME bug.
  1997.       WindowHandle := CreateWindowEx(ExStyle, WinClassName, '',
  1998.         Style and (not ES_READONLY),
  1999.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2000.       if WindowHandle <> 0 then
  2001.         SendMessage(WindowHandle, EM_SETREADONLY, Ord(True), 0);
  2002.     end
  2003.     else
  2004.       WindowHandle := CreateWindowEx(ExStyle, WinClassName, '', Style,
  2005.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2006.     SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  2007.   end;
  2008. end;
  2009.  
  2010. function TCustomMemo.GetCaretPos: TPoint;
  2011. begin
  2012.   Result.X := LongRec(SendMessage(Handle, EM_GETSEL, 0, 0)).Hi;
  2013.   Result.Y := SendMessage(Handle, EM_LINEFROMCHAR, Result.X, 0);
  2014.   Result.X := Result.X - SendMessage(Handle, EM_LINEINDEX, -1, 0);
  2015. end;
  2016.  
  2017. function TCustomMemo.GetControlsAlignment: TAlignment;
  2018. begin
  2019.   Result := FAlignment;
  2020. end;
  2021.  
  2022. procedure TCustomMemo.Loaded;
  2023. begin
  2024.   inherited Loaded;
  2025.   Modified := False;
  2026. end;
  2027.  
  2028. procedure TCustomMemo.SetAlignment(Value: TAlignment);
  2029. begin
  2030.   if FAlignment <> Value then
  2031.   begin
  2032.     FAlignment := Value;
  2033.     RecreateWnd;
  2034.   end;
  2035. end;
  2036.  
  2037. procedure TCustomMemo.SetLines(Value: TStrings);
  2038. begin
  2039.   FLines.Assign(Value);
  2040. end;
  2041.  
  2042. procedure TCustomMemo.SetScrollBars(Value: TScrollStyle);
  2043. begin
  2044.   if FScrollBars <> Value then
  2045.   begin
  2046.     FScrollBars := Value;
  2047.     RecreateWnd;
  2048.   end;
  2049. end;
  2050.  
  2051. procedure TCustomMemo.SetWordWrap(Value: Boolean);
  2052. begin
  2053.   if Value <> FWordWrap then
  2054.   begin
  2055.     FWordWrap := Value;
  2056.     RecreateWnd;
  2057.   end;
  2058. end;
  2059.  
  2060. procedure TCustomMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
  2061. begin
  2062.   inherited;
  2063.   if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
  2064.   else Message.Result := Message.Result and not DLGC_WANTTAB;
  2065.   if not FWantReturns then
  2066.     Message.Result := Message.Result and not DLGC_WANTALLKEYS;
  2067. end;
  2068.  
  2069. procedure TCustomMemo.WMNCDestroy(var Message: TWMNCDestroy);
  2070. begin
  2071.   inherited;
  2072. end;
  2073.  
  2074. procedure TCustomMemo.KeyPress(var Key: Char);
  2075. begin
  2076.   inherited KeyPress(Key);
  2077.   if (Key = Char(VK_RETURN)) and not FWantReturns then Key := #0;
  2078. end;
  2079.  
  2080. { TComboBoxStrings }
  2081.  
  2082. function TComboBoxStrings.GetCount: Integer;
  2083. begin
  2084.   Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
  2085. end;
  2086.  
  2087. function TComboBoxStrings.Get(Index: Integer): string;
  2088. var
  2089.   Text: array[0..4095] of Char;
  2090.   Len: Integer;
  2091. begin
  2092.   Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(@Text));
  2093.   if Len = CB_ERR then Len := 0;
  2094.   SetString(Result, Text, Len);
  2095. end;
  2096.  
  2097. function TComboBoxStrings.GetObject(Index: Integer): TObject;
  2098. begin
  2099.   Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
  2100.   if Longint(Result) = CB_ERR then
  2101.     Error(SListIndexError, Index);
  2102. end;
  2103.  
  2104. procedure TComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
  2105. begin
  2106.   SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(AObject));
  2107. end;
  2108.  
  2109. function TComboBoxStrings.Add(const S: string): Integer;
  2110. begin
  2111.   Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  2112.   if Result < 0 then
  2113.     raise EOutOfResources.Create(SInsertLineError);
  2114. end;
  2115.  
  2116. procedure TComboBoxStrings.Insert(Index: Integer; const S: string);
  2117. begin
  2118.   if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
  2119.     Longint(PChar(S))) < 0 then
  2120.     raise EOutOfResources.Create(SInsertLineError);
  2121. end;
  2122.  
  2123. procedure TComboBoxStrings.Delete(Index: Integer);
  2124. begin
  2125.   SendMessage(ComboBox.Handle, CB_DELETESTRING, Index, 0);
  2126. end;
  2127.  
  2128. procedure TComboBoxStrings.Clear;
  2129. var
  2130.   S: string;
  2131. begin
  2132.   S := ComboBox.Text;
  2133.   SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
  2134.   ComboBox.Text := S;
  2135.   ComboBox.Update;
  2136. end;
  2137.  
  2138. procedure TComboBoxStrings.SetUpdateState(Updating: Boolean);
  2139. begin
  2140.   SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  2141.   if not Updating then ComboBox.Refresh;
  2142. end;
  2143.  
  2144. function TComboBoxStrings.IndexOf(const S: string): Integer;
  2145. begin
  2146.   Result := SendMessage(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PChar(S)));
  2147. end;
  2148.  
  2149. { TCustomComboBox }
  2150.  
  2151. constructor TCustomComboBox.Create(AOwner: TComponent);
  2152. const
  2153.   ComboBoxStyle = [csCaptureMouse, csSetCaption, csDoubleClicks,
  2154.     csFixedHeight, csReflector];
  2155. begin
  2156.   inherited Create(AOwner);
  2157.   if NewStyleControls then
  2158.     ControlStyle := ComboBoxStyle else
  2159.     ControlStyle := ComboBoxStyle + [csFramed];
  2160.   Width := 145;
  2161.   Height := 25;
  2162.   TabStop := True;
  2163.   ParentColor := False;
  2164.   FItems := TComboBoxStrings.Create;
  2165.   TComboBoxStrings(FItems).ComboBox := Self;
  2166.   FCanvas := TControlCanvas.Create;
  2167.   FItemHeight := 16;
  2168.   FStyle := csDropDown;
  2169.   FEditInstance := MakeObjectInstance(EditWndProc);
  2170.   FListInstance := MakeObjectInstance(ListWndProc);
  2171.   FDropDownCount := 8;
  2172.   FSaveIndex := -1;
  2173. end;
  2174.  
  2175. destructor TCustomComboBox.Destroy;
  2176. begin
  2177.   if HandleAllocated then DestroyWindowHandle;
  2178.   FreeObjectInstance(FListInstance);
  2179.   FreeObjectInstance(FEditInstance);
  2180.   FCanvas.Free;
  2181.   FItems.Free;
  2182.   FSaveItems.Free;
  2183.   inherited Destroy;
  2184. end;
  2185.  
  2186. procedure TCustomComboBox.Clear;
  2187. begin
  2188.   SetTextBuf('');
  2189.   FItems.Clear;
  2190.   FSaveIndex := -1;
  2191. end;
  2192.  
  2193. procedure TCustomComboBox.SelectAll;
  2194. begin
  2195.   SendMessage(Handle, CB_SETEDITSEL, 0, Integer($FFFF0000));
  2196. end;
  2197.  
  2198. function TCustomComboBox.GetDroppedDown: Boolean;
  2199. begin
  2200.   Result := LongBool(SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0));
  2201. end;
  2202.  
  2203. procedure TCustomComboBox.SetDroppedDown(Value: Boolean);
  2204. var
  2205.   R: TRect;
  2206. begin
  2207.   SendMessage(Handle, CB_SHOWDROPDOWN, Longint(Value), 0);
  2208.   R := ClientRect;
  2209.   InvalidateRect(Handle, @R, True);
  2210. end;
  2211.  
  2212. function TCustomComboBox.GetItemIndex: Integer;
  2213. begin
  2214.   Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
  2215. end;
  2216.  
  2217. procedure TCustomComboBox.SetItemIndex(Value: Integer);
  2218. begin
  2219.   if GetItemIndex <> Value then
  2220.     SendMessage(Handle, CB_SETCURSEL, Value, 0);
  2221. end;
  2222.  
  2223. function TCustomComboBox.GetSelStart: Integer;
  2224. begin
  2225.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Result), 0);
  2226. end;
  2227.  
  2228. procedure TCustomComboBox.SetSelStart(Value: Integer);
  2229. var
  2230.   Selection: TSelection;
  2231. begin
  2232.   Selection.StartPos := Value;
  2233.   Selection.EndPos := Value;
  2234.   SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos,
  2235.     Selection.EndPos));
  2236. end;
  2237.  
  2238. function TCustomComboBox.GetSelLength: Integer;
  2239. var
  2240.   Selection: TSelection;
  2241. begin
  2242.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  2243.     Longint(@Selection.EndPos));
  2244.   Result := Selection.EndPos - Selection.StartPos;
  2245. end;
  2246.  
  2247. procedure TCustomComboBox.SetSelLength(Value: Integer);
  2248. var
  2249.   Selection: TSelection;
  2250. begin
  2251.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  2252.     Longint(@Selection.EndPos));
  2253.   Selection.EndPos := Selection.StartPos + Value;
  2254.   SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos,
  2255.     Selection.EndPos));
  2256. end;
  2257.  
  2258. function TCustomComboBox.GetSelText: string;
  2259. begin
  2260.   Result := '';
  2261.   if FStyle < csDropDownList then
  2262.     Result := Copy(Text, GetSelStart + 1, GetSelLength);
  2263. end;
  2264.  
  2265. procedure TCustomComboBox.SetSelText(const Value: string);
  2266. begin
  2267.   if FStyle < csDropDownList then
  2268.   begin
  2269.     HandleNeeded;
  2270.     SendMessage(FEditHandle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  2271.   end;
  2272. end;
  2273.  
  2274. procedure TCustomComboBox.SetMaxLength(Value: Integer);
  2275. begin
  2276.   if Value < 0 then Value := 0;
  2277.   if FMaxLength <> Value then
  2278.   begin
  2279.     FMaxLength := Value;
  2280.     if HandleAllocated then SendMessage(Handle, CB_LIMITTEXT, Value, 0);
  2281.   end;
  2282. end;
  2283.  
  2284. procedure TCustomComboBox.SetSorted(Value: Boolean);
  2285. begin
  2286.   if FSorted <> Value then
  2287.   begin
  2288.     FSorted := Value;
  2289.     RecreateWnd;
  2290.   end;
  2291. end;
  2292.  
  2293. procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
  2294. begin
  2295.   if FStyle <> Value then
  2296.   begin
  2297.     FStyle := Value;
  2298.     if Value = csSimple then
  2299.       ControlStyle := ControlStyle - [csFixedHeight] else
  2300.       ControlStyle := ControlStyle + [csFixedHeight];
  2301.     RecreateWnd;
  2302.   end;
  2303. end;
  2304.  
  2305. function TCustomComboBox.GetItemHeight: Integer;
  2306. begin
  2307.   if FStyle in [csOwnerDrawFixed, csOwnerDrawVariable] then
  2308.     Result := FItemHeight else
  2309.     Result := Perform(CB_GETITEMHEIGHT, 0, 0);
  2310. end;
  2311.  
  2312. procedure TCustomComboBox.SetItemHeight(Value: Integer);
  2313. begin
  2314.   if Value > 0 then
  2315.   begin
  2316.     FItemHeight := Value;
  2317.     RecreateWnd;
  2318.   end;
  2319. end;
  2320.  
  2321. procedure TCustomComboBox.SetItems(Value: TStrings);
  2322. begin
  2323.   Items.Assign(Value);
  2324. end;
  2325.  
  2326. procedure TCustomComboBox.CreateParams(var Params: TCreateParams);
  2327. const
  2328.   ComboBoxStyles: array[TComboBoxStyle] of DWORD = (
  2329.     CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
  2330.     CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
  2331.     CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
  2332.   CharCases: array[TEditCharCase] of DWORD = (0, CBS_UPPERCASE, CBS_LOWERCASE);
  2333.   Sorts: array[Boolean] of DWORD = (0, CBS_SORT);
  2334. begin
  2335.   inherited CreateParams(Params);
  2336.   CreateSubClass(Params, 'COMBOBOX');
  2337.   with Params do
  2338.   begin
  2339.     Style := Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL) or
  2340.       ComboBoxStyles[FStyle] or Sorts[FSorted] or CharCases[FCharCase];
  2341.   end;
  2342. end;
  2343.  
  2344. procedure TCustomComboBox.CreateWnd;
  2345. var
  2346.   ChildHandle: THandle;
  2347. begin
  2348.   inherited CreateWnd;
  2349.   SendMessage(Handle, CB_LIMITTEXT, FMaxLength, 0);
  2350.   if FSaveItems <> nil then
  2351.   begin
  2352.     FItems.Assign(FSaveItems);
  2353.     FSaveItems.Free;
  2354.     FSaveItems := nil;
  2355.     if FSaveIndex <> -1 then
  2356.     begin
  2357.       if FItems.Count < FSaveIndex then FSaveIndex := Items.Count;
  2358.       SendMessage(Handle, CB_SETCURSEL, FSaveIndex, 0);
  2359.     end;
  2360.   end;
  2361.   FEditHandle := 0;
  2362.   FListHandle := 0;
  2363.   if FStyle in [csDropDown, csSimple] then
  2364.   begin
  2365.     ChildHandle := GetWindow(GetComboControl, GW_CHILD);
  2366.     if ChildHandle <> 0 then
  2367.     begin
  2368.       if FStyle = csSimple then
  2369.       begin
  2370.         FListHandle := ChildHandle;
  2371.         FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
  2372.         SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
  2373.         ChildHandle := GetWindow(ChildHandle, GW_HWNDNEXT);
  2374.       end;
  2375.       FEditHandle := ChildHandle;
  2376.       FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  2377.       SetWindowLong(FEditHandle, GWL_WNDPROC, Longint(FEditInstance));
  2378.     end;
  2379.   end;
  2380.   if NewStyleControls and (FEditHandle <> 0) then
  2381.     SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  2382. end;
  2383.  
  2384. procedure TCustomComboBox.DestroyWnd;
  2385. begin
  2386.   if FItems.Count > 0 then
  2387.   begin
  2388.     FSaveIndex := ItemIndex;
  2389.     FSaveItems := TStringList.Create;
  2390.     FSaveItems.Assign(FItems);
  2391.   end;
  2392.   inherited DestroyWnd;
  2393. end;
  2394.  
  2395. procedure TCustomComboBox.WMCreate(var Message: TWMCreate);
  2396. begin
  2397.   inherited;
  2398.   if WindowText <> nil then
  2399.     SetWindowText(Handle, WindowText);
  2400. end;
  2401.  
  2402. procedure TCustomComboBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2403. begin
  2404.   if Style = csSimple then
  2405.   begin
  2406.     FillRect(Message.DC, ClientRect, Parent.Brush.Handle);
  2407.     Message.Result := 1;
  2408.   end
  2409.   else
  2410.     DefaultHandler(Message);
  2411. end;
  2412.  
  2413. procedure TCustomComboBox.WMDrawItem(var Message: TWMDrawItem);
  2414. begin
  2415.   DefaultHandler(Message);
  2416. end;
  2417.  
  2418. procedure TCustomComboBox.WMMeasureItem(var Message: TWMMeasureItem);
  2419. begin
  2420.   DefaultHandler(Message);
  2421. end;
  2422.  
  2423. procedure TCustomComboBox.WMDeleteItem(var Message: TWMDeleteItem);
  2424. begin
  2425.   DefaultHandler(Message);
  2426. end;
  2427.  
  2428. procedure TCustomComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
  2429. begin
  2430.   inherited;
  2431.   if DroppedDown then Message.Result := Message.Result or DLGC_WANTALLKEYS;
  2432. end;
  2433.  
  2434. procedure TCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
  2435. begin
  2436.   if Message.Sender <> Self then Perform(CB_SHOWDROPDOWN, 0, 0);
  2437. end;
  2438.  
  2439. procedure TCustomComboBox.CMCtl3DChanged(var Message: TMessage);
  2440. begin
  2441.   if NewStyleControls then RecreateWnd;
  2442.   inherited;
  2443. end;
  2444.  
  2445. procedure TCustomComboBox.CMParentColorChanged(var Message: TMessage);
  2446. begin
  2447.   inherited;
  2448.   if not NewStyleControls and (Style < csDropDownList) then Invalidate;
  2449. end;
  2450.  
  2451. procedure TCustomComboBox.EditWndProc(var Message: TMessage);
  2452. var
  2453.   P: TPoint;
  2454.   Form: TCustomForm;
  2455. begin
  2456.   if Message.Msg = WM_SYSCOMMAND then
  2457.   begin
  2458.     WndProc(Message);
  2459.     Exit;
  2460.   end
  2461.   else if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
  2462.   begin
  2463.     Form := GetParentForm(Self);
  2464.     if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
  2465.   end;
  2466.   ComboWndProc(Message, FEditHandle, FDefEditProc);
  2467.   case Message.Msg of
  2468.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2469.       begin
  2470.         if DragMode = dmAutomatic then
  2471.         begin
  2472.           GetCursorPos(P);
  2473.           P := ScreenToClient(P);
  2474.           SendMessage(FEditHandle, WM_LBUTTONUP, 0,Longint(PointToSmallPoint(P)));
  2475.           BeginDrag(False);
  2476.         end;
  2477.       end;
  2478.     WM_SETFONT:
  2479.       if NewStyleControls then
  2480.         SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  2481.   end;
  2482. end;
  2483.  
  2484. procedure TCustomComboBox.ListWndProc(var Message: TMessage);
  2485. begin
  2486.   ComboWndProc(Message, FListHandle, FDefListProc);
  2487. end;
  2488.  
  2489. function TCustomComboBox.GetComboControl: HWND;
  2490. begin
  2491.   Result := Handle;
  2492. end;
  2493.  
  2494. procedure TCustomComboBox.SetCharCase(Value: TEditCharCase);
  2495. begin
  2496.   if FCharCase <> Value then
  2497.   begin
  2498.     FCharCase := Value;
  2499.     RecreateWnd;
  2500.   end;
  2501. end;
  2502.  
  2503. procedure TCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  2504.   ComboProc: Pointer);
  2505. var
  2506.   Point: TPoint;
  2507.   Form: TCustomForm;
  2508. begin
  2509.   try
  2510.     with Message do
  2511.     begin
  2512.       case Msg of
  2513.         WM_SETFOCUS:
  2514.           begin
  2515.             Form := GetParentForm(Self);
  2516.             if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
  2517.           end;
  2518.         WM_KILLFOCUS:
  2519.           if csFocusing in ControlState then Exit;
  2520.         WM_KEYDOWN, WM_SYSKEYDOWN:
  2521.           if (ComboWnd <> FListHandle) and DoKeyDown(TWMKey(Message)) then
  2522.             Exit;
  2523.         WM_CHAR:
  2524.           begin
  2525.             if DoKeyPress(TWMKey(Message)) then Exit;
  2526.             if ((TWMKey(Message).CharCode = VK_RETURN) or
  2527.               (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2528.             begin
  2529.               DroppedDown := False;
  2530.               Exit;
  2531.             end;
  2532.           end;
  2533.         WM_KEYUP, WM_SYSKEYUP:
  2534.           if DoKeyUp(TWMKey(Message)) then Exit;
  2535.         WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
  2536.         WM_RBUTTONUP:
  2537.           if HasPopup(Self) then
  2538.           begin
  2539.             with TWMRButtonUp(Message) do
  2540.             begin
  2541.               Point.X := Pos.X;
  2542.               Point.Y := Pos.Y;
  2543.               MapWindowPoints(ComboWnd, Handle, Point, 1);
  2544.               Pos.X := Point.X;
  2545.               Pos.Y := Point.Y;
  2546.             end;
  2547.             WndProc(Message);
  2548.             Exit;
  2549.           end;
  2550.         WM_GETDLGCODE:
  2551.           if DroppedDown then
  2552.           begin
  2553.             Result := DLGC_WANTALLKEYS;
  2554.             Exit;
  2555.           end;
  2556.         WM_NCHITTEST:
  2557.           if csDesigning in ComponentState then
  2558.           begin
  2559.             Result := HTTRANSPARENT;
  2560.             Exit;
  2561.           end;
  2562.         CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR:
  2563.           begin
  2564.             WndProc(Message);
  2565.             Exit;
  2566.           end;
  2567.       end;
  2568.       Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam);
  2569.       if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then
  2570.         DblClick;
  2571.     end;
  2572.   except
  2573.     Application.HandleException(Self);
  2574.   end;
  2575. end;
  2576.  
  2577. procedure TCustomComboBox.WndProc(var Message: TMessage);
  2578. begin
  2579.     {for auto drag mode, let listbox handle itself, instead of TControl}
  2580.   if not (csDesigning in ComponentState) and
  2581.      ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
  2582.      not Dragging then
  2583.   begin
  2584.     if DragMode = dmAutomatic then
  2585.     begin
  2586.       if IsControlMouseMsg(TWMMouse(Message)) then
  2587.         Exit;
  2588.       ControlState := ControlState + [csLButtonDown];
  2589.       Dispatch(Message);  {overrides TControl's BeginDrag}
  2590.       Exit;
  2591.     end;
  2592.   end;
  2593.   with Message do
  2594.     case Msg of
  2595.       WM_SIZE:
  2596.         { Prevent TWinControl from handling WM_SIZE when adjusting drop-down
  2597.           listbox size. }
  2598.         if FDroppingDown then
  2599.         begin
  2600.           DefaultHandler(Message);
  2601.           Exit;
  2602.         end;
  2603.       WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  2604.         begin
  2605.           SetTextColor(WParam, ColorToRGB(Font.Color));
  2606.           SetBkColor(WParam, ColorToRGB(Brush.Color));
  2607.           Result := Brush.Handle;
  2608.           Exit;
  2609.         end;
  2610.       CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  2611.         if not NewStyleControls and (Style < csDropDownList) then
  2612.         begin
  2613.           Result := Parent.Brush.Handle;
  2614.           Exit;
  2615.         end;
  2616.       WM_CHAR:
  2617.         begin
  2618.           if DoKeyPress(TWMKey(Message)) then Exit;
  2619.           if ((TWMKey(Message).CharCode = VK_RETURN) or
  2620.             (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2621.           begin
  2622.             DroppedDown := False;
  2623.             Exit;
  2624.           end;
  2625.         end;
  2626.     end;
  2627.   inherited WndProc(Message);
  2628. end;
  2629.  
  2630. procedure TCustomComboBox.AdjustDropDown;
  2631. var
  2632.   ItemCount: Integer;
  2633. begin
  2634.   ItemCount := FItems.Count;
  2635.   if ItemCount > DropDownCount then ItemCount := DropDownCount;
  2636.   if ItemCount < 1 then ItemCount := 1;
  2637.   FDroppingDown := True;
  2638.   try
  2639.     SetWindowPos(Handle, 0, 0, 0, Width, ItemHeight * ItemCount +
  2640.       Height + 2, SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW +
  2641.       SWP_HIDEWINDOW);
  2642.   finally
  2643.     FDroppingDown := False;
  2644.   end;
  2645.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE +
  2646.     SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW + SWP_SHOWWINDOW);
  2647. end;
  2648.  
  2649. procedure TCustomComboBox.CNCommand(var Message: TWMCommand);
  2650. begin
  2651.   case Message.NotifyCode of
  2652.     CBN_DBLCLK:
  2653.       DblClick;
  2654.     CBN_EDITCHANGE:
  2655.       Change;
  2656.     CBN_DROPDOWN:
  2657.       begin
  2658.         FFocusChanged := False;
  2659.         DropDown;
  2660.         AdjustDropDown;
  2661.         if FFocusChanged then
  2662.         begin
  2663.           PostMessage(Handle, WM_CANCELMODE, 0, 0);
  2664.           if not FIsFocused then PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  2665.         end;
  2666.       end;
  2667.     CBN_SELCHANGE:
  2668.       begin
  2669.         Text := Items[ItemIndex];
  2670.         Click;
  2671.         Change;
  2672.       end;
  2673.     CBN_SETFOCUS:
  2674.       begin
  2675.         FIsFocused := True;
  2676.         FFocusChanged := True;
  2677.         SetIme;
  2678.       end;
  2679.     CBN_KILLFOCUS:
  2680.       begin
  2681.         FIsFocused := False;
  2682.         FFocusChanged := True;
  2683.         ResetIme;
  2684.       end;
  2685.   end;
  2686. end;
  2687.  
  2688. procedure TCustomComboBox.Change;
  2689. begin
  2690.   inherited Changed;
  2691.   if Assigned(FOnChange) then FOnChange(Self);
  2692. end;
  2693.  
  2694. procedure TCustomComboBox.DrawItem(Index: Integer; Rect: TRect;
  2695.   State: TOwnerDrawState);
  2696. begin
  2697.   TControlCanvas(FCanvas).UpdateTextFlags;
  2698.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
  2699.   else
  2700.   begin
  2701.     FCanvas.FillRect(Rect);
  2702.     FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  2703.   end;
  2704. end;
  2705.  
  2706. procedure TCustomComboBox.DropDown;
  2707. begin
  2708.   if Assigned(FOnDropDown) then FOnDropDown(Self);
  2709. end;
  2710.  
  2711. procedure TCustomComboBox.MeasureItem(Index: Integer; var Height: Integer);
  2712. begin
  2713.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  2714. end;
  2715.  
  2716. procedure TCustomComboBox.CNDrawItem(var Message: TWMDrawItem);
  2717. var
  2718.   State: TOwnerDrawState;
  2719. begin
  2720.   with Message.DrawItemStruct^ do
  2721.   begin
  2722.     State := TOwnerDrawState(LongRec(itemState).Lo);
  2723.     if itemState and ODS_COMBOBOXEDIT <> 0 then
  2724.       Include(State, odComboBoxEdit);
  2725.     if itemState and ODS_DEFAULT <> 0 then
  2726.       Include(State, odDefault);  
  2727.     FCanvas.Handle := hDC;
  2728.     FCanvas.Font := Font;
  2729.     FCanvas.Brush := Brush;
  2730.     if (Integer(itemID) >= 0) and (odSelected in State) then
  2731.     begin
  2732.       FCanvas.Brush.Color := clHighlight;
  2733.       FCanvas.Font.Color := clHighlightText
  2734.     end;
  2735.     if Integer(itemID) >= 0 then
  2736.       DrawItem(itemID, rcItem, State) else
  2737.       FCanvas.FillRect(rcItem);
  2738.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  2739.     FCanvas.Handle := 0;
  2740.   end;
  2741. end;
  2742.  
  2743. procedure TCustomComboBox.CNMeasureItem(var Message: TWMMeasureItem);
  2744. begin
  2745.   with Message.MeasureItemStruct^ do
  2746.   begin
  2747.     itemHeight := FItemHeight;
  2748.     if FStyle = csOwnerDrawVariable then
  2749.       MeasureItem(itemID, Integer(itemHeight));
  2750.   end;
  2751. end;
  2752.  
  2753. procedure TCustomComboBox.WMLButtonDown(var Message: TWMLButtonDown);
  2754. var
  2755.   Form: TCustomForm;
  2756. begin
  2757.   if (DragMode = dmAutomatic) and (Style = csDropDownList) and
  2758.       (Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then
  2759.   begin
  2760.     SetFocus;
  2761.     BeginDrag(False);
  2762.     Exit;
  2763.   end;
  2764.   inherited;
  2765.   if MouseCapture then
  2766.   begin
  2767.     Form := GetParentForm(Self);
  2768.     if (Form <> nil) and (Form.ActiveControl <> Self) then
  2769.       MouseCapture := False;
  2770.   end;
  2771. end;
  2772.  
  2773. function TCustomComboBox.Focused: Boolean;
  2774. var
  2775.   FocusedWnd: HWND;
  2776. begin
  2777.   Result := False;
  2778.   if HandleAllocated then
  2779.   begin
  2780.     FocusedWnd := GetFocus;
  2781.     Result := (FocusedWnd = FEditHandle) or (FocusedWnd = FListHandle);
  2782.   end;
  2783. end;
  2784.  
  2785. { TButtonActionLink }
  2786.  
  2787. procedure TButtonActionLink.AssignClient(AClient: TObject);
  2788. begin
  2789.   inherited AssignClient(AClient);
  2790.   FClient := AClient as TButtonControl;
  2791. end;
  2792.  
  2793. function TButtonActionLink.IsCheckedLinked: Boolean;
  2794. begin
  2795.   Result := inherited IsCheckedLinked and
  2796.     (FClient.Checked = (Action as TCustomAction).Checked);
  2797. end;
  2798.  
  2799. procedure TButtonActionLink.SetChecked(Value: Boolean);
  2800. begin
  2801.   if IsCheckedLinked then
  2802.   begin
  2803.     FClient.ClicksDisabled := True;
  2804.     try
  2805.       FClient.Checked := Value;
  2806.     finally
  2807.       FClient.ClicksDisabled := False;
  2808.     end;
  2809.   end;
  2810. end;
  2811.  
  2812. { TButtonControl }
  2813.  
  2814. constructor TButtonControl.Create(AOwner: TComponent);
  2815. begin
  2816.   inherited Create(AOwner);
  2817.   if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
  2818.     ImeMode := imDisable;
  2819. end;
  2820.  
  2821. procedure TButtonControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  2822. begin
  2823.   inherited ActionChange(Sender, CheckDefaults);
  2824.   if Sender is TCustomAction then
  2825.     with TCustomAction(Sender) do
  2826.     begin
  2827.       if not CheckDefaults or (Self.Checked = False) then
  2828.         Self.Checked := Checked;
  2829.     end;
  2830. end;
  2831.  
  2832. function TButtonControl.GetActionLinkClass: TControlActionLinkClass;
  2833. begin
  2834.   Result := TButtonActionLink;
  2835. end;
  2836.  
  2837. function TButtonControl.GetChecked: Boolean;
  2838. begin
  2839.   Result := False;
  2840. end;
  2841.  
  2842. function TButtonControl.IsCheckedStored: Boolean;
  2843. begin
  2844.   Result := (ActionLink = nil) or not TButtonActionLink(ActionLink).IsCheckedLinked;
  2845. end;
  2846.  
  2847. procedure TButtonControl.SetChecked(Value: Boolean);
  2848. begin
  2849. end;
  2850.  
  2851. procedure TButtonControl.WndProc(var Message: TMessage);
  2852. begin
  2853.   case Message.Msg of
  2854.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2855.       if not (csDesigning in ComponentState) and not Focused then
  2856.       begin
  2857.         FClicksDisabled := True;
  2858.         Windows.SetFocus(Handle);
  2859.         FClicksDisabled := False;
  2860.         if not Focused then Exit;
  2861.       end;
  2862.     CN_COMMAND:
  2863.       if FClicksDisabled then Exit;
  2864.   end;
  2865.   inherited WndProc(Message);
  2866. end;
  2867.  
  2868. { TButton }
  2869.  
  2870. constructor TButton.Create(AOwner: TComponent);
  2871. begin
  2872.   inherited Create(AOwner);
  2873.   ControlStyle := [csSetCaption, csOpaque, csDoubleClicks];
  2874.   Width := 75;
  2875.   Height := 25;
  2876.   TabStop := True;
  2877. end;
  2878.  
  2879. procedure TButton.Click;
  2880. var
  2881.   Form: TCustomForm;
  2882. begin
  2883.   Form := GetParentForm(Self);
  2884.   if Form <> nil then Form.ModalResult := ModalResult;
  2885.   inherited Click;
  2886. end;
  2887.  
  2888. function TButton.UseRightToLeftAlignment: Boolean;
  2889. begin
  2890.   Result := False;
  2891. end;
  2892.  
  2893. procedure TButton.SetButtonStyle(ADefault: Boolean);
  2894. const
  2895.   BS_MASK = $000F;
  2896. var
  2897.   Style: Word;
  2898. begin
  2899.   if HandleAllocated then
  2900.   begin
  2901.     if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON;
  2902.     if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
  2903.       SendMessage(Handle, BM_SETSTYLE, Style, 1);
  2904.   end;
  2905. end;
  2906.  
  2907. procedure TButton.SetDefault(Value: Boolean);
  2908. var
  2909.   Form: TCustomForm;
  2910. begin
  2911.   FDefault := Value;
  2912.   if HandleAllocated then
  2913.   begin
  2914.     Form := GetParentForm(Self);
  2915.     if Form <> nil then
  2916.       Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  2917.   end;
  2918. end;
  2919.  
  2920. procedure TButton.CreateParams(var Params: TCreateParams);
  2921. const
  2922.   ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
  2923. begin
  2924.   inherited CreateParams(Params);
  2925.   CreateSubClass(Params, 'BUTTON');
  2926.   Params.Style := Params.Style or ButtonStyles[FDefault];
  2927. end;
  2928.  
  2929. procedure TButton.CreateWnd;
  2930. begin
  2931.   inherited CreateWnd;
  2932.   FActive := FDefault;
  2933. end;
  2934.  
  2935. procedure TButton.CNCommand(var Message: TWMCommand);
  2936. begin
  2937.   if Message.NotifyCode = BN_CLICKED then Click;
  2938. end;
  2939.  
  2940. procedure TButton.CMDialogKey(var Message: TCMDialogKey);
  2941. begin
  2942.   with Message do
  2943.     if  (((CharCode = VK_RETURN) and FActive) or
  2944.       ((CharCode = VK_ESCAPE) and FCancel)) and
  2945.       (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
  2946.     begin
  2947.       Click;
  2948.       Result := 1;
  2949.     end else
  2950.       inherited;
  2951. end;
  2952.  
  2953. procedure TButton.CMDialogChar(var Message: TCMDialogChar);
  2954. begin
  2955.   with Message do
  2956.     if IsAccel(CharCode, Caption) and CanFocus then
  2957.     begin
  2958.       Click;
  2959.       Result := 1;
  2960.     end else
  2961.       inherited;
  2962. end;
  2963.  
  2964. procedure TButton.CMFocusChanged(var Message: TCMFocusChanged);
  2965. begin
  2966.   with Message do
  2967.     if Sender is TButton then
  2968.       FActive := Sender = Self
  2969.     else
  2970.       FActive := FDefault;
  2971.   SetButtonStyle(FActive);
  2972.   inherited;
  2973. end;
  2974.  
  2975. procedure TButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2976. begin
  2977.   DefaultHandler(Message);
  2978. end;
  2979.  
  2980. { TCustomCheckBox }
  2981.  
  2982. constructor TCustomCheckBox.Create(AOwner: TComponent);
  2983. begin
  2984.   inherited Create(AOwner);
  2985.   Width := 97;
  2986.   Height := 17;
  2987.   TabStop := True;
  2988.   ControlStyle := [csSetCaption, csDoubleClicks];
  2989.   FAlignment := taRightJustify;
  2990. end;
  2991.  
  2992. function TCustomCheckBox.GetControlsAlignment: TAlignment;
  2993. begin
  2994.   if not UseRightToLeftAlignment then
  2995.     Result := taRightJustify
  2996.   else
  2997.     if FAlignment = taRightJustify then
  2998.       Result := taLeftJustify
  2999.     else
  3000.       Result := taRightJustify;
  3001. end;
  3002.  
  3003. procedure TCustomCheckBox.Toggle;
  3004. begin
  3005.   case State of
  3006.     cbUnchecked:
  3007.       if AllowGrayed then State := cbGrayed else State := cbChecked;
  3008.     cbChecked: State := cbUnchecked;
  3009.     cbGrayed: State := cbChecked;
  3010.   end;
  3011. end;
  3012.  
  3013. procedure TCustomCheckBox.Click;
  3014. begin
  3015.   inherited Changed;
  3016.   inherited Click;
  3017. end;
  3018.  
  3019. function TCustomCheckBox.GetChecked: Boolean;
  3020. begin
  3021.   Result := State = cbChecked;
  3022. end;
  3023.  
  3024. procedure TCustomCheckBox.SetAlignment(Value: TLeftRight);
  3025. begin
  3026.   if FAlignment <> Value then
  3027.   begin
  3028.     FAlignment := Value;
  3029.     RecreateWnd;
  3030.   end;
  3031. end;
  3032.  
  3033. procedure TCustomCheckBox.SetChecked(Value: Boolean);
  3034. begin
  3035.   if Value then State := cbChecked else State := cbUnchecked;
  3036. end;
  3037.  
  3038. procedure TCustomCheckBox.SetState(Value: TCheckBoxState);
  3039. begin
  3040.   if FState <> Value then
  3041.   begin
  3042.     FState := Value;
  3043.     if HandleAllocated then
  3044.       SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  3045.     if not ClicksDisabled then Click;
  3046.   end;
  3047. end;
  3048.  
  3049. procedure TCustomCheckBox.CreateParams(var Params: TCreateParams);
  3050. const
  3051.   Alignments: array[Boolean, TLeftRight] of DWORD =
  3052.     ((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
  3053. begin
  3054.   inherited CreateParams(Params);
  3055.   CreateSubClass(Params, 'BUTTON');
  3056.   with Params do
  3057.   begin
  3058.     Style := Style or BS_3STATE or
  3059.       Alignments[UseRightToLeftAlignment, FAlignment];
  3060.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  3061.   end;
  3062. end;
  3063.  
  3064. procedure TCustomCheckBox.CreateWnd;
  3065. begin
  3066.   inherited CreateWnd;
  3067.   SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  3068. end;
  3069.  
  3070. procedure TCustomCheckBox.WMSize(var Message: TMessage);
  3071. begin
  3072.   inherited;
  3073.   Invalidate;
  3074. end;
  3075.  
  3076. procedure TCustomCheckBox.CMCtl3DChanged(var Message: TMessage);
  3077. begin
  3078.   RecreateWnd;
  3079. end;
  3080.  
  3081. procedure TCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
  3082. begin
  3083.   with Message do
  3084.     if IsAccel(CharCode, Caption) and CanFocus then
  3085.     begin
  3086.       SetFocus;
  3087.       if Focused then Toggle;
  3088.       Result := 1;
  3089.     end else
  3090.       inherited;
  3091. end;
  3092.  
  3093. procedure TCustomCheckBox.CNCommand(var Message: TWMCommand);
  3094. begin
  3095.   if Message.NotifyCode = BN_CLICKED then Toggle;
  3096. end;
  3097.  
  3098. { TRadioButton }
  3099.  
  3100. constructor TRadioButton.Create(AOwner: TComponent);
  3101. begin
  3102.   inherited Create(AOwner);
  3103.   Width := 113;
  3104.   Height := 17;
  3105.   ControlStyle := [csSetCaption, csDoubleClicks];
  3106.   FAlignment := taRightJustify;
  3107. end;
  3108.  
  3109. function TRadioButton.GetChecked: Boolean;
  3110. begin
  3111.   Result := FChecked;
  3112. end;
  3113.  
  3114. function TRadioButton.GetControlsAlignment: TAlignment;
  3115. begin
  3116.   if not UseRightToLeftAlignment then
  3117.     Result := taRightJustify
  3118.   else
  3119.     if FAlignment = taRightJustify then
  3120.       Result := taLeftJustify
  3121.     else
  3122.       Result := taRightJustify;
  3123. end;
  3124.  
  3125. procedure TRadioButton.SetAlignment(Value: TLeftRight);
  3126. begin
  3127.   if FAlignment <> Value then
  3128.   begin
  3129.     FAlignment := Value;
  3130.     RecreateWnd;
  3131.   end;
  3132. end;
  3133.  
  3134. procedure TRadioButton.SetChecked(Value: Boolean);
  3135.  
  3136.   procedure TurnSiblingsOff;
  3137.   var
  3138.     I: Integer;
  3139.     Sibling: TControl;
  3140.   begin
  3141.     if Parent <> nil then
  3142.       with Parent do
  3143.         for I := 0 to ControlCount - 1 do
  3144.         begin
  3145.           Sibling := Controls[I];
  3146.           if (Sibling <> Self) and (Sibling is TRadioButton) then
  3147.             TRadioButton(Sibling).SetChecked(False);
  3148.         end;
  3149.   end;
  3150.  
  3151. begin
  3152.   if FChecked <> Value then
  3153.   begin
  3154.     FChecked := Value;
  3155.     TabStop := Value;
  3156.     if HandleAllocated then
  3157.       SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
  3158.     if Value then
  3159.     begin
  3160.       TurnSiblingsOff;
  3161.       inherited Changed;
  3162.       if not ClicksDisabled then Click;
  3163.     end;
  3164.   end;
  3165. end;
  3166.  
  3167. procedure TRadioButton.CreateParams(var Params: TCreateParams);
  3168. const
  3169.   Alignments: array[Boolean, TLeftRight] of DWORD =
  3170.     ((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
  3171. begin
  3172.   inherited CreateParams(Params);
  3173.   CreateSubClass(Params, 'BUTTON');
  3174.   with Params do
  3175.     Style := Style or BS_RADIOBUTTON or
  3176.       Alignments[UseRightToLeftAlignment, FAlignment];
  3177. end;
  3178.  
  3179. procedure TRadioButton.CreateWnd;
  3180. begin
  3181.   inherited CreateWnd;
  3182.   SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
  3183. end;
  3184.  
  3185. procedure TRadioButton.CMCtl3DChanged(var Message: TMessage);
  3186. begin
  3187.   RecreateWnd;
  3188. end;
  3189.  
  3190. procedure TRadioButton.CMDialogChar(var Message: TCMDialogChar);
  3191. begin
  3192.   with Message do
  3193.     if IsAccel(Message.CharCode, Caption) and CanFocus then
  3194.     begin
  3195.       SetFocus;
  3196.       Result := 1;
  3197.     end else
  3198.       inherited;
  3199. end;
  3200.  
  3201. procedure TRadioButton.CNCommand(var Message: TWMCommand);
  3202. begin
  3203.   case Message.NotifyCode of
  3204.     BN_CLICKED: SetChecked(True);
  3205.     BN_DOUBLECLICKED: DblClick;
  3206.   end;
  3207. end;
  3208.  
  3209. { TListBoxStrings }
  3210.  
  3211. function TListBoxStrings.GetCount: Integer;
  3212. begin
  3213.   Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
  3214. end;
  3215.  
  3216. function TListBoxStrings.Get(Index: Integer): string;
  3217. var
  3218.   Len: Integer;
  3219.   Text: array[0..4095] of Char;
  3220. begin
  3221.   Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, Longint(@Text));
  3222.   if Len < 0 then Error(SListIndexError, Index);
  3223.   SetString(Result, Text, Len);
  3224. end;
  3225.  
  3226. function TListBoxStrings.GetObject(Index: Integer): TObject;
  3227. begin
  3228.   Result := TObject(ListBox.GetItemData(Index));
  3229.   if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  3230. end;
  3231.  
  3232. procedure TListBoxStrings.Put(Index: Integer; const S: string);
  3233. var
  3234.   I: Integer;
  3235.   TempData: Longint;
  3236. begin
  3237.   I := ListBox.ItemIndex;
  3238.   TempData := ListBox.InternalGetItemData(Index);
  3239.   // Set the Item to 0 in case it is an object that gets freed during Delete
  3240.   ListBox.InternalSetItemData(Index, 0);
  3241.   Delete(Index);
  3242.   InsertObject(Index, S, nil);
  3243.   ListBox.InternalSetItemData(Index, TempData);
  3244.   ListBox.ItemIndex := I;
  3245. end;
  3246.  
  3247. procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
  3248. begin
  3249.   ListBox.SetItemData(Index, LongInt(AObject));
  3250. end;
  3251.  
  3252. function TListBoxStrings.Add(const S: string): Integer;
  3253. begin
  3254.   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
  3255.   if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
  3256. end;
  3257.  
  3258. procedure TListBoxStrings.Insert(Index: Integer; const S: string);
  3259. begin
  3260.   if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
  3261.     Longint(PChar(S))) < 0 then
  3262.     raise EOutOfResources.Create(SInsertLineError);
  3263. end;
  3264.  
  3265. procedure TListBoxStrings.Delete(Index: Integer);
  3266. begin
  3267.   ListBox.DeleteString(Index);
  3268. end;
  3269.  
  3270. procedure TListBoxStrings.Exchange(Index1, Index2: Integer);
  3271. var
  3272.   TempData: Longint;
  3273.   TempString: string;
  3274. begin
  3275.   BeginUpdate;
  3276.   try
  3277.     TempString := Strings[Index1];
  3278.     TempData := ListBox.InternalGetItemData(Index1);
  3279.     Strings[Index1] := Strings[Index2];
  3280.     ListBox.InternalSetItemData(Index1, ListBox.InternalGetItemData(Index2));
  3281.     Strings[Index2] := TempString;
  3282.     ListBox.InternalSetItemData(Index2, TempData);
  3283.     if ListBox.ItemIndex = Index1 then
  3284.       ListBox.ItemIndex := Index2
  3285.     else if ListBox.ItemIndex = Index2 then
  3286.       ListBox.ItemIndex := Index1;  
  3287.   finally
  3288.     EndUpdate;
  3289.   end;
  3290. end;
  3291.  
  3292. procedure TListBoxStrings.Clear;
  3293. begin
  3294.   ListBox.ResetContent;
  3295. end;
  3296.  
  3297. procedure TListBoxStrings.SetUpdateState(Updating: Boolean);
  3298. begin
  3299.   SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3300.   if not Updating then ListBox.Refresh;
  3301. end;
  3302.  
  3303. function TListBoxStrings.IndexOf(const S: string): Integer;
  3304. begin
  3305.   Result := SendMessage(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PChar(S)));
  3306. end;
  3307.  
  3308. procedure TListBoxStrings.Move(CurIndex, NewIndex: Integer);
  3309. var
  3310.   TempData: Longint;
  3311.   TempString: string;
  3312. begin
  3313.   BeginUpdate;
  3314.   ListBox.FMoving := True;
  3315.   try
  3316.     if CurIndex <> NewIndex then
  3317.     begin
  3318.       TempString := Get(CurIndex);
  3319.       TempData := ListBox.InternalGetItemData(CurIndex);
  3320.       ListBox.InternalSetItemData(CurIndex, 0);
  3321.       Delete(CurIndex);
  3322.       Insert(NewIndex, TempString);
  3323.       ListBox.InternalSetItemData(NewIndex, TempData);
  3324.     end;
  3325.   finally
  3326.     ListBox.FMoving := False;
  3327.     EndUpdate;
  3328.   end;
  3329. end;
  3330.  
  3331. { TCustomListBox }
  3332.  
  3333. constructor TCustomListBox.Create(AOwner: TComponent);
  3334. const
  3335.   ListBoxStyle = [csSetCaption, csDoubleClicks];
  3336. begin
  3337.   inherited Create(AOwner);
  3338.   if NewStyleControls then
  3339.     ControlStyle := ListBoxStyle else
  3340.     ControlStyle := ListBoxStyle + [csFramed];
  3341.   Width := 121;
  3342.   Height := 97;
  3343.   TabStop := True;
  3344.   ParentColor := False;
  3345.   FItems := TListBoxStrings.Create;
  3346.   TListBoxStrings(FItems).ListBox := Self;
  3347.   FCanvas := TControlCanvas.Create;
  3348.   TControlCanvas(FCanvas).Control := Self;
  3349.   FItemHeight := 16;
  3350.   FBorderStyle := bsSingle;
  3351.   FExtendedSelect := True;
  3352. end;
  3353.  
  3354. destructor TCustomListBox.Destroy;
  3355. begin
  3356.   inherited Destroy;
  3357.   FCanvas.Free;
  3358.   FItems.Free;
  3359.   FSaveItems.Free;
  3360. end;
  3361.  
  3362. function TCustomListBox.GetItemData(Index: Integer): LongInt;
  3363. begin
  3364.   Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
  3365. end;
  3366.  
  3367. procedure TCustomListBox.SetItemData(Index: Integer; AData: LongInt);
  3368. begin
  3369.   SendMessage(Handle, LB_SETITEMDATA, Index, AData);
  3370. end;
  3371.  
  3372. function TCustomListBox.InternalGetItemData(Index: Integer): LongInt;
  3373. begin
  3374.   Result := GetItemData(Index);
  3375. end;
  3376.  
  3377. procedure TCustomListBox.InternalSetItemData(Index: Integer; AData: LongInt);
  3378. begin
  3379.   SetItemData(Index, AData);
  3380. end;
  3381.  
  3382. procedure TCustomListBox.DeleteString( Index: Integer );
  3383. begin
  3384.   SendMessage(Handle, LB_DELETESTRING, Index, 0);
  3385. end;
  3386.  
  3387. procedure TCustomListBox.ResetContent;
  3388. begin
  3389.   SendMessage(Handle, LB_RESETCONTENT, 0, 0);
  3390. end;
  3391.  
  3392. procedure TCustomListBox.Clear;
  3393. begin
  3394.   FItems.Clear;
  3395. end;
  3396.  
  3397. procedure TCustomListBox.SetColumnWidth;
  3398. var
  3399.   ColWidth: Integer;
  3400. begin
  3401.   if (FColumns > 0) and (Width > 0) then
  3402.   begin
  3403.     ColWidth := (Width + FColumns - 3) div FColumns;
  3404.     if ColWidth < 1 then ColWidth := 1;
  3405.     SendMessage(Handle, LB_SETCOLUMNWIDTH, ColWidth, 0);
  3406.   end;
  3407. end;
  3408.  
  3409. procedure TCustomListBox.SetColumns(Value: Integer);
  3410. begin
  3411.   if FColumns <> Value then
  3412.     if (FColumns = 0) or (Value = 0) then
  3413.     begin
  3414.       FColumns := Value;
  3415.       RecreateWnd;
  3416.     end else
  3417.     begin
  3418.       FColumns := Value;
  3419.       if HandleAllocated then SetColumnWidth;
  3420.     end;
  3421. end;
  3422.  
  3423. function TCustomListBox.GetItemIndex: Integer;
  3424. begin
  3425.   if MultiSelect then Result := SendMessage(Handle, LB_GETCARETINDEX, 0, 0)
  3426.   else Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
  3427. end;
  3428.  
  3429. function TCustomListBox.GetSelCount: Integer;
  3430. begin
  3431.   Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
  3432. end;
  3433.  
  3434. procedure TCustomListBox.SetItemIndex(Value: Integer);
  3435. begin
  3436.   if GetItemIndex <> Value then
  3437.     if MultiSelect then SendMessage(Handle, LB_SETCARETINDEX, Value, 0)
  3438.     else SendMessage(Handle, LB_SETCURSEL, Value, 0);
  3439. end;
  3440.  
  3441. procedure TCustomListBox.SetExtendedSelect(Value: Boolean);
  3442. begin
  3443.   if Value <> FExtendedSelect then
  3444.   begin
  3445.     FExtendedSelect := Value;
  3446.     RecreateWnd;
  3447.   end;
  3448. end;
  3449.  
  3450. procedure TCustomListBox.SetIntegralHeight(Value: Boolean);
  3451. begin
  3452.   if Value <> FIntegralHeight then
  3453.   begin
  3454.     FIntegralHeight := Value;
  3455.     RecreateWnd;
  3456.     RequestAlign;
  3457.   end;
  3458. end;
  3459.  
  3460. function TCustomListBox.GetItemHeight: Integer;
  3461. var
  3462.   R: TRect;
  3463. begin
  3464.   Result := FItemHeight;
  3465.   if HandleAllocated and (FStyle = lbStandard) then
  3466.   begin
  3467.     Perform(LB_GETITEMRECT, 0, Longint(@R));
  3468.     Result := R.Bottom - R.Top;
  3469.   end;
  3470. end;
  3471.  
  3472. procedure TCustomListBox.SetItemHeight(Value: Integer);
  3473. begin
  3474.   if (FItemHeight <> Value) and (Value > 0) then
  3475.   begin
  3476.     FItemHeight := Value;
  3477.     RecreateWnd;
  3478.   end;
  3479. end;
  3480.  
  3481. procedure TCustomListBox.SetTabWidth(Value: Integer);
  3482. begin
  3483.   if Value < 0 then Value := 0;
  3484.   if FTabWidth <> Value then
  3485.   begin
  3486.     FTabWidth := Value;
  3487.     RecreateWnd;
  3488.   end;
  3489. end;
  3490.  
  3491. procedure TCustomListBox.SetMultiSelect(Value: Boolean);
  3492. begin
  3493.   if FMultiSelect <> Value then
  3494.   begin
  3495.     FMultiSelect := Value;
  3496.     RecreateWnd;
  3497.   end;
  3498. end;
  3499.  
  3500. function TCustomListBox.GetSelected(Index: Integer): Boolean;
  3501. var
  3502.   R: Longint;
  3503. begin
  3504.   R := SendMessage(Handle, LB_GETSEL, Index, 0);
  3505.   if R = LB_ERR then
  3506.     raise EListError.CreateResFmt(@SListIndexError, [Index]);
  3507.   Result := LongBool(R);
  3508. end;
  3509.  
  3510. procedure TCustomListBox.SetSelected(Index: Integer; Value: Boolean);
  3511. begin
  3512.   if SendMessage(Handle, LB_SETSEL, Longint(Value), Index) = LB_ERR then
  3513.     raise EListError.CreateResFmt(@SListIndexError, [Index]);
  3514. end;
  3515.  
  3516. procedure TCustomListBox.SetSorted(Value: Boolean);
  3517. begin
  3518.   if FSorted <> Value then
  3519.   begin
  3520.     FSorted := Value;
  3521.     RecreateWnd;
  3522.   end;
  3523. end;
  3524.  
  3525. procedure TCustomListBox.SetStyle(Value: TListBoxStyle);
  3526. begin
  3527.   if FStyle <> Value then
  3528.   begin
  3529.     FStyle := Value;
  3530.     RecreateWnd;
  3531.   end;
  3532. end;
  3533.  
  3534. function TCustomListBox.GetTopIndex: Integer;
  3535. begin
  3536.   Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
  3537. end;
  3538.  
  3539. procedure TCustomListBox.SetBorderStyle(Value: TBorderStyle);
  3540. begin
  3541.   if FBorderStyle <> Value then
  3542.   begin
  3543.     FBorderStyle := Value;
  3544.     RecreateWnd;
  3545.   end;
  3546. end;
  3547.  
  3548. procedure TCustomListBox.SetTopIndex(Value: Integer);
  3549. begin
  3550.   if GetTopIndex <> Value then
  3551.     SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
  3552. end;
  3553.  
  3554. procedure TCustomListBox.SetItems(Value: TStrings);
  3555. begin
  3556.   Items.Assign(Value);
  3557. end;
  3558.  
  3559. function TCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  3560. var
  3561.   Count: Integer;
  3562.   ItemRect: TRect;
  3563. begin
  3564.   if PtInRect(ClientRect, Pos) then
  3565.   begin
  3566.     Result := TopIndex;
  3567.     Count := Items.Count;
  3568.     while Result < Count do
  3569.     begin
  3570.       Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
  3571.       if PtInRect(ItemRect, Pos) then Exit;
  3572.       Inc(Result);
  3573.     end;
  3574.     if not Existing then Exit;
  3575.   end;
  3576.   Result := -1;
  3577. end;
  3578.  
  3579. function TCustomListBox.ItemRect(Index: Integer): TRect;
  3580. var
  3581.   Count: Integer;
  3582. begin
  3583.   Count := Items.Count;
  3584.   if (Index = 0) or (Index < Count) then
  3585.     Perform(LB_GETITEMRECT, Index, Longint(@Result))
  3586.   else if Index = Count then
  3587.   begin
  3588.     Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
  3589.     OffsetRect(Result, 0, Result.Bottom - Result.Top);
  3590.   end else FillChar(Result, SizeOf(Result), 0);
  3591. end;
  3592.  
  3593. procedure TCustomListBox.CreateParams(var Params: TCreateParams);
  3594. type
  3595.   PSelects = ^TSelects;
  3596.   TSelects = array[Boolean] of DWORD;
  3597. const
  3598.   Styles: array[TListBoxStyle] of DWORD =
  3599.     (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE);
  3600.   Sorteds: array[Boolean] of DWORD = (0, LBS_SORT);
  3601.   MultiSelects: array[Boolean] of DWORD = (0, LBS_MULTIPLESEL);
  3602.   ExtendSelects: array[Boolean] of DWORD = (0, LBS_EXTENDEDSEL);
  3603.   IntegralHeights: array[Boolean] of DWORD = (LBS_NOINTEGRALHEIGHT, 0);
  3604.   MultiColumns: array[Boolean] of DWORD = (0, LBS_MULTICOLUMN);
  3605.   TabStops: array[Boolean] of DWORD = (0, LBS_USETABSTOPS);
  3606.   CSHREDRAW: array[Boolean] of DWORD = (CS_HREDRAW, 0);
  3607. var
  3608.   Selects: PSelects;
  3609. begin
  3610.   inherited CreateParams(Params);
  3611.   CreateSubClass(Params, 'LISTBOX');
  3612.   with Params do
  3613.   begin
  3614.     Selects := @MultiSelects;
  3615.     if FExtendedSelect then Selects := @ExtendSelects;
  3616.     Style := Style or (WS_HSCROLL or WS_VSCROLL or LBS_HASSTRINGS or
  3617.       LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
  3618.       Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
  3619.       MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
  3620.       TabStops[FTabWidth <> 0];
  3621.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  3622.     begin
  3623.       Style := Style and not WS_BORDER;
  3624.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  3625.     end;
  3626.     WindowClass.style := WindowClass.style and not (CSHREDRAW[UseRightToLeftAlignment] or CS_VREDRAW);
  3627.   end;
  3628. end;
  3629.  
  3630. procedure TCustomListBox.CreateWnd;
  3631. var
  3632.   W, H: Integer;
  3633. begin
  3634.   W := Width;
  3635.   H := Height;
  3636.   inherited CreateWnd;
  3637.   SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
  3638.   if FTabWidth <> 0 then
  3639.     SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
  3640.   SetColumnWidth;
  3641.   if FSaveItems <> nil then
  3642.   begin
  3643.     FItems.Assign(FSaveItems);
  3644.     SetTopIndex(FSaveTopIndex);
  3645.     SetItemIndex(FSaveItemIndex);
  3646.     FSaveItems.Free;
  3647.     FSaveItems := nil;
  3648.   end;
  3649. end;
  3650.  
  3651. procedure TCustomListBox.DestroyWnd;
  3652. begin
  3653.   if FItems.Count > 0 then
  3654.   begin
  3655.     FSaveItems := TStringList.Create;
  3656.     FSaveItems.Assign(FItems);
  3657.     FSaveTopIndex := GetTopIndex;
  3658.     FSaveItemIndex := GetItemIndex;
  3659.   end;
  3660.   inherited DestroyWnd;
  3661. end;
  3662.  
  3663. procedure TCustomListBox.WndProc(var Message: TMessage);
  3664. begin
  3665.   {for auto drag mode, let listbox handle itself, instead of TControl}
  3666.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  3667.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
  3668.   begin
  3669.     if DragMode = dmAutomatic then
  3670.     begin
  3671.       if IsControlMouseMsg(TWMMouse(Message)) then
  3672.         Exit;
  3673.       ControlState := ControlState + [csLButtonDown];
  3674.       Dispatch(Message);  {overrides TControl's BeginDrag}
  3675.       Exit;
  3676.     end;
  3677.   end;
  3678.   inherited WndProc(Message);
  3679. end;
  3680.  
  3681. procedure TCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
  3682. var
  3683.   ItemNo : Integer;
  3684.   ShiftState: TShiftState;
  3685. begin
  3686.   ShiftState := KeysToShiftState(Message.Keys);
  3687.   if (DragMode = dmAutomatic) and FMultiSelect then
  3688.   begin
  3689.     if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
  3690.     begin
  3691.       ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
  3692.       if (ItemNo >= 0) and (Selected[ItemNo]) then
  3693.       begin
  3694.         BeginDrag (False);
  3695.         Exit;
  3696.       end;
  3697.     end;
  3698.   end;
  3699.   inherited;
  3700.   if (DragMode = dmAutomatic) and not (FMultiSelect and
  3701.     ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
  3702.     BeginDrag(False);
  3703. end;
  3704.  
  3705. procedure TCustomListBox.CNCommand(var Message: TWMCommand);
  3706. begin
  3707.   case Message.NotifyCode of
  3708.     LBN_SELCHANGE:
  3709.       begin
  3710.         inherited Changed;
  3711.         Click;
  3712.       end;
  3713.     LBN_DBLCLK: DblClick;
  3714.   end;
  3715. end;
  3716.  
  3717. procedure TCustomListBox.WMPaint(var Message: TWMPaint);
  3718.  
  3719.   procedure PaintListBox;
  3720.   var
  3721.     DrawItemMsg: TWMDrawItem;
  3722.     MeasureItemMsg: TWMMeasureItem;
  3723.     DrawItemStruct: TDrawItemStruct;
  3724.     MeasureItemStruct: TMeasureItemStruct;
  3725.     R: TRect;
  3726.     Y, I, H, W: Integer;
  3727.   begin
  3728.     { Initialize drawing records }
  3729.     DrawItemMsg.Msg := CN_DRAWITEM;
  3730.     DrawItemMsg.DrawItemStruct := @DrawItemStruct;
  3731.     DrawItemMsg.Ctl := Handle;
  3732.     DrawItemStruct.CtlType := ODT_LISTBOX;
  3733.     DrawItemStruct.itemAction := ODA_DRAWENTIRE;
  3734.     DrawItemStruct.itemState := 0;
  3735.     DrawItemStruct.hDC := Message.DC;
  3736.     DrawItemStruct.CtlID := Handle;
  3737.     DrawItemStruct.hwndItem := Handle;
  3738.  
  3739.     { Intialize measure records }
  3740.     MeasureItemMsg.Msg := CN_MEASUREITEM;
  3741.     MeasureItemMsg.IDCtl := Handle;
  3742.     MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
  3743.     MeasureItemStruct.CtlType := ODT_LISTBOX;
  3744.     MeasureItemStruct.CtlID := Handle;
  3745.  
  3746.     { Draw the listbox }
  3747.     Y := 0;
  3748.     I := TopIndex;
  3749.     GetClipBox(Message.DC, R);
  3750.     H := Height;
  3751.     W := Width;
  3752.     while Y < H do
  3753.     begin
  3754.       MeasureItemStruct.itemID := I;
  3755.       if I < Items.Count then
  3756.         MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
  3757.       MeasureItemStruct.itemWidth := W;
  3758.       MeasureItemStruct.itemHeight := FItemHeight;
  3759.       DrawItemStruct.itemData := MeasureItemStruct.itemData;
  3760.       DrawItemStruct.itemID := I;
  3761.       Dispatch(MeasureItemMsg);
  3762.       DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
  3763.         Y + Integer(MeasureItemStruct.itemHeight));
  3764.       Dispatch(DrawItemMsg);
  3765.       Inc(Y, MeasureItemStruct.itemHeight);
  3766.       Inc(I);
  3767.       if I >= Items.Count then break;
  3768.     end;
  3769.   end;
  3770.  
  3771. begin
  3772.   if Message.DC <> 0 then
  3773.     { Listboxes don't allow paint "sub-classing" like the other windows controls
  3774.       so we have to do it ourselves. }
  3775.     PaintListBox
  3776.   else inherited;
  3777. end;
  3778.  
  3779. procedure TCustomListBox.WMSize(var Message: TWMSize);
  3780. begin
  3781.   inherited;
  3782.   SetColumnWidth;
  3783. end;
  3784.  
  3785. procedure TCustomListBox.DragCanceled;
  3786. var
  3787.   M: TWMMouse;
  3788.   MousePos: TPoint;
  3789. begin
  3790.   with M do
  3791.   begin
  3792.     Msg := WM_LBUTTONDOWN;
  3793.     GetCursorPos(MousePos);
  3794.     Pos := PointToSmallPoint(ScreenToClient(MousePos));
  3795.     Keys := 0;
  3796.     Result := 0;
  3797.   end;
  3798.   DefaultHandler(M);
  3799.   M.Msg := WM_LBUTTONUP;
  3800.   DefaultHandler(M);
  3801. end;
  3802.  
  3803. procedure TCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  3804.   State: TOwnerDrawState);
  3805. var
  3806.   Flags: Longint;
  3807. begin
  3808.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State) else
  3809.   begin
  3810.     FCanvas.FillRect(Rect);
  3811.     if Index < Items.Count then
  3812.     begin
  3813.       Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  3814.       if not UseRightToLeftAlignment then
  3815.         Inc(Rect.Left, 2)
  3816.       else
  3817.         Dec(Rect.Right, 2);
  3818.       DrawText(FCanvas.Handle, PChar(Items[Index]), Length(Items[Index]), Rect,
  3819.         Flags);
  3820.     end;
  3821.   end;
  3822. end;
  3823.  
  3824. procedure TCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
  3825. begin
  3826.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  3827. end;
  3828.  
  3829. procedure TCustomListBox.CNDrawItem(var Message: TWMDrawItem);
  3830. var
  3831.   State: TOwnerDrawState;
  3832. begin
  3833.   with Message.DrawItemStruct^ do
  3834.   begin
  3835.     State := TOwnerDrawState(LongRec(itemState).Lo);
  3836.     FCanvas.Handle := hDC;
  3837.     FCanvas.Font := Font;
  3838.     FCanvas.Brush := Brush;
  3839.     if (Integer(itemID) >= 0) and (odSelected in State) then
  3840.     begin
  3841.       FCanvas.Brush.Color := clHighlight;
  3842.       FCanvas.Font.Color := clHighlightText
  3843.     end;
  3844.     if Integer(itemID) >= 0 then
  3845.       DrawItem(itemID, rcItem, State) else
  3846.       FCanvas.FillRect(rcItem);
  3847.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  3848.     FCanvas.Handle := 0;
  3849.   end;
  3850. end;
  3851.  
  3852. procedure TCustomListBox.CNMeasureItem(var Message: TWMMeasureItem);
  3853. begin
  3854.   with Message.MeasureItemStruct^ do
  3855.   begin
  3856.     itemHeight := FItemHeight;
  3857.     if FStyle = lbOwnerDrawVariable then
  3858.       MeasureItem(itemID, Integer(itemHeight));
  3859.   end;
  3860. end;
  3861.  
  3862. procedure TCustomListBox.CMCtl3DChanged(var Message: TMessage);
  3863. begin
  3864.   if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  3865.   inherited;
  3866. end;
  3867.  
  3868. { TScrollBar }
  3869.  
  3870. constructor TScrollBar.Create(AOwner: TComponent);
  3871. begin
  3872.   inherited Create(AOwner);
  3873.   Width := 121;
  3874.   Height := GetSystemMetrics(SM_CYHSCROLL);
  3875.   TabStop := True;
  3876.   ControlStyle := [csFramed, csDoubleClicks, csOpaque];
  3877.   FKind := sbHorizontal;
  3878.   FPosition := 0;
  3879.   FMin := 0;
  3880.   FMax := 100;
  3881.   FSmallChange := 1;
  3882.   FLargeChange := 1;
  3883.   if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
  3884.     ImeMode := imDisable;
  3885. end;
  3886.  
  3887. procedure TScrollBar.CreateParams(var Params: TCreateParams);
  3888. const
  3889.   Kinds: array[TScrollBarKind] of DWORD = (SBS_HORZ, SBS_VERT);
  3890. begin
  3891.   inherited CreateParams(Params);
  3892.   CreateSubClass(Params, 'SCROLLBAR');
  3893.   Params.Style := Params.Style or Kinds[FKind];
  3894.   if FKind = sbVertical then
  3895.     if not UseRightToLeftAlignment then
  3896.       Params.Style := Params.Style or SBS_RIGHTALIGN
  3897.     else
  3898.       Params.Style := Params.Style or SBS_LEFTALIGN;
  3899.   if NotRightToLeft then
  3900.     FRTLFactor := 1
  3901.   else
  3902.     FRTLFactor := -1;
  3903. end;
  3904.  
  3905. procedure TScrollBar.CreateWnd;
  3906. var
  3907.   ScrollInfo: TScrollInfo;
  3908. begin
  3909.   inherited CreateWnd;
  3910.   SetScrollRange(Handle, SB_CTL, FMin, FMax, False);
  3911.   ScrollInfo.cbSize := SizeOf(ScrollInfo);
  3912.   ScrollInfo.nPage := FPageSize;
  3913.   ScrollInfo.fMask := SIF_PAGE;
  3914.   SetScrollInfo(Handle, SB_CTL, ScrollInfo, False);
  3915.   if NotRightToLeft then
  3916.     SetScrollPos(Handle, SB_CTL, FPosition, True)
  3917.   else
  3918.     SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
  3919. end;
  3920.  
  3921. function TScrollBar.NotRightToLeft: Boolean;
  3922. begin
  3923.   Result := (not IsRightToLeft) or (FKind = sbVertical);
  3924. end;
  3925.  
  3926. procedure TScrollBar.SetKind(Value: TScrollBarKind);
  3927. begin
  3928.   if FKind <> Value then
  3929.   begin
  3930.     FKind := Value;
  3931.     if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
  3932.     RecreateWnd;
  3933.   end;
  3934. end;
  3935.  
  3936. procedure TScrollBar.SetParams(APosition, AMin, AMax: Integer);
  3937. begin
  3938.   if AMax < AMin then
  3939.     raise EInvalidOperation.Create(SScrollBarRange);
  3940.   if APosition < AMin then APosition := AMin;
  3941.   if APosition > AMax then APosition := AMax;
  3942.   if (FMin <> AMin) or (FMax <> AMax) then
  3943.   begin
  3944.     FMin := AMin;
  3945.     FMax := AMax;
  3946.     if HandleAllocated then
  3947.       SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
  3948.   end;
  3949.   if FPosition <> APosition then
  3950.   begin
  3951.     FPosition := APosition;
  3952.     if HandleAllocated then
  3953.       if NotRightToLeft then
  3954.         SetScrollPos(Handle, SB_CTL, FPosition, True)
  3955.       else
  3956.         SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
  3957.     Enabled := True;
  3958.     Change;
  3959.   end;
  3960. end;
  3961.  
  3962. procedure TScrollBar.SetPosition(Value: Integer);
  3963. begin
  3964.   SetParams(Value, FMin, FMax);
  3965. end;
  3966.  
  3967. procedure TScrollBar.SetPageSize(Value: Integer);
  3968. var
  3969.   ScrollInfo: TScrollInfo;
  3970. begin
  3971.   if (FPageSize = Value) or (FPageSize > FMax) then exit;
  3972.   FPageSize := Value;
  3973.   ScrollInfo.cbSize := SizeOf(ScrollInfo);
  3974.   ScrollInfo.nPage := Value;
  3975.   ScrollInfo.fMask := SIF_PAGE;
  3976.   if HandleAllocated then
  3977.     SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
  3978. end;
  3979.  
  3980. procedure TScrollBar.SetMin(Value: Integer);
  3981. begin
  3982.   SetParams(FPosition, Value, FMax);
  3983. end;
  3984.  
  3985. procedure TScrollBar.SetMax(Value: Integer);
  3986. begin
  3987.   SetParams(FPosition, FMin, Value);
  3988. end;
  3989.  
  3990. procedure TScrollBar.Change;
  3991. begin
  3992.   inherited Changed;
  3993.   if Assigned(FOnChange) then FOnChange(Self);
  3994. end;
  3995.  
  3996. procedure TScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
  3997. begin
  3998.   if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
  3999. end;
  4000.  
  4001. procedure TScrollBar.DoScroll(var Message: TWMScroll);
  4002. var
  4003.   ScrollPos: Integer;
  4004.   NewPos: Longint;
  4005.   ScrollInfo: TScrollInfo;
  4006. begin
  4007.   with Message do
  4008.   begin
  4009.     NewPos := FPosition;
  4010.     case TScrollCode(ScrollCode) of
  4011.       scLineUp:
  4012.         Dec(NewPos, FSmallChange * FRTLFactor);
  4013.       scLineDown:
  4014.         Inc(NewPos, FSmallChange * FRTLFactor);
  4015.       scPageUp:
  4016.         Dec(NewPos, FLargeChange * FRTLFactor);
  4017.       scPageDown:
  4018.         Inc(NewPos, FLargeChange * FRTLFactor);
  4019.       scPosition, scTrack:
  4020.         with ScrollInfo do
  4021.         begin
  4022.           cbSize := SizeOf(ScrollInfo);
  4023.           fMask := SIF_ALL;
  4024.           GetScrollInfo(Handle, SB_CTL, ScrollInfo);
  4025.           NewPos := nTrackPos;
  4026.           { We need to reverse the positioning because SetPosition below
  4027.             calls SetParams that reverses the position. This acts as a
  4028.             double negative. }
  4029.           if not NotRightToLeft then NewPos := FMax - NewPos;
  4030.         end;
  4031.       scTop:
  4032.         NewPos := FMin;
  4033.       scBottom:
  4034.         NewPos := FMax;
  4035.     end;
  4036.     if NewPos < FMin then NewPos := FMin;
  4037.     if NewPos > FMax then NewPos := FMax;
  4038.     ScrollPos := NewPos;
  4039.     Scroll(TScrollCode(ScrollCode), ScrollPos);
  4040.     SetPosition(ScrollPos);
  4041.   end;
  4042. end;
  4043.  
  4044. procedure TScrollBar.CNHScroll(var Message: TWMHScroll);
  4045. begin
  4046.   DoScroll(Message);
  4047. end;
  4048.  
  4049. procedure TScrollBar.CNVScroll(var Message: TWMVScroll);
  4050. begin
  4051.   DoScroll(Message);
  4052. end;
  4053.  
  4054. procedure TScrollBar.CNCtlColorScrollBar(var Message: TMessage);
  4055. begin
  4056.   with Message do
  4057.     CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
  4058. end;
  4059.  
  4060. procedure TScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  4061. begin
  4062.   DefaultHandler(Message);
  4063. end;
  4064.  
  4065. { TCustomStaticText }
  4066.  
  4067. constructor TCustomStaticText.Create(AOwner: TComponent);
  4068. begin
  4069.   inherited Create(AOwner);
  4070.   ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption,
  4071.     csOpaque, csReplicatable, csDoubleClicks];
  4072.   Width := 65;
  4073.   Height := 17;
  4074.   FAutoSize := True;
  4075.   FShowAccelChar := True;
  4076.   AdjustBounds;
  4077. end;
  4078.  
  4079. procedure TCustomStaticText.CreateParams(var Params: TCreateParams);
  4080. const
  4081.   Alignments: array[Boolean, TAlignment] of DWORD =
  4082.     ((SS_LEFT, SS_RIGHT, SS_CENTER), (SS_RIGHT, SS_LEFT, SS_CENTER));
  4083.   Borders: array[TStaticBorderStyle] of DWORD = (0, WS_BORDER, SS_SUNKEN);
  4084. begin
  4085.   inherited CreateParams(Params);
  4086.   CreateSubClass(Params, 'STATIC');
  4087.   with Params do
  4088.   begin
  4089.     Style := Style or SS_NOTIFY or
  4090.       Alignments[UseRightToLeftAlignment, FAlignment] or Borders[FBorderStyle];
  4091.     if not FShowAccelChar then Style := Style or SS_NOPREFIX;
  4092.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  4093.   end;
  4094. end;
  4095.  
  4096. procedure TCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
  4097. begin
  4098.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  4099.     IsAccel(Message.CharCode, Caption) then
  4100.     with FFocusControl do
  4101.       if CanFocus then
  4102.       begin
  4103.         SetFocus;
  4104.         Message.Result := 1;
  4105.       end;
  4106. end;
  4107.  
  4108. procedure TCustomStaticText.CMFontChanged(var Message: TMessage);
  4109. begin
  4110.   inherited;
  4111.   AdjustBounds;
  4112. end;
  4113.  
  4114. procedure TCustomStaticText.CMTextChanged(var Message: TMessage);
  4115. begin
  4116.   inherited;
  4117.   AdjustBounds;
  4118.   Invalidate;
  4119. end;
  4120.  
  4121. procedure TCustomStaticText.Loaded;
  4122. begin
  4123.   inherited Loaded;
  4124.   AdjustBounds;
  4125. end;
  4126.  
  4127. procedure TCustomStaticText.AdjustBounds;
  4128. var
  4129.   DC: HDC;
  4130.   SaveFont: HFont;
  4131.   TextSize: TSize;
  4132. begin
  4133.   if not (csReading in ComponentState) and FAutoSize then
  4134.   begin
  4135.     DC := GetDC(0);
  4136.     SaveFont := SelectObject(DC, Font.Handle);
  4137.     GetTextExtentPoint32(DC, PChar(Caption), Length(Caption), TextSize);
  4138.     SelectObject(DC, SaveFont);
  4139.     ReleaseDC(0, DC);
  4140.     SetBounds(Left, Top,
  4141.       TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4),
  4142.       TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4));
  4143.   end;
  4144. end;
  4145.  
  4146. procedure TCustomStaticText.Notification(AComponent: TComponent;
  4147.   Operation: TOperation);
  4148. begin
  4149.   inherited Notification(AComponent, Operation);
  4150.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  4151.     FFocusControl := nil;
  4152. end;
  4153.  
  4154. procedure TCustomStaticText.SetAlignment(Value: TAlignment);
  4155. begin
  4156.   if FAlignment <> Value then
  4157.   begin
  4158.     FAlignment := Value;
  4159.     RecreateWnd;
  4160.   end;
  4161. end;
  4162.  
  4163. procedure TCustomStaticText.SetAutoSize(Value: Boolean);
  4164. begin
  4165.   if FAutoSize <> Value then
  4166.   begin
  4167.     FAutoSize := Value;
  4168.     if Value then AdjustBounds;
  4169.   end;
  4170. end;
  4171.  
  4172. procedure TCustomStaticText.SetBorderStyle(Value: TStaticBorderStyle);
  4173. begin
  4174.   if FBorderStyle <> Value then
  4175.   begin
  4176.     FBorderStyle := Value;
  4177.     RecreateWnd;
  4178.   end;
  4179. end;
  4180.  
  4181. procedure TCustomStaticText.SetFocusControl(Value: TWinControl);
  4182. begin
  4183.   FFocusControl := Value;
  4184.   if Value <> nil then Value.FreeNotification(Self);
  4185. end;
  4186.  
  4187. procedure TCustomStaticText.SetShowAccelChar(Value: Boolean);
  4188. begin
  4189.   if FShowAccelChar <> Value then
  4190.   begin
  4191.     FShowAccelChar := Value;
  4192.     RecreateWnd;
  4193.   end;
  4194. end;
  4195.  
  4196. end.
  4197.