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