home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Install / DATA.Z / STDCTRLS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-09  |  93.6 KB  |  3,349 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit StdCtrls;
  11.  
  12. {$R-}
  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.   protected
  25.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  26.     procedure Paint; override;
  27.   public
  28.     constructor Create(AOwner: TComponent); override;
  29.   end;
  30.  
  31.   TGroupBox = class(TCustomGroupBox)
  32.   published
  33.     property Align;
  34.     property Caption;
  35.     property Color;
  36.     property Ctl3D;
  37.     property DragCursor;
  38.     property DragMode;
  39.     property Enabled;
  40.     property Font;
  41.     property ParentColor;
  42.     property ParentCtl3D;
  43.     property ParentFont;
  44.     property ParentShowHint;
  45.     property PopupMenu;
  46.     property ShowHint;
  47.     property TabOrder;
  48.     property TabStop;
  49.     property Visible;
  50.     property OnClick;
  51.     property OnDblClick;
  52.     property OnDragDrop;
  53.     property OnDragOver;
  54.     property OnEndDrag;
  55.     property OnEnter;
  56.     property OnExit;
  57.     property OnMouseDown;
  58.     property OnMouseMove;
  59.     property OnMouseUp;
  60.     property OnStartDrag;
  61.   end;
  62.  
  63.   TCustomLabel = class(TGraphicControl)
  64.   private
  65.     FFocusControl: TWinControl;
  66.     FAlignment: TAlignment;
  67.     FAutoSize: Boolean;
  68.     FWordWrap: Boolean;
  69.     FShowAccelChar: Boolean;
  70.     procedure AdjustBounds;
  71.     procedure DoDrawText(var Rect: TRect; Flags: Word);
  72.     function GetTransparent: Boolean;
  73.     procedure SetAlignment(Value: TAlignment);
  74.     procedure SetFocusControl(Value: TWinControl);
  75.     procedure SetShowAccelChar(Value: Boolean);
  76.     procedure SetTransparent(Value: Boolean);
  77.     procedure SetWordWrap(Value: Boolean);
  78.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  79.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  80.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  81.   protected
  82.     function GetLabelText: string; virtual;
  83.     procedure Notification(AComponent: TComponent;
  84.       Operation: TOperation); override;
  85.     procedure Paint; override;
  86.     procedure SetAutoSize(Value: Boolean); virtual;
  87.     property Alignment: TAlignment read FAlignment write SetAlignment
  88.       default taLeftJustify;
  89.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  90.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  91.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  92.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  93.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  94.   public
  95.     constructor Create(AOwner: TComponent); override;
  96.     property Canvas;
  97.   end;
  98.  
  99.   TLabel = class(TCustomLabel)
  100.   published
  101.     property Align;
  102.     property Alignment;
  103.     property AutoSize;
  104.     property Caption;
  105.     property Color;
  106.     property DragCursor;
  107.     property DragMode;
  108.     property Enabled;
  109.     property FocusControl;
  110.     property Font;
  111.     property ParentColor;
  112.     property ParentFont;
  113.     property ParentShowHint;
  114.     property PopupMenu;
  115.     property ShowAccelChar;
  116.     property ShowHint;
  117.     property Transparent;
  118.     property Visible;
  119.     property WordWrap;
  120.     property OnClick;
  121.     property OnDblClick;
  122.     property OnDragDrop;
  123.     property OnDragOver;
  124.     property OnEndDrag;
  125.     property OnMouseDown;
  126.     property OnMouseMove;
  127.     property OnMouseUp;
  128.     property OnStartDrag;
  129.   end;
  130.  
  131.   TEditCharCase = (ecNormal, ecUpperCase, ecLowerCase);
  132.  
  133.   TCustomEdit = class(TWinControl)
  134.   private
  135.     FMaxLength: Integer;
  136.     FBorderStyle: TBorderStyle;
  137.     FPasswordChar: Char;
  138.     FReadOnly: Boolean;
  139.     FAutoSize: Boolean;
  140.     FAutoSelect: Boolean;
  141.     FHideSelection: Boolean;
  142.     FOEMConvert: Boolean;
  143.     FCharCase: TEditCharCase;
  144.     FCreating: Boolean;
  145.     FModified: Boolean;
  146.     FOnChange: TNotifyEvent;
  147.     procedure AdjustHeight;
  148.     procedure DefaultHandler(var Message); override;
  149.     function GetModified: Boolean;
  150.     function GetSelLength: Integer;
  151.     function GetSelStart: Integer;
  152.     function GetSelText: string;
  153.     procedure SetAutoSize(Value: Boolean);
  154.     procedure SetBorderStyle(Value: TBorderStyle);
  155.     procedure SetCharCase(Value: TEditCharCase);
  156.     procedure SetHideSelection(Value: Boolean);
  157.     procedure SetMaxLength(Value: Integer);
  158.     procedure SetModified(Value: Boolean);
  159.     procedure SetOEMConvert(Value: Boolean);
  160.     procedure SetPasswordChar(Value: Char);
  161.     procedure SetReadOnly(Value: Boolean);
  162.     procedure SetSelLength(Value: Integer);
  163.     procedure SetSelStart(Value: Integer);
  164.     procedure SetSelText(const Value: string);
  165.     procedure UpdateHeight;
  166.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  167.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  168.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  169.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  170.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  171.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  172.   protected
  173.     procedure Change; dynamic;
  174.     procedure CreateParams(var Params: TCreateParams); override;
  175.     procedure CreateWnd; override;
  176.     procedure DestroyWnd; override;
  177.     property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
  178.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  179.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  180.     property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
  181.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  182.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  183.     property OEMConvert: Boolean read FOEMConvert write SetOEMConvert default False;
  184.     property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
  185.     property ParentColor default False;
  186.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  187.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  188.   public
  189.     constructor Create(AOwner: TComponent); override;
  190.     procedure Clear;
  191.     procedure ClearSelection;
  192.     procedure CopyToClipboard;
  193.     procedure CutToClipboard;
  194.     procedure PasteFromClipboard;
  195.     function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  196.     procedure SelectAll;
  197.     procedure SetSelTextBuf(Buffer: PChar);
  198.     property Modified: Boolean read GetModified write SetModified;
  199.     property SelLength: Integer read GetSelLength write SetSelLength;
  200.     property SelStart: Integer read GetSelStart write SetSelStart;
  201.     property SelText: string read GetSelText write SetSelText;
  202.     property Text;
  203.   published
  204.     property TabStop default True;
  205.   end;
  206.  
  207.   TEdit = class(TCustomEdit)
  208.   published
  209.     property AutoSelect;
  210.     property AutoSize;
  211.     property BorderStyle;
  212.     property CharCase;
  213.     property Color;
  214.     property Ctl3D;
  215.     property DragCursor;
  216.     property DragMode;
  217.     property Enabled;
  218.     property Font;
  219.     property HideSelection;
  220.     property MaxLength;
  221.     property OEMConvert;
  222.     property ParentColor;
  223.     property ParentCtl3D;
  224.     property ParentFont;
  225.     property ParentShowHint;
  226.     property PasswordChar;
  227.     property PopupMenu;
  228.     property ReadOnly;
  229.     property ShowHint;
  230.     property TabOrder;
  231.     property TabStop;
  232.     property Text;
  233.     property Visible;
  234.     property OnChange;
  235.     property OnClick;
  236.     property OnDblClick;
  237.     property OnDragDrop;
  238.     property OnDragOver;
  239.     property OnEndDrag;
  240.     property OnEnter;
  241.     property OnExit;
  242.     property OnKeyDown;
  243.     property OnKeyPress;
  244.     property OnKeyUp;
  245.     property OnMouseDown;
  246.     property OnMouseMove;
  247.     property OnMouseUp;
  248.     property OnStartDrag;
  249.   end;
  250.  
  251.   TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);
  252.  
  253.   TCustomMemo = class(TCustomEdit)
  254.   private
  255.     FLines: TStrings;
  256.     FAlignment: TAlignment;
  257.     FScrollBars: TScrollStyle;
  258.     FWordWrap: Boolean;
  259.     FWantReturns: Boolean;
  260.     FWantTabs: Boolean;
  261.     FReserved: Byte;
  262.     HEditDS: THandle;
  263.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  264.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  265.   protected
  266.     procedure CreateParams(var Params: TCreateParams); override;
  267.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  268.     procedure KeyPress(var Key: Char); override;
  269.     procedure Loaded; override;
  270.     procedure SetAlignment(Value: TAlignment);
  271.     procedure SetLines(Value: TStrings);
  272.     procedure SetScrollBars(Value: TScrollStyle);
  273.     procedure SetWordWrap(Value: Boolean);
  274.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  275.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
  276.     property WantReturns: Boolean read FWantReturns write FWantReturns default True;
  277.     property WantTabs: Boolean read FWantTabs write FWantTabs default False;
  278.     property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  279.   public
  280.     constructor Create(AOwner: TComponent); override;
  281.     destructor Destroy; override;
  282.     property Lines: TStrings read FLines write SetLines;
  283.   end;
  284.  
  285.   TMemo = class(TCustomMemo)
  286.   private
  287.     procedure ReadStringData(Reader: TReader);
  288.   published
  289.     property Align;
  290.     property Alignment;
  291.     property BorderStyle;
  292.     property Color;
  293.     property Ctl3D;
  294.     property DragCursor;
  295.     property DragMode;
  296.     property Enabled;
  297.     property Font;
  298.     property HideSelection;
  299.     property Lines;
  300.     property MaxLength;
  301.     property OEMConvert;
  302.     property ParentColor;
  303.     property ParentCtl3D;
  304.     property ParentFont;
  305.     property ParentShowHint;
  306.     property PopupMenu;
  307.     property ReadOnly;
  308.     property ScrollBars;
  309.     property ShowHint;
  310.     property TabOrder;
  311.     property TabStop;
  312.     property Visible;
  313.     property WantReturns;
  314.     property WantTabs;
  315.     property WordWrap;
  316.     property OnChange;
  317.     property OnClick;
  318.     property OnDblClick;
  319.     property OnDragDrop;
  320.     property OnDragOver;
  321.     property OnEndDrag;
  322.     property OnEnter;
  323.     property OnExit;
  324.     property OnKeyDown;
  325.     property OnKeyPress;
  326.     property OnKeyUp;
  327.     property OnMouseDown;
  328.     property OnMouseMove;
  329.     property OnMouseUp;
  330.     property OnStartDrag;
  331.   end;
  332.  
  333.   TComboBoxStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,
  334.     csOwnerDrawVariable);
  335.   TOwnerDrawState = set of (odSelected, odGrayed, odDisabled, odChecked,
  336.     odFocused);
  337.  
  338.   TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
  339.     Rect: TRect; State: TOwnerDrawState) of object;
  340.  
  341.   TMeasureItemEvent = procedure(Control: TWinControl; Index: Integer;
  342.     var Height: Integer) of object;
  343.  
  344.   TCustomComboBox = class(TWinControl)
  345.   private
  346.     FItems: TStrings;
  347.     FCanvas: TCanvas;
  348.     FSorted: Boolean;
  349.     FStyle: TComboBoxStyle;
  350.     FItemHeight: Integer;
  351.     FMaxLength: Integer;
  352.     FDropDownCount: Integer;
  353.     FEditHandle: HWnd;
  354.     FListHandle: HWnd;
  355.     FEditInstance: Pointer;
  356.     FListInstance: Pointer;
  357.     FDefEditProc: Pointer;
  358.     FDefListProc: Pointer;
  359.     FIsFocused: Boolean;
  360.     FFocusChanged: Boolean;
  361.     FSaveItems: TStringList;
  362.     FOnChange: TNotifyEvent;
  363.     FOnDropDown: TNotifyEvent;
  364.     FOnDrawItem: TDrawItemEvent;
  365.     FOnMeasureItem: TMeasureItemEvent;
  366.     procedure AdjustDropDown;
  367.     procedure EditWndProc(var Message: TMessage);
  368.     function GetDroppedDown: Boolean;
  369.     function GetItemIndex: Integer;
  370.     function GetSelLength: Integer;
  371.     function GetSelStart: Integer;
  372.     function GetSelText: string;
  373.     procedure ListWndProc(var Message: TMessage);
  374.     procedure SetDroppedDown(Value: Boolean);
  375.     procedure SetItems(Value: TStrings);
  376.     procedure SetItemIndex(Value: Integer);
  377.     procedure SetSelLength(Value: Integer);
  378.     procedure SetSelStart(Value: Integer);
  379.     procedure SetSelText(const Value: string);
  380.     procedure SetSorted(Value: Boolean);
  381.     function  GetItemHeight: Integer;
  382.     procedure SetItemHeight(Value: Integer);
  383.     procedure SetMaxLength(Value: Integer);
  384.     procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
  385.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  386.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  387.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  388.     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  389.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  390.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  391.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  392.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  393.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  394.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  395.     procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
  396.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  397.   protected
  398.     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  399.       ComboProc: Pointer); virtual;
  400.     procedure WndProc(var Message: TMessage); override;
  401.     procedure CreateParams(var Params: TCreateParams); override;
  402.     procedure CreateWnd; override;
  403.     procedure DestroyWnd; override;
  404.     procedure DrawItem(Index: Integer; Rect: TRect;
  405.       State: TOwnerDrawState); virtual;
  406.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  407.     procedure Change; dynamic;
  408.     procedure DropDown; dynamic;
  409.     procedure SetStyle(Value: TComboBoxStyle); virtual;
  410.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
  411.     property EditHandle: HWnd read FEditHandle;
  412.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  413.     property ListHandle: HWnd read FListHandle;
  414.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  415.     property ParentColor default False;
  416.     property Sorted: Boolean read FSorted write SetSorted default False;
  417.     property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown;
  418.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  419.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  420.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  421.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  422.   public
  423.     constructor Create(AOwner: TComponent); override;
  424.     destructor Destroy; override;
  425.     procedure Clear;
  426.     procedure SelectAll;
  427.     property Canvas: TCanvas read FCanvas;
  428.     property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown;
  429.     property Items: TStrings read FItems write SetItems;
  430.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  431.     property SelLength: Integer read GetSelLength write SetSelLength;
  432.     property SelStart: Integer read GetSelStart write SetSelStart;
  433.     property SelText: string read GetSelText write SetSelText;
  434.   published
  435.     property TabStop default True;
  436.   end;
  437.  
  438.   TComboBox = class(TCustomComboBox)
  439.   published
  440.     property Style; {Must be published before Items}
  441.     property Color;
  442.     property Ctl3D;
  443.     property DragMode;
  444.     property DragCursor;
  445.     property DropDownCount;
  446.     property Enabled;
  447.     property Font;
  448.     property ItemHeight;
  449.     property Items;
  450.     property MaxLength;
  451.     property ParentColor;
  452.     property ParentCtl3D;
  453.     property ParentFont;
  454.     property ParentShowHint;
  455.     property PopupMenu;
  456.     property ShowHint;
  457.     property Sorted;
  458.     property TabOrder;
  459.     property TabStop;
  460.     property Text;
  461.     property Visible;
  462.     property OnChange;
  463.     property OnClick;
  464.     property OnDblClick;
  465.     property OnDragDrop;
  466.     property OnDragOver;
  467.     property OnDrawItem;
  468.     property OnDropDown;
  469.     property OnEndDrag;
  470.     property OnEnter;
  471.     property OnExit;
  472.     property OnKeyDown;
  473.     property OnKeyPress;
  474.     property OnKeyUp;
  475.     property OnMeasureItem;
  476.     property OnStartDrag;
  477.   end;
  478.  
  479.   TButtonControl = class(TWinControl)
  480.   private
  481.     FClicksDisabled: Boolean;
  482.     FReserved: Byte;
  483.   protected
  484.     procedure WndProc(var Message: TMessage); override;
  485.   end;
  486.  
  487.   TButton = class(TButtonControl)
  488.   private
  489.     FDefault: Boolean;
  490.     FCancel: Boolean;
  491.     FActive: Boolean;
  492.     FReserved: Byte;
  493.     FModalResult: TModalResult;
  494.     procedure SetDefault(Value: Boolean);
  495.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  496.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  497.     procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  498.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  499.   protected
  500.     procedure CreateParams(var Params: TCreateParams); override;
  501.     procedure CreateWnd; override;
  502.     procedure SetButtonStyle(ADefault: Boolean); virtual;
  503.   public
  504.     constructor Create(AOwner: TComponent); override;
  505.     procedure Click; override;
  506.   published
  507.     property Cancel: Boolean read FCancel write FCancel default False;
  508.     property Caption;
  509.     property Default: Boolean read FDefault write SetDefault default False;
  510.     property DragCursor;
  511.     property DragMode;
  512.     property Enabled;
  513.     property Font;
  514.     property ModalResult: TModalResult read FModalResult write FModalResult default 0;
  515.     property ParentFont;
  516.     property ParentShowHint;
  517.     property PopupMenu;
  518.     property ShowHint;
  519.     property TabOrder;
  520.     property TabStop default True;
  521.     property Visible;
  522.     property OnClick;
  523.     property OnDragDrop;
  524.     property OnDragOver;
  525.     property OnEndDrag;
  526.     property OnEnter;
  527.     property OnExit;
  528.     property OnKeyDown;
  529.     property OnKeyPress;
  530.     property OnKeyUp;
  531.     property OnMouseDown;
  532.     property OnMouseMove;
  533.     property OnMouseUp;
  534.     property OnStartDrag;
  535.   end;
  536.  
  537.   TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
  538.  
  539.   TCustomCheckBox = class(TButtonControl)
  540.   private
  541.     FAlignment: TLeftRight;
  542.     FAllowGrayed: Boolean;
  543.     FState: TCheckBoxState;
  544.     function GetChecked: Boolean;
  545.     procedure SetAlignment(Value: TLeftRight);
  546.     procedure SetChecked(Value: Boolean);
  547.     procedure SetState(Value: TCheckBoxState);
  548.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  549.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  550.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  551.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  552.   protected
  553.     procedure Toggle; virtual;
  554.     procedure CreateParams(var Params: TCreateParams); override;
  555.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  556.     procedure CreateWnd; override;
  557.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  558.     property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
  559.     property Checked: Boolean read GetChecked write SetChecked stored False;
  560.     property State: TCheckBoxState read FState write SetState default cbUnchecked;
  561.   public
  562.     constructor Create(AOwner: TComponent); override;
  563.   published
  564.     property TabStop default True;
  565.   end;
  566.  
  567.   TCheckBox = class(TCustomCheckBox)
  568.   published
  569.     property Alignment;
  570.     property AllowGrayed;
  571.     property Caption;
  572.     property Checked;
  573.     property Color;
  574.     property Ctl3D;
  575.     property DragCursor;
  576.     property DragMode;
  577.     property Enabled;
  578.     property Font;
  579.     property ParentColor;
  580.     property ParentCtl3D;
  581.     property ParentFont;
  582.     property ParentShowHint;
  583.     property PopupMenu;
  584.     property ShowHint;
  585.     property State;
  586.     property TabOrder;
  587.     property TabStop;
  588.     property Visible;
  589.     property OnClick;
  590.     property OnDragDrop;
  591.     property OnDragOver;
  592.     property OnEndDrag;
  593.     property OnEnter;
  594.     property OnExit;
  595.     property OnKeyDown;
  596.     property OnKeyPress;
  597.     property OnKeyUp;
  598.     property OnMouseDown;
  599.     property OnMouseMove;
  600.     property OnMouseUp;
  601.     property OnStartDrag;
  602.   end;
  603.  
  604.   TRadioButton = class(TButtonControl)
  605.   private
  606.     FAlignment: TLeftRight;
  607.     FChecked: Boolean;
  608.     procedure SetAlignment(Value: TLeftRight);
  609.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  610.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  611.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  612.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  613.   protected
  614.     procedure SetChecked(Value: Boolean);
  615.     procedure CreateParams(var Params: TCreateParams); override;
  616.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  617.     procedure CreateWnd; override;
  618.   public
  619.     constructor Create(AOwner: TComponent); override;
  620.   published
  621.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  622.     property Caption;
  623.     property Checked: Boolean read FChecked write SetChecked default False;
  624.     property Color;
  625.     property Ctl3D;
  626.     property DragCursor;
  627.     property DragMode;
  628.     property Enabled;
  629.     property Font;
  630.     property ParentColor;
  631.     property ParentCtl3D;
  632.     property ParentFont;
  633.     property ParentShowHint;
  634.     property PopupMenu;
  635.     property ShowHint;
  636.     property TabOrder;
  637.     property TabStop;
  638.     property Visible;
  639.     property OnClick;
  640.     property OnDblClick;
  641.     property OnDragDrop;
  642.     property OnDragOver;
  643.     property OnEndDrag;
  644.     property OnEnter;
  645.     property OnExit;
  646.     property OnKeyDown;
  647.     property OnKeyPress;
  648.     property OnKeyUp;
  649.     property OnMouseDown;
  650.     property OnMouseMove;
  651.     property OnMouseUp;
  652.     property OnStartDrag;
  653.   end;
  654.  
  655.   TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable);
  656.  
  657.   TCustomListBox = class(TWinControl)
  658.   private
  659.     FItems: TStrings;
  660.     FBorderStyle: TBorderStyle;
  661.     FCanvas: TCanvas;
  662.     FColumns: Integer;
  663.     FItemHeight: Integer;
  664.     FStyle: TListBoxStyle;
  665.     FIntegralHeight: Boolean;
  666.     FMultiSelect: Boolean;
  667.     FSorted: Boolean;
  668.     FExtendedSelect: Boolean;
  669.     FTabWidth: Integer;
  670.     FSaveItems: TStringList;
  671.     FSaveTopIndex: Integer;
  672.     FSaveItemIndex: Integer;
  673.     FOnDrawItem: TDrawItemEvent;
  674.     FOnMeasureItem: TMeasureItemEvent;
  675.     function GetItemHeight: Integer;
  676.     function GetItemIndex: Integer;
  677.     function GetSelCount: Integer;
  678.     function GetSelected(Index: Integer): Boolean;
  679.     function GetTopIndex: Integer;
  680.     procedure SetBorderStyle(Value: TBorderStyle);
  681.     procedure SetColumnWidth;
  682.     procedure SetColumns(Value: Integer);
  683.     procedure SetExtendedSelect(Value: Boolean);
  684.     procedure SetIntegralHeight(Value: Boolean);
  685.     procedure SetItemHeight(Value: Integer);
  686.     procedure SetItems(Value: TStrings);
  687.     procedure SetItemIndex(Value: Integer);
  688.     procedure SetMultiSelect(Value: Boolean);
  689.     procedure SetSelected(Index: Integer; Value: Boolean);
  690.     procedure SetSorted(Value: Boolean);
  691.     procedure SetStyle(Value: TListBoxStyle);
  692.     procedure SetTabWidth(Value: Integer);
  693.     procedure SetTopIndex(Value: Integer);
  694.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  695.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  696.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  697.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  698.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  699.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  700.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  701.   protected
  702.     procedure CreateParams(var Params: TCreateParams); override;
  703.     procedure CreateWnd; override;
  704.     procedure DestroyWnd; override;
  705.     procedure WndProc(var Message: TMessage); override;
  706.     procedure DragCanceled; override;
  707.     procedure DrawItem(Index: Integer; Rect: TRect;
  708.       State: TOwnerDrawState); virtual;
  709.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  710.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  711.     property Columns: Integer read FColumns write SetColumns default 0;
  712.     property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
  713.     property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
  714.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  715.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
  716.     property ParentColor default False;
  717.     property Sorted: Boolean read FSorted write SetSorted default False;
  718.     property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
  719.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  720.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  721.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  722.   public
  723.     constructor Create(AOwner: TComponent); override;
  724.     destructor Destroy; override;
  725.     procedure Clear;
  726.     function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  727.     function ItemRect(Index: Integer): TRect;
  728.     property Canvas: TCanvas read FCanvas;
  729.     property Items: TStrings read FItems write SetItems;
  730.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  731.     property SelCount: Integer read GetSelCount;
  732.     property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
  733.     property TopIndex: Integer read GetTopIndex write SetTopIndex;
  734.   published
  735.     property TabStop default True;
  736.   end;
  737.  
  738.   TListBox = class(TCustomListBox)
  739.   published
  740.     property Align;
  741.     property BorderStyle;
  742.     property Color;
  743.     property Columns;
  744.     property Ctl3D;
  745.     property DragCursor;
  746.     property DragMode;
  747.     property Enabled;
  748.     property ExtendedSelect;
  749.     property Font;
  750.     property IntegralHeight;
  751.     property ItemHeight;
  752.     property Items;
  753.     property MultiSelect;
  754.     property ParentColor;
  755.     property ParentCtl3D;
  756.     property ParentFont;
  757.     property ParentShowHint;
  758.     property PopupMenu;
  759.     property ShowHint;
  760.     property Sorted;
  761.     property Style;
  762.     property TabOrder;
  763.     property TabStop;
  764.     property TabWidth;
  765.     property Visible;
  766.     property OnClick;
  767.     property OnDblClick;
  768.     property OnDragDrop;
  769.     property OnDragOver;
  770.     property OnDrawItem;
  771.     property OnEndDrag;
  772.     property OnEnter;
  773.     property OnExit;
  774.     property OnKeyDown;
  775.     property OnKeyPress;
  776.     property OnKeyUp;
  777.     property OnMeasureItem;
  778.     property OnMouseDown;
  779.     property OnMouseMove;
  780.     property OnMouseUp;
  781.     property OnStartDrag;
  782.   end;
  783.  
  784.   TScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
  785.     scTrack, scTop, scBottom, scEndScroll);
  786.  
  787.   TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode;
  788.     var ScrollPos: Integer) of object;
  789.  
  790.   TScrollBar = class(TWinControl)
  791.   private
  792.     FKind: TScrollBarKind;
  793.     FReserved: Byte;
  794.     FPosition: Integer;
  795.     FMin: Integer;
  796.     FMax: Integer;
  797.     FSmallChange: TScrollBarInc;
  798.     FLargeChange: TScrollBarInc;
  799.     FOnChange: TNotifyEvent;
  800.     FOnScroll: TScrollEvent;
  801.     procedure DoScroll(var Message: TWMScroll);
  802.     procedure SetKind(Value: TScrollBarKind);
  803.     procedure SetMax(Value: Integer);
  804.     procedure SetMin(Value: Integer);
  805.     procedure SetPosition(Value: Integer);
  806.     procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  807.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  808.   protected
  809.     procedure CreateParams(var Params: TCreateParams); override;
  810.     procedure CreateWnd; override;
  811.     procedure Change; dynamic;
  812.     procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
  813.   public
  814.     constructor Create(AOwner: TComponent); override;
  815.     procedure SetParams(APosition, AMin, AMax: Integer);
  816.   published
  817.     property Ctl3D;
  818.     property DragCursor;
  819.     property DragMode;
  820.     property Enabled;
  821.     property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
  822.     property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
  823.     property Max: Integer read FMax write SetMax default 100;
  824.     property Min: Integer read FMin write SetMin default 0;
  825.     property ParentCtl3D;
  826.     property ParentShowHint;
  827.     property PopupMenu;
  828.     property Position: Integer read FPosition write SetPosition default 0;
  829.     property ShowHint;
  830.     property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
  831.     property TabOrder;
  832.     property TabStop default True;
  833.     property Visible;
  834.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  835.     property OnDragDrop;
  836.     property OnDragOver;
  837.     property OnEndDrag;
  838.     property OnEnter;
  839.     property OnExit;
  840.     property OnKeyDown;
  841.     property OnKeyPress;
  842.     property OnKeyUp;
  843.     property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
  844.     property OnStartDrag;
  845.   end;
  846.  
  847. implementation
  848.  
  849. uses Consts;
  850.  
  851. function HasPopup(Control: TControl): Boolean;
  852. begin
  853.   Result := True;
  854.   while Control <> nil do
  855.     if TCustomEdit(Control).PopupMenu <> nil then Exit else Control := Control.Parent;
  856.   Result := False;
  857. end;
  858.  
  859. type
  860.   TSelection = record
  861.     StartPos, EndPos: Integer;
  862.   end;
  863.  
  864.   TMemoStrings = class(TStrings)
  865.   private
  866.     Memo: TCustomMemo;
  867.   protected
  868.     function Get(Index: Integer): string; override;
  869.     function GetCount: Integer; override;
  870.     function GetTextStr: string; override;
  871.     procedure Put(Index: Integer; const S: string); override;
  872.     procedure SetTextStr(const Value: string); override;
  873.     procedure SetUpdateState(Updating: Boolean); override;
  874.   public
  875.     procedure Clear; override;
  876.     procedure Delete(Index: Integer); override;
  877.     procedure Insert(Index: Integer; const S: string); override;
  878.   end;
  879.  
  880.   TComboBoxStrings = class(TStrings)
  881.   private
  882.     ComboBox: TCustomComboBox;
  883.   protected
  884.     function Get(Index: Integer): string; override;
  885.     function GetCount: Integer; override;
  886.     function GetObject(Index: Integer): TObject; override;
  887.     procedure PutObject(Index: Integer; AObject: TObject); override;
  888.     procedure SetUpdateState(Updating: Boolean); override;
  889.   public
  890.     function Add(const S: string): Integer; override;
  891.     procedure Clear; override;
  892.     procedure Delete(Index: Integer); override;
  893.     procedure Insert(Index: Integer; const S: string); override;
  894.   end;
  895.  
  896.   TListBoxStrings = class(TStrings)
  897.   private
  898.     ListBox: TCustomListBox;
  899.   protected
  900.     function Get(Index: Integer): string; override;
  901.     function GetCount: Integer; override;
  902.     function GetObject(Index: Integer): TObject; override;
  903.     procedure PutObject(Index: Integer; AObject: TObject); override;
  904.     procedure SetUpdateState(Updating: Boolean); override;
  905.   public
  906.     function Add(const S: string): Integer; override;
  907.     procedure Clear; override;
  908.     procedure Delete(Index: Integer); override;
  909.     procedure Insert(Index: Integer; const S: string); override;
  910.   end;
  911.  
  912. const
  913.   BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
  914.  
  915. { TCustomGroupBox }
  916.  
  917. constructor TCustomGroupBox.Create(AOwner: TComponent);
  918. begin
  919.   inherited Create(AOwner);
  920.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  921.     csSetCaption, csDoubleClicks, csReplicatable];
  922.   Width := 185;
  923.   Height := 105;
  924. end;
  925.  
  926. procedure TCustomGroupBox.AlignControls(AControl: TControl; var Rect: TRect);
  927. begin
  928.   Canvas.Font := Font;
  929.   Inc(Rect.Top, Canvas.TextHeight('0'));
  930.   InflateRect(Rect, -1, -1);
  931.   if Ctl3d then InflateRect(Rect, -1, -1);
  932.   inherited AlignControls(AControl, Rect);
  933. end;
  934.  
  935. procedure TCustomGroupBox.Paint;
  936. var
  937.   H: Integer;
  938.   R: TRect;
  939. begin
  940.   with Canvas do
  941.   begin
  942.     Font := Self.Font;
  943.     H := TextHeight('0');
  944.     R := Rect(0, H div 2 - 1, Width, Height);
  945.     if Ctl3D then
  946.     begin
  947.       Inc(R.Left);
  948.       Inc(R.Top);
  949.       Brush.Color := clBtnHighlight;
  950.       FrameRect(R);
  951.       OffsetRect(R, -1, -1);
  952.       Brush.Color := clBtnShadow;
  953.     end else
  954.       Brush.Color := clWindowFrame;
  955.     FrameRect(R);
  956.     if Text <> '' then
  957.     begin
  958.       R := Rect(8, 0, 0, H);
  959.       DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE or
  960.         DT_CALCRECT);
  961.       Brush.Color := Color;
  962.       DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE);
  963.     end;
  964.   end;
  965. end;
  966.  
  967. procedure TCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
  968. begin
  969.   with Message do
  970.     if IsAccel(CharCode, Caption) and CanFocus then
  971.     begin
  972.       SelectFirst;
  973.       Result := 1;
  974.     end else
  975.       inherited;
  976. end;
  977.  
  978. procedure TCustomGroupBox.CMTextChanged(var Message: TMessage);
  979. begin
  980.   Invalidate;
  981.   Realign;
  982. end;
  983.  
  984. procedure TCustomGroupBox.CMCtl3DChanged(var Message: TMessage);
  985. begin
  986.   inherited;
  987.   Invalidate;
  988.   Realign;
  989. end;
  990.  
  991. { TCustomLabel }
  992.  
  993. constructor TCustomLabel.Create(AOwner: TComponent);
  994. begin
  995.   inherited Create(AOwner);
  996.   ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  997.   Width := 65;
  998.   Height := 17;
  999.   FAutoSize := True;
  1000.   FShowAccelChar := True;
  1001. end;
  1002.  
  1003. function TCustomLabel.GetLabelText: string;
  1004. begin
  1005.   Result := Caption;
  1006. end;
  1007.  
  1008. procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Word);
  1009. var
  1010.   Text: string;
  1011. begin
  1012.   Text := GetLabelText;
  1013.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
  1014.     (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  1015.   if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
  1016.   Canvas.Font := Font;
  1017.   if not Enabled then Canvas.Font.Color := clGrayText;
  1018.   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  1019. end;
  1020.  
  1021. procedure TCustomLabel.Paint;
  1022. const
  1023.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  1024.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1025. var
  1026.   Rect: TRect;
  1027. begin
  1028.   with Canvas do
  1029.   begin
  1030.     if not Transparent then
  1031.     begin
  1032.       Brush.Color := Self.Color;
  1033.       Brush.Style := bsSolid;
  1034.       FillRect(ClientRect);
  1035.     end;
  1036.     Brush.Style := bsClear;
  1037.     Rect := ClientRect;
  1038.     DoDrawText(Rect, DT_EXPANDTABS or WordWraps[FWordWrap] or
  1039.       Alignments[FAlignment]);
  1040.   end;
  1041. end;
  1042.  
  1043. procedure TCustomLabel.AdjustBounds;
  1044. const
  1045.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1046. var
  1047.   DC: HDC;
  1048.   X: Integer;
  1049.   Rect: TRect;
  1050. begin
  1051.   if not (csReading in ComponentState) and FAutoSize then
  1052.   begin
  1053.     Rect := ClientRect;
  1054.     DC := GetDC(0);
  1055.     Canvas.Handle := DC;
  1056.     DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  1057.     Canvas.Handle := 0;
  1058.     ReleaseDC(0, DC);
  1059.     X := Left;
  1060.     if FAlignment = taRightJustify then Inc(X, Width - Rect.Right);
  1061.     SetBounds(X, Top, Rect.Right, Rect.Bottom);
  1062.   end;
  1063. end;
  1064.  
  1065. procedure TCustomLabel.SetAlignment(Value: TAlignment);
  1066. begin
  1067.   if FAlignment <> Value then
  1068.   begin
  1069.     FAlignment := Value;
  1070.     Invalidate;
  1071.   end;
  1072. end;
  1073.  
  1074. procedure TCustomLabel.SetAutoSize(Value: Boolean);
  1075. begin
  1076.   if FAutoSize <> Value then
  1077.   begin
  1078.     FAutoSize := Value;
  1079.     AdjustBounds;
  1080.   end;
  1081. end;
  1082.  
  1083. function TCustomLabel.GetTransparent: Boolean;
  1084. begin
  1085.   Result := not (csOpaque in ControlStyle);
  1086. end;
  1087.  
  1088. procedure TCustomLabel.SetFocusControl(Value: TWinControl);
  1089. begin
  1090.   FFocusControl := Value;
  1091.   if Value <> nil then Value.FreeNotification(Self);
  1092. end;
  1093.  
  1094. procedure TCustomLabel.SetShowAccelChar(Value: Boolean);
  1095. begin
  1096.   if FShowAccelChar <> Value then
  1097.   begin
  1098.     FShowAccelChar := Value;
  1099.     Invalidate;
  1100.   end;
  1101. end;
  1102.  
  1103. procedure TCustomLabel.SetTransparent(Value: Boolean);
  1104. begin
  1105.   if Transparent <> Value then
  1106.   begin
  1107.     if Value then
  1108.       ControlStyle := ControlStyle - [csOpaque] else
  1109.       ControlStyle := ControlStyle + [csOpaque];
  1110.     Invalidate;
  1111.   end;
  1112. end;
  1113.  
  1114. procedure TCustomLabel.SetWordWrap(Value: Boolean);
  1115. begin
  1116.   if FWordWrap <> Value then
  1117.   begin
  1118.     FWordWrap := Value;
  1119.     AdjustBounds;
  1120.   end;
  1121. end;
  1122.  
  1123. procedure TCustomLabel.Notification(AComponent: TComponent;
  1124.   Operation: TOperation);
  1125. begin
  1126.   inherited Notification(AComponent, Operation);
  1127.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  1128.     FFocusControl := nil;
  1129. end;
  1130.  
  1131. procedure TCustomLabel.CMTextChanged(var Message: TMessage);
  1132. begin
  1133.   Invalidate;
  1134.   AdjustBounds;
  1135. end;
  1136.  
  1137. procedure TCustomLabel.CMFontChanged(var Message: TMessage);
  1138. begin
  1139.   inherited;
  1140.   AdjustBounds;
  1141. end;
  1142.  
  1143. procedure TCustomLabel.CMDialogChar(var Message: TCMDialogChar);
  1144. begin
  1145.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  1146.     IsAccel(Message.CharCode, Caption) then
  1147.     with FFocusControl do
  1148.       if CanFocus then
  1149.       begin
  1150.         SetFocus;
  1151.         Message.Result := 1;
  1152.       end;
  1153. end;
  1154.  
  1155. { TCustomEdit }
  1156.  
  1157. constructor TCustomEdit.Create(AOwner: TComponent);
  1158. const
  1159.   EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
  1160. begin
  1161.   inherited Create(AOwner);
  1162.   if NewStyleControls then
  1163.     ControlStyle := EditStyle else
  1164.     ControlStyle := EditStyle + [csFramed];
  1165.   Width := 121;
  1166.   Height := 25;
  1167.   TabStop := True;
  1168.   ParentColor := False;
  1169.   FBorderStyle := bsSingle;
  1170.   FAutoSize := True;
  1171.   FAutoSelect := True;
  1172.   FHideSelection := True;
  1173.   AdjustHeight;
  1174. end;
  1175.  
  1176. procedure TCustomEdit.SetAutoSize(Value: Boolean);
  1177. begin
  1178.   if FAutoSize <> Value then
  1179.   begin
  1180.     FAutoSize := Value;
  1181.     UpdateHeight;
  1182.   end;
  1183. end;
  1184.  
  1185. procedure TCustomEdit.SetBorderStyle(Value: TBorderStyle);
  1186. begin
  1187.   if FBorderStyle <> Value then
  1188.   begin
  1189.     FBorderStyle := Value;
  1190.     UpdateHeight;
  1191.     RecreateWnd;
  1192.   end;
  1193. end;
  1194.  
  1195. procedure TCustomEdit.SetCharCase(Value: TEditCharCase);
  1196. begin
  1197.   if FCharCase <> Value then
  1198.   begin
  1199.     FCharCase := Value;
  1200.     RecreateWnd;
  1201.   end;
  1202. end;
  1203.  
  1204. procedure TCustomEdit.SetHideSelection(Value: Boolean);
  1205. begin
  1206.   if FHideSelection <> Value then
  1207.   begin
  1208.     FHideSelection := Value;
  1209.     RecreateWnd;
  1210.   end;
  1211. end;
  1212.  
  1213. procedure TCustomEdit.SetMaxLength(Value: Integer);
  1214. begin
  1215.   if FMaxLength <> Value then
  1216.   begin
  1217.     FMaxLength := Value;
  1218.     if HandleAllocated then SendMessage(Handle, EM_LIMITTEXT, Value, 0);
  1219.   end;
  1220. end;
  1221.  
  1222. procedure TCustomEdit.SetOEMConvert(Value: Boolean);
  1223. begin
  1224.   if FOEMConvert <> Value then
  1225.   begin
  1226.     FOEMConvert := Value;
  1227.     RecreateWnd;
  1228.   end;
  1229. end;
  1230.  
  1231. function TCustomEdit.GetModified: Boolean;
  1232. begin
  1233.   Result := FModified;
  1234.   if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0;
  1235. end;
  1236.  
  1237. procedure TCustomEdit.SetModified(Value: Boolean);
  1238. begin
  1239.   if HandleAllocated then
  1240.     SendMessage(Handle, EM_SETMODIFY, Byte(Value), 0) else
  1241.     FModified := Value;
  1242. end;
  1243.  
  1244. procedure TCustomEdit.SetPasswordChar(Value: Char);
  1245. begin
  1246.   if FPasswordChar <> Value then
  1247.   begin
  1248.     FPasswordChar := Value;
  1249.     if HandleAllocated then
  1250.     begin
  1251.       SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1252.       SetTextBuf(PChar(Text));
  1253.     end;
  1254.   end;
  1255. end;
  1256.  
  1257. procedure TCustomEdit.SetReadOnly(Value: Boolean);
  1258. begin
  1259.   if FReadOnly <> Value then
  1260.   begin
  1261.     FReadOnly := Value;
  1262.     if HandleAllocated then
  1263.       SendMessage(Handle, EM_SETREADONLY, Ord(Value), 0);
  1264.   end;
  1265. end;
  1266.  
  1267. function TCustomEdit.GetSelStart: Integer;
  1268. begin
  1269.   SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
  1270. end;
  1271.  
  1272. procedure TCustomEdit.SetSelStart(Value: Integer);
  1273. begin
  1274.   SendMessage(Handle, EM_SETSEL, Value, Value);
  1275. end;
  1276.  
  1277. function TCustomEdit.GetSelLength: Integer;
  1278. var
  1279.   Selection: TSelection;
  1280. begin
  1281.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1282.   Result := Selection.EndPos - Selection.StartPos;
  1283. end;
  1284.  
  1285. procedure TCustomEdit.SetSelLength(Value: Integer);
  1286. var
  1287.   Selection: TSelection;
  1288. begin
  1289.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1290.   Selection.EndPos := Selection.StartPos + Value;
  1291.   SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  1292. end;
  1293.  
  1294. procedure TCustomEdit.Clear;
  1295. begin
  1296.   SetWindowText(Handle, '');
  1297. end;
  1298.  
  1299. procedure TCustomEdit.ClearSelection;
  1300. begin
  1301.   SendMessage(Handle, WM_CLEAR, 0, 0);
  1302. end;
  1303.  
  1304. procedure TCustomEdit.CopyToClipboard;
  1305. begin
  1306.   SendMessage(Handle, WM_COPY, 0, 0);
  1307. end;
  1308.  
  1309. procedure TCustomEdit.CutToClipboard;
  1310. begin
  1311.   SendMessage(Handle, WM_CUT, 0, 0);
  1312. end;
  1313.  
  1314. procedure TCustomEdit.PasteFromClipboard;
  1315. begin
  1316.   SendMessage(Handle, WM_PASTE, 0, 0);
  1317. end;
  1318.  
  1319. procedure TCustomEdit.SelectAll;
  1320. begin
  1321.   SendMessage(Handle, EM_SETSEL, 0, -1);
  1322. end;
  1323.  
  1324. function TCustomEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  1325. var
  1326.   P: PChar;
  1327.   Selection: TSelection;
  1328. begin
  1329.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1330.   P := StrAlloc(GetTextLen + 1);
  1331.   try
  1332.     GetTextBuf(P, StrBufSize(P));
  1333.     Result := Selection.EndPos - Selection.StartPos;
  1334.     if Result >= BufSize then Result := BufSize - 1;
  1335.     StrLCopy(Buffer, P + Selection.StartPos, Result);
  1336.   finally
  1337.     StrDispose(P);
  1338.   end;
  1339. end;
  1340.  
  1341. procedure TCustomEdit.SetSelTextBuf(Buffer: PChar);
  1342. begin
  1343.   SendMessage(Handle, EM_REPLACESEL, 0, LongInt(Buffer));
  1344. end;
  1345.  
  1346. function TCustomEdit.GetSelText: string;
  1347. var
  1348.   P: PChar;
  1349.   SelStart, SelEnd, Len: Integer;
  1350. begin
  1351.   SendMessage(Handle, EM_GETSEL, Longint(@SelStart), Longint(@SelEnd));
  1352.   Len := SelEnd - SelStart;
  1353.   SetString(Result, PChar(nil), Len);
  1354.   if Len <> 0 then
  1355.   begin
  1356.     P := StrAlloc(GetTextLen + 1);
  1357.     try
  1358.       GetTextBuf(P, StrBufSize(P));
  1359.       Move(P[SelStart], Pointer(Result)^, Len);
  1360.     finally
  1361.       StrDispose(P);
  1362.     end;
  1363.   end;
  1364. end;
  1365.  
  1366. procedure TCustomEdit.SetSelText(const Value: String);
  1367. begin
  1368.   SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  1369. end;
  1370.  
  1371. procedure TCustomEdit.CreateParams(var Params: TCreateParams);
  1372. const
  1373.   Passwords: array[Boolean] of Longint = (0, ES_PASSWORD);
  1374.   ReadOnlys: array[Boolean] of Longint = (0, ES_READONLY);
  1375.   CharCases: array[TEditCharCase] of Longint = (0, ES_UPPERCASE, ES_LOWERCASE);
  1376.   HideSelections: array[Boolean] of Longint = (ES_NOHIDESEL, 0);
  1377.   OEMConverts: array[Boolean] of Longint = (0, ES_OEMCONVERT);
  1378. begin
  1379.   inherited CreateParams(Params);
  1380.   CreateSubClass(Params, 'EDIT');
  1381.   Params.Style := Params.Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
  1382.     BorderStyles[FBorderStyle] or Passwords[FPasswordChar <> #0] or
  1383.     ReadOnlys[FReadOnly] or CharCases[FCharCase] or
  1384.     HideSelections[FHideSelection] or OEMConverts[FOEMConvert];
  1385.   if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  1386.   begin
  1387.     Params.Style := Params.Style and not WS_BORDER;
  1388.     Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  1389.   end;
  1390. end;
  1391.  
  1392. procedure TCustomEdit.CreateWnd;
  1393. begin
  1394.   FCreating := True;
  1395.   try
  1396.     inherited CreateWnd;
  1397.   finally
  1398.     FCreating := False;
  1399.   end;
  1400.   SendMessage(Handle, EM_LIMITTEXT, FMaxLength, 0);
  1401.   Modified := FModified;
  1402.   if FPasswordChar <> #0 then
  1403.     SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1404.   UpdateHeight;
  1405. end;
  1406.  
  1407. procedure TCustomEdit.DestroyWnd;
  1408. begin
  1409.   FModified := Modified;
  1410.   inherited DestroyWnd;
  1411. end;
  1412.  
  1413. procedure TCustomEdit.UpdateHeight;
  1414. begin
  1415.   if FAutoSize and (BorderStyle = bsSingle) then
  1416.   begin
  1417.     ControlStyle := ControlStyle + [csFixedHeight];
  1418.     AdjustHeight;
  1419.   end else
  1420.     ControlStyle := ControlStyle - [csFixedHeight];
  1421. end;
  1422.  
  1423. procedure TCustomEdit.AdjustHeight;
  1424. var
  1425.   DC: HDC;
  1426.   SaveFont: HFont;
  1427.   I: Integer;
  1428.   SysMetrics, Metrics: TTextMetric;
  1429. begin
  1430.   DC := GetDC(0);
  1431.   GetTextMetrics(DC, SysMetrics);
  1432.   SaveFont := SelectObject(DC, Font.Handle);
  1433.   GetTextMetrics(DC, Metrics);
  1434.   SelectObject(DC, SaveFont);
  1435.   ReleaseDC(0, DC);
  1436.   if NewStyleControls then
  1437.   begin
  1438.     if Ctl3D then I := 8 else I := 6;
  1439.     I := GetSystemMetrics(SM_CYBORDER) * I;
  1440.   end else
  1441.   begin
  1442.     I := SysMetrics.tmHeight;
  1443.     if I > Metrics.tmHeight then I := Metrics.tmHeight;
  1444.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  1445.   end;
  1446.   Height := Metrics.tmHeight + I;
  1447. end;
  1448.  
  1449. procedure TCustomEdit.Change;
  1450. begin
  1451.   if Assigned(FOnChange) then FOnChange(Self);
  1452. end;
  1453.  
  1454. procedure TCustomEdit.DefaultHandler(var Message);
  1455. begin
  1456.   case TMessage(Message).Msg of
  1457.     WM_RBUTTONUP:
  1458.       if HasPopup(Self) then Exit;
  1459.     WM_SETFOCUS:
  1460.       if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  1461.         not IsWindow(TWMSetFocus(Message).FocusedWnd) then
  1462.     TWMSetFocus(Message).FocusedWnd := 0;
  1463.   end;
  1464.   inherited;
  1465. end;
  1466.  
  1467. procedure TCustomEdit.WMSetFont(var Message: TWMSetFont);
  1468. begin
  1469.   inherited;
  1470.   if NewStyleControls and
  1471.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then
  1472.     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  1473. end;
  1474.  
  1475. procedure TCustomEdit.CMCtl3DChanged(var Message: TMessage);
  1476. begin
  1477.   if NewStyleControls and (FBorderStyle = bsSingle) then
  1478.   begin
  1479.     UpdateHeight;
  1480.     RecreateWnd;
  1481.   end;
  1482.   inherited;
  1483. end;
  1484.  
  1485. procedure TCustomEdit.CMFontChanged(var Message: TMessage);
  1486. begin
  1487.   inherited;
  1488.   if (csFixedHeight in ControlStyle) and not ((csDesigning in
  1489.     ComponentState) and (csLoading in ComponentState)) then AdjustHeight;
  1490. end;
  1491.  
  1492. procedure TCustomEdit.CNCommand(var Message: TWMCommand);
  1493. begin
  1494.   if (Message.NotifyCode = EN_CHANGE) and not FCreating then Change;
  1495. end;
  1496.  
  1497. procedure TCustomEdit.CMEnter(var Message: TCMGotFocus);
  1498. begin
  1499.   if FAutoSelect and not (csLButtonDown in ControlState) and
  1500.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then SelectAll;
  1501.   inherited;
  1502. end;
  1503.  
  1504. procedure TCustomEdit.CMTextChanged(var Message: TMessage);
  1505. begin
  1506.   inherited;
  1507.   if not HandleAllocated or (GetWindowLong(Handle, GWL_STYLE) and
  1508.     ES_MULTILINE <> 0) then Change;
  1509. end;
  1510.  
  1511. { TMemoStrings }
  1512.  
  1513. function TMemoStrings.GetCount: Integer;
  1514. begin
  1515.   Result := SendMessage(Memo.Handle, EM_GETLINECOUNT, 0, 0);
  1516.   if SendMessage(Memo.Handle, EM_LINELENGTH, SendMessage(Memo.Handle,
  1517.     EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  1518. end;
  1519.  
  1520. function TMemoStrings.Get(Index: Integer): string;
  1521. var
  1522.   Text: array[0..4095] of Char;
  1523. begin
  1524.   Word((@Text)^) := SizeOf(Text);
  1525.   SetString(Result, Text, SendMessage(Memo.Handle, EM_GETLINE, Index,
  1526.     Longint(@Text)));
  1527. end;
  1528.  
  1529. procedure TMemoStrings.Put(Index: Integer; const S: string);
  1530. var
  1531.   SelStart: Integer;
  1532. begin
  1533.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1534.   if SelStart >= 0 then
  1535.   begin
  1536.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart +
  1537.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0));
  1538.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  1539.   end;
  1540. end;
  1541.  
  1542. procedure TMemoStrings.Insert(Index: Integer; const S: string);
  1543. var
  1544.   SelStart, LineLen: Integer;
  1545.   Line: string;
  1546. begin
  1547.   if Index >= 0 then
  1548.   begin
  1549.     SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1550.     if SelStart >= 0 then Line := S + #13#10 else
  1551.     begin
  1552.       SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index - 1, 0);
  1553.       if SelStart < 0 then Exit;
  1554.       LineLen := SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1555.       if LineLen = 0 then Exit;
  1556.       Inc(SelStart, LineLen);
  1557.       Line := #13#10 + s;
  1558.     end;
  1559.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart);
  1560.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
  1561.   end;
  1562. end;
  1563.  
  1564. procedure TMemoStrings.Delete(Index: Integer);
  1565. const
  1566.   Empty: PChar = '';
  1567. var
  1568.   SelStart, SelEnd: Integer;
  1569. begin
  1570.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1571.   if SelStart >= 0 then
  1572.   begin
  1573.     SelEnd := SendMessage(Memo.Handle, EM_LINEINDEX, Index + 1, 0);
  1574.     if SelEnd < 0 then SelEnd := SelStart +
  1575.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1576.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelEnd);
  1577.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(Empty));
  1578.   end;
  1579. end;
  1580.  
  1581. procedure TMemoStrings.Clear;
  1582. begin
  1583.   Memo.Clear;
  1584. end;
  1585.  
  1586. procedure TMemoStrings.SetUpdateState(Updating: Boolean);
  1587. begin
  1588.   SendMessage(Memo.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1589.   if not Updating then Memo.Refresh;
  1590. end;
  1591.  
  1592. function TMemoStrings.GetTextStr: string;
  1593. begin
  1594.   Result := Memo.Text;
  1595. end;
  1596.  
  1597. procedure TMemoStrings.SetTextStr(const Value: string);
  1598. var
  1599.   NewText: string;
  1600. begin
  1601.   NewText := AdjustLineBreaks(Value);
  1602.   if (Length(NewText) <> Memo.GetTextLen) or (NewText <> Memo.Text) then
  1603.   begin
  1604.     if SendMessage(Memo.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
  1605.       raise EInvalidOperation.CreateRes(SInvalidMemoSize);
  1606.     Memo.Perform(CM_TEXTCHANGED, 0, 0);
  1607.   end;
  1608. end;
  1609.  
  1610. { TCustomMemo }
  1611.  
  1612. constructor TCustomMemo.Create(AOwner: TComponent);
  1613. begin
  1614.   inherited Create(AOwner);
  1615.   Width := 185;
  1616.   Height := 89;
  1617.   AutoSize := False;
  1618.   FWordWrap := True;
  1619.   FWantReturns := True;
  1620.   FLines := TMemoStrings.Create;
  1621.   TMemoStrings(FLines).Memo := Self;
  1622. end;
  1623.  
  1624. destructor TCustomMemo.Destroy;
  1625. begin
  1626.   FLines.Free;
  1627.   inherited Destroy;
  1628. end;
  1629.  
  1630. procedure TCustomMemo.CreateParams(var Params: TCreateParams);
  1631. const
  1632.   Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
  1633.   ScrollBar: array[TScrollStyle] of LongInt = (0, WS_HSCROLL, WS_VSCROLL,
  1634.     WS_HSCROLL or WS_VSCROLL);
  1635.   WordWraps: array[Boolean] of LongInt = (0, ES_AUTOHSCROLL);
  1636. begin
  1637.   inherited CreateParams(Params);
  1638.   Params.Style := Params.Style and not WordWraps[FWordWrap] or
  1639.     ES_MULTILINE or Alignments[FAlignment] or ScrollBar[FScrollBars];
  1640. end;
  1641.  
  1642. procedure TCustomMemo.CreateWindowHandle(const Params: TCreateParams);
  1643. begin
  1644.   with Params do
  1645.   begin
  1646.     WindowHandle := CreateWindowEx(ExStyle, WinClassName, '', Style,
  1647.       X, Y, Width, Height, WndParent, 0, HInstance, Param);
  1648.     SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  1649.   end;
  1650. end;
  1651.  
  1652. procedure TCustomMemo.Loaded;
  1653. begin
  1654.   inherited Loaded;
  1655.   Modified := False;
  1656. end;
  1657.  
  1658. procedure TCustomMemo.SetAlignment(Value: TAlignment);
  1659. begin
  1660.   if FAlignment <> Value then
  1661.   begin
  1662.     FAlignment := Value;
  1663.     RecreateWnd;
  1664.   end;
  1665. end;
  1666.  
  1667. procedure TCustomMemo.SetLines(Value: TStrings);
  1668. begin
  1669.   FLines.Assign(Value);
  1670. end;
  1671.  
  1672. procedure TCustomMemo.SetScrollBars(Value: TScrollStyle);
  1673. begin
  1674.   if FScrollBars <> Value then
  1675.   begin
  1676.     FScrollBars := Value;
  1677.     RecreateWnd;
  1678.   end;
  1679. end;
  1680.  
  1681. procedure TCustomMemo.SetWordWrap(Value: Boolean);
  1682. begin
  1683.   if Value <> FWordWrap then
  1684.   begin
  1685.     FWordWrap := Value;
  1686.     RecreateWnd;
  1687.   end;
  1688. end;
  1689.  
  1690. procedure TCustomMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
  1691. begin
  1692.   inherited;
  1693.   if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
  1694.   else Message.Result := Message.Result and not DLGC_WANTTAB;
  1695.   if not FWantReturns then
  1696.     Message.Result := Message.Result and not DLGC_WANTALLKEYS;
  1697. end;
  1698.  
  1699. procedure TCustomMemo.WMNCDestroy(var Message: TWMNCDestroy);
  1700. begin
  1701.   inherited;
  1702. end;
  1703.  
  1704. procedure TCustomMemo.KeyPress(var Key: Char);
  1705. begin
  1706.   inherited KeyPress(Key);
  1707.   if (Key = Char(VK_RETURN)) and not FWantReturns then Key := #0;
  1708. end;
  1709.  
  1710. { TMemo }
  1711.  
  1712. procedure TMemo.ReadStringData(Reader: TReader);
  1713. begin
  1714.   Reader.ReadString;
  1715. end;
  1716.  
  1717. { TComboBoxStrings }
  1718.  
  1719. function TComboBoxStrings.GetCount: Integer;
  1720. begin
  1721.   Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
  1722. end;
  1723.  
  1724. function TComboBoxStrings.Get(Index: Integer): string;
  1725. var
  1726.   Text: array[0..4095] of Char;
  1727.   Len: Integer;
  1728. begin
  1729.   Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(@Text));
  1730.   if Len = CB_ERR then Len := 0;
  1731.   SetString(Result, Text, Len);
  1732. end;
  1733.  
  1734. function TComboBoxStrings.GetObject(Index: Integer): TObject;
  1735. begin
  1736.   Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
  1737. end;
  1738.  
  1739. procedure TComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
  1740. begin
  1741.   SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(AObject));
  1742. end;
  1743.  
  1744. function TComboBoxStrings.Add(const S: string): Integer;
  1745. begin
  1746.   Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  1747.   if Result < 0 then
  1748.     raise EOutOfResources.CreateRes(SInsertLineError);
  1749. end;
  1750.  
  1751. procedure TComboBoxStrings.Insert(Index: Integer; const S: string);
  1752. begin
  1753.   if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
  1754.     Longint(PChar(S))) < 0 then
  1755.     raise EOutOfResources.CreateRes(SInsertLineError);
  1756. end;
  1757.  
  1758. procedure TComboBoxStrings.Delete(Index: Integer);
  1759. begin
  1760.   SendMessage(ComboBox.Handle, CB_DELETESTRING, Index, 0);
  1761. end;
  1762.  
  1763. procedure TComboBoxStrings.Clear;
  1764. var
  1765.   S: string;
  1766. begin
  1767.   S := ComboBox.Text;
  1768.   SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
  1769.   ComboBox.Text := S;
  1770.   ComboBox.Update;
  1771. end;
  1772.  
  1773. procedure TComboBoxStrings.SetUpdateState(Updating: Boolean);
  1774. begin
  1775.   SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1776.   if not Updating then ComboBox.Refresh;
  1777. end;
  1778.  
  1779. { TCustomComboBox }
  1780.  
  1781. constructor TCustomComboBox.Create(AOwner: TComponent);
  1782. const
  1783.   ComboBoxStyle = [csCaptureMouse, csSetCaption, csDoubleClicks,
  1784.     csFixedHeight];
  1785. begin
  1786.   inherited Create(AOwner);
  1787.   if NewStyleControls then
  1788.     ControlStyle := ComboBoxStyle else
  1789.     ControlStyle := ComboBoxStyle + [csFramed];
  1790.   Width := 145;
  1791.   Height := 25;
  1792.   TabStop := True;
  1793.   ParentColor := False;
  1794.   FItems := TComboBoxStrings.Create;
  1795.   TComboBoxStrings(FItems).ComboBox := Self;
  1796.   FCanvas := TControlCanvas.Create;
  1797.   FItemHeight := 16;
  1798.   FStyle := csDropDown;
  1799.   FEditInstance := MakeObjectInstance(EditWndProc);
  1800.   FListInstance := MakeObjectInstance(ListWndProc);
  1801.   FDropDownCount := 8;
  1802. end;
  1803.  
  1804. destructor TCustomComboBox.Destroy;
  1805. begin
  1806.   if HandleAllocated then DestroyWindowHandle;
  1807.   FreeObjectInstance(FListInstance);
  1808.   FreeObjectInstance(FEditInstance);
  1809.   FCanvas.Free;
  1810.   FItems.Free;
  1811.   FSaveItems.Free;
  1812.   inherited Destroy;
  1813. end;
  1814.  
  1815. procedure TCustomComboBox.Clear;
  1816. begin
  1817.   SetTextBuf('');
  1818.   FItems.Clear;
  1819. end;
  1820.  
  1821. procedure TCustomComboBox.SelectAll;
  1822. begin
  1823.   SendMessage(Handle, CB_SETEDITSEL, 1, $FFFF0000);
  1824. end;
  1825.  
  1826. function TCustomComboBox.GetDroppedDown: Boolean;
  1827. begin
  1828.   Result := LongBool(SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0));
  1829. end;
  1830.  
  1831. procedure TCustomComboBox.SetDroppedDown(Value: Boolean);
  1832. begin
  1833.   SendMessage(Handle, CB_SHOWDROPDOWN, Longint(Value), 0);
  1834. end;
  1835.  
  1836. function TCustomComboBox.GetItemIndex: Integer;
  1837. begin
  1838.   Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
  1839. end;
  1840.  
  1841. procedure TCustomComboBox.SetItemIndex(Value: Integer);
  1842. begin
  1843.   SendMessage(Handle, CB_SETCURSEL, Value, 0);
  1844. end;
  1845.  
  1846. function TCustomComboBox.GetSelStart: Integer;
  1847. begin
  1848.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Result), 0);
  1849. end;
  1850.  
  1851. procedure TCustomComboBox.SetSelStart(Value: Integer);
  1852. var
  1853.   Selection: TSelection;
  1854. begin
  1855.   Selection.StartPos := Value;
  1856.   Selection.EndPos := Value;
  1857.   SendMessage(Handle, CB_SETEDITSEL, Selection.StartPos, Selection.EndPos);
  1858. end;
  1859.  
  1860. function TCustomComboBox.GetSelLength: Integer;
  1861. var
  1862.   Selection: TSelection;
  1863. begin
  1864.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  1865.     Longint(@Selection.EndPos));
  1866.   Result := Selection.EndPos - Selection.StartPos;
  1867. end;
  1868.  
  1869. procedure TCustomComboBox.SetSelLength(Value: Integer);
  1870. var
  1871.   Selection: TSelection;
  1872. begin
  1873.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  1874.     Longint(@Selection.EndPos));
  1875.   Selection.EndPos := Selection.StartPos + Value;
  1876.   SendMessage(Handle, CB_SETEDITSEL, Selection.StartPos, Selection.EndPos);
  1877. end;
  1878.  
  1879. function TCustomComboBox.GetSelText: string;
  1880. begin
  1881.   Result := '';
  1882.   if FStyle < csDropDownList then
  1883.     Result := Copy(Text, GetSelStart + 1, GetSelLength);
  1884. end;
  1885.  
  1886. procedure TCustomComboBox.SetSelText(const Value: string);
  1887. begin
  1888.   if FStyle < csDropDownList then
  1889.   begin
  1890.     HandleNeeded;
  1891.     SendMessage(FEditHandle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  1892.   end;
  1893. end;
  1894.  
  1895. procedure TCustomComboBox.SetMaxLength(Value: Integer);
  1896. begin
  1897.   if FMaxLength <> Value then
  1898.   begin
  1899.     FMaxLength := Value;
  1900.     if HandleAllocated then SendMessage(Handle, CB_LIMITTEXT, Value, 0);
  1901.   end;
  1902. end;
  1903.  
  1904. procedure TCustomComboBox.SetSorted(Value: Boolean);
  1905. begin
  1906.   if FSorted <> Value then
  1907.   begin
  1908.     FSorted := Value;
  1909.     RecreateWnd;
  1910.   end;
  1911. end;
  1912.  
  1913. procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
  1914. begin
  1915.   if FStyle <> Value then
  1916.   begin
  1917.     FStyle := Value;
  1918.     if Value = csSimple then
  1919.       ControlStyle := ControlStyle - [csFixedHeight] else
  1920.       ControlStyle := ControlStyle + [csFixedHeight];
  1921.     RecreateWnd;
  1922.   end;
  1923. end;
  1924.  
  1925. function TCustomComboBox.GetItemHeight: Integer;
  1926. begin
  1927.   if FStyle in [csOwnerDrawFixed, csOwnerDrawVariable] then
  1928.     Result := FItemHeight else
  1929.     Result := Perform(CB_GETITEMHEIGHT, 0, 0);
  1930. end;
  1931.  
  1932. procedure TCustomComboBox.SetItemHeight(Value: Integer);
  1933. begin
  1934.   if Value > 0 then FItemHeight := Value;
  1935. end;
  1936.  
  1937. procedure TCustomComboBox.SetItems(Value: TStrings);
  1938. begin
  1939.   Items.Assign(Value);
  1940. end;
  1941.  
  1942. procedure TCustomComboBox.CreateParams(var Params: TCreateParams);
  1943. const
  1944.   ComboBoxStyles: array[TComboBoxStyle] of Longint = (
  1945.     CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
  1946.     CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
  1947.     CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
  1948.   Sorts: array[Boolean] of Longint = (0, CBS_SORT);
  1949. begin
  1950.   inherited CreateParams(Params);
  1951.   CreateSubClass(Params, 'COMBOBOX');
  1952.   Params.Style := Params.Style or (WS_VSCROLL or CBS_HASSTRINGS or
  1953.     CBS_AUTOHSCROLL) or ComboBoxStyles[FStyle] or Sorts[FSorted];
  1954.   if NewStyleControls and Ctl3D then
  1955.     Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  1956. end;
  1957.  
  1958. procedure TCustomComboBox.CreateWnd;
  1959. var
  1960.   ChildHandle: THandle;
  1961.   MaxChars: Integer;
  1962. begin
  1963.   inherited CreateWnd;
  1964.   MaxChars := FMaxLength;
  1965.   if (MaxChars <= 0) or (MaxChars > 255) then MaxChars := 255;
  1966.   SendMessage(Handle, CB_LIMITTEXT, MaxChars, 0);
  1967.   if FSaveItems <> nil then
  1968.   begin
  1969.     FItems.Assign(FSaveItems);
  1970.     FSaveItems.Free;
  1971.     FSaveItems := nil;
  1972.   end;
  1973.   FEditHandle := 0;
  1974.   FListHandle := 0;
  1975.   if FStyle in [csDropDown, csSimple] then
  1976.   begin
  1977.     ChildHandle := GetWindow(Handle, GW_CHILD);
  1978.     if ChildHandle <> 0 then
  1979.     begin
  1980.       if FStyle = csSimple then
  1981.       begin
  1982.         FListHandle := ChildHandle;
  1983.         FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
  1984.         SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
  1985.         ChildHandle := GetWindow(ChildHandle, GW_HWNDNEXT);
  1986.       end;
  1987.       FEditHandle := ChildHandle;
  1988.       FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  1989.       SetWindowLong(FEditHandle, GWL_WNDPROC, Longint(FEditInstance));
  1990.     end;
  1991.   end;
  1992.   if NewStyleControls and (FEditHandle <> 0) then
  1993.     SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  1994. end;
  1995.  
  1996. procedure TCustomComboBox.DestroyWnd;
  1997. begin
  1998.   if FItems.Count > 0 then
  1999.   begin
  2000.     FSaveItems := TStringList.Create;
  2001.     FSaveItems.Assign(FItems);
  2002.   end;
  2003.   inherited DestroyWnd;
  2004. end;
  2005.  
  2006. procedure TCustomComboBox.WMCreate(var Message: TWMCreate);
  2007. begin
  2008.   inherited;
  2009.   SetWindowText(Handle, WindowText);
  2010. end;
  2011.  
  2012. procedure TCustomComboBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2013. begin
  2014.   if Style < csDropDownList then
  2015.   begin
  2016.     FillRect(Message.DC, ClientRect, Parent.Brush.Handle);
  2017.     Message.Result := 1;
  2018.   end;
  2019. end;
  2020.  
  2021. procedure TCustomComboBox.WMDrawItem(var Message: TWMDrawItem);
  2022. begin
  2023.   DefaultHandler(Message);
  2024. end;
  2025.  
  2026. procedure TCustomComboBox.WMMeasureItem(var Message: TWMMeasureItem);
  2027. begin
  2028.   DefaultHandler(Message);
  2029. end;
  2030.  
  2031. procedure TCustomComboBox.WMDeleteItem(var Message: TWMDeleteItem);
  2032. begin
  2033.   DefaultHandler(Message);
  2034. end;
  2035.  
  2036. procedure TCustomComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
  2037. begin
  2038.   inherited;
  2039.   if DroppedDown then Message.Result := Message.Result or DLGC_WANTALLKEYS;
  2040. end;
  2041.  
  2042. procedure TCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
  2043. begin
  2044.   if Message.Sender <> Self then Perform(CB_SHOWDROPDOWN, 0, 0);
  2045. end;
  2046.  
  2047. procedure TCustomComboBox.CMCtl3DChanged(var Message: TMessage);
  2048. begin
  2049.   if NewStyleControls then RecreateWnd;
  2050.   inherited;
  2051. end;
  2052.  
  2053. procedure TCustomComboBox.CMParentColorChanged(var Message: TMessage);
  2054. begin
  2055.   inherited;
  2056.   if not NewStyleControls and (Style < csDropDownList) then Invalidate;
  2057. end;
  2058.  
  2059. procedure TCustomComboBox.EditWndProc(var Message: TMessage);
  2060. var
  2061.   P: TPoint;
  2062. begin
  2063.   if Message.Msg = WM_SYSCOMMAND then
  2064.   begin
  2065.     WndProc(Message);
  2066.     Exit;
  2067.   end;
  2068.   ComboWndProc(Message, FEditHandle, FDefEditProc);
  2069.   case Message.Msg of
  2070.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2071.       begin
  2072.         if DragMode = dmAutomatic then
  2073.         begin
  2074.           GetCursorPos(P);
  2075.           P := ScreenToClient(P);
  2076.           SendMessage(FEditHandle, WM_LBUTTONUP, 0,Longint(PointToSmallPoint(P)));
  2077.           BeginDrag(False);
  2078.         end;
  2079.       end;
  2080.     WM_SETFONT:
  2081.       if NewStyleControls then
  2082.         SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  2083.   end;
  2084. end;
  2085.  
  2086. procedure TCustomComboBox.ListWndProc(var Message: TMessage);
  2087. begin
  2088.   ComboWndProc(Message, FListHandle, FDefListProc);
  2089. end;
  2090.  
  2091. procedure TCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  2092.   ComboProc: Pointer);
  2093. var
  2094.   Point: TPoint;
  2095. begin
  2096.   try
  2097.     with Message do
  2098.     begin
  2099.       case Msg of
  2100.         WM_SETFOCUS:
  2101.           if not GetParentForm(Self).SetFocusedControl(Self) then Exit;
  2102.         WM_KILLFOCUS:
  2103.           if csFocusing in ControlState then Exit;
  2104.         WM_KEYDOWN, WM_SYSKEYDOWN:
  2105.           if (ComboWnd <> FListHandle) and DoKeyDown(TWMKey(Message)) then
  2106.             Exit;
  2107.         WM_CHAR:
  2108.           begin
  2109.             if DoKeyPress(TWMKey(Message)) then Exit;
  2110.             if ((TWMKey(Message).CharCode = VK_RETURN) or
  2111.               (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2112.             begin
  2113.               DroppedDown := False;
  2114.               Exit;
  2115.             end;
  2116.           end;
  2117.         WM_KEYUP, WM_SYSKEYUP:
  2118.           if DoKeyUp(TWMKey(Message)) then Exit;
  2119.         WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
  2120.         WM_RBUTTONUP:
  2121.           if HasPopup(Self) then
  2122.           begin
  2123.             with TWMRButtonUp(Message) do
  2124.             begin
  2125.               Point.X := Pos.X;
  2126.               Point.Y := Pos.Y;
  2127.               MapWindowPoints(ComboWnd, Handle, Point, 1);
  2128.               Pos.X := Point.X;
  2129.               Pos.Y := Point.Y;
  2130.             end;
  2131.             WndProc(Message);
  2132.             Exit;
  2133.           end;
  2134.         WM_GETDLGCODE:
  2135.           if DroppedDown then
  2136.           begin
  2137.             Result := DLGC_WANTALLKEYS;
  2138.             Exit;
  2139.           end;
  2140.         WM_NCHITTEST:
  2141.           if csDesigning in ComponentState then
  2142.           begin
  2143.             Result := HTTRANSPARENT;
  2144.             Exit;
  2145.           end;
  2146.         CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR:
  2147.           begin
  2148.             WndProc(Message);
  2149.             Exit;
  2150.           end;
  2151.       end;
  2152.       Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam);
  2153.       if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then
  2154.         DblClick;
  2155.     end;
  2156.   except
  2157.     Application.HandleException(Self);
  2158.   end;
  2159. end;
  2160.  
  2161. procedure TCustomComboBox.WndProc(var Message: TMessage);
  2162. begin
  2163.     {for auto drag mode, let listbox handle itself, instead of TControl}
  2164.   if not (csDesigning in ComponentState) and
  2165.      ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
  2166.      not Dragging then
  2167.   begin
  2168.     if DragMode = dmAutomatic then
  2169.     begin
  2170.       if IsControlMouseMsg(TWMMouse(Message)) then
  2171.         Exit;
  2172.       ControlState := ControlState + [csLButtonDown];
  2173.       Dispatch(Message);  {overrides TControl's BeginDrag}
  2174.       Exit;
  2175.     end;
  2176.   end;
  2177.   with Message do
  2178.     case Msg of
  2179.       WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  2180.         begin
  2181.           SetTextColor(WParam, ColorToRGB(Font.Color));
  2182.           SetBkColor(WParam, ColorToRGB(Brush.Color));
  2183.           Result := Brush.Handle;
  2184.           Exit;
  2185.         end;
  2186.       CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  2187.         if not NewStyleControls and (Style < csDropDownList) then
  2188.         begin
  2189.           Result := Parent.Brush.Handle;
  2190.           Exit;
  2191.         end;
  2192.       WM_CHAR:
  2193.         begin
  2194.           if DoKeyPress(TWMKey(Message)) then Exit;
  2195.           if ((TWMKey(Message).CharCode = VK_RETURN) or
  2196.             (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2197.           begin
  2198.             DroppedDown := False;
  2199.             Exit;
  2200.           end;
  2201.         end;
  2202.     end;
  2203.   inherited WndProc(Message);
  2204. end;
  2205.  
  2206. procedure TCustomComboBox.AdjustDropDown;
  2207. var
  2208.   ItemCount: Integer;
  2209. begin
  2210.   ItemCount := FItems.Count;
  2211.   if ItemCount > DropDownCount then ItemCount := DropDownCount;
  2212.   if ItemCount < 1 then ItemCount := 1;
  2213.   SetWindowPos(Handle, 0, 0, 0, Width, ItemHeight * ItemCount +
  2214.     Height + 2, SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW +
  2215.     SWP_HIDEWINDOW);
  2216.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE +
  2217.     SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW + SWP_SHOWWINDOW);
  2218. end;
  2219.  
  2220. procedure TCustomComboBox.CNCommand(var Message: TWMCommand);
  2221. begin
  2222.   case Message.NotifyCode of
  2223.     CBN_DBLCLK:
  2224.       DblClick;
  2225.     CBN_EDITCHANGE:
  2226.       Change;
  2227.     CBN_DROPDOWN:
  2228.       begin
  2229.         FFocusChanged := False;
  2230.         DropDown;
  2231.         AdjustDropDown;
  2232.         if FFocusChanged then
  2233.         begin
  2234.           PostMessage(Handle, WM_CANCELMODE, 0, 0);
  2235.           if not FIsFocused then PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  2236.         end;
  2237.       end;
  2238.     CBN_SELCHANGE:
  2239.       begin
  2240.         Text := Items[ItemIndex];
  2241.         Click;
  2242.         Change;
  2243.       end;
  2244.     CBN_SETFOCUS:
  2245.       begin
  2246.         FIsFocused := True;
  2247.         FFocusChanged := True;
  2248.       end;
  2249.     CBN_KILLFOCUS:
  2250.       begin
  2251.         FIsFocused := False;
  2252.         FFocusChanged := True;
  2253.       end;
  2254.   end;
  2255. end;
  2256.  
  2257. procedure TCustomComboBox.Change;
  2258. begin
  2259.   if Assigned(FOnChange) then FOnChange(Self);
  2260. end;
  2261.  
  2262. procedure TCustomComboBox.DrawItem(Index: Integer; Rect: TRect;
  2263.   State: TOwnerDrawState);
  2264. begin
  2265.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
  2266.   else
  2267.   begin
  2268.     FCanvas.FillRect(Rect);
  2269.     FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  2270.   end;
  2271. end;
  2272.  
  2273. procedure TCustomComboBox.DropDown;
  2274. begin
  2275.   if Assigned(FOnDropDown) then FOnDropDown(Self);
  2276. end;
  2277.  
  2278. procedure TCustomComboBox.MeasureItem(Index: Integer; var Height: Integer);
  2279. begin
  2280.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  2281. end;
  2282.  
  2283. procedure TCustomComboBox.CNDrawItem(var Message: TWMDrawItem);
  2284. var
  2285.   State: TOwnerDrawState;
  2286. begin
  2287.   with Message.DrawItemStruct^ do
  2288.   begin
  2289.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  2290.     FCanvas.Handle := hDC;
  2291.     FCanvas.Font := Font;
  2292.     FCanvas.Brush := Brush;
  2293.     if (Integer(itemID) >= 0) and (odSelected in State) then
  2294.     begin
  2295.       FCanvas.Brush.Color := clHighlight;
  2296.       FCanvas.Font.Color := clHighlightText
  2297.     end;
  2298.     if Integer(itemID) >= 0 then
  2299.       DrawItem(itemID, rcItem, State) else
  2300.       FCanvas.FillRect(rcItem);
  2301.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  2302.     FCanvas.Handle := 0;
  2303.   end;
  2304. end;
  2305.  
  2306. procedure TCustomComboBox.CNMeasureItem(var Message: TWMMeasureItem);
  2307. begin
  2308.   with Message.MeasureItemStruct^ do
  2309.   begin
  2310.     itemHeight := FItemHeight;
  2311.     if FStyle = csOwnerDrawVariable then
  2312.       MeasureItem(itemID, Integer(itemHeight));
  2313.   end;
  2314. end;
  2315.  
  2316. procedure TCustomComboBox.WMLButtonDown(var Message: TWMLButtonDown);
  2317. begin
  2318.   if (DragMode = dmAutomatic) and (Style = csDropDownList) and
  2319.       (Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then
  2320.   begin
  2321.     SetFocus;
  2322.     BeginDrag(False);
  2323.     Exit;
  2324.   end;
  2325.   inherited;
  2326.   if MouseCapture and (ValidParentForm(Self).ActiveControl <> Self) then
  2327.     MouseCapture := False;
  2328. end;
  2329.  
  2330. { TButtonControl }
  2331.  
  2332. procedure TButtonControl.WndProc(var Message: TMessage);
  2333. begin
  2334.   case Message.Msg of
  2335.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2336.       if not (csDesigning in ComponentState) and not Focused then
  2337.       begin
  2338.         FClicksDisabled := True;
  2339.         Windows.SetFocus(Handle);
  2340.         FClicksDisabled := False;
  2341.         if not Focused then Exit;
  2342.       end;
  2343.     CN_COMMAND:
  2344.       if FClicksDisabled then Exit;
  2345.   end;
  2346.   inherited WndProc(Message);
  2347. end;
  2348.  
  2349. { TButton }
  2350.  
  2351. constructor TButton.Create(AOwner: TComponent);
  2352. begin
  2353.   inherited Create(AOwner);
  2354.   ControlStyle := [csSetCaption, csOpaque, csDoubleClicks];
  2355.   Width := 75;
  2356.   Height := 25;
  2357.   TabStop := True;
  2358. end;
  2359.  
  2360. procedure TButton.Click;
  2361. var
  2362.   Form: TForm;
  2363. begin
  2364.   Form := GetParentForm(Self);
  2365.   if Form <> nil then Form.ModalResult := ModalResult;
  2366.   inherited Click;
  2367. end;
  2368.  
  2369. procedure TButton.SetButtonStyle(ADefault: Boolean);
  2370. const
  2371.   BS_MASK = $000F;
  2372. var
  2373.   Style: Word;
  2374. begin
  2375.   if HandleAllocated then
  2376.   begin
  2377.     if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON;
  2378.     if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
  2379.       SendMessage(Handle, BM_SETSTYLE, Style, 1);
  2380.   end;
  2381. end;
  2382.  
  2383. procedure TButton.SetDefault(Value: Boolean);
  2384. begin
  2385.   FDefault := Value;
  2386.   if HandleAllocated then
  2387.     with GetParentForm(Self) do
  2388.       Perform(CM_FOCUSCHANGED, 0, Longint(ActiveControl));
  2389. end;
  2390.  
  2391. procedure TButton.CreateParams(var Params: TCreateParams);
  2392. const
  2393.   ButtonStyles: array[Boolean] of LongInt = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
  2394. begin
  2395.   inherited CreateParams(Params);
  2396.   CreateSubClass(Params, 'BUTTON');
  2397.   with Params do Style := Style or ButtonStyles[FDefault];
  2398. end;
  2399.  
  2400. procedure TButton.CreateWnd;
  2401. begin
  2402.   inherited CreateWnd;
  2403.   FActive := FDefault;
  2404. end;
  2405.  
  2406. procedure TButton.CNCommand(var Message: TWMCommand);
  2407. begin
  2408.   if Message.NotifyCode = BN_CLICKED then Click;
  2409. end;
  2410.  
  2411. procedure TButton.CMDialogKey(var Message: TCMDialogKey);
  2412. begin
  2413.   with Message do
  2414.     if  (((CharCode = VK_RETURN) and FActive) or
  2415.       ((CharCode = VK_ESCAPE) and FCancel)) and
  2416.       (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
  2417.     begin
  2418.       Click;
  2419.       Result := 1;
  2420.     end else
  2421.       inherited;
  2422. end;
  2423.  
  2424. procedure TButton.CMDialogChar(var Message: TCMDialogChar);
  2425. begin
  2426.   with Message do
  2427.     if IsAccel(CharCode, Caption) and CanFocus then
  2428.     begin
  2429.       Click;
  2430.       Result := 1;
  2431.     end else
  2432.       inherited;
  2433. end;
  2434.  
  2435. procedure TButton.CMFocusChanged(var Message: TCMFocusChanged);
  2436. begin
  2437.   with Message do
  2438.     if Sender is TButton then
  2439.       FActive := Sender = Self
  2440.     else
  2441.       FActive := FDefault;
  2442.   SetButtonStyle(FActive);
  2443.   inherited;
  2444. end;
  2445.  
  2446. { TCustomCheckBox }
  2447.  
  2448. constructor TCustomCheckBox.Create(AOwner: TComponent);
  2449. begin
  2450.   inherited Create(AOwner);
  2451.   Width := 97;
  2452.   Height := 17;
  2453.   TabStop := True;
  2454.   ControlStyle := [csSetCaption, csDoubleClicks];
  2455.   FAlignment := taRightJustify;
  2456.   FState := cbUnchecked;
  2457. end;
  2458.  
  2459. procedure TCustomCheckBox.Toggle;
  2460. begin
  2461.   case State of
  2462.     cbUnchecked:
  2463.       if AllowGrayed then State := cbGrayed else State := cbChecked;
  2464.     cbChecked: State := cbUnchecked;
  2465.     cbGrayed: State := cbChecked;
  2466.   end;
  2467. end;
  2468.  
  2469. function TCustomCheckBox.GetChecked: Boolean;
  2470. begin
  2471.   Result := State = cbChecked;
  2472. end;
  2473.  
  2474. procedure TCustomCheckBox.SetAlignment(Value: TLeftRight);
  2475. begin
  2476.   if FAlignment <> Value then
  2477.   begin
  2478.     FAlignment := Value;
  2479.     RecreateWnd;
  2480.   end;
  2481. end;
  2482.  
  2483. procedure TCustomCheckBox.SetChecked(Value: Boolean);
  2484. begin
  2485.   if Value then State := cbChecked else State := cbUnchecked;
  2486. end;
  2487.  
  2488. procedure TCustomCheckBox.SetState(Value: TCheckBoxState);
  2489. begin
  2490.   if FState <> Value then
  2491.   begin
  2492.     FState := Value;
  2493.     if HandleAllocated then
  2494.       SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  2495.     Click;
  2496.   end;
  2497. end;
  2498.  
  2499. procedure TCustomCheckBox.CreateParams(var Params: TCreateParams);
  2500. const
  2501.   Alignments: array[TLeftRight] of LongInt = (BS_LEFTTEXT, 0);
  2502. begin
  2503.   inherited CreateParams(Params);
  2504.   CreateSubClass(Params, 'BUTTON');
  2505.   with Params do
  2506.     Style := Style or BS_3STATE or Alignments[FAlignment];
  2507. end;
  2508.  
  2509. procedure TCustomCheckBox.CreateWnd;
  2510. begin
  2511.   inherited CreateWnd;
  2512.   SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  2513. end;
  2514.  
  2515. procedure TCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
  2516. begin
  2517.   if Ctl3D and not NewStyleControls then
  2518.   begin      // special subclassing required by unicode Ctl3D on NT
  2519.     with Params do
  2520.       WindowHandle := CreateWindowEx(ExStyle, 'BUTTON', Caption, Style,
  2521.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2522.     Subclass3DWnd(WindowHandle);
  2523.     DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  2524.     CreationControl := Self;
  2525.     SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
  2526.     SendMessage(WindowHandle, WM_NULL, 0, 0);
  2527.   end
  2528.   else
  2529.     inherited CreateWindowHandle(Params);
  2530. end;
  2531.  
  2532. procedure TCustomCheckBox.CMCtl3DChanged(var Message: TMessage);
  2533. begin
  2534.   RecreateWnd;
  2535. end;
  2536.  
  2537. procedure TCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
  2538. begin
  2539.   with Message do
  2540.     if IsAccel(CharCode, Caption) and CanFocus then
  2541.     begin
  2542.       SetFocus;
  2543.       if Focused then Toggle;
  2544.       Result := 1;
  2545.     end else
  2546.       inherited;
  2547. end;
  2548.  
  2549. procedure TCustomCheckBox.CNCommand(var Message: TWMCommand);
  2550. begin
  2551.   if Message.NotifyCode = BN_CLICKED then Toggle;
  2552. end;
  2553.  
  2554. procedure TCustomCheckBox.WMSetFocus(var Message: TWMSetFocus);
  2555. begin // fix double focus rect drawing bug in Ctl3D when switching notebook pages
  2556.   if Ctl3D and not NewStyleControls then  UpdateWindow(Handle);
  2557.   inherited;
  2558. end;
  2559.  
  2560. { TRadioButton }
  2561.  
  2562. constructor TRadioButton.Create(AOwner: TComponent);
  2563. begin
  2564.   inherited Create(AOwner);
  2565.   Width := 113;
  2566.   Height := 17;
  2567.   ControlStyle := [csSetCaption, csDoubleClicks];
  2568.   FAlignment := taRightJustify;
  2569. end;
  2570.  
  2571. procedure TRadioButton.SetAlignment(Value: TLeftRight);
  2572. begin
  2573.   if FAlignment <> Value then
  2574.   begin
  2575.     FAlignment := Value;
  2576.     RecreateWnd;
  2577.   end;
  2578. end;
  2579.  
  2580. procedure TRadioButton.SetChecked(Value: Boolean);
  2581.  
  2582.   procedure TurnSiblingsOff;
  2583.   var
  2584.     I: Integer;
  2585.     Sibling: TControl;
  2586.   begin
  2587.     if Parent <> nil then
  2588.       with Parent do
  2589.         for I := 0 to ControlCount - 1 do
  2590.         begin
  2591.           Sibling := Controls[I];
  2592.           if (Sibling <> Self) and (Sibling is TRadioButton) then
  2593.             TRadioButton(Sibling).SetChecked(False);
  2594.         end;
  2595.   end;
  2596.  
  2597. begin
  2598.   if FChecked <> Value then
  2599.   begin
  2600.     FChecked := Value;
  2601.     TabStop := Value;
  2602.     if HandleAllocated then
  2603.       SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
  2604.     if Value then
  2605.     begin
  2606.       TurnSiblingsOff;
  2607.       Click;
  2608.     end;
  2609.   end;
  2610. end;
  2611.  
  2612. procedure TRadioButton.CreateParams(var Params: TCreateParams);
  2613. const
  2614.   Alignments: array[TLeftRight] of LongInt = (BS_LEFTTEXT, 0);
  2615. begin
  2616.   inherited CreateParams(Params);
  2617.   CreateSubClass(Params, 'BUTTON');
  2618.   with Params do
  2619.     Style := Style or BS_RADIOBUTTON or Alignments[FAlignment];
  2620. end;
  2621.  
  2622. procedure TRadioButton.CreateWnd;
  2623. begin
  2624.   inherited CreateWnd;
  2625.   SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
  2626. end;
  2627.  
  2628. procedure TRadioButton.CreateWindowHandle(const Params: TCreateParams);
  2629. begin
  2630.   if Ctl3D and not NewStyleControls then
  2631.   begin      // special subclassing required by unicode Ctl3D on NT
  2632.     with Params do
  2633.       WindowHandle := CreateWindowEx(ExStyle, 'BUTTON', Caption, Style,
  2634.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2635.     Subclass3DWnd(WindowHandle);
  2636.     DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  2637.     CreationControl := Self;
  2638.     SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
  2639.     SendMessage(WindowHandle, WM_NULL, 0, 0);
  2640.   end
  2641.   else
  2642.     inherited CreateWindowHandle(Params);
  2643. end;
  2644.  
  2645. procedure TRadioButton.CMCtl3DChanged(var Message: TMessage);
  2646. begin
  2647.   RecreateWnd;
  2648. end;
  2649.  
  2650. procedure TRadioButton.CMDialogChar(var Message: TCMDialogChar);
  2651. begin
  2652.   with Message do
  2653.     if IsAccel(Message.CharCode, Caption) and CanFocus then
  2654.     begin
  2655.       SetFocus;
  2656.       Result := 1;
  2657.     end else
  2658.       inherited;
  2659. end;
  2660.  
  2661. procedure TRadioButton.CNCommand(var Message: TWMCommand);
  2662. begin
  2663.   case Message.NotifyCode of
  2664.     BN_CLICKED: SetChecked(True);
  2665.     BN_DOUBLECLICKED: DblClick;
  2666.   end;
  2667. end;
  2668.  
  2669. procedure TRadioButton.WMSetFocus(var Message: TWMSetFocus);
  2670. begin // fix double focus rect drawing bug in Ctl3D when switching notebook pages
  2671.   if Ctl3D and not NewStyleControls then  UpdateWindow(Handle);
  2672.   inherited;
  2673. end;
  2674.  
  2675.  
  2676. { TListBoxStrings }
  2677.  
  2678. function TListBoxStrings.GetCount: Integer;
  2679. begin
  2680.   Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
  2681. end;
  2682.  
  2683. function TListBoxStrings.Get(Index: Integer): string;
  2684. var
  2685.   Len: Integer;
  2686.   Text: array[0..4095] of Char;
  2687. begin
  2688.   Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, Longint(@Text));
  2689.   if Len < 0 then raise EStringListError.CreateRes(SListIndexError);
  2690.   SetString(Result, Text, Len);
  2691. end;
  2692.  
  2693. function TListBoxStrings.GetObject(Index: Integer): TObject;
  2694. begin
  2695.   Result := TObject(SendMessage(ListBox.Handle, LB_GETITEMDATA, Index, 0));
  2696.   if Longint(Result) = LB_ERR then
  2697.     raise EStringListError.CreateRes(SListIndexError);
  2698. end;
  2699.  
  2700. procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
  2701. begin
  2702.   SendMessage(ListBox.Handle, LB_SETITEMDATA, Index, Longint(AObject));
  2703. end;
  2704.  
  2705. function TListBoxStrings.Add(const S: string): Integer;
  2706. begin
  2707.   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
  2708.   if Result < 0 then raise EOutOfResources.CreateRes(SInsertLineError);
  2709. end;
  2710.  
  2711. procedure TListBoxStrings.Insert(Index: Integer; const S: string);
  2712. begin
  2713.   if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
  2714.     Longint(PChar(S))) < 0 then
  2715.     raise EOutOfResources.CreateRes(SInsertLineError);
  2716. end;
  2717.  
  2718. procedure TListBoxStrings.Delete(Index: Integer);
  2719. begin
  2720.   SendMessage(ListBox.Handle, LB_DELETESTRING, Index, 0);
  2721. end;
  2722.  
  2723. procedure TListBoxStrings.Clear;
  2724. begin
  2725.   SendMessage(ListBox.Handle, LB_RESETCONTENT, 0, 0);
  2726. end;
  2727.  
  2728. procedure TListBoxStrings.SetUpdateState(Updating: Boolean);
  2729. begin
  2730.   SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  2731.   if not Updating then ListBox.Refresh;
  2732. end;
  2733.  
  2734. { TCustomListBox }
  2735.  
  2736. constructor TCustomListBox.Create(AOwner: TComponent);
  2737. const
  2738.   ListBoxStyle = [csSetCaption, csDoubleClicks];
  2739. begin
  2740.   inherited Create(AOwner);
  2741.   if NewStyleControls then
  2742.     ControlStyle := ListBoxStyle else
  2743.     ControlStyle := ListBoxStyle + [csFramed];
  2744.   Width := 121;
  2745.   Height := 97;
  2746.   TabStop := True;
  2747.   ParentColor := False;
  2748.   FItems := TListBoxStrings.Create;
  2749.   TListBoxStrings(FItems).ListBox := Self;
  2750.   FCanvas := TControlCanvas.Create;
  2751.   TControlCanvas(FCanvas).Control := Self;
  2752.   FItemHeight := 16;
  2753.   FBorderStyle := bsSingle;
  2754.   FExtendedSelect := True;
  2755. end;
  2756.  
  2757. destructor TCustomListBox.Destroy;
  2758. begin
  2759.   FCanvas.Free;
  2760.   FItems.Free;
  2761.   FSaveItems.Free;
  2762.   inherited Destroy;
  2763. end;
  2764.  
  2765. procedure TCustomListBox.Clear;
  2766. begin
  2767.   FItems.Clear;
  2768. end;
  2769.  
  2770. procedure TCustomListBox.SetColumnWidth;
  2771. begin
  2772.   if FColumns > 0 then
  2773.     SendMessage(Handle, LB_SETCOLUMNWIDTH,
  2774.       (Width + FColumns - 3) div FColumns, 0);
  2775. end;
  2776.  
  2777. procedure TCustomListBox.SetColumns(Value: Integer);
  2778. begin
  2779.   if FColumns <> Value then
  2780.     if (FColumns = 0) or (Value = 0) then
  2781.     begin
  2782.       FColumns := Value;
  2783.       RecreateWnd;
  2784.     end else
  2785.     begin
  2786.       FColumns := Value;
  2787.       if HandleAllocated then SetColumnWidth;
  2788.     end;
  2789. end;
  2790.  
  2791. function TCustomListBox.GetItemIndex: Integer;
  2792. begin
  2793.   Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
  2794. end;
  2795.  
  2796. function TCustomListBox.GetSelCount: Integer;
  2797. begin
  2798.   Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
  2799. end;
  2800.  
  2801. procedure TCustomListBox.SetItemIndex(Value: Integer);
  2802. begin
  2803.   if GetItemIndex <> Value then
  2804.     SendMessage(Handle, LB_SETCURSEL, Value, 0);
  2805. end;
  2806.  
  2807. procedure TCustomListBox.SetExtendedSelect(Value: Boolean);
  2808. begin
  2809.   if Value <> FExtendedSelect then
  2810.   begin
  2811.     FExtendedSelect := Value;
  2812.     RecreateWnd;
  2813.   end;
  2814. end;
  2815.  
  2816. procedure TCustomListBox.SetIntegralHeight(Value: Boolean);
  2817. begin
  2818.   if Value <> FIntegralHeight then
  2819.   begin
  2820.     FIntegralHeight := Value;
  2821.     RecreateWnd;
  2822.   end;
  2823. end;
  2824.  
  2825. function TCustomListBox.GetItemHeight: Integer;
  2826. var
  2827.   R: TRect;
  2828. begin
  2829.   Result := FItemHeight;
  2830.   if HandleAllocated and (FStyle = lbStandard) then
  2831.   begin
  2832.     Perform(LB_GETITEMRECT, 0, Longint(@R));
  2833.     Result := R.Bottom - R.Top;
  2834.   end;
  2835. end;
  2836.  
  2837. procedure TCustomListBox.SetItemHeight(Value: Integer);
  2838. begin
  2839.   if (FItemHeight <> Value) and (Value > 0) then
  2840.   begin
  2841.     FItemHeight := Value;
  2842.     RecreateWnd;
  2843.   end;
  2844. end;
  2845.  
  2846. procedure TCustomListBox.SetTabWidth(Value: Integer);
  2847. begin
  2848.   if Value < 0 then Value := 0;
  2849.   if FTabWidth <> Value then
  2850.   begin
  2851.     FTabWidth := Value;
  2852.     RecreateWnd;
  2853.   end;
  2854. end;
  2855.  
  2856. procedure TCustomListBox.SetMultiSelect(Value: Boolean);
  2857. begin
  2858.   if FMultiSelect <> Value then
  2859.   begin
  2860.     FMultiSelect := Value;
  2861.     RecreateWnd;
  2862.   end;
  2863. end;
  2864.  
  2865. function TCustomListBox.GetSelected(Index: Integer): Boolean;
  2866. var
  2867.   R: Longint;
  2868. begin
  2869.   R := SendMessage(Handle, LB_GETSEL, Index, 0);
  2870.   if R = LB_ERR then
  2871.     raise EListError.CreateRes(SListIndexError);
  2872.   Result := LongBool(R);
  2873. end;
  2874.  
  2875. procedure TCustomListBox.SetSelected(Index: Integer; Value: Boolean);
  2876. begin
  2877.   if SendMessage(Handle, LB_SETSEL, Longint(Value), Index) = LB_ERR then
  2878.     raise EListError.CreateRes(SListIndexError);
  2879. end;
  2880.  
  2881. procedure TCustomListBox.SetSorted(Value: Boolean);
  2882. begin
  2883.   if FSorted <> Value then
  2884.   begin
  2885.     FSorted := Value;
  2886.     RecreateWnd;
  2887.   end;
  2888. end;
  2889.  
  2890. procedure TCustomListBox.SetStyle(Value: TListBoxStyle);
  2891. begin
  2892.   if FStyle <> Value then
  2893.   begin
  2894.     FStyle := Value;
  2895.     RecreateWnd;
  2896.   end;
  2897. end;
  2898.  
  2899. function TCustomListBox.GetTopIndex: Integer;
  2900. begin
  2901.   Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
  2902. end;
  2903.  
  2904. procedure TCustomListBox.SetBorderStyle(Value: TBorderStyle);
  2905. begin
  2906.   if FBorderStyle <> Value then
  2907.   begin
  2908.     FBorderStyle := Value;
  2909.     RecreateWnd;
  2910.   end;
  2911. end;
  2912.  
  2913. procedure TCustomListBox.SetTopIndex(Value: Integer);
  2914. begin
  2915.   if GetTopIndex <> Value then
  2916.     SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
  2917. end;
  2918.  
  2919. procedure TCustomListBox.SetItems(Value: TStrings);
  2920. begin
  2921.   Items.Assign(Value);
  2922. end;
  2923.  
  2924. function TCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  2925. var
  2926.   Count: Integer;
  2927.   ItemRect: TRect;
  2928. begin
  2929.   if PtInRect(ClientRect, Pos) then
  2930.   begin
  2931.     Result := TopIndex;
  2932.     Count := Items.Count;
  2933.     while Result < Count do
  2934.     begin
  2935.       Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
  2936.       if PtInRect(ItemRect, Pos) then Exit;
  2937.       Inc(Result);
  2938.     end;
  2939.     if not Existing then Exit;
  2940.   end;
  2941.   Result := -1;
  2942. end;
  2943.  
  2944. function TCustomListBox.ItemRect(Index: Integer): TRect;
  2945. var
  2946.   Count: Integer;
  2947. begin
  2948.   Count := Items.Count;
  2949.   if (Index = 0) or (Index < Count) then
  2950.     Perform(LB_GETITEMRECT, Index, Longint(@Result))
  2951.   else if Index = Count then
  2952.   begin
  2953.     Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
  2954.     OffsetRect(Result, 0, Result.Bottom - Result.Top);
  2955.   end else FillChar(Result, SizeOf(Result), 0);
  2956. end;
  2957.  
  2958. procedure TCustomListBox.CreateParams(var Params: TCreateParams);
  2959. type
  2960.   PSelects = ^TSelects;
  2961.   TSelects = array[Boolean] of Longint;
  2962. const
  2963.   Styles: array[TListBoxStyle] of Longint =
  2964.     (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE);
  2965.   Sorteds: array[Boolean] of Longint = (0, LBS_SORT);
  2966.   MultiSelects: array[Boolean] of Longint = (0, LBS_MULTIPLESEL);
  2967.   ExtendSelects: array[Boolean] of Longint = (0, LBS_EXTENDEDSEL);
  2968.   IntegralHeights: array[Boolean] of Longint = (LBS_NOINTEGRALHEIGHT, 0);
  2969.   MultiColumns: array[Boolean] of Longint = (0, LBS_MULTICOLUMN);
  2970.   TabStops: array[Boolean] of Longint = (0, LBS_USETABSTOPS);
  2971. var
  2972.   Selects: PSelects;
  2973. begin
  2974.   inherited CreateParams(Params);
  2975.   CreateSubClass(Params, 'LISTBOX');
  2976.   with Params do
  2977.   begin
  2978.     Selects := @MultiSelects;
  2979.     if FExtendedSelect then Selects := @ExtendSelects;
  2980.     Style := Style or (WS_HSCROLL or WS_VSCROLL or LBS_HASSTRINGS or
  2981.       LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
  2982.       Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
  2983.       MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
  2984.       TabStops[FTabWidth <> 0];
  2985.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  2986.     begin
  2987.       Style := Style and not WS_BORDER;
  2988.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  2989.     end;
  2990.   end;
  2991. end;
  2992.  
  2993. procedure TCustomListBox.CreateWnd;
  2994. var
  2995.   W, H: Integer;
  2996. begin
  2997.   W := Width;
  2998.   H := Height;
  2999.   inherited CreateWnd;
  3000.   SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
  3001.   if FTabWidth <> 0 then
  3002.     SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
  3003.   SetColumnWidth;
  3004.   if FSaveItems <> nil then
  3005.   begin
  3006.     FItems.Assign(FSaveItems);
  3007.     SetTopIndex(FSaveTopIndex);
  3008.     SetItemIndex(FSaveItemIndex);
  3009.     FSaveItems.Free;
  3010.     FSaveItems := nil;
  3011.   end;
  3012. end;
  3013.  
  3014. procedure TCustomListBox.DestroyWnd;
  3015. begin
  3016.   if FItems.Count > 0 then
  3017.   begin
  3018.     FSaveItems := TStringList.Create;
  3019.     FSaveItems.Assign(FItems);
  3020.     FSaveTopIndex := GetTopIndex;
  3021.     FSaveItemIndex := GetItemIndex;
  3022.   end;
  3023.   inherited DestroyWnd;
  3024. end;
  3025.  
  3026. procedure TCustomListBox.WndProc(var Message: TMessage);
  3027. begin
  3028.   {for auto drag mode, let listbox handle itself, instead of TControl}
  3029.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  3030.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
  3031.   begin
  3032.     if DragMode = dmAutomatic then
  3033.     begin
  3034.       if IsControlMouseMsg(TWMMouse(Message)) then
  3035.         Exit;
  3036.       ControlState := ControlState + [csLButtonDown];
  3037.       Dispatch(Message);  {overrides TControl's BeginDrag}
  3038.       Exit;
  3039.     end;
  3040.   end;
  3041.   inherited WndProc(Message);
  3042. end;
  3043.  
  3044. procedure TCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
  3045. var
  3046.   ItemNo : Integer;
  3047.   ShiftState: TShiftState;
  3048. begin
  3049.   ShiftState := KeysToShiftState(Message.Keys);
  3050.   if (DragMode = dmAutomatic) and FMultiSelect then
  3051.   begin
  3052.     if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
  3053.     begin
  3054.       ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
  3055.       if (ItemNo >= 0) and (Selected[ItemNo]) then
  3056.       begin
  3057.         BeginDrag (False);
  3058.         Exit;
  3059.       end;
  3060.     end;
  3061.   end;
  3062.   inherited;
  3063.   if (DragMode = dmAutomatic) and not (FMultiSelect and
  3064.     ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
  3065.     BeginDrag(False);
  3066. end;
  3067.  
  3068. procedure TCustomListBox.CNCommand(var Message: TWMCommand);
  3069. begin
  3070.   case Message.NotifyCode of
  3071.     LBN_SELCHANGE: Click;
  3072.     LBN_DBLCLK: DblClick;
  3073.   end;
  3074. end;
  3075.  
  3076. procedure TCustomListBox.WMPaint(var Message: TWMPaint);
  3077.  
  3078.   procedure PaintListBox;
  3079.   var
  3080.     DrawItemMsg: TWMDrawItem;
  3081.     MeasureItemMsg: TWMMeasureItem;
  3082.     DrawItemStruct: TDrawItemStruct;
  3083.     MeasureItemStruct: TMeasureItemStruct;
  3084.     R: TRect;
  3085.     Y, I, H, W: Integer;
  3086.   begin
  3087.     { Initialize drawing records }
  3088.     DrawItemMsg.Msg := CN_DRAWITEM;
  3089.     DrawItemMsg.DrawItemStruct := @DrawItemStruct;
  3090.     DrawItemMsg.Ctl := Handle;
  3091.     DrawItemStruct.CtlType := ODT_LISTBOX;
  3092.     DrawItemStruct.itemAction := ODA_DRAWENTIRE;
  3093.     DrawItemStruct.itemState := 0;
  3094.     DrawItemStruct.hDC := Message.DC;
  3095.     DrawItemStruct.CtlID := Handle;
  3096.     DrawItemStruct.hwndItem := Handle;
  3097.  
  3098.     { Intialize measure records }
  3099.     MeasureItemMsg.Msg := CN_MEASUREITEM;
  3100.     MeasureItemMsg.IDCtl := Handle;
  3101.     MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
  3102.     MeasureItemStruct.CtlType := ODT_LISTBOX;
  3103.     MeasureItemStruct.CtlID := Handle;
  3104.  
  3105.     { Draw the listbox }
  3106.     Y := 0;
  3107.     I := TopIndex;
  3108.     GetClipBox(Message.DC, R);
  3109.     H := Height;
  3110.     W := Width;
  3111.     while Y < H do
  3112.     begin
  3113.       MeasureItemStruct.itemID := I;
  3114.       if I < Items.Count then
  3115.         MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
  3116.       MeasureItemStruct.itemWidth := W;
  3117.       MeasureItemStruct.itemHeight := FItemHeight;
  3118.       DrawItemStruct.itemData := MeasureItemStruct.itemData;
  3119.       DrawItemStruct.itemID := I;
  3120.       Dispatch(MeasureItemMsg);
  3121.       DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
  3122.         Y + MeasureItemStruct.itemHeight);
  3123.       Dispatch(DrawItemMsg);
  3124.       Inc(Y, MeasureItemStruct.itemHeight);
  3125.       Inc(I);
  3126.       if I >= Items.Count then break;
  3127.     end;
  3128.   end;
  3129.  
  3130. begin
  3131.   if Message.DC <> 0 then
  3132.     { Listboxes don't allow paint "sub-classing" like the other windows controls
  3133.       so we have to do it ourselves. }
  3134.     PaintListBox
  3135.   else inherited;
  3136. end;
  3137.  
  3138. procedure TCustomListBox.WMSize(var Message: TWMSize);
  3139. begin
  3140.   inherited;
  3141.   SetColumnWidth;
  3142. end;
  3143.  
  3144. procedure TCustomListBox.DragCanceled;
  3145. var
  3146.   M: TWMMouse;
  3147.   MousePos: TPoint;
  3148. begin
  3149.   with M do
  3150.   begin
  3151.     Msg := WM_LBUTTONDOWN;
  3152.     GetCursorPos(MousePos);
  3153.     Pos := PointToSmallPoint(ScreenToClient(MousePos));
  3154.     Keys := 0;
  3155.     Result := 0;
  3156.   end;
  3157.   DefaultHandler(M);
  3158.   M.Msg := WM_LBUTTONUP;
  3159.   DefaultHandler(M);
  3160. end;
  3161.  
  3162. procedure TCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  3163.   State: TOwnerDrawState);
  3164. begin
  3165.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State) else
  3166.   begin
  3167.     FCanvas.FillRect(Rect);
  3168.     if Index < Items.Count then
  3169.       FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  3170.   end;
  3171. end;
  3172.  
  3173. procedure TCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
  3174. begin
  3175.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  3176. end;
  3177.  
  3178. procedure TCustomListBox.CNDrawItem(var Message: TWMDrawItem);
  3179. var
  3180.   State: TOwnerDrawState;
  3181. begin
  3182.   with Message.DrawItemStruct^ do
  3183.   begin
  3184.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  3185.     FCanvas.Handle := hDC;
  3186.     FCanvas.Font := Font;
  3187.     FCanvas.Brush := Brush;
  3188.     if (Integer(itemID) >= 0) and (odSelected in State) then
  3189.     begin
  3190.       FCanvas.Brush.Color := clHighlight;
  3191.       FCanvas.Font.Color := clHighlightText
  3192.     end;
  3193.     if Integer(itemID) >= 0 then
  3194.       DrawItem(itemID, rcItem, State) else
  3195.       FCanvas.FillRect(rcItem);
  3196.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  3197.     FCanvas.Handle := 0;
  3198.   end;
  3199. end;
  3200.  
  3201. procedure TCustomListBox.CNMeasureItem(var Message: TWMMeasureItem);
  3202. begin
  3203.   with Message.MeasureItemStruct^ do
  3204.   begin
  3205.     itemHeight := FItemHeight;
  3206.     if FStyle = lbOwnerDrawVariable then
  3207.       MeasureItem(itemID, Integer(itemHeight));
  3208.   end;
  3209. end;
  3210.  
  3211. procedure TCustomListBox.CMCtl3DChanged(var Message: TMessage);
  3212. begin
  3213.   if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  3214.   inherited;
  3215. end;
  3216.  
  3217. { TScrollBar }
  3218.  
  3219. constructor TScrollBar.Create(AOwner: TComponent);
  3220. begin
  3221.   inherited Create(AOwner);
  3222.   Width := 121;
  3223.   Height := GetSystemMetrics(SM_CYHSCROLL);
  3224.   TabStop := True;
  3225.   ControlStyle := [csFramed, csDoubleClicks];
  3226.   FKind := sbHorizontal;
  3227.   FPosition := 0;
  3228.   FMin := 0;
  3229.   FMax := 100;
  3230.   FSmallChange := 1;
  3231.   FLargeChange := 1;
  3232. end;
  3233.  
  3234. procedure TScrollBar.CreateParams(var Params: TCreateParams);
  3235. const
  3236.   Kinds: array[TScrollBarKind] of LongInt = (SBS_HORZ, SBS_VERT);
  3237. begin
  3238.   inherited CreateParams(Params);
  3239.   CreateSubClass(Params, 'SCROLLBAR');
  3240.   with Params do Style := Style or Kinds[FKind];
  3241. end;
  3242.  
  3243. procedure TScrollBar.CreateWnd;
  3244. begin
  3245.   inherited CreateWnd;
  3246.   SetScrollRange(Handle, SB_CTL, FMin, FMax, False);
  3247.   SetScrollPos(Handle, SB_CTL, FPosition, True);
  3248. end;
  3249.  
  3250. procedure TScrollBar.SetKind(Value: TScrollBarKind);
  3251. begin
  3252.   if FKind <> Value then
  3253.   begin
  3254.     FKind := Value;
  3255.     if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
  3256.     RecreateWnd;
  3257.   end;
  3258. end;
  3259.  
  3260. procedure TScrollBar.SetParams(APosition, AMin, AMax: Integer);
  3261. begin
  3262.   if AMax < AMin then
  3263.     raise EInvalidOperation.CreateRes(SScrollBarRange);
  3264.   if APosition < AMin then APosition := AMin;
  3265.   if APosition > AMax then APosition := AMax;
  3266.   if (FMin <> AMin) or (FMax <> AMax) then
  3267.   begin
  3268.     FMin := AMin;
  3269.     FMax := AMax;
  3270.     if HandleAllocated then
  3271.       SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
  3272.   end;
  3273.   if FPosition <> APosition then
  3274.   begin
  3275.     FPosition := APosition;
  3276.     if HandleAllocated then SetScrollPos(Handle, SB_CTL, APosition, True);
  3277.     Change;
  3278.   end;
  3279. end;
  3280.  
  3281. procedure TScrollBar.SetPosition(Value: Integer);
  3282. begin
  3283.   SetParams(Value, FMin, FMax);
  3284. end;
  3285.  
  3286. procedure TScrollBar.SetMin(Value: Integer);
  3287. begin
  3288.   SetParams(FPosition, Value, FMax);
  3289. end;
  3290.  
  3291. procedure TScrollBar.SetMax(Value: Integer);
  3292. begin
  3293.   SetParams(FPosition, FMin, Value);
  3294. end;
  3295.  
  3296. procedure TScrollBar.Change;
  3297. begin
  3298.   if Assigned(FOnChange) then FOnChange(Self);
  3299. end;
  3300.  
  3301. procedure TScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
  3302. begin
  3303.   if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
  3304. end;
  3305.  
  3306. procedure TScrollBar.DoScroll(var Message: TWMScroll);
  3307. var
  3308.   ScrollPos: Integer;
  3309.   NewPos: Longint;
  3310. begin
  3311.   with Message do
  3312.   begin
  3313.     NewPos := FPosition;
  3314.     case TScrollCode(ScrollCode) of
  3315.       scLineUp:
  3316.         Dec(NewPos, FSmallChange);
  3317.       scLineDown:
  3318.         Inc(NewPos, FSmallChange);
  3319.       scPageUp:
  3320.         Dec(NewPos, FLargeChange);
  3321.       scPageDown:
  3322.         Inc(NewPos, FLargeChange);
  3323.       scPosition, scTrack:
  3324.         NewPos := Pos;
  3325.       scTop:
  3326.         NewPos := FMin;
  3327.       scBottom:
  3328.         NewPos := FMax;
  3329.     end;
  3330.     if NewPos < FMin then NewPos := FMin;
  3331.     if NewPos > FMax then NewPos := FMax;
  3332.     ScrollPos := NewPos;
  3333.     Scroll(TScrollCode(ScrollCode), ScrollPos);
  3334.     SetPosition(ScrollPos);
  3335.   end;
  3336. end;
  3337.  
  3338. procedure TScrollBar.CNHScroll(var Message: TWMHScroll);
  3339. begin
  3340.   DoScroll(Message);
  3341. end;
  3342.  
  3343. procedure TScrollBar.CNVScroll(var Message: TWMVScroll);
  3344. begin
  3345.   DoScroll(Message);
  3346. end;
  3347.  
  3348. end.
  3349.