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