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