home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RxCtrls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  147.0 KB  |  5,128 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RXCtrls;
  13.  
  14. {$I RX.INC}
  15. {$W-,T-}
  16.  
  17. interface
  18.  
  19. uses Windows, Registry, RTLConsts,  Messages, Classes, Controls, Graphics, StdCtrls, ExtCtrls, Forms,
  20.   Buttons, Menus, RxTimer, RxConst, IniFiles, Placemnt;
  21.  
  22. type
  23.   TPositiveInt = 1..MaxInt;
  24.  
  25. { TTextListBox }
  26.  
  27.   TTextListBox = class(TCustomListBox)
  28.   private
  29.     FMaxWidth: Integer;
  30. {$IFNDEF WIN32}
  31.     FTabWidth: Integer;
  32.     procedure SetTabWidth(Value: Integer);
  33. {$ENDIF}
  34.     procedure ResetHorizontalExtent;
  35.     procedure SetHorizontalExtent;
  36.     function GetItemWidth(Index: Integer): Integer;
  37.   protected
  38. {$IFNDEF WIN32}
  39.     procedure CreateParams(var Params: TCreateParams); override;
  40.     procedure CreateWnd; override;
  41. {$ENDIF}
  42.     procedure WndProc(var Message: TMessage); override;
  43.   published
  44.     property Align;
  45.     property BorderStyle;
  46.     property Color;
  47.     property Ctl3D;
  48.     property DragCursor;
  49.     property DragMode;
  50.     property Enabled;
  51.     property ExtendedSelect;
  52.     property Font;
  53.     property IntegralHeight;
  54. {$IFDEF RX_D4}
  55.     property Anchors;
  56.     property BiDiMode;
  57.     property Constraints;
  58.     property DragKind;
  59.     property ParentBiDiMode;
  60. {$ENDIF}
  61. {$IFDEF WIN32}
  62.   {$IFNDEF VER90}
  63.     property ImeMode;
  64.     property ImeName;
  65.   {$ENDIF}
  66. {$ENDIF}
  67.     property ItemHeight;
  68.     property Items;
  69.     property MultiSelect;
  70.     property ParentColor;
  71.     property ParentCtl3D;
  72.     property ParentFont;
  73.     property ParentShowHint;
  74.     property PopupMenu;
  75.     property ShowHint;
  76.     property Sorted;
  77.     property TabOrder;
  78.     property TabStop;
  79. {$IFDEF WIN32}
  80.     property TabWidth;
  81. {$ELSE}
  82.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  83. {$ENDIF}
  84.     property Visible;
  85.     property OnClick;
  86.     property OnDblClick;
  87.     property OnDragDrop;
  88.     property OnDragOver;
  89.     property OnEndDrag;
  90.     property OnEnter;
  91.     property OnExit;
  92.     property OnKeyDown;
  93.     property OnKeyPress;
  94.     property OnKeyUp;
  95.     property OnMouseDown;
  96.     property OnMouseMove;
  97.     property OnMouseUp;
  98. {$IFDEF WIN32}
  99.     property OnStartDrag;
  100. {$ENDIF}
  101. {$IFDEF RX_D5}
  102.     property OnContextPopup;
  103. {$ENDIF}
  104. {$IFDEF RX_D4}
  105.     property OnMouseWheelDown;
  106.     property OnMouseWheelUp;
  107.     property OnEndDock;
  108.     property OnStartDock;
  109. {$ENDIF}
  110.   end;
  111.  
  112. { TRxCustomListBox }
  113.  
  114.   TGetItemWidthEvent = procedure(Control: TWinControl; Index: Integer;
  115.     var Width: Integer) of object;
  116.  
  117.   TRxCustomListBox = class(TWinControl)
  118.   private
  119.     FItems: TStrings;
  120.     FBorderStyle: TBorderStyle;
  121.     FCanvas: TCanvas;
  122.     FColumns: Integer;
  123.     FItemHeight: Integer;
  124.     FStyle: TListBoxStyle;
  125.     FIntegralHeight: Boolean;
  126.     FMultiSelect: Boolean;
  127.     FSorted: Boolean;
  128.     FExtendedSelect: Boolean;
  129.     FTabWidth: Integer;
  130.     FSaveItems: TStringList;
  131.     FSaveTopIndex: Integer;
  132.     FSaveItemIndex: Integer;
  133.     FAutoScroll: Boolean;
  134.     FGraySelection: Boolean;
  135.     FMaxItemWidth: Integer;
  136.     FOnDrawItem: TDrawItemEvent;
  137.     FOnMeasureItem: TMeasureItemEvent;
  138.     FOnGetItemWidth: TGetItemWidthEvent;
  139.     procedure ResetHorizontalExtent;
  140.     procedure SetHorizontalExtent;
  141.     function GetAutoScroll: Boolean;
  142.     function GetItemHeight: Integer; virtual;
  143.     function GetItemIndex: Integer;
  144.     function GetSelCount: Integer;
  145.     function GetSelected(Index: Integer): Boolean;
  146.     function GetTopIndex: Integer;
  147.     procedure SetAutoScroll(Value: Boolean);
  148.     procedure SetBorderStyle(Value: TBorderStyle);
  149.     procedure SetColumnWidth;
  150.     procedure SetColumns(Value: Integer);
  151.     procedure SetExtendedSelect(Value: Boolean);
  152.     procedure SetIntegralHeight(Value: Boolean);
  153.     procedure SetItemHeight(Value: Integer);
  154.     procedure SetItemIndex(Value: Integer);
  155.     procedure SetMultiSelect(Value: Boolean);
  156.     procedure SetSelected(Index: Integer; Value: Boolean);
  157.     procedure SetSorted(Value: Boolean);
  158.     procedure SetStyle(Value: TListBoxStyle);
  159.     procedure SetTabWidth(Value: Integer);
  160.     procedure SetTopIndex(Value: Integer);
  161.     procedure SetGraySelection(Value: Boolean);
  162.     procedure SetOnDrawItem(Value: TDrawItemEvent);
  163.     procedure SetOnGetItemWidth(Value: TGetItemWidthEvent);
  164.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  165.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  166.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  167.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  168.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  169.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  170.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  171.     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  172.     procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  173. {$IFDEF WIN32}
  174.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  175. {$ENDIF}
  176.   protected
  177.     procedure CreateParams(var Params: TCreateParams); override;
  178.     procedure CreateWnd; override;
  179.     procedure DestroyWnd; override;
  180.     function CreateItemList: TStrings; virtual;
  181.     function GetItemWidth(Index: Integer): Integer; virtual;
  182.     procedure WndProc(var Message: TMessage); override;
  183.     procedure DragCanceled; override;
  184.     procedure DrawItem(Index: Integer; Rect: TRect;
  185.       State: TOwnerDrawState); virtual;
  186.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  187.     function GetItemData(Index: Integer): Longint; dynamic;
  188.     procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
  189.     procedure SetItems(Value: TStrings); virtual;
  190.     procedure ResetContent; dynamic;
  191.     procedure DeleteString(Index: Integer); dynamic;
  192.     property AutoScroll: Boolean read GetAutoScroll write SetAutoScroll default False;
  193.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  194.     property Columns: Integer read FColumns write SetColumns default 0;
  195.     property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
  196.     property GraySelection: Boolean read FGraySelection write SetGraySelection default False;
  197.     property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
  198.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  199.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
  200.     property ParentColor default False;
  201.     property Sorted: Boolean read FSorted write SetSorted default False;
  202.     property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
  203.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  204.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
  205.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  206.     property OnGetItemWidth: TGetItemWidthEvent read FOnGetItemWidth write SetOnGetItemWidth;
  207.   public
  208.     constructor Create(AOwner: TComponent); override;
  209.     destructor Destroy; override;
  210.     procedure Clear;
  211.     procedure DefaultDrawText(X, Y: Integer; const S: string);
  212.     function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  213.     function ItemRect(Index: Integer): TRect;
  214.     property Canvas: TCanvas read FCanvas;
  215.     property Items: TStrings read FItems write SetItems;
  216.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  217.     property SelCount: Integer read GetSelCount;
  218.     property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
  219.     property TopIndex: Integer read GetTopIndex write SetTopIndex;
  220.   published
  221.     property TabStop default True;
  222.   end;
  223.  
  224. { TRxCheckListBox }
  225.  
  226.   TCheckKind = (ckCheckBoxes, ckRadioButtons, ckCheckMarks);
  227.   TChangeStateEvent = procedure (Sender: TObject; Index: Integer) of object;
  228.  
  229.   TRxCheckListBox = class(TRxCustomListBox)
  230.   private
  231.     FAllowGrayed: Boolean;
  232.     FCheckKind: TCheckKind;
  233.     FSaveStates: TList;
  234.     FDrawBitmap: TBitmap;
  235.     FCheckWidth, FCheckHeight: Integer;
  236.     FReserved: Integer;
  237.     FInUpdateStates: Boolean;
  238.     FIniLink: TIniLink;
  239.     FOnClickCheck: TNotifyEvent;
  240.     FOnStateChange: TChangeStateEvent;
  241.     procedure ResetItemHeight;
  242.     function GetItemHeight: Integer; override;
  243.     procedure DrawCheck(R: TRect; AState: TCheckBoxState; Enabled: Boolean);
  244.     procedure SetCheckKind(Value: TCheckKind);
  245.     procedure SetChecked(Index: Integer; AChecked: Boolean);
  246.     function GetChecked(Index: Integer): Boolean;
  247.     procedure SetState(Index: Integer; AState: TCheckBoxState);
  248.     function GetState(Index: Integer): TCheckBoxState;
  249.     procedure SetItemEnabled(Index: Integer; Value: Boolean);
  250.     function GetItemEnabled(Index: Integer): Boolean;
  251.     function GetAllowGrayed: Boolean;
  252.     procedure ToggleClickCheck(Index: Integer);
  253.     procedure InvalidateCheck(Index: Integer);
  254.     procedure InvalidateItem(Index: Integer);
  255.     function CreateCheckObject(Index: Integer): TObject;
  256.     function FindCheckObject(Index: Integer): TObject;
  257.     function GetCheckObject(Index: Integer): TObject;
  258.     function IsCheckObject(Index: Integer): Boolean;
  259.     procedure ReadVersion(Reader: TReader);
  260.     procedure WriteVersion(Writer: TWriter);
  261.     procedure ReadCheckData(Reader: TReader);
  262.     procedure WriteCheckData(Writer: TWriter);
  263.     procedure InternalSaveStates(IniFile: TObject; const Section: string);
  264.     procedure InternalRestoreStates(IniFile: TObject; const Section: string);
  265.     function GetStorage: TFormPlacement;
  266.     procedure SetStorage(Value: TFormPlacement);
  267.     procedure IniSave(Sender: TObject);
  268.     procedure IniLoad(Sender: TObject);
  269.     procedure UpdateCheckStates;
  270.     function GetCheckedIndex: Integer;
  271.     procedure SetCheckedIndex(Value: Integer);
  272.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  273.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  274.   protected
  275.     function CreateItemList: TStrings; override;
  276.     procedure DrawItem(Index: Integer; Rect: TRect;
  277.       State: TOwnerDrawState); override;
  278.     procedure DefineProperties(Filer: TFiler); override;
  279.     function GetItemWidth(Index: Integer): Integer; override;
  280.     function GetItemData(Index: Integer): LongInt; override;
  281.     procedure SetItemData(Index: Integer; AData: LongInt); override;
  282.     procedure KeyPress(var Key: Char); override;
  283.     procedure Loaded; override;
  284.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  285.       X, Y: Integer); override;
  286.     procedure ResetContent; override;
  287.     procedure DeleteString(Index: Integer); override;
  288.     procedure ClickCheck; dynamic;
  289.     procedure ChangeItemState(Index: Integer); dynamic;
  290.     procedure CreateParams(var Params: TCreateParams); override;
  291.     procedure CreateWnd; override;
  292.     procedure DestroyWnd; override;
  293.     procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  294.     function GetCheckWidth: Integer;
  295.     procedure SetItems(Value: TStrings); override;
  296.   public
  297.     constructor Create(AOwner: TComponent); override;
  298.     destructor Destroy; override;
  299. {$IFDEF WIN32}
  300.     procedure SaveStatesReg(IniFile: TRegIniFile);
  301.     procedure RestoreStatesReg(IniFile: TRegIniFile);
  302. {$ENDIF WIN32}
  303.     procedure SaveStates(IniFile: TIniFile);
  304.     procedure RestoreStates(IniFile: TIniFile);
  305.     procedure ApplyState(AState: TCheckBoxState; EnabledOnly: Boolean);
  306.     property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
  307.     property State[Index: Integer]: TCheckBoxState read GetState write SetState;
  308.     property EnabledItem[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
  309.   published
  310.     property AllowGrayed: Boolean read GetAllowGrayed write FAllowGrayed default False;
  311.     property CheckKind: TCheckKind read FCheckKind write SetCheckKind default ckCheckBoxes;
  312.     property CheckedIndex: Integer read GetCheckedIndex write SetCheckedIndex default -1;
  313.     property IniStorage: TFormPlacement read GetStorage write SetStorage;
  314.     property Align;
  315.     property AutoScroll default True;
  316.     property BorderStyle;
  317.     property Color;
  318.     property Columns;
  319.     property Ctl3D;
  320.     property DragCursor;
  321.     property DragMode;
  322.     property Enabled;
  323.     property ExtendedSelect;
  324.     property Font;
  325.     property GraySelection;
  326. {$IFDEF RX_D4}
  327.     property Anchors;
  328.     property BiDiMode;
  329.     property Constraints;
  330.     property DragKind;
  331.     property ParentBiDiMode;
  332. {$ENDIF}
  333. {$IFDEF WIN32}
  334.   {$IFNDEF VER90}
  335.     property ImeMode;
  336.     property ImeName;
  337.   {$ENDIF}
  338. {$ENDIF}
  339.     property IntegralHeight;
  340.     property ItemHeight;
  341.     property Items stored False;
  342.     property MultiSelect;
  343.     property ParentColor;
  344.     property ParentCtl3D;
  345.     property ParentFont;
  346.     property ParentShowHint;
  347.     property PopupMenu;
  348.     property ShowHint;
  349.     property Sorted;
  350.     property Style;
  351.     property TabOrder;
  352.     property TabWidth;
  353.     property Visible;
  354.     property OnStateChange: TChangeStateEvent read FOnStateChange write FOnStateChange;
  355.     property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
  356.     property OnClick;
  357.     property OnDblClick;
  358.     property OnDragDrop;
  359.     property OnDragOver;
  360.     property OnDrawItem;
  361.     property OnEndDrag;
  362.     property OnEnter;
  363.     property OnExit;
  364.     property OnGetItemWidth;
  365.     property OnKeyDown;
  366.     property OnKeyPress;
  367.     property OnKeyUp;
  368.     property OnMeasureItem;
  369.     property OnMouseDown;
  370.     property OnMouseMove;
  371.     property OnMouseUp;
  372. {$IFDEF WIN32}
  373.     property OnStartDrag;
  374. {$ENDIF}
  375. {$IFDEF RX_D5}
  376.     property OnContextPopup;
  377. {$ENDIF}
  378. {$IFDEF RX_D4}
  379.     property OnMouseWheelDown;
  380.     property OnMouseWheelUp;
  381.     property OnEndDock;
  382.     property OnStartDock;
  383. {$ENDIF}
  384.   end;
  385.  
  386. const
  387.   clbDefaultState = cbUnchecked;
  388.   clbDefaultEnabled = True;
  389.  
  390. { TRxCustomLabel }
  391.  
  392. type
  393.   TShadowPosition = (spLeftTop, spLeftBottom, spRightBottom, spRightTop);
  394. {$IFNDEF RX_D3}
  395.   TTextLayout = (tlTop, tlCenter, tlBottom);
  396. {$ENDIF}
  397.  
  398.   TRxCustomLabel = class(TGraphicControl)
  399.   private
  400.     FFocusControl: TWinControl;
  401.     FAlignment: TAlignment;
  402.     FAutoSize: Boolean;
  403.     FLayout: TTextLayout;
  404.     FShadowColor: TColor;
  405.     FShadowSize: Byte;
  406.     FShadowPos: TShadowPosition;
  407.     FWordWrap: Boolean;
  408.     FShowAccelChar: Boolean;
  409.     FShowFocus: Boolean;
  410.     FFocused: Boolean;
  411.     FMouseInControl: Boolean;
  412.     FDragging: Boolean;
  413.     FLeftMargin: Integer;
  414.     FRightMargin: Integer;
  415.     FOnMouseEnter: TNotifyEvent;
  416.     FOnMouseLeave: TNotifyEvent;
  417.     procedure DoDrawText(var Rect: TRect; Flags: Word);
  418.     function GetTransparent: Boolean;
  419.     procedure UpdateTracking;
  420.     procedure SetAlignment(Value: TAlignment);
  421.     procedure SetFocusControl(Value: TWinControl);
  422.     procedure SetLayout(Value: TTextLayout);
  423.     procedure SetLeftMargin(Value: Integer);
  424.     procedure SetRightMargin(Value: Integer);
  425.     procedure SetShadowColor(Value: TColor);
  426.     procedure SetShadowSize(Value: Byte);
  427.     procedure SetShadowPos(Value: TShadowPosition);
  428.     procedure SetShowAccelChar(Value: Boolean);
  429.     procedure SetTransparent(Value: Boolean);
  430.     procedure SetWordWrap(Value: Boolean);
  431.     procedure SetShowFocus(Value: Boolean);
  432.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  433.     procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  434.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  435.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  436.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  437.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  438.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  439.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  440.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  441.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  442.   protected
  443.     procedure SetAutoSize(Value: Boolean); override;
  444.     procedure AdjustBounds;
  445.     function GetDefaultFontColor: TColor; virtual;
  446.     function GetLabelCaption: string; virtual;
  447.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  448.       X, Y: Integer); override;
  449.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  450.       X, Y: Integer); override;
  451.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  452.     procedure Paint; override;
  453.     procedure MouseEnter; dynamic;
  454.     procedure MouseLeave; dynamic;
  455.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  456.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  457.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  458.     property Layout: TTextLayout read FLayout write SetLayout default tlTop;
  459.     property LeftMargin: Integer read FLeftMargin write SetLeftMargin default 0;
  460.     property RightMargin: Integer read FRightMargin write SetRightMargin default 0;
  461.     property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnHighlight;
  462.     property ShadowSize: Byte read FShadowSize write SetShadowSize default 1;
  463.     property ShadowPos: TShadowPosition read FShadowPos write SetShadowPos default spLeftTop;
  464.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  465.     property ShowFocus: Boolean read FShowFocus write SetShowFocus default False;
  466.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  467.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  468.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  469.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  470.   public
  471.     constructor Create(AOwner: TComponent); override;
  472.     property Canvas;
  473.     property MouseInControl: Boolean read FMouseInControl;
  474.   end;
  475.  
  476. { TRxLabel }
  477.  
  478.   TRxLabel = class(TRxCustomLabel)
  479.   published
  480.     property Align;
  481.     property Alignment;
  482.     property AutoSize;
  483.     property Caption;
  484.     property Color;
  485.     property DragCursor;
  486.     property DragMode;
  487.     property Enabled;
  488.     property FocusControl;
  489.     property Font;
  490. {$IFDEF RX_D4}
  491.     property Anchors;
  492.     property BiDiMode;
  493.     property Constraints;
  494.     property DragKind;
  495.     property ParentBiDiMode;
  496. {$ENDIF}
  497.     property Layout;
  498.     property ParentColor;
  499.     property ParentFont;
  500.     property ParentShowHint;
  501.     property PopupMenu;
  502.     property ShadowColor;
  503.     property ShadowSize;
  504.     property ShadowPos;
  505.     property ShowAccelChar;
  506.     property ShowFocus;
  507.     property ShowHint;
  508.     property Transparent;
  509.     property Visible;
  510.     property WordWrap;
  511.     property OnClick;
  512.     property OnDblClick;
  513.     property OnDragDrop;
  514.     property OnDragOver;
  515.     property OnEndDrag;
  516.     property OnMouseDown;
  517.     property OnMouseMove;
  518.     property OnMouseUp;
  519.     property OnMouseEnter;
  520.     property OnMouseLeave;
  521. {$IFDEF WIN32}
  522.     property OnStartDrag;
  523. {$ENDIF}
  524. {$IFDEF RX_D5}
  525.     property OnContextPopup;
  526. {$ENDIF}
  527. {$IFDEF RX_D4}
  528.     property OnEndDock;
  529.     property OnStartDock;
  530. {$ENDIF}
  531.   end;
  532.  
  533. { TSecretPanel }
  534.  
  535.   TGlyphLayout = (glGlyphLeft, glGlyphRight, glGlyphTop, glGlyphBottom);
  536.   TScrollDirection = (sdVertical, sdHorizontal);
  537.   TPanelDrawEvent = procedure(Sender: TObject; Canvas: TCanvas;
  538.     Rect: TRect) of object;
  539.  
  540.   TSecretPanel = class(TCustomPanel)
  541.   private
  542.     FActive: Boolean;
  543.     FAlignment: TAlignment;
  544.     FLines: TStrings;
  545.     FCycled: Boolean;
  546.     FScrollCnt: Integer;
  547.     FMaxScroll: Integer;
  548.     FTxtDivider: Byte;
  549.     FFirstLine: Integer;
  550.     FTimer: TRxTimer;
  551.     FTxtRect: TRect;
  552.     FPaintRect: TRect;
  553.     FGlyphOrigin: TPoint;
  554.     FMemoryImage: TBitmap;
  555.     FGlyph: TBitmap;
  556.     FHiddenList: TList;
  557.     FTextStyle: TPanelBevel;
  558.     FDirection: TScrollDirection;
  559.     FGlyphLayout: TGlyphLayout;
  560.     FOnPaintClient: TPanelDrawEvent;
  561.     FOnStartPlay: TNotifyEvent;
  562.     FOnStopPlay: TNotifyEvent;
  563. {$IFDEF RX_D3}
  564.     FAsyncDrawing: Boolean;
  565.     procedure SetAsyncDrawing(Value: Boolean);
  566. {$ENDIF}
  567.     function GetInflateWidth: Integer;
  568.     function GetInterval: Cardinal;
  569.     procedure SetInterval(Value: Cardinal);
  570.     procedure SetGlyph(Value: TBitmap);
  571.     procedure SetLines(Value: TStrings);
  572.     procedure SetActive(Value: Boolean);
  573.     procedure SetAlignment(Value: TAlignment);
  574.     procedure SetGlyphLayout(Value: TGlyphLayout);
  575.     procedure SetTextStyle(Value: TPanelBevel);
  576.     procedure SetDirection(Value: TScrollDirection);
  577.     procedure RecalcDrawRect;
  578.     procedure PaintGlyph;
  579.     procedure PaintText;
  580.     procedure UpdateMemoryImage;
  581.     procedure GlyphChanged(Sender: TObject);
  582.     procedure LinesChanged(Sender: TObject);
  583.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  584.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  585.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  586.   protected
  587.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  588.     procedure Paint; override;
  589.     procedure PaintClient(Canvas: TCanvas; Rect: TRect); virtual;
  590.     procedure TimerExpired(Sender: TObject); virtual;
  591.     procedure StartPlay; dynamic;
  592.     procedure StopPlay; dynamic;
  593.   public
  594.     constructor Create(AOwner: TComponent); override;
  595.     destructor Destroy; override;
  596.     procedure Play;
  597.     procedure Stop;
  598.     property Canvas;
  599.   published
  600. {$IFDEF RX_D3}
  601.     property AsyncDrawing: Boolean read FAsyncDrawing write SetAsyncDrawing default True;
  602. {$ENDIF}
  603.     property Active: Boolean read FActive write SetActive default False;
  604.     property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
  605.     property Cycled: Boolean read FCycled write FCycled default False;
  606.     property Glyph: TBitmap read FGlyph write SetGlyph;
  607.     property GlyphLayout: TGlyphLayout read FGlyphLayout write SetGlyphLayout
  608.       default glGlyphLeft;
  609.     property Interval: Cardinal read GetInterval write SetInterval default 30;
  610.     property Lines: TStrings read FLines write SetLines;
  611.     property ScrollDirection: TScrollDirection read FDirection write SetDirection
  612.       default sdVertical;
  613.     property TextStyle: TPanelBevel read FTextStyle write SetTextStyle default bvNone;
  614. {$IFDEF RX_D4}
  615.     property Anchors;
  616.     property BiDiMode;
  617.     property Constraints;
  618.     property DragKind;
  619.     property ParentBiDiMode;
  620. {$ENDIF}
  621.     property Align;
  622.     property BevelInner;
  623.     property BevelOuter default bvLowered;
  624.     property BevelWidth;
  625.     property BorderWidth;
  626.     property BorderStyle;
  627.     property DragCursor;
  628.     property DragMode;
  629.     property Color;
  630.     property Ctl3D;
  631.     property Font;
  632.     property ParentColor;
  633.     property ParentCtl3D;
  634.     property ParentFont;
  635.     property ParentShowHint;
  636.     property PopupMenu;
  637.     property ShowHint;
  638.     property TabOrder;
  639.     property TabStop;
  640.     property Visible;
  641.     property OnPaintClient: TPanelDrawEvent read FOnPaintClient write FOnPaintClient;
  642.     property OnStartPlay: TNotifyEvent read FOnStartPlay write FOnStartPlay;
  643.     property OnStopPlay: TNotifyEvent read FOnStopPlay write FOnStopPlay;
  644.     property OnClick;
  645.     property OnDblClick;
  646.     property OnDragDrop;
  647.     property OnDragOver;
  648.     property OnEndDrag;
  649.     property OnEnter;
  650.     property OnExit;
  651.     property OnMouseDown;
  652.     property OnMouseMove;
  653.     property OnMouseUp;
  654. {$IFDEF WIN32}
  655.     property OnStartDrag;
  656. {$ENDIF}
  657. {$IFDEF RX_D5}
  658.     property OnContextPopup;
  659. {$ENDIF}
  660. {$IFDEF RX_D4}
  661.     property OnEndDock;
  662.     property OnStartDock;
  663. {$ENDIF}
  664.     property OnResize;
  665.   end;
  666.  
  667. { TRxSpeedButton }
  668.  
  669.   TRxNumGlyphs = 1..5;
  670.   TRxDropDownMenuPos = (dmpBottom, dmpRight);
  671.   TRxButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);
  672.  
  673.   TRxSpeedButton = class(TGraphicControl)
  674.   private
  675.     FGroupIndex: Integer;
  676.     FStyle: TButtonStyle;
  677.     FGlyph: Pointer;
  678.     FDrawImage: TBitmap;
  679.     FDown: Boolean;
  680.     FDragging: Boolean;
  681.     FFlat: Boolean;
  682.     FMouseInControl: Boolean;
  683.     FAllowAllUp: Boolean;
  684.     FLayout: TButtonLayout;
  685.     FSpacing: Integer;
  686.     FMargin: Integer;
  687.     FModalResult: TModalResult;
  688.     FTransparent: Boolean;
  689.     FMarkDropDown: Boolean;
  690.     FDropDownMenu: TPopupMenu;
  691.     FMenuPosition: TRxDropDownMenuPos;
  692.     FInactiveGrayed: Boolean;
  693.     FMenuTracking: Boolean;
  694.     FRepeatTimer: TTimer;
  695.     FAllowTimer: Boolean;
  696.     FInitRepeatPause: Word;
  697.     FRepeatPause: Word;
  698.     FOnMouseEnter: TNotifyEvent;
  699.     FOnMouseLeave: TNotifyEvent;
  700.     procedure GlyphChanged(Sender: TObject);
  701.     procedure UpdateExclusive;
  702.     function GetGlyph: TBitmap;
  703.     procedure SetGlyph(Value: TBitmap);
  704.     function GetNumGlyphs: TRxNumGlyphs;
  705.     procedure SetNumGlyphs(Value: TRxNumGlyphs);
  706.     function GetWordWrap: Boolean;
  707.     procedure SetWordWrap(Value: Boolean);
  708.     function GetAlignment: TAlignment;
  709.     procedure SetAlignment(Value: TAlignment);
  710.     procedure SetDown(Value: Boolean);
  711.     procedure SetAllowAllUp(Value: Boolean);
  712.     procedure SetGroupIndex(Value: Integer);
  713.     procedure SetLayout(Value: TButtonLayout);
  714.     procedure SetSpacing(Value: Integer);
  715.     procedure SetMargin(Value: Integer);
  716.     procedure SetDropDownMenu(Value: TPopupMenu);
  717.     procedure SetFlat(Value: Boolean);
  718.     procedure SetStyle(Value: TButtonStyle);
  719.     procedure SetInactiveGrayed(Value: Boolean);
  720.     procedure SetTransparent(Value: Boolean);
  721.     procedure SetMarkDropDown(Value: Boolean);
  722.     procedure TimerExpired(Sender: TObject);
  723.     procedure SetAllowTimer(Value: Boolean);
  724.     function CheckMenuDropDown(const Pos: TSmallPoint;
  725.       Manual: Boolean): Boolean;
  726.     procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
  727.       X, Y: Integer);
  728.     procedure CMButtonPressed(var Message: TMessage); message CM_RXBUTTONPRESSED;
  729.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  730.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  731.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  732.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  733.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  734.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  735.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  736.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  737.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  738.     procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
  739.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  740.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  741.   protected
  742.     FState: TRxButtonState;
  743. {$IFDEF RX_D4}
  744.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  745. {$ENDIF}
  746.     function GetDropDownMenuPos: TPoint;
  747.     function GetPalette: HPALETTE; override;
  748.     procedure Paint; override;
  749.     procedure Loaded; override;
  750.     procedure PaintGlyph(Canvas: TCanvas; ARect: TRect; AState: TRxButtonState;
  751.       DrawMark: Boolean); virtual;
  752.     procedure MouseEnter; dynamic;
  753.     procedure MouseLeave; dynamic;
  754.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  755.       X, Y: Integer); override;
  756.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  757.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  758.       X, Y: Integer); override;
  759.     procedure Notification(AComponent: TComponent;
  760.       Operation: TOperation); override;
  761.     property ButtonGlyph: Pointer read FGlyph;
  762.   public
  763.     constructor Create(AOwner: TComponent); override;
  764.     destructor Destroy; override;
  765.     procedure ButtonClick;
  766.     function CheckBtnMenuDropDown: Boolean;
  767.     procedure Click; override;
  768.     procedure UpdateTracking;
  769.   published
  770. {$IFDEF RX_D4}
  771.     property Action;
  772.     property Anchors;
  773.     property BiDiMode;
  774.     property Constraints;
  775.     property DragKind;
  776.     property ParentBiDiMode;
  777. {$ENDIF}
  778.     property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter;
  779.     property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
  780.     property AllowTimer: Boolean read FAllowTimer write SetAllowTimer default False;
  781.     property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
  782.     { Ensure group index is declared before Down }
  783.     property Down: Boolean read FDown write SetDown default False;
  784.     property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
  785.     property MenuPosition: TRxDropDownMenuPos read FMenuPosition write FMenuPosition
  786.       default dmpBottom;
  787.     property Caption;
  788.     property DragCursor;
  789.     property DragMode;
  790.     property Enabled;
  791.     property Flat: Boolean read FFlat write SetFlat default False;
  792.     property Font;
  793.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  794.     property GrayedInactive: Boolean read FInactiveGrayed write SetInactiveGrayed
  795.       default True;
  796.     property InitPause: Word read FInitRepeatPause write FInitRepeatPause default 500;
  797.     property Layout: TButtonLayout read FLayout write SetLayout default blGlyphTop;
  798.     property Margin: Integer read FMargin write SetMargin default -1;
  799.     property MarkDropDown: Boolean read FMarkDropDown write SetMarkDropDown default True;
  800.     property ModalResult: TModalResult read FModalResult write FModalResult default 0;
  801.     property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
  802.     property ParentFont;
  803.     property ParentShowHint default False;
  804.     property RepeatInterval: Word read FRepeatPause write FRepeatPause default 100;
  805.     property ShowHint default True;
  806.     property Spacing: Integer read FSpacing write SetSpacing default 1;
  807.     property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
  808.     property Transparent: Boolean read FTransparent write SetTransparent default False;
  809.     property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
  810.     property Visible;
  811.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  812.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  813.     property OnClick;
  814.     property OnDblClick;
  815.     property OnDragDrop;
  816.     property OnDragOver;
  817.     property OnEndDrag;
  818.     property OnMouseDown;
  819.     property OnMouseMove;
  820.     property OnMouseUp;
  821. {$IFDEF WIN32}
  822.     property OnStartDrag;
  823. {$ENDIF}
  824. {$IFDEF RX_D4}
  825.     property OnEndDock;
  826.     property OnStartDock;
  827. {$ENDIF}
  828.   end;
  829.  
  830. { TButtonImage }
  831.  
  832.   TButtonImage = class(TObject)
  833.   private
  834.     FGlyph: TObject;
  835.     FButtonSize: TPoint;
  836.     FCaption: TCaption;
  837.     function GetNumGlyphs: TRxNumGlyphs;
  838.     procedure SetNumGlyphs(Value: TRxNumGlyphs);
  839.     function GetWordWrap: Boolean;
  840.     procedure SetWordWrap(Value: Boolean);
  841.     function GetAlignment: TAlignment;
  842.     procedure SetAlignment(Value: TAlignment);
  843.     function GetGlyph: TBitmap;
  844.     procedure SetGlyph(Value: TBitmap);
  845.   public
  846.     constructor Create;
  847.     destructor Destroy; override;
  848.     procedure Invalidate;
  849. {$IFDEF WIN32}
  850.     procedure DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  851.       Layout: TButtonLayout; AFont: TFont; Images: TImageList;
  852.       ImageIndex: Integer; Flags: Word);
  853. {$ENDIF}
  854.     procedure Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  855.       Layout: TButtonLayout; AFont: TFont; Flags: Word);
  856.     property Alignment: TAlignment read GetAlignment write SetAlignment;
  857.     property Caption: TCaption read FCaption write FCaption;
  858.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  859.     property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs;
  860.     property ButtonSize: TPoint read FButtonSize write FButtonSize;
  861.     property WordWrap: Boolean read GetWordWrap write SetWordWrap;
  862.   end;
  863.  
  864. { TRxButtonGlyph }
  865.  
  866.   TRxButtonGlyph = class
  867.   private
  868.     FOriginal: TBitmap;
  869.     FGlyphList: TImageList;
  870.     FIndexs: array[TRxButtonState] of Integer;
  871.     FTransparentColor: TColor;
  872.     FNumGlyphs: TRxNumGlyphs;
  873.     FWordWrap: Boolean;
  874.     FAlignment: TAlignment;
  875.     FOnChange: TNotifyEvent;
  876.     procedure GlyphChanged(Sender: TObject);
  877.     procedure SetGlyph(Value: TBitmap);
  878.     procedure SetNumGlyphs(Value: TRxNumGlyphs);
  879.     function MapColor(Color: TColor): TColor;
  880.   protected
  881.     procedure MinimizeCaption(Canvas: TCanvas; const Caption: string;
  882.       Buffer: PChar; MaxLen, Width: Integer);
  883.     function CreateButtonGlyph(State: TRxButtonState): Integer;
  884. {$IFDEF WIN32}
  885.     function CreateImageGlyph(State: TRxButtonState; Images: TImageList;
  886.       Index: Integer): Integer;
  887. {$ENDIF}
  888.     procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  889.       var Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  890.       PopupMark: Boolean; var GlyphPos: TPoint; var TextBounds: TRect;
  891.       Flags: Word {$IFDEF WIN32}; Images: TImageList; ImageIndex: Integer
  892.       {$ENDIF});
  893.   public
  894.     constructor Create;
  895.     destructor Destroy; override;
  896.     procedure Invalidate;
  897.     function DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
  898.       State: TRxButtonState): TPoint;
  899. {$IFDEF WIN32}
  900.     function DrawButtonImage(Canvas: TCanvas; X, Y: Integer; Images: TImageList;
  901.       ImageIndex: Integer; State: TRxButtonState): TPoint;
  902.     function DrawEx(Canvas: TCanvas; const Client: TRect; const Caption: string;
  903.       Layout: TButtonLayout; Margin, Spacing: Integer; PopupMark: Boolean;
  904.       Images: TImageList; ImageIndex: Integer; State: TRxButtonState;
  905.       Flags: Word): TRect;
  906. {$ENDIF}
  907.     procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
  908.       TextBounds: TRect; State: TRxButtonState; Flags: Word);
  909.     procedure DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
  910.       State: TRxButtonState);
  911.     function Draw(Canvas: TCanvas; const Client: TRect; const Caption: string;
  912.       Layout: TButtonLayout; Margin, Spacing: Integer; PopupMark: Boolean;
  913.       State: TRxButtonState; Flags: Word): TRect;
  914.     property Alignment: TAlignment read FAlignment write FAlignment;
  915.     property Glyph: TBitmap read FOriginal write SetGlyph;
  916.     property NumGlyphs: TRxNumGlyphs read FNumGlyphs write SetNumGlyphs;
  917.     property WordWrap: Boolean read FWordWrap write FWordWrap;
  918.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  919.   end;
  920.  
  921. function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
  922.   Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
  923.   ShadowPos: TShadowPosition): Integer;
  924.  
  925. function CheckBitmap: TBitmap;
  926.  
  927. implementation
  928.  
  929. {$IFDEF WIN32}
  930.  {$R *.R32}
  931. {$ELSE}
  932.  {$R *.R16}
  933. {$ENDIF}
  934.  
  935. uses SysUtils, Dialogs, {$IFDEF WIN32} CommCtrl, {$ELSE} Str16, {$ENDIF}
  936.   VCLUtils, MaxMin, Consts, AppUtils {$IFDEF RX_D4}, ImgList,
  937.   ActnList {$ENDIF};
  938.  
  939. const
  940.   Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  941.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  942.  
  943. { TTextListBox }
  944.  
  945. procedure TTextListBox.SetHorizontalExtent;
  946. begin
  947.   SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxWidth, 0);
  948. end;
  949.  
  950. function TTextListBox.GetItemWidth(Index: Integer): Integer;
  951. var
  952.   ATabWidth: Longint;
  953.   S: string;
  954. begin
  955.   S := Items[Index] + 'x';
  956.   if TabWidth > 0 then begin
  957.     ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
  958.     Result := LoWord(GetTabbedTextExtent(Canvas.Handle, @S[1], Length(S),
  959.       1, ATabWidth));
  960.   end
  961.   else Result := Canvas.TextWidth(S);
  962. end;
  963.  
  964. procedure TTextListBox.ResetHorizontalExtent;
  965. var
  966.   I: Integer;
  967. begin
  968.   FMaxWidth := 0;
  969.   for I := 0 to Items.Count - 1 do
  970.     FMaxWidth := Max(FMaxWidth, GetItemWidth(I));
  971.   SetHorizontalExtent;
  972. end;
  973.  
  974. {$IFNDEF WIN32}
  975.  
  976. procedure TTextListBox.SetTabWidth(Value: Integer);
  977. begin
  978.   if Value < 0 then Value := 0;
  979.   if FTabWidth <> Value then begin
  980.     FTabWidth := Value;
  981.     RecreateWnd;
  982.   end;
  983. end;
  984.  
  985. procedure TTextListBox.CreateParams(var Params: TCreateParams);
  986. const
  987.   TabStops: array[Boolean] of Longword = (0, LBS_USETABSTOPS);
  988. begin
  989.   inherited CreateParams(Params);
  990.   Params.Style := Params.Style or TabStops[FTabWidth <> 0];
  991. end;
  992.  
  993. procedure TTextListBox.CreateWnd;
  994. begin
  995.   inherited CreateWnd;
  996.   if FTabWidth <> 0 then
  997.     SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
  998. end;
  999.  
  1000. {$ENDIF}
  1001.  
  1002. procedure TTextListBox.WndProc(var Message: TMessage);
  1003. begin
  1004.   case Message.Msg of
  1005.     LB_ADDSTRING, LB_INSERTSTRING:
  1006.       begin
  1007.         inherited WndProc(Message);
  1008.         FMaxWidth := Max(FMaxWidth, GetItemWidth(Message.Result));
  1009.         SetHorizontalExtent;
  1010.       end;
  1011.     LB_DELETESTRING:
  1012.       begin
  1013.         if GetItemWidth(Message.wParam) >= FMaxWidth then begin
  1014.           Perform(WM_HSCROLL, SB_TOP, 0);
  1015.           inherited WndProc(Message);
  1016.           ResetHorizontalExtent;
  1017.         end
  1018.         else inherited WndProc(Message);
  1019.       end;
  1020.     LB_RESETCONTENT:
  1021.       begin
  1022.         FMaxWidth := 0;
  1023.         SetHorizontalExtent;
  1024.         Perform(WM_HSCROLL, SB_TOP, 0);
  1025.         inherited WndProc(Message);
  1026.       end;
  1027.     WM_SETFONT:
  1028.       begin
  1029.         inherited WndProc(Message);
  1030.         Canvas.Font.Assign(Self.Font);
  1031.         ResetHorizontalExtent;
  1032.         Exit;
  1033.       end;
  1034.     else inherited WndProc(Message);
  1035.   end;
  1036. end;
  1037.  
  1038. { TRxCustomListBox implementation copied from STDCTRLS.PAS and modified }
  1039.  
  1040. { TRxListBoxStrings }
  1041.  
  1042. type
  1043.   TRxListBoxStrings = class(TStrings)
  1044.   private
  1045.     ListBox: TRxCustomListBox;
  1046.   protected
  1047. {$IFNDEF RX_D3}
  1048.     procedure Error(Msg: Word; Data: Integer);
  1049. {$ENDIF}
  1050.     function Get(Index: Integer): string; override;
  1051.     function GetCount: Integer; override;
  1052.     function GetObject(Index: Integer): TObject; override;
  1053.     procedure PutObject(Index: Integer; AObject: TObject); override;
  1054.     procedure SetUpdateState(Updating: Boolean); override;
  1055.   public
  1056.     function Add(const S: string): Integer; override;
  1057.     procedure Clear; override;
  1058.     procedure Delete(Index: Integer); override;
  1059.     procedure Insert(Index: Integer; const S: string); override;
  1060.   end;
  1061.  
  1062. {$IFNDEF RX_D3}
  1063. procedure TRxListBoxStrings.Error(Msg: Word; Data: Integer);
  1064.  
  1065. {$IFDEF WIN32}
  1066.   function ReturnAddr: Pointer;
  1067.   asm
  1068.           MOV     EAX,[EBP+4]
  1069.   end;
  1070. {$ELSE}
  1071.   function ReturnAddr: Pointer; assembler;
  1072.   asm
  1073.           MOV     AX,[BP].Word[2]
  1074.           MOV     DX,[BP].Word[4]
  1075.   end;
  1076. {$ENDIF}
  1077.  
  1078. begin
  1079.   raise EStringListError.CreateFmt('%s: %d', [LoadStr(Msg),
  1080.     Data]) at ReturnAddr;
  1081. end;
  1082. {$ENDIF}
  1083.  
  1084. function TRxListBoxStrings.GetCount: Integer;
  1085. begin
  1086.   Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
  1087. end;
  1088.  
  1089. function TRxListBoxStrings.Get(Index: Integer): string;
  1090. var
  1091.   Len: Integer;
  1092. {$IFDEF WIN32}
  1093.   Text: array[0..4095] of Char;
  1094. {$ENDIF}
  1095. begin
  1096.   Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index,
  1097.     {$IFDEF WIN32} LongInt(@Text) {$ELSE} LongInt(@Result) {$ENDIF});
  1098.   if Len < 0 then Error(SListIndexError, Index);
  1099. {$IFDEF WIN32}
  1100.   SetString(Result, Text, Len);
  1101. {$ELSE}
  1102.   System.Move(Result[0], Result[1], Len);
  1103.   Result[0] := Char(Len);
  1104. {$ENDIF}
  1105. end;
  1106.  
  1107. function TRxListBoxStrings.GetObject(Index: Integer): TObject;
  1108. begin
  1109.   Result := TObject(ListBox.GetItemData(Index));
  1110.   if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  1111. end;
  1112.  
  1113. procedure TRxListBoxStrings.PutObject(Index: Integer; AObject: TObject);
  1114. begin
  1115.   ListBox.SetItemData(Index, LongInt(AObject));
  1116. end;
  1117.  
  1118. function TRxListBoxStrings.Add(const S: string): Integer;
  1119. {$IFNDEF WIN32}
  1120. var
  1121.   Text: array[0..255] of Char;
  1122. {$ENDIF}
  1123. begin
  1124. {$IFDEF WIN32}
  1125.   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, LongInt(PChar(S)));
  1126. {$ELSE}
  1127.   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, LongInt(StrPCopy(Text, S)));
  1128. {$ENDIF}
  1129.   if Result < 0 then raise EOutOfResources.Create(ResStr(SInsertLineError));
  1130. end;
  1131.  
  1132. procedure TRxListBoxStrings.Insert(Index: Integer; const S: string);
  1133. {$IFNDEF WIN32}
  1134. var
  1135.   Text: array[0..255] of Char;
  1136. {$ENDIF}
  1137. begin
  1138.   if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
  1139. {$IFDEF WIN32}
  1140.     Longint(PChar(S))) < 0 then
  1141. {$ELSE}
  1142.     Longint(StrPCopy(Text, S))) < 0 then
  1143. {$ENDIF}
  1144.       raise EOutOfResources.Create(ResStr(SInsertLineError));
  1145. end;
  1146.  
  1147. procedure TRxListBoxStrings.Delete(Index: Integer);
  1148. begin
  1149.   ListBox.DeleteString(Index);
  1150. end;
  1151.  
  1152. procedure TRxListBoxStrings.Clear;
  1153. begin
  1154.   ListBox.ResetContent;
  1155. end;
  1156.  
  1157. procedure TRxListBoxStrings.SetUpdateState(Updating: Boolean);
  1158. begin
  1159.   SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1160.   if not Updating then ListBox.Refresh;
  1161. end;
  1162.  
  1163. { TRxCustomListBox }
  1164.  
  1165. procedure ListIndexError(Index: Integer);
  1166.  
  1167. {$IFDEF WIN32}
  1168.   function ReturnAddr: Pointer;
  1169.   asm
  1170.           MOV     EAX,[EBP+4]
  1171.   end;
  1172. {$ELSE}
  1173.   function ReturnAddr: Pointer; assembler;
  1174.   asm
  1175.           MOV     AX,[BP].Word[2]
  1176.           MOV     DX,[BP].Word[4]
  1177.   end;
  1178. {$ENDIF}
  1179.  
  1180. begin
  1181. {$IFDEF RX_D3}
  1182.   raise EStringListError.CreateFmt(SListIndexError, [Index]) at ReturnAddr;
  1183. {$ELSE}
  1184.   raise EStringListError.CreateFmt('%s: %d', [LoadStr(SListIndexError),
  1185.     Index]) at ReturnAddr;
  1186. {$ENDIF}
  1187. end;
  1188.  
  1189. constructor TRxCustomListBox.Create(AOwner: TComponent);
  1190. const
  1191.   ListBoxStyle = [csSetCaption, csDoubleClicks];
  1192. begin
  1193.   inherited Create(AOwner);
  1194. {$IFDEF WIN32}
  1195.   if NewStyleControls then ControlStyle := ListBoxStyle
  1196.   else ControlStyle := ListBoxStyle + [csFramed];
  1197. {$ELSE}
  1198.   ControlStyle := ListBoxStyle + [csFramed];
  1199. {$ENDIF}
  1200.   Width := 121;
  1201.   Height := 97;
  1202.   TabStop := True;
  1203.   ParentColor := False;
  1204.   FItems := CreateItemList;
  1205.   TRxListBoxStrings(FItems).ListBox := Self;
  1206.   FCanvas := TControlCanvas.Create;
  1207.   TControlCanvas(FCanvas).Control := Self;
  1208.   FItemHeight := 16;
  1209.   FBorderStyle := bsSingle;
  1210.   FExtendedSelect := True;
  1211. end;
  1212.  
  1213. destructor TRxCustomListBox.Destroy;
  1214. begin
  1215.   inherited Destroy;
  1216.   FCanvas.Free;
  1217.   FItems.Free;
  1218.   FSaveItems.Free;
  1219. end;
  1220.  
  1221. function TRxCustomListBox.CreateItemList: TStrings;
  1222. begin
  1223.   Result := TRxListBoxStrings.Create;
  1224. end;
  1225.  
  1226. function TRxCustomListBox.GetItemData(Index: Integer): LongInt;
  1227. begin
  1228.   Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
  1229. end;
  1230.  
  1231. procedure TRxCustomListBox.SetItemData(Index: Integer; AData: LongInt);
  1232. begin
  1233.   SendMessage(Handle, LB_SETITEMDATA, Index, AData);
  1234. end;
  1235.  
  1236. procedure TRxCustomListBox.DeleteString(Index: Integer);
  1237. begin
  1238.   SendMessage(Handle, LB_DELETESTRING, Index, 0);
  1239. end;
  1240.  
  1241. procedure TRxCustomListBox.SetHorizontalExtent;
  1242. begin
  1243.   SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxItemWidth, 0);
  1244. end;
  1245.  
  1246. function TRxCustomListBox.GetItemWidth(Index: Integer): Integer;
  1247. var
  1248.   ATabWidth: Longint;
  1249.   S: string;
  1250. begin
  1251.   if (Style <> lbStandard) and Assigned(FOnGetItemWidth) and
  1252.     Assigned(FOnDrawItem) then
  1253.   begin
  1254.     Result := 0;
  1255.     FOnGetItemWidth(Self, Index, Result);
  1256.   end
  1257.   else begin
  1258.     S := Items[Index] + 'x';
  1259.     if TabWidth > 0 then begin
  1260.       {if (FTabChar > #0) then
  1261.         for I := 1 to Length(S) do
  1262.           if S[I] = FTabChar then S[I] := #9;}
  1263.       ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
  1264.       Result := LoWord(GetTabbedTextExtent(Canvas.Handle, @S[1], Length(S),
  1265.         1, ATabWidth));
  1266.     end
  1267.     else Result := Canvas.TextWidth(S);
  1268.   end;
  1269. end;
  1270.  
  1271. procedure TRxCustomListBox.ResetHorizontalExtent;
  1272. var
  1273.   I: Integer;
  1274. begin
  1275.   FMaxItemWidth := 0;
  1276.   for I := 0 to Items.Count - 1 do
  1277.     FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(I));
  1278.   SetHorizontalExtent;
  1279. end;
  1280.  
  1281. procedure TRxCustomListBox.ResetContent;
  1282. begin
  1283.   SendMessage(Handle, LB_RESETCONTENT, 0, 0);
  1284. end;
  1285.  
  1286. procedure TRxCustomListBox.Clear;
  1287. begin
  1288.   FItems.Clear;
  1289. end;
  1290.  
  1291. procedure TRxCustomListBox.SetColumnWidth;
  1292. begin
  1293.   if FColumns > 0 then
  1294.     SendMessage(Handle, LB_SETCOLUMNWIDTH, (Width + FColumns - 3) div
  1295.       FColumns, 0);
  1296. end;
  1297.  
  1298. procedure TRxCustomListBox.SetColumns(Value: Integer);
  1299. begin
  1300.   if FColumns <> Value then
  1301.     if (FColumns = 0) or (Value = 0) then begin
  1302.       FColumns := Value;
  1303.       RecreateWnd;
  1304.     end
  1305.     else begin
  1306.       FColumns := Value;
  1307.       if HandleAllocated then SetColumnWidth;
  1308.     end;
  1309. end;
  1310.  
  1311. function TRxCustomListBox.GetItemIndex: Integer;
  1312. begin
  1313.   Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
  1314. end;
  1315.  
  1316. function TRxCustomListBox.GetSelCount: Integer;
  1317. begin
  1318.   Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
  1319. end;
  1320.  
  1321. procedure TRxCustomListBox.SetItemIndex(Value: Integer);
  1322. begin
  1323.   if GetItemIndex <> Value then
  1324.     SendMessage(Handle, LB_SETCURSEL, Value, 0);
  1325. end;
  1326.  
  1327. procedure TRxCustomListBox.SetExtendedSelect(Value: Boolean);
  1328. begin
  1329.   if Value <> FExtendedSelect then begin
  1330.     FExtendedSelect := Value;
  1331.     RecreateWnd;
  1332.   end;
  1333. end;
  1334.  
  1335. procedure TRxCustomListBox.SetIntegralHeight(Value: Boolean);
  1336. begin
  1337.   if Value <> FIntegralHeight then begin
  1338.     FIntegralHeight := Value;
  1339.     RecreateWnd;
  1340.   end;
  1341. end;
  1342.  
  1343. function TRxCustomListBox.GetAutoScroll: Boolean;
  1344. begin
  1345.   Result := FAutoScroll and (Columns = 0);
  1346. end;
  1347.  
  1348. procedure TRxCustomListBox.SetOnDrawItem(Value: TDrawItemEvent);
  1349. begin
  1350.   if Assigned(FOnDrawItem) <> Assigned(Value) then begin
  1351.     FOnDrawItem := Value;
  1352.     Perform(WM_HSCROLL, SB_TOP, 0);
  1353.     if HandleAllocated then
  1354.       if AutoScroll then ResetHorizontalExtent
  1355.       else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1356.   end
  1357.   else FOnDrawItem := Value;
  1358. end;
  1359.  
  1360. procedure TRxCustomListBox.SetOnGetItemWidth(Value: TGetItemWidthEvent);
  1361. begin
  1362.   if Assigned(FOnGetItemWidth) <> Assigned(Value) then begin
  1363.     FOnGetItemWidth := Value;
  1364.     Perform(WM_HSCROLL, SB_TOP, 0);
  1365.     if HandleAllocated then
  1366.       if AutoScroll then ResetHorizontalExtent
  1367.       else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1368.   end
  1369.   else FOnGetItemWidth := Value;
  1370. end;
  1371.  
  1372. procedure TRxCustomListBox.SetAutoScroll(Value: Boolean);
  1373. begin
  1374.   if AutoScroll <> Value then begin
  1375.     FAutoScroll := Value;
  1376.     Perform(WM_HSCROLL, SB_TOP, 0);
  1377.     if HandleAllocated then begin
  1378.       if AutoScroll then ResetHorizontalExtent
  1379.       else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1380.     end;
  1381.   end;
  1382. end;
  1383.  
  1384. function TRxCustomListBox.GetItemHeight: Integer;
  1385. var
  1386.   R: TRect;
  1387. begin
  1388.   Result := FItemHeight;
  1389.   if HandleAllocated and (FStyle = lbStandard) then begin
  1390.     Perform(LB_GETITEMRECT, 0, Longint(@R));
  1391.     Result := R.Bottom - R.Top;
  1392.   end;
  1393. end;
  1394.  
  1395. procedure TRxCustomListBox.SetItemHeight(Value: Integer);
  1396. begin
  1397.   if (FItemHeight <> Value) and (Value > 0) then begin
  1398.     FItemHeight := Value;
  1399.     RecreateWnd;
  1400.   end;
  1401. end;
  1402.  
  1403. procedure TRxCustomListBox.SetTabWidth(Value: Integer);
  1404. begin
  1405.   if Value < 0 then Value := 0;
  1406.   if FTabWidth <> Value then begin
  1407.     FTabWidth := Value;
  1408.     RecreateWnd;
  1409.   end;
  1410. end;
  1411.  
  1412. procedure TRxCustomListBox.SetMultiSelect(Value: Boolean);
  1413. begin
  1414.   if FMultiSelect <> Value then begin
  1415.     FMultiSelect := Value;
  1416.     RecreateWnd;
  1417.   end;
  1418. end;
  1419.  
  1420. function TRxCustomListBox.GetSelected(Index: Integer): Boolean;
  1421. var
  1422.   R: Longint;
  1423. begin
  1424.   R := SendMessage(Handle, LB_GETSEL, Index, 0);
  1425.   if R = LB_ERR then ListIndexError(Index);
  1426.   Result := LongBool(R);
  1427. end;
  1428.  
  1429. procedure TRxCustomListBox.SetSelected(Index: Integer; Value: Boolean);
  1430. begin
  1431.   if MultiSelect then begin
  1432.     if SendMessage(Handle, LB_SETSEL, Ord(Value), Index) = LB_ERR then
  1433.       ListIndexError(Index);
  1434.   end
  1435.   else begin
  1436.     if Value then SetItemIndex(Index)
  1437.     else if (ItemIndex = Index) then SetItemIndex(-1);
  1438.   end;
  1439. end;
  1440.  
  1441. procedure TRxCustomListBox.SetSorted(Value: Boolean);
  1442. begin
  1443.   if FSorted <> Value then begin
  1444.     FSorted := Value;
  1445.     RecreateWnd;
  1446.   end;
  1447. end;
  1448.  
  1449. procedure TRxCustomListBox.SetStyle(Value: TListBoxStyle);
  1450. begin
  1451.   if FStyle <> Value then begin
  1452.     FStyle := Value;
  1453.     RecreateWnd;
  1454.   end;
  1455. end;
  1456.  
  1457. function TRxCustomListBox.GetTopIndex: Integer;
  1458. begin
  1459.   Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
  1460. end;
  1461.  
  1462. procedure TRxCustomListBox.SetBorderStyle(Value: TBorderStyle);
  1463. begin
  1464.   if FBorderStyle <> Value then begin
  1465.     FBorderStyle := Value;
  1466.     RecreateWnd;
  1467.   end;
  1468. end;
  1469.  
  1470. procedure TRxCustomListBox.SetTopIndex(Value: Integer);
  1471. begin
  1472.   if GetTopIndex <> Value then SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
  1473. end;
  1474.  
  1475. procedure TRxCustomListBox.SetGraySelection(Value: Boolean);
  1476. begin
  1477.   if FGraySelection <> Value then begin
  1478.     FGraySelection := Value;
  1479.     if not Focused then Invalidate;
  1480.   end;
  1481. end;
  1482.  
  1483. procedure TRxCustomListBox.SetItems(Value: TStrings);
  1484. begin
  1485.   Items.Assign(Value);
  1486. end;
  1487.  
  1488. function TRxCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  1489. var
  1490.   Count: Integer;
  1491.   ItemRect: TRect;
  1492. begin
  1493.   if PtInRect(ClientRect, Pos) then begin
  1494.     Result := TopIndex;
  1495.     Count := Items.Count;
  1496.     while Result < Count do begin
  1497.       Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
  1498.       if PtInRect(ItemRect, Pos) then Exit;
  1499.       Inc(Result);
  1500.     end;
  1501.     if not Existing then Exit;
  1502.   end;
  1503.   Result := -1;
  1504. end;
  1505.  
  1506. function TRxCustomListBox.ItemRect(Index: Integer): TRect;
  1507. var
  1508.   Count: Integer;
  1509. begin
  1510.   Count := Items.Count;
  1511.   if (Index = 0) or (Index < Count) then
  1512.     Perform(LB_GETITEMRECT, Index, Longint(@Result))
  1513.   else if Index = Count then begin
  1514.     Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
  1515.     OffsetRect(Result, 0, Result.Bottom - Result.Top);
  1516.   end
  1517.   else FillChar(Result, SizeOf(Result), 0);
  1518. end;
  1519.  
  1520. procedure TRxCustomListBox.CreateParams(var Params: TCreateParams);
  1521. type
  1522.   PSelects = ^TSelects;
  1523.   TSelects = array[Boolean] of Longword;
  1524. const
  1525.   BorderStyles: array[TBorderStyle] of Longword = (0, WS_BORDER);
  1526.   Styles: array[TListBoxStyle] of Longword =
  1527.     (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE);
  1528.   Sorteds: array[Boolean] of Longword = (0, LBS_SORT);
  1529.   MultiSelects: array[Boolean] of Longword = (0, LBS_MULTIPLESEL);
  1530.   ExtendSelects: array[Boolean] of Longword = (0, LBS_EXTENDEDSEL);
  1531.   IntegralHeights: array[Boolean] of Longword = (LBS_NOINTEGRALHEIGHT, 0);
  1532.   MultiColumns: array[Boolean] of Longword = (0, LBS_MULTICOLUMN);
  1533.   TabStops: array[Boolean] of Longword = (0, LBS_USETABSTOPS);
  1534. var
  1535.   Selects: PSelects;
  1536. begin
  1537.   inherited CreateParams(Params);
  1538.   CreateSubClass(Params, 'LISTBOX');
  1539.   with Params do begin
  1540. {$IFNDEF WIN32}
  1541.     Inc(X); Inc(Y);
  1542.     Dec(Width, 2); Dec(Height, 2);
  1543. {$ENDIF}
  1544.     Selects := @MultiSelects;
  1545.     if FExtendedSelect then Selects := @ExtendSelects;
  1546.     Style := Style or (WS_HSCROLL or WS_VSCROLL or LBS_HASSTRINGS or
  1547.       LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
  1548.       Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
  1549.       MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
  1550.       TabStops[FTabWidth <> 0];
  1551. {$IFDEF WIN32}
  1552.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
  1553.       Style := Style and not WS_BORDER;
  1554.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  1555.     end;
  1556. {$ENDIF}
  1557.     WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
  1558.   end;
  1559. end;
  1560.  
  1561. procedure TRxCustomListBox.CreateWnd;
  1562. var
  1563.   W, H: Integer;
  1564. begin
  1565.   W := Width;
  1566.   H := Height;
  1567.   inherited CreateWnd;
  1568.   SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
  1569.   if FTabWidth <> 0 then
  1570.     SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
  1571.   SetColumnWidth;
  1572.   if FSaveItems <> nil then begin
  1573.     FItems.Assign(FSaveItems);
  1574.     SetTopIndex(FSaveTopIndex);
  1575.     SetItemIndex(FSaveItemIndex);
  1576.     FSaveItems.Free;
  1577.     FSaveItems := nil;
  1578.   end;
  1579. end;
  1580.  
  1581. procedure TRxCustomListBox.DestroyWnd;
  1582. begin
  1583.   if FItems.Count > 0 then begin
  1584.     FSaveItems := TStringList.Create;
  1585.     FSaveItems.Assign(FItems);
  1586.     FSaveTopIndex := GetTopIndex;
  1587.     FSaveItemIndex := GetItemIndex;
  1588.   end;
  1589.   inherited DestroyWnd;
  1590. end;
  1591.  
  1592. procedure TRxCustomListBox.WndProc(var Message: TMessage);
  1593. begin
  1594.   if AutoScroll then begin
  1595.     case Message.Msg of
  1596.       LB_ADDSTRING, LB_INSERTSTRING:
  1597.         begin
  1598.           inherited WndProc(Message);
  1599.           FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(Message.Result));
  1600.           SetHorizontalExtent;
  1601.           Exit;
  1602.         end;
  1603.       LB_DELETESTRING:
  1604.         begin
  1605.           if GetItemWidth(Message.wParam) >= FMaxItemWidth then begin
  1606.             Perform(WM_HSCROLL, SB_TOP, 0);
  1607.             inherited WndProc(Message);
  1608.             ResetHorizontalExtent;
  1609.           end
  1610.           else inherited WndProc(Message);
  1611.           Exit;
  1612.         end;
  1613.       LB_RESETCONTENT:
  1614.         begin
  1615.           FMaxItemWidth := 0;
  1616.           SetHorizontalExtent;
  1617.           Perform(WM_HSCROLL, SB_TOP, 0);
  1618.           inherited WndProc(Message);
  1619.           Exit;
  1620.         end;
  1621.       WM_SETFONT:
  1622.         begin
  1623.           inherited WndProc(Message);
  1624.           Canvas.Font.Assign(Self.Font);
  1625.           ResetHorizontalExtent;
  1626.           Exit;
  1627.         end;
  1628.     end;
  1629.   end;
  1630.   {for auto drag mode, let listbox handle itself, instead of TControl}
  1631.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  1632.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
  1633.   begin
  1634.     if DragMode = dmAutomatic then begin
  1635.       if IsControlMouseMsg(TWMMouse(Message)) then Exit;
  1636.       ControlState := ControlState + [csLButtonDown];
  1637.       Dispatch(Message);  {overrides TControl's BeginDrag}
  1638.       Exit;
  1639.     end;
  1640.   end;
  1641.   inherited WndProc(Message);
  1642. end;
  1643.  
  1644. procedure TRxCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
  1645. var
  1646.   ItemNo: Integer;
  1647.   ShiftState: TShiftState;
  1648. begin
  1649.   ShiftState := KeysToShiftState(Message.Keys);
  1650.   if (DragMode = dmAutomatic) and FMultiSelect then begin
  1651.     if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then begin
  1652.       ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
  1653.       if (ItemNo >= 0) and (Selected[ItemNo]) then begin
  1654.         BeginDrag(False);
  1655.         Exit;
  1656.       end;
  1657.     end;
  1658.   end;
  1659.   inherited;
  1660.   if (DragMode = dmAutomatic) and not (FMultiSelect and
  1661.     ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
  1662.     BeginDrag(False);
  1663. end;
  1664.  
  1665. procedure TRxCustomListBox.WMNCHitTest(var Msg: TWMNCHitTest);
  1666. begin
  1667.   if csDesigning in ComponentState then DefaultHandler(Msg)
  1668.   else inherited;
  1669. end;
  1670.  
  1671. procedure TRxCustomListBox.CNCommand(var Message: TWMCommand);
  1672. begin
  1673.   case Message.NotifyCode of
  1674.     LBN_SELCHANGE:
  1675.       begin
  1676. {$IFDEF RX_D3}
  1677.         inherited Changed;
  1678. {$ENDIF}
  1679.         Click;
  1680.       end;
  1681.     LBN_DBLCLK: DblClick;
  1682.   end;
  1683. end;
  1684.  
  1685. procedure TRxCustomListBox.WMPaint(var Message: TWMPaint);
  1686.  
  1687.   procedure PaintListBox;
  1688.   var
  1689.     DrawItemMsg: TWMDrawItem;
  1690.     MeasureItemMsg: TWMMeasureItem;
  1691.     DrawItemStruct: TDrawItemStruct;
  1692.     MeasureItemStruct: TMeasureItemStruct;
  1693.     R: TRect;
  1694.     Y, I, H, W: Integer;
  1695.   begin
  1696.     { Initialize drawing records }
  1697.     DrawItemMsg.Msg := CN_DRAWITEM;
  1698.     DrawItemMsg.DrawItemStruct := @DrawItemStruct;
  1699.     DrawItemMsg.Ctl := Handle;
  1700.     DrawItemStruct.CtlType := ODT_LISTBOX;
  1701.     DrawItemStruct.itemAction := ODA_DRAWENTIRE;
  1702.     DrawItemStruct.itemState := 0;
  1703.     DrawItemStruct.hDC := Message.DC;
  1704.     DrawItemStruct.CtlID := Handle;
  1705.     DrawItemStruct.hwndItem := Handle;
  1706.     { Intialize measure records }
  1707.     MeasureItemMsg.Msg := CN_MEASUREITEM;
  1708.     MeasureItemMsg.IDCtl := Handle;
  1709.     MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
  1710.     MeasureItemStruct.CtlType := ODT_LISTBOX;
  1711.     MeasureItemStruct.CtlID := Handle;
  1712.     { Draw the listbox }
  1713.     Y := 0;
  1714.     I := TopIndex;
  1715.     GetClipBox(Message.DC, R);
  1716.     H := Height;
  1717.     W := Width;
  1718.     while Y < H do begin
  1719.       MeasureItemStruct.itemID := I;
  1720.       if I < Items.Count then
  1721.         MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
  1722.       MeasureItemStruct.itemWidth := W;
  1723.       MeasureItemStruct.itemHeight := FItemHeight;
  1724.       DrawItemStruct.itemData := MeasureItemStruct.itemData;
  1725.       DrawItemStruct.itemID := I;
  1726.       Dispatch(MeasureItemMsg);
  1727.       DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
  1728.         Y + Integer(MeasureItemStruct.itemHeight));
  1729.       Dispatch(DrawItemMsg);
  1730.       Inc(Y, MeasureItemStruct.itemHeight);
  1731.       Inc(I);
  1732.       if I >= Items.Count then break;
  1733.     end;
  1734.   end;
  1735.  
  1736. begin
  1737.   if Message.DC <> 0 then PaintListBox
  1738.   else inherited;
  1739. end;
  1740.  
  1741. procedure TRxCustomListBox.WMSize(var Message: TWMSize);
  1742. begin
  1743.   inherited;
  1744.   SetColumnWidth;
  1745. end;
  1746.  
  1747. procedure TRxCustomListBox.DragCanceled;
  1748. var
  1749.   M: TWMMouse;
  1750. {$IFDEF WIN32}
  1751.   MousePos: TPoint;
  1752. {$ENDIF}
  1753. begin
  1754.   with M do begin
  1755.     Msg := WM_LBUTTONDOWN;
  1756. {$IFDEF WIN32}
  1757.     GetCursorPos(MousePos);
  1758.     Pos := PointToSmallPoint(ScreenToClient(MousePos));
  1759. {$ELSE}
  1760.     GetCursorPos(Pos);
  1761.     Pos := ScreenToClient(Pos);
  1762. {$ENDIF}
  1763.     Keys := 0;
  1764.     Result := 0;
  1765.   end;
  1766.   DefaultHandler(M);
  1767.   M.Msg := WM_LBUTTONUP;
  1768.   DefaultHandler(M);
  1769. end;
  1770.  
  1771. procedure TRxCustomListBox.DefaultDrawText(X, Y: Integer; const S: string);
  1772. var
  1773.   ATabWidth: Longint;
  1774. begin
  1775. {$IFDEF RX_D4}
  1776.   TControlCanvas(FCanvas).UpdateTextFlags;
  1777. {$ENDIF}
  1778.   if FTabWidth = 0 then FCanvas.TextOut(X, Y, S)
  1779.   else begin
  1780.     ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
  1781.     TabbedTextOut(FCanvas.Handle, X, Y, @S[1], Length(S), 1, ATabWidth, X);
  1782.   end;
  1783. end;
  1784.  
  1785. procedure TRxCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  1786.   State: TOwnerDrawState);
  1787. begin
  1788.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
  1789.   else begin
  1790.     FCanvas.FillRect(Rect);
  1791.     if Index < Items.Count then begin
  1792. {$IFDEF RX_D4}
  1793.       if not UseRightToLeftAlignment then Inc(Rect.Left, 2)
  1794.       else Dec(Rect.Right, 2);
  1795. {$ELSE}
  1796.       Inc(Rect.Left, 2);
  1797. {$ENDIF}
  1798.       DefaultDrawText(Rect.Left, Max(Rect.Top, (Rect.Bottom +
  1799.         Rect.Top - Canvas.TextHeight('Wy')) div 2), Items[Index]);
  1800.     end;
  1801.   end;
  1802. end;
  1803.  
  1804. procedure TRxCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
  1805. begin
  1806.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  1807. end;
  1808.  
  1809. procedure TRxCustomListBox.CNDrawItem(var Message: TWMDrawItem);
  1810. var
  1811.   State: TOwnerDrawState;
  1812. begin
  1813.   with Message.DrawItemStruct^ do begin
  1814. {$IFDEF WIN32}
  1815.  {$IFDEF RX_D5}
  1816.     State := TOwnerDrawState(LongRec(itemState).Lo);
  1817.  {$ELSE}
  1818.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1819.  {$ENDIF}
  1820. {$ELSE}
  1821.     State := TOwnerDrawState(WordRec(itemState).Lo);
  1822. {$ENDIF}
  1823.     FCanvas.Handle := hDC;
  1824.     FCanvas.Font := Font;
  1825.     FCanvas.Brush := Brush;
  1826.     if (Integer(itemID) >= 0) and (odSelected in State) then begin
  1827.       with FCanvas do
  1828.         if not (csDesigning in ComponentState) and FGraySelection and
  1829.           not Focused then
  1830.         begin
  1831.           Brush.Color := clBtnFace;
  1832.           if ColorToRGB(Font.Color) = ColorToRGB(clBtnFace) then
  1833.             Font.Color := clBtnText;
  1834.         end
  1835.         else begin
  1836.           Brush.Color := clHighlight;
  1837.           Font.Color := clHighlightText
  1838.         end;
  1839.     end;
  1840.     if Integer(itemID) >= 0 then DrawItem(itemID, rcItem, State)
  1841.     else FCanvas.FillRect(rcItem);
  1842.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  1843.     FCanvas.Handle := 0;
  1844.   end;
  1845. end;
  1846.  
  1847. procedure TRxCustomListBox.CNMeasureItem(var Message: TWMMeasureItem);
  1848. begin
  1849.   with Message.MeasureItemStruct^ do begin
  1850.     itemHeight := FItemHeight;
  1851.     if FStyle = lbOwnerDrawVariable then
  1852.       MeasureItem(itemID, Integer(itemHeight));
  1853.   end;
  1854. end;
  1855.  
  1856. procedure TRxCustomListBox.WMKillFocus(var Msg: TWMKillFocus);
  1857. begin
  1858.   inherited;
  1859.   if FGraySelection and MultiSelect and (SelCount > 1) then Invalidate;
  1860. end;
  1861.  
  1862. procedure TRxCustomListBox.WMSetFocus(var Msg: TWMSetFocus);
  1863. begin
  1864.   inherited;
  1865.   if FGraySelection and MultiSelect and (SelCount > 1) then Invalidate;
  1866. end;
  1867.  
  1868. {$IFDEF WIN32}
  1869. procedure TRxCustomListBox.CMCtl3DChanged(var Message: TMessage);
  1870. begin
  1871.   if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  1872.   inherited;
  1873. end;
  1874. {$ENDIF}
  1875.  
  1876. { TCheckListBoxItem }
  1877.  
  1878. type
  1879.   TCheckListBoxItem = class
  1880.   private
  1881.     FData: LongInt;
  1882.     FState: TCheckBoxState;
  1883.     FEnabled: Boolean;
  1884.     function GetChecked: Boolean;
  1885.   public
  1886.     constructor Create;
  1887.     property Checked: Boolean read GetChecked;
  1888.     property Enabled: Boolean read FEnabled write FEnabled;
  1889.     property State: TCheckBoxState read FState write FState;
  1890.   end;
  1891.  
  1892. constructor TCheckListBoxItem.Create;
  1893. begin
  1894.   inherited Create;
  1895.   FState := clbDefaultState;
  1896.   FEnabled := clbDefaultEnabled;
  1897. end;
  1898.  
  1899. function TCheckListBoxItem.GetChecked: Boolean;
  1900. begin
  1901.   Result := FState = cbChecked;
  1902. end;
  1903.  
  1904. { TCheckListBoxStrings }
  1905.  
  1906. type
  1907.   TCheckListBoxStrings = class(TRxListBoxStrings)
  1908.   public
  1909.     procedure Exchange(Index1, Index2: Integer); override;
  1910.     procedure Move(CurIndex, NewIndex: Integer); override;
  1911.   end;
  1912.  
  1913. procedure TCheckListBoxStrings.Exchange(Index1, Index2: Integer);
  1914. var
  1915.   TempEnabled1, TempEnabled2: Boolean;
  1916.   TempState1, TempState2: TCheckBoxState;
  1917. begin
  1918.   with TRxCheckListBox(ListBox) do begin
  1919.     TempState1 := State[Index1];
  1920.     TempEnabled1 := EnabledItem[Index1];
  1921.     TempState2 := State[Index2];
  1922.     TempEnabled2 := EnabledItem[Index2];
  1923.     inherited Exchange(Index1, Index2);
  1924.     State[Index1] := TempState2;
  1925.     EnabledItem[Index1] := TempEnabled2;
  1926.     State[Index2] := TempState1;
  1927.     EnabledItem[Index2] := TempEnabled1;
  1928.   end;
  1929. end;
  1930.  
  1931. procedure TCheckListBoxStrings.Move(CurIndex, NewIndex: Integer);
  1932. var
  1933.   TempEnabled: Boolean;
  1934.   TempState: TCheckBoxState;
  1935. begin
  1936.   with TRxCheckListBox(ListBox) do begin
  1937.     TempState := State[CurIndex];
  1938.     TempEnabled := EnabledItem[CurIndex];
  1939.     inherited Move(CurIndex, NewIndex);
  1940.     State[NewIndex] := TempState;
  1941.     EnabledItem[NewIndex] := TempEnabled;
  1942.   end;
  1943. end;
  1944.  
  1945. { TRxCheckListBox }
  1946.  
  1947. const
  1948.   FCheckBitmap: TBitmap = nil;
  1949.  
  1950. function CheckBitmap: TBitmap;
  1951. begin
  1952.   if FCheckBitmap = nil then begin
  1953.     FCheckBitmap := TBitmap.Create;
  1954.     FCheckBitmap.Handle := LoadBitmap(hInstance, 'CHECK_IMAGES');
  1955.   end;
  1956.   Result := FCheckBitmap;
  1957. end;
  1958.  
  1959. procedure DestroyLocals; far;
  1960. begin
  1961.   if FCheckBitmap <> nil then begin
  1962.     FCheckBitmap.Free;
  1963.     FCheckBitmap := nil;
  1964.   end;
  1965. end;
  1966.  
  1967. const
  1968.   InternalVersion = 202; { for backward compatibility only }
  1969.  
  1970. constructor TRxCheckListBox.Create(AOwner: TComponent);
  1971. begin
  1972.   inherited Create(AOwner);
  1973.   FAutoScroll := True;
  1974.   with CheckBitmap do begin
  1975.     FCheckWidth := Width div 6;
  1976.     FCheckHeight := Height div 3;
  1977.   end;
  1978.   FDrawBitmap := TBitmap.Create;
  1979.   with FDrawBitmap do begin
  1980.     Width := FCheckWidth;
  1981.     Height := FCheckHeight;
  1982.   end;
  1983.   FIniLink := TIniLink.Create;
  1984.   FIniLink.OnSave := IniSave;
  1985.   FIniLink.OnLoad := IniLoad;
  1986. end;
  1987.  
  1988. destructor TRxCheckListBox.Destroy;
  1989. begin
  1990.   FSaveStates.Free;
  1991.   FSaveStates := nil;
  1992.   FDrawBitmap.Free;
  1993.   FDrawBitmap := nil;
  1994.   FIniLink.Free;
  1995.   inherited Destroy;
  1996. end;
  1997.  
  1998. procedure TRxCheckListBox.Loaded;
  1999. begin
  2000.   inherited Loaded;
  2001.   UpdateCheckStates;
  2002. end;
  2003.  
  2004. function TRxCheckListBox.CreateItemList: TStrings;
  2005. begin
  2006.   Result := TCheckListBoxStrings.Create;
  2007. end;
  2008.  
  2009. const
  2010.   sCount = 'Count';
  2011.   sItem = 'Item';
  2012.  
  2013. procedure TRxCheckListBox.InternalSaveStates(IniFile: TObject;
  2014.   const Section: string);
  2015. var
  2016.   I: Integer;
  2017. begin
  2018.   IniEraseSection(IniFile, Section);
  2019.   IniWriteInteger(IniFile, Section, sCount, Items.Count);
  2020.   for I := 0 to Items.Count - 1 do
  2021.     IniWriteInteger(IniFile, Section, sItem + IntToStr(I), Integer(State[I]));
  2022. end;
  2023.  
  2024. procedure TRxCheckListBox.InternalRestoreStates(IniFile: TObject;
  2025.   const Section: string);
  2026. var
  2027.   I: Integer;
  2028.   ACount: Integer;
  2029. begin
  2030.   ACount := Min(IniReadInteger(IniFile, Section, sCount, 0), Items.Count);
  2031.   for I := 0 to ACount - 1 do begin
  2032.     State[I] := TCheckBoxState(IniReadInteger(IniFile, Section,
  2033.       sItem + IntToStr(I), Integer(clbDefaultState)));
  2034.     if (State[I] = cbChecked) and (FCheckKind = ckRadioButtons) then Exit;
  2035.   end;
  2036. end;
  2037.  
  2038. {$IFDEF WIN32}
  2039. procedure TRxCheckListBox.SaveStatesReg(IniFile: TRegIniFile);
  2040. begin
  2041.   InternalSaveStates(IniFile, GetDefaultSection(Self));
  2042. end;
  2043.  
  2044. procedure TRxCheckListBox.RestoreStatesReg(IniFile: TRegIniFile);
  2045. begin
  2046.   InternalRestoreStates(IniFile, GetDefaultSection(Self));
  2047. end;
  2048. {$ENDIF WIN32}
  2049.  
  2050. procedure TRxCheckListBox.SaveStates(IniFile: TIniFile);
  2051. begin
  2052.   InternalSaveStates(IniFile, GetDefaultSection(Self));
  2053. end;
  2054.  
  2055. procedure TRxCheckListBox.RestoreStates(IniFile: TIniFile);
  2056. begin
  2057.   InternalRestoreStates(IniFile, GetDefaultSection(Self));
  2058. end;
  2059.  
  2060. function TRxCheckListBox.GetStorage: TFormPlacement;
  2061. begin
  2062.   Result := FIniLink.Storage;
  2063. end;
  2064.  
  2065. procedure TRxCheckListBox.SetStorage(Value: TFormPlacement);
  2066. begin
  2067.   FIniLink.Storage := Value;
  2068. end;
  2069.  
  2070. procedure TRxCheckListBox.IniSave(Sender: TObject);
  2071. begin
  2072.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  2073.     InternalSaveStates(FIniLink.IniObject, FIniLink.RootSection +
  2074.       GetDefaultSection(Self));
  2075. end;
  2076.  
  2077. procedure TRxCheckListBox.IniLoad(Sender: TObject);
  2078. begin
  2079.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  2080.     InternalRestoreStates(FIniLink.IniObject, FIniLink.RootSection +
  2081.       GetDefaultSection(Self));
  2082. end;
  2083.  
  2084. procedure TRxCheckListBox.ReadCheckData(Reader: TReader);
  2085. var
  2086.   I: Integer;
  2087. begin
  2088.   Items.BeginUpdate;
  2089.   try
  2090.     Reader.ReadListBegin;
  2091.     Clear;
  2092.     while not Reader.EndOfList do begin
  2093.       I := Items.Add(Reader.ReadString);
  2094.       if FReserved >= InternalVersion then begin
  2095.         State[I] := TCheckBoxState(Reader.ReadInteger);
  2096.         EnabledItem[I] := Reader.ReadBoolean;
  2097.       end
  2098.       else begin { for backward compatibility only }
  2099.         Checked[I] := Reader.ReadBoolean;
  2100.         EnabledItem[I] := Reader.ReadBoolean;
  2101.         if FReserved > 0 then
  2102.           State[I] := TCheckBoxState(Reader.ReadInteger);
  2103.       end;
  2104.     end;
  2105.     Reader.ReadListEnd;
  2106.     UpdateCheckStates;
  2107.   finally
  2108.     Items.EndUpdate;
  2109.   end;
  2110. end;
  2111.  
  2112. procedure TRxCheckListBox.WriteCheckData(Writer: TWriter);
  2113. var
  2114.   I: Integer;
  2115. begin
  2116.   with Writer do begin
  2117.     WriteListBegin;
  2118.     for I := 0 to Items.Count - 1 do begin
  2119.       WriteString(Items[I]);
  2120.       WriteInteger(Integer(Self.State[I]));
  2121.       WriteBoolean(EnabledItem[I]);
  2122.     end;
  2123.     WriteListEnd;
  2124.   end;
  2125. end;
  2126.  
  2127. procedure TRxCheckListBox.ReadVersion(Reader: TReader);
  2128. begin
  2129.   FReserved := Reader.ReadInteger;
  2130. end;
  2131.  
  2132. procedure TRxCheckListBox.WriteVersion(Writer: TWriter);
  2133. begin
  2134.   Writer.WriteInteger(InternalVersion);
  2135. end;
  2136.  
  2137. procedure TRxCheckListBox.DefineProperties(Filer: TFiler);
  2138.  
  2139. {$IFDEF WIN32}
  2140.   function DoWrite: Boolean;
  2141.   var
  2142.     I: Integer;
  2143.     Ancestor: TRxCheckListBox;
  2144.   begin
  2145.     Result := False;
  2146.     Ancestor := TRxCheckListBox(Filer.Ancestor);
  2147.     if (Ancestor <> nil) and (Ancestor.Items.Count = Items.Count) and
  2148.       (Ancestor.Items.Count > 0) then
  2149.       for I := 1 to Items.Count - 1 do begin
  2150.         Result := (CompareText(Items[I], Ancestor.Items[I]) <> 0) or
  2151.           (State[I] <> Ancestor.State[I]) or
  2152.           (EnabledItem[I] <> Ancestor.EnabledItem[I]);
  2153.         if Result then Break;
  2154.       end
  2155.     else Result := Items.Count > 0;
  2156.   end;
  2157. {$ENDIF}
  2158.  
  2159. begin
  2160.   inherited DefineProperties(Filer);
  2161.   Filer.DefineProperty('InternalVersion', ReadVersion, WriteVersion,
  2162.     {$IFDEF WIN32} Filer.Ancestor = nil {$ELSE} True {$ENDIF});
  2163.   Filer.DefineProperty('Strings', ReadCheckData, WriteCheckData,
  2164.     {$IFDEF WIN32} DoWrite {$ELSE} Items.Count > 0 {$ENDIF});
  2165. end;
  2166.  
  2167. procedure TRxCheckListBox.CreateWnd;
  2168. begin
  2169.   inherited CreateWnd;
  2170.   if FSaveStates <> nil then begin
  2171.     FSaveStates.Free;
  2172.     FSaveStates := nil;
  2173.   end;
  2174.   ResetItemHeight;
  2175. end;
  2176.  
  2177. procedure TRxCheckListBox.DestroyWnd;
  2178. begin
  2179.   inherited DestroyWnd;
  2180. end;
  2181.  
  2182. procedure TRxCheckListBox.WMDestroy(var Msg: TWMDestroy);
  2183. var
  2184.   I: Integer;
  2185. begin
  2186.   if Items.Count > 0 then begin
  2187.     if FSaveStates <> nil then FSaveStates.Clear
  2188.     else FSaveStates := TList.Create;
  2189.     for I := 0 to Items.Count - 1 do begin
  2190.       FSaveStates.Add(TObject(MakeLong(Ord(EnabledItem[I]), Word(State[I]))));
  2191.       FindCheckObject(I).Free;
  2192.     end;
  2193.   end;
  2194.   inherited;
  2195. end;
  2196.  
  2197. procedure TRxCheckListBox.CreateParams(var Params: TCreateParams);
  2198. begin
  2199.   inherited CreateParams(Params);
  2200.   with Params do
  2201.     if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
  2202.       Style := Style or LBS_OWNERDRAWFIXED;
  2203. end;
  2204.  
  2205. procedure TRxCheckListBox.SetItems(Value: TStrings);
  2206. var
  2207.   I: Integer;
  2208. begin
  2209.   Items.BeginUpdate;
  2210.   try
  2211.     inherited SetItems(Value);
  2212.     if (Value <> nil) and (Value is TRxListBoxStrings) and
  2213.       (TRxListBoxStrings(Value).ListBox <> nil) and
  2214.       (TRxListBoxStrings(Value).ListBox is TRxCheckListBox) then
  2215.     begin
  2216.       for I := 0 to Items.Count - 1 do
  2217.         if I < Value.Count then begin
  2218.           Self.State[I] := TRxCheckListBox(TRxListBoxStrings(Value).ListBox).State[I];
  2219.           EnabledItem[I] := TRxCheckListBox(TRxListBoxStrings(Value).ListBox).EnabledItem[I];
  2220.         end;
  2221.     end;
  2222.   finally
  2223.     Items.EndUpdate;
  2224.   end;
  2225. end;
  2226.  
  2227. function TRxCheckListBox.GetItemWidth(Index: Integer): Integer;
  2228. begin
  2229.   Result := inherited GetItemWidth(Index) + GetCheckWidth;
  2230. end;
  2231.  
  2232. function TRxCheckListBox.GetCheckWidth: Integer;
  2233. begin
  2234.   Result := FCheckWidth + 2;
  2235. end;
  2236.  
  2237. function TRxCheckListBox.GetAllowGrayed: Boolean;
  2238. begin
  2239.   Result := FAllowGrayed and (FCheckKind in [ckCheckBoxes, ckCheckMarks]);
  2240. end;
  2241.  
  2242. procedure TRxCheckListBox.CMFontChanged(var Message: TMessage);
  2243. begin
  2244.   inherited;
  2245.   ResetItemHeight;
  2246. end;
  2247.  
  2248. function TRxCheckListBox.GetItemHeight: Integer;
  2249. var
  2250.   R: TRect;
  2251. begin
  2252.   Result := FItemHeight;
  2253.   if HandleAllocated and ((FStyle = lbStandard) or
  2254.     ((FStyle = lbOwnerDrawFixed) and not Assigned(FOnDrawItem))) then
  2255.   begin
  2256.     Perform(LB_GETITEMRECT, 0, Longint(@R));
  2257.     Result := R.Bottom - R.Top;
  2258.   end;
  2259. end;
  2260.  
  2261. procedure TRxCheckListBox.ResetItemHeight;
  2262. var
  2263.   H: Integer;
  2264. begin
  2265.   if (Style = lbStandard) or ((Style = lbOwnerDrawFixed) and
  2266.     not Assigned(FOnDrawItem)) then
  2267.   begin
  2268.     Canvas.Font := Font;
  2269.     H := Max(Canvas.TextHeight('Wg'), FCheckHeight);
  2270.     if Style = lbOwnerDrawFixed then H := Max(H, FItemHeight);
  2271.     Perform(LB_SETITEMHEIGHT, 0, H);
  2272.     if (H * Items.Count) <= ClientHeight then
  2273.       SetScrollRange(Handle, SB_VERT, 0, 0, True);
  2274.   end;
  2275. end;
  2276.  
  2277. procedure TRxCheckListBox.DrawItem(Index: Integer; Rect: TRect;
  2278.   State: TOwnerDrawState);
  2279. var
  2280.   R: TRect;
  2281.   SaveEvent: TDrawItemEvent;
  2282. begin
  2283.   if Index < Items.Count then begin
  2284.     R := Rect;
  2285. {$IFDEF RX_D4}
  2286.     if not UseRightToLeftAlignment then begin
  2287.       R.Right := Rect.Left;
  2288.       R.Left := R.Right - GetCheckWidth;
  2289.     end
  2290.     else
  2291.     begin
  2292.       R.Left := Rect.Right;
  2293.       R.Right := R.Left + GetCheckWidth;
  2294.     end;
  2295. {$ELSE}
  2296.     R.Right := Rect.Left;
  2297.     R.Left := R.Right - GetCheckWidth;
  2298. {$ENDIF}
  2299.     DrawCheck(R, GetState(Index), EnabledItem[Index]);
  2300.     if not EnabledItem[Index] then
  2301.       if odSelected in State then Canvas.Font.Color := clInactiveCaptionText
  2302.       else Canvas.Font.Color := clGrayText;
  2303.   end;
  2304.   if (Style = lbStandard) and Assigned(FOnDrawItem) then begin
  2305.     SaveEvent := OnDrawItem;
  2306.     OnDrawItem := nil;
  2307.     try
  2308.       inherited DrawItem(Index, Rect, State);
  2309.     finally
  2310.       OnDrawItem := SaveEvent;
  2311.     end;
  2312.   end
  2313.   else inherited DrawItem(Index, Rect, State);
  2314. end;
  2315.  
  2316. procedure TRxCheckListBox.CNDrawItem(var Message: TWMDrawItem);
  2317. begin
  2318.   with Message.DrawItemStruct^ do
  2319. {$IFDEF RX_D4}
  2320.     if not UseRightToLeftAlignment then
  2321.       rcItem.Left := rcItem.Left + GetCheckWidth
  2322.     else
  2323.       rcItem.Right := rcItem.Right - GetCheckWidth;
  2324. {$ELSE}
  2325.     rcItem.Left := rcItem.Left + GetCheckWidth;
  2326. {$ENDIF}
  2327.   inherited;
  2328. end;
  2329.  
  2330. procedure TRxCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState;
  2331.   Enabled: Boolean);
  2332. const
  2333.   CheckImages: array[TCheckBoxState, TCheckKind, Boolean] of Integer =
  2334.     (((3, 0), (9,  6), (15, 12)),   { unchecked }
  2335.      ((4, 1), (10, 7), (16, 13)),   { checked   }
  2336.      ((5, 2), (11, 8), (17, 14)));  { grayed    }
  2337. var
  2338.   DrawRect: TRect;
  2339.   SaveColor: TColor;
  2340. begin
  2341.   DrawRect.Left := R.Left + (R.Right - R.Left - FCheckWidth) div 2;
  2342.   DrawRect.Top := R.Top + (R.Bottom - R.Top - FCheckHeight) div 2;
  2343.   DrawRect.Right := DrawRect.Left + FCheckWidth;
  2344.   DrawRect.Bottom := DrawRect.Top + FCheckHeight;
  2345.   SaveColor := Canvas.Brush.Color;
  2346.   AssignBitmapCell(CheckBitmap, FDrawBitmap, 6, 3,
  2347.     CheckImages[AState, FCheckKind, Enabled]);
  2348.   Canvas.Brush.Color := Self.Color;
  2349.   try
  2350.     Canvas.BrushCopy(DrawRect, FDrawBitmap, Bounds(0, 0, FCheckWidth,
  2351.       FCheckHeight), CheckBitmap.TransparentColor and not PaletteMask);
  2352.   finally
  2353.     Canvas.Brush.Color := SaveColor;
  2354.   end;
  2355. end;
  2356.  
  2357. procedure TRxCheckListBox.ApplyState(AState: TCheckBoxState;
  2358.   EnabledOnly: Boolean);
  2359. var
  2360.   I: Integer;
  2361. begin
  2362.   if FCheckKind in [ckCheckBoxes, ckCheckMarks] then
  2363.     for I := 0 to Items.Count - 1 do
  2364.       if not EnabledOnly or EnabledItem[I] then begin
  2365.         State[I] := AState;
  2366.       end;
  2367. end;
  2368.  
  2369. function TRxCheckListBox.GetCheckedIndex: Integer;
  2370. var
  2371.   I: Integer;
  2372. begin
  2373.   Result := -1;
  2374.   if FCheckKind = ckRadioButtons then
  2375.     for I := 0 to Items.Count - 1 do
  2376.       if State[I] = cbChecked then begin
  2377.         Result := I;
  2378.         Exit;
  2379.       end;
  2380. end;
  2381.  
  2382. procedure TRxCheckListBox.SetCheckedIndex(Value: Integer);
  2383. begin
  2384.   if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then
  2385.     SetState(Max(Value, 0), cbChecked);
  2386. end;
  2387.  
  2388. procedure TRxCheckListBox.UpdateCheckStates;
  2389. begin
  2390.   if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then begin
  2391.     FInUpdateStates := True;
  2392.     try
  2393.       SetState(Max(GetCheckedIndex, 0), cbChecked);
  2394.     finally
  2395.       FInUpdateStates := False;
  2396.     end;
  2397.   end;
  2398. end;
  2399.  
  2400. procedure TRxCheckListBox.SetCheckKind(Value: TCheckKind);
  2401. begin
  2402.   if FCheckKind <> Value then begin
  2403.     FCheckKind := Value;
  2404.     UpdateCheckStates;
  2405.     Invalidate;
  2406.   end;
  2407. end;
  2408.  
  2409. procedure TRxCheckListBox.SetChecked(Index: Integer; AChecked: Boolean);
  2410. const
  2411.   CheckStates: array[Boolean] of TCheckBoxState = (cbUnchecked, cbChecked);
  2412. begin
  2413.   SetState(Index, CheckStates[AChecked]);
  2414. end;
  2415.  
  2416. procedure TRxCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
  2417. var
  2418.   I: Integer;
  2419. begin
  2420.   if (AState <> GetState(Index)) or FInUpdateStates then begin
  2421.     if (FCheckKind = ckRadioButtons) and (AState = cbUnchecked) and
  2422.       (GetCheckedIndex = Index) then Exit;
  2423.     TCheckListBoxItem(GetCheckObject(Index)).State := AState;
  2424.     if (FCheckKind = ckRadioButtons) and (AState = cbChecked) then
  2425.       for I := Items.Count - 1 downto 0 do begin
  2426.         if (I <> Index) and (GetState(I) = cbChecked) then begin
  2427.           TCheckListBoxItem(GetCheckObject(I)).State := cbUnchecked;
  2428.           InvalidateCheck(I);
  2429.         end;
  2430.       end;
  2431.     InvalidateCheck(Index);
  2432.     if not (csReading in ComponentState) then ChangeItemState(Index);
  2433.   end;
  2434. end;
  2435.  
  2436. procedure TRxCheckListBox.SetItemEnabled(Index: Integer; Value: Boolean);
  2437. begin
  2438.   if Value <> GetItemEnabled(Index) then begin
  2439.     TCheckListBoxItem(GetCheckObject(Index)).Enabled := Value;
  2440.     InvalidateItem(Index);
  2441.   end;
  2442. end;
  2443.  
  2444. procedure TRxCheckListBox.InvalidateCheck(Index: Integer);
  2445. var
  2446.   R: TRect;
  2447. begin
  2448.   R := ItemRect(Index);
  2449. {$IFDEF RX_D4}
  2450.   if not UseRightToLeftAlignment then R.Right := R.Left + GetCheckWidth
  2451.   else R.Left := R.Right - GetCheckWidth;
  2452. {$ELSE}
  2453.   R.Right := R.Left + GetCheckWidth;
  2454. {$ENDIF}
  2455.   InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
  2456.   UpdateWindow(Handle);
  2457. end;
  2458.  
  2459. procedure TRxCheckListBox.InvalidateItem(Index: Integer);
  2460. var
  2461.   R: TRect;
  2462. begin
  2463.   R := ItemRect(Index);
  2464.   InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
  2465.   UpdateWindow(Handle);
  2466. end;
  2467.  
  2468. function TRxCheckListBox.GetChecked(Index: Integer): Boolean;
  2469. begin
  2470.   if IsCheckObject(Index) then
  2471.     Result := TCheckListBoxItem(GetCheckObject(Index)).GetChecked
  2472.   else Result := False;
  2473. end;
  2474.  
  2475. function TRxCheckListBox.GetState(Index: Integer): TCheckBoxState;
  2476. begin
  2477.   if IsCheckObject(Index) then
  2478.     Result := TCheckListBoxItem(GetCheckObject(Index)).State
  2479.   else Result := clbDefaultState;
  2480.   if (FCheckKind = ckRadioButtons) and (Result <> cbChecked) then
  2481.     Result := cbUnchecked;
  2482. end;
  2483.  
  2484. function TRxCheckListBox.GetItemEnabled(Index: Integer): Boolean;
  2485. begin
  2486.   if IsCheckObject(Index) then
  2487.     Result := TCheckListBoxItem(GetCheckObject(Index)).Enabled
  2488.   else Result := clbDefaultEnabled;
  2489. end;
  2490.  
  2491. procedure TRxCheckListBox.KeyPress(var Key: Char);
  2492. begin
  2493.   inherited KeyPress(Key);
  2494.   case Key of
  2495.     ' ': 
  2496.       begin
  2497.         ToggleClickCheck(ItemIndex);
  2498.         Key := #0;
  2499.       end;
  2500.     '+':
  2501.       begin
  2502.         ApplyState(cbChecked, True);
  2503.         ClickCheck;
  2504.       end;
  2505.     '-':
  2506.       begin
  2507.         ApplyState(cbUnchecked, True);
  2508.         ClickCheck;
  2509.       end;
  2510.   end;
  2511. end;
  2512.  
  2513. procedure TRxCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2514.   X, Y: Integer);
  2515. var
  2516.   Index: Integer;
  2517. begin
  2518.   inherited MouseDown(Button, Shift, X, Y);
  2519.   if Button = mbLeft then begin
  2520.     Index := ItemAtPos(Point(X,Y), True);
  2521.     if (Index <> -1) then begin
  2522. {$IFDEF RX_D4}
  2523.       if not UseRightToLeftAlignment then begin
  2524.         if X - ItemRect(Index).Left < GetCheckWidth then
  2525.           ToggleClickCheck(Index);
  2526.       end
  2527.       else begin
  2528.         Dec(X, ItemRect(Index).Right - GetCheckWidth);
  2529.         if (X > 0) and (X < GetCheckWidth) then
  2530.           ToggleClickCheck(Index);
  2531.       end;
  2532. {$ELSE}
  2533.       if X - ItemRect(Index).Left < GetCheckWidth then
  2534.         ToggleClickCheck(Index);
  2535. {$ENDIF}
  2536.     end;
  2537.   end;
  2538. end;
  2539.  
  2540. procedure TRxCheckListBox.ToggleClickCheck(Index: Integer);
  2541. var
  2542.   State: TCheckBoxState;
  2543. begin
  2544.   if (Index >= 0) and (Index < Items.Count) and EnabledItem[Index] then begin
  2545.     State := Self.State[Index];
  2546.     case State of
  2547.       cbUnchecked:
  2548.         if AllowGrayed then State := cbGrayed else State := cbChecked;
  2549.       cbChecked: State := cbUnchecked;
  2550.       cbGrayed: State := cbChecked;
  2551.     end;
  2552.     Self.State[Index] := State;
  2553.     ClickCheck;
  2554.   end;
  2555. end;
  2556.  
  2557. procedure TRxCheckListBox.ChangeItemState(Index: Integer);
  2558. begin
  2559.   if Assigned(FOnStateChange) then FOnStateChange(Self, Index);
  2560. end;
  2561.  
  2562. procedure TRxCheckListBox.ClickCheck;
  2563. begin
  2564.   if Assigned(FOnClickCheck) then FOnClickCheck(Self);
  2565. end;
  2566.  
  2567. function TRxCheckListBox.GetItemData(Index: Integer): LongInt;
  2568. var
  2569.   Item: TCheckListBoxItem;
  2570. begin
  2571.   Result := 0;
  2572.   if IsCheckObject(Index) then begin
  2573.     Item := TCheckListBoxItem(GetCheckObject(Index));
  2574.     if Item <> nil then Result := Item.FData;
  2575.   end;
  2576. end;
  2577.  
  2578. function TRxCheckListBox.GetCheckObject(Index: Integer): TObject;
  2579. begin
  2580.   Result := FindCheckObject(Index);
  2581.   if Result = nil then Result := CreateCheckObject(Index);
  2582. end;
  2583.  
  2584. function TRxCheckListBox.FindCheckObject(Index: Integer): TObject;
  2585. var
  2586.   ItemData: Longint;
  2587. begin
  2588.   Result := nil;
  2589.   ItemData := inherited GetItemData(Index);
  2590.   if ItemData = LB_ERR then ListIndexError(Index)
  2591.   else begin
  2592.     Result := TCheckListBoxItem(ItemData);
  2593.     if not (Result is TCheckListBoxItem) then Result := nil;
  2594.   end;
  2595. end;
  2596.  
  2597. function TRxCheckListBox.CreateCheckObject(Index: Integer): TObject;
  2598. begin
  2599.   Result := TCheckListBoxItem.Create;
  2600.   inherited SetItemData(Index, LongInt(Result));
  2601. end;
  2602.  
  2603. function TRxCheckListBox.IsCheckObject(Index: Integer): Boolean;
  2604. begin
  2605.   Result := FindCheckObject(Index) <> nil;
  2606. end;
  2607.  
  2608. procedure TRxCheckListBox.SetItemData(Index: Integer; AData: LongInt);
  2609. var
  2610.   Item: TCheckListBoxItem;
  2611.   L: Longint;
  2612. begin
  2613.   Item := TCheckListBoxItem(GetCheckObject(Index));
  2614.   Item.FData := AData;
  2615.   if (FSaveStates <> nil) and (FSaveStates.Count > 0) then begin
  2616.     L := Longint(Pointer(FSaveStates[0]));
  2617.     Item.FState := TCheckBoxState(LongRec(L).Hi);
  2618.     Item.FEnabled := LongRec(L).Lo <> 0;
  2619.     FSaveStates.Delete(0);
  2620.   end;
  2621. end;
  2622.  
  2623. procedure TRxCheckListBox.ResetContent;
  2624. var
  2625.   I: Integer;
  2626. begin
  2627.   for I := Items.Count - 1 downto 0 do begin
  2628.     if IsCheckObject(I) then GetCheckObject(I).Free;
  2629.     inherited SetItemData(I, 0);
  2630.   end;
  2631.   inherited ResetContent;
  2632. end;
  2633.  
  2634. procedure TRxCheckListBox.DeleteString(Index: Integer);
  2635. begin
  2636.   if IsCheckObject(Index) then GetCheckObject(Index).Free;
  2637.   inherited SetItemData(Index, 0);
  2638.   inherited DeleteString(Index);
  2639. end;
  2640.  
  2641. { TRxCustomLabel }
  2642.  
  2643. function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
  2644.   Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
  2645.   ShadowPos: TShadowPosition): Integer;
  2646. var
  2647.   RText, RShadow: TRect;
  2648.   Color: TColorRef;
  2649. begin
  2650.   RText := Rect;
  2651.   RShadow := Rect;
  2652.   Color := SetTextColor(DC, ShadowColor);
  2653.   case ShadowPos of
  2654.     spLeftTop: OffsetRect(RShadow, -ShadowSize, -ShadowSize);
  2655.     spRightBottom: OffsetRect(RShadow, ShadowSize, ShadowSize);
  2656.     spLeftBottom:
  2657.       begin
  2658.         {OffsetRect(RText, ShadowSize, 0);}
  2659.         OffsetRect(RShadow, -ShadowSize, ShadowSize);
  2660.       end;
  2661.     spRightTop:
  2662.       begin
  2663.         {OffsetRect(RText, 0, ShadowSize);}
  2664.         OffsetRect(RShadow, ShadowSize, -ShadowSize);
  2665.       end;
  2666.   end; { case }
  2667.   Result := DrawText(DC, Str, Count, RShadow, Format);
  2668.   if Result > 0 then Inc(Result, ShadowSize);
  2669.   SetTextColor(DC, Color);
  2670.   DrawText(DC, Str, Count, RText, Format);
  2671.   UnionRect(Rect, RText, RShadow);
  2672. end;
  2673.  
  2674. constructor TRxCustomLabel.Create(AOwner: TComponent);
  2675. begin
  2676.   inherited Create(AOwner);
  2677.   ControlStyle := ControlStyle + [csOpaque];
  2678. {$IFDEF WIN32}
  2679.   ControlStyle := ControlStyle + [csReplicatable];
  2680. {$ENDIF}
  2681.   Width := 65;
  2682.   Height := 17;
  2683.   FAutoSize := True;
  2684.   FShowAccelChar := True;
  2685.   FShadowColor := clBtnHighlight;
  2686.   FShadowSize := 1;
  2687.   FShadowPos := spLeftTop;
  2688. end;
  2689.  
  2690. function TRxCustomLabel.GetLabelCaption: string;
  2691. begin
  2692.   Result := Caption;
  2693. end;
  2694.  
  2695. function TRxCustomLabel.GetDefaultFontColor: TColor;
  2696. begin
  2697.   Result := Font.Color;
  2698. end;
  2699.  
  2700. procedure TRxCustomLabel.DoDrawText(var Rect: TRect; Flags: Word);
  2701. var
  2702. {$IFDEF WIN32}
  2703.   Text: string;
  2704. {$ELSE}
  2705.   Text: array[0..255] of Char;
  2706. {$ENDIF}
  2707.   PosShadow: TShadowPosition;
  2708.   SizeShadow: Byte;
  2709.   ColorShadow: TColor;
  2710. begin
  2711. {$IFDEF WIN32}
  2712.   Text := GetLabelCaption;
  2713.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
  2714.     (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  2715. {$ELSE}
  2716.   StrPLCopy(Text, GetLabelCaption, 255);
  2717.   if (Flags and DT_CALCRECT <> 0) and ((Text[0] = #0) or FShowAccelChar and
  2718.     (Text[0] = '&') and (Text[1] = #0)) then StrCopy(Text, ' ');
  2719. {$ENDIF}
  2720.   if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
  2721. {$IFDEF RX_D4}
  2722.   Flags := DrawTextBiDiModeFlags(Flags);
  2723. {$ENDIF}
  2724.   Canvas.Font := Font;
  2725.   Canvas.Font.Color := GetDefaultFontColor;
  2726.   PosShadow := FShadowPos;
  2727.   SizeShadow := FShadowSize;
  2728.   ColorShadow := FShadowColor;
  2729.   if not Enabled then begin
  2730.     if (FShadowSize = 0) and NewStyleControls then begin
  2731.       PosShadow := spRightBottom;
  2732.       SizeShadow := 1;
  2733.     end;
  2734.     Canvas.Font.Color := clGrayText;
  2735.     ColorShadow := clBtnHighlight;
  2736.   end;
  2737. {$IFDEF WIN32}
  2738.   DrawShadowText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags,
  2739.     SizeShadow, ColorToRGB(ColorShadow), PosShadow);
  2740. {$ELSE}
  2741.   DrawShadowText(Canvas.Handle, Text, StrLen(Text), Rect, Flags,
  2742.     SizeShadow, ColorToRGB(ColorShadow), PosShadow);
  2743. {$ENDIF}
  2744. end;
  2745.  
  2746. procedure TRxCustomLabel.Paint;
  2747. var
  2748.   Rect: TRect;
  2749.   DrawStyle: Integer;
  2750. begin
  2751.   if not Enabled and not (csDesigning in ComponentState) then
  2752.     FDragging := False;
  2753.   with Canvas do begin
  2754.     if not Transparent then begin
  2755.       Brush.Color := Self.Color;
  2756.       Brush.Style := bsSolid;
  2757.       FillRect(ClientRect);
  2758.     end;
  2759.     Brush.Style := bsClear;
  2760.     Rect := ClientRect;
  2761.     Inc(Rect.Left, FLeftMargin);
  2762.     Dec(Rect.Right, FRightMargin);
  2763.     InflateRect(Rect, -1, 0);
  2764.     DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
  2765.     { Calculate vertical layout }
  2766.     if FLayout <> tlTop then begin
  2767.       DoDrawText(Rect, DrawStyle or DT_CALCRECT);
  2768.       Rect.Left := ClientRect.Left + FLeftMargin;
  2769.       Rect.Right := ClientRect.Right - FRightMargin;
  2770.       if FLayout = tlBottom then OffsetRect(Rect, 0, Height - Rect.Bottom)
  2771.       else OffsetRect(Rect, 0, (Height - Rect.Bottom) div 2);
  2772.     end;
  2773.     DoDrawText(Rect, DrawStyle);
  2774.     if FShowFocus and Assigned(FFocusControl) and FFocused and
  2775.       not (csDesigning in ComponentState) then
  2776.     begin
  2777.       InflateRect(Rect, 1, 0);
  2778. {$IFDEF WIN32}
  2779.       Brush.Color := Self.Color;
  2780. {$ENDIF}
  2781.       DrawFocusRect(Rect);
  2782.     end;
  2783.   end;
  2784. end;
  2785.  
  2786. procedure TRxCustomLabel.AdjustBounds;
  2787. var
  2788.   DC: HDC;
  2789.   X: Integer;
  2790.   Rect: TRect;
  2791.   AAlignment: TAlignment;
  2792. begin
  2793.   if AutoSize then begin
  2794.     Rect := ClientRect;
  2795.     Inc(Rect.Left, FLeftMargin);
  2796.     Dec(Rect.Right, FRightMargin);
  2797.     InflateRect(Rect, -1, 0);
  2798.     DC := GetDC(0);
  2799.     Canvas.Handle := DC;
  2800.     DoDrawText(Rect, DT_EXPANDTABS or DT_CALCRECT or WordWraps[FWordWrap]);
  2801.     Dec(Rect.Left, FLeftMargin);
  2802.     Inc(Rect.Right, FRightMargin);
  2803.     Canvas.Handle := 0;
  2804.     ReleaseDC(0, DC);
  2805.     InflateRect(Rect, 1, 0);
  2806.     X := Left;
  2807.     AAlignment := FAlignment;
  2808. {$IFDEF RX_D4}
  2809.     if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  2810. {$ENDIF}
  2811.     if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
  2812.     SetBounds(X, Top, Rect.Right, Rect.Bottom);
  2813.   end;
  2814. end;
  2815.  
  2816. procedure TRxCustomLabel.SetAlignment(Value: TAlignment);
  2817. begin
  2818.   if FAlignment <> Value then begin
  2819.     FAlignment := Value;
  2820.     Invalidate;
  2821.   end;
  2822. end;
  2823.  
  2824. procedure TRxCustomLabel.SetAutoSize(Value: Boolean);
  2825. begin
  2826.   inherited SetAutoSize(Value);
  2827.   FAutoSize := Value;
  2828.   AdjustBounds;
  2829. end;
  2830.  
  2831. procedure TRxCustomLabel.SetLayout(Value: TTextLayout);
  2832. begin
  2833.   if FLayout <> Value then begin
  2834.     FLayout := Value;
  2835.     Invalidate;
  2836.   end;
  2837. end;
  2838.  
  2839. procedure TRxCustomLabel.SetLeftMargin(Value: Integer);
  2840. begin
  2841.   if FLeftMargin <> Value then begin
  2842.     FLeftMargin := Max(Value, 0);
  2843.     AdjustBounds;
  2844.     Invalidate;
  2845.   end;
  2846. end;
  2847.  
  2848. procedure TRxCustomLabel.SetRightMargin(Value: Integer);
  2849. begin
  2850.   if FRightMargin <> Value then begin
  2851.     FRightMargin := Max(Value, 0);
  2852.     AdjustBounds;
  2853.     Invalidate;
  2854.   end;
  2855. end;
  2856.  
  2857. procedure TRxCustomLabel.SetShadowColor(Value: TColor);
  2858. begin
  2859.   if Value <> FShadowColor then begin
  2860.     FShadowColor := Value;
  2861.     Invalidate;
  2862.   end;
  2863. end;
  2864.  
  2865. procedure TRxCustomLabel.SetShadowSize(Value: Byte);
  2866. begin
  2867.   if Value <> FShadowSize then begin
  2868.     FShadowSize := Value;
  2869.     AdjustBounds;
  2870.     Invalidate;
  2871.   end;
  2872. end;
  2873.  
  2874. procedure TRxCustomLabel.SetShadowPos(Value: TShadowPosition);
  2875. begin
  2876.   if Value <> FShadowPos then begin
  2877.     FShadowPos := Value;
  2878.     Invalidate;
  2879.   end;
  2880. end;
  2881.  
  2882. function TRxCustomLabel.GetTransparent: Boolean;
  2883. begin
  2884.   Result := not (csOpaque in ControlStyle);
  2885. end;
  2886.  
  2887. procedure TRxCustomLabel.SetFocusControl(Value: TWinControl);
  2888. begin
  2889.   FFocusControl := Value;
  2890. {$IFDEF WIN32}
  2891.   if Value <> nil then Value.FreeNotification(Self);
  2892. {$ENDIF}
  2893.   if FShowFocus then Invalidate;
  2894. end;
  2895.  
  2896. procedure TRxCustomLabel.SetShowAccelChar(Value: Boolean);
  2897. begin
  2898.   if FShowAccelChar <> Value then begin
  2899.     FShowAccelChar := Value;
  2900.     Invalidate;
  2901.   end;
  2902. end;
  2903.  
  2904. procedure TRxCustomLabel.SetTransparent(Value: Boolean);
  2905. begin
  2906.   if Transparent <> Value then begin
  2907.     if Value then ControlStyle := ControlStyle - [csOpaque]
  2908.     else ControlStyle := ControlStyle + [csOpaque];
  2909.     Invalidate;
  2910.   end;
  2911. end;
  2912.  
  2913. procedure TRxCustomLabel.SetShowFocus(Value: Boolean);
  2914. begin
  2915.   if FShowFocus <> Value then begin
  2916.     FShowFocus := Value;
  2917.     Invalidate;
  2918.   end;
  2919. end;
  2920.  
  2921. procedure TRxCustomLabel.SetWordWrap(Value: Boolean);
  2922. begin
  2923.   if FWordWrap <> Value then begin
  2924.     FWordWrap := Value;
  2925.     AdjustBounds;
  2926.   end;
  2927. end;
  2928.  
  2929. procedure TRxCustomLabel.Notification(AComponent: TComponent;
  2930.   Operation: TOperation);
  2931. begin
  2932.   inherited Notification(AComponent, Operation);
  2933.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  2934.     FocusControl := nil;
  2935. end;
  2936.  
  2937. procedure TRxCustomLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2938.   X, Y: Integer);
  2939. begin
  2940.   inherited MouseDown(Button, Shift, X, Y);
  2941.   if (Button = mbLeft) and Enabled then begin
  2942.     FDragging := True;
  2943.   end;
  2944. end;
  2945.  
  2946. procedure TRxCustomLabel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2947.   X, Y: Integer);
  2948. begin
  2949.   inherited MouseUp(Button, Shift, X, Y);
  2950.   if FDragging and (Button = mbLeft) then FDragging := False;
  2951.   UpdateTracking;
  2952. end;
  2953.  
  2954. procedure TRxCustomLabel.MouseEnter;
  2955. begin
  2956.   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  2957. end;
  2958.  
  2959. procedure TRxCustomLabel.MouseLeave;
  2960. begin
  2961.   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  2962. end;
  2963.  
  2964. procedure TRxCustomLabel.UpdateTracking;
  2965. var
  2966.   P: TPoint;
  2967.   OldValue: Boolean;
  2968. begin
  2969.   OldValue := FMouseInControl;
  2970.   GetCursorPos(P);
  2971.   FMouseInControl := Enabled and (FindDragTarget(P, True) = Self) and
  2972.     IsForegroundTask;
  2973.   if (FMouseInControl <> OldValue) then
  2974.     if FMouseInControl then MouseEnter else MouseLeave;
  2975. end;
  2976.  
  2977. procedure TRxCustomLabel.CMFocusChanged(var Message: TCMFocusChanged);
  2978. var
  2979.   Active: Boolean;
  2980. begin
  2981.   Active := Assigned(FFocusControl) and (Message.Sender = FFocusControl);
  2982.   if FFocused <> Active then begin
  2983.     FFocused := Active;
  2984.     if FShowFocus then Invalidate;
  2985.   end;
  2986.   inherited;
  2987. end;
  2988.  
  2989. procedure TRxCustomLabel.CMTextChanged(var Message: TMessage);
  2990. begin
  2991.   Invalidate;
  2992.   AdjustBounds;
  2993. end;
  2994.  
  2995. procedure TRxCustomLabel.CMFontChanged(var Message: TMessage);
  2996. begin
  2997.   inherited;
  2998.   AdjustBounds;
  2999. end;
  3000.  
  3001. procedure TRxCustomLabel.CMDialogChar(var Message: TCMDialogChar);
  3002. begin
  3003.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  3004.     IsAccel(Message.CharCode, GetLabelCaption) then
  3005.     with FFocusControl do
  3006.       if CanFocus then begin
  3007.         SetFocus;
  3008.         Message.Result := 1;
  3009.       end;
  3010. end;
  3011.  
  3012. procedure TRxCustomLabel.WMRButtonDown(var Message: TWMRButtonDown);
  3013. begin
  3014.   inherited;
  3015.   UpdateTracking;
  3016. end;
  3017.  
  3018. procedure TRxCustomLabel.WMRButtonUp(var Message: TWMRButtonUp);
  3019. begin
  3020.   inherited;
  3021.   UpdateTracking;
  3022. end;
  3023.  
  3024. procedure TRxCustomLabel.CMEnabledChanged(var Message: TMessage);
  3025. begin
  3026.   inherited;
  3027.   UpdateTracking;
  3028. end;
  3029.  
  3030. procedure TRxCustomLabel.CMVisibleChanged(var Message: TMessage);
  3031. begin
  3032.   inherited;
  3033.   if Visible then UpdateTracking;
  3034. end;
  3035.  
  3036. procedure TRxCustomLabel.CMMouseEnter(var Message: TMessage);
  3037. begin
  3038.   inherited;
  3039.   if not FMouseInControl and Enabled and IsForegroundTask then begin
  3040.     FMouseInControl := True;
  3041.     MouseEnter;
  3042.   end;
  3043. end;
  3044.  
  3045. procedure TRxCustomLabel.CMMouseLeave(var Message: TMessage);
  3046. begin
  3047.   inherited;
  3048.   if FMouseInControl and Enabled and not FDragging then begin
  3049.     FMouseInControl := False;
  3050.     MouseLeave;
  3051.   end;
  3052. end;
  3053.  
  3054. { TSecretPanel }
  3055.  
  3056. constructor TSecretPanel.Create(AOwner: TComponent);
  3057. begin
  3058.   inherited Create(AOwner);
  3059.   FScrollCnt := 0;
  3060.   FAlignment := taCenter;
  3061.   FActive := False;
  3062.   FTxtDivider := 1;
  3063.   FGlyphLayout := glGlyphLeft;
  3064.   ControlStyle := ControlStyle - [csSetCaption];
  3065.   BevelOuter := bvLowered;
  3066.   FTextStyle := bvNone;
  3067.   FLines := TStringList.Create;
  3068.   TStringList(FLines).OnChange := LinesChanged;
  3069.   FGlyph := TBitmap.Create;
  3070.   FGlyph.OnChange := GlyphChanged;
  3071.   FHiddenList := TList.Create;
  3072.   FTimer := TRxTimer.Create(Self);
  3073.   with FTimer do begin
  3074.     Enabled := False;
  3075.     OnTimer := TimerExpired;
  3076.     Interval := 30;
  3077. {$IFDEF RX_D3}
  3078.     SyncEvent := False;
  3079.     FAsyncDrawing := True;
  3080. {$ENDIF}
  3081.   end;
  3082. end;
  3083.  
  3084. destructor TSecretPanel.Destroy;
  3085. begin
  3086.   SetActive(False);
  3087.   FGlyph.OnChange := nil;
  3088.   FGlyph.Free;
  3089.   TStringList(FLines).OnChange := nil;
  3090.   FLines.Free;
  3091.   FHiddenList.Free;
  3092.   inherited Destroy;
  3093. end;
  3094.  
  3095. procedure TSecretPanel.GlyphChanged(Sender: TObject);
  3096. begin
  3097.   if Active then begin
  3098.     UpdateMemoryImage;
  3099.     Invalidate;
  3100.   end;
  3101. end;
  3102.  
  3103. procedure TSecretPanel.LinesChanged(Sender: TObject);
  3104. begin
  3105.   if Active then begin
  3106.     FScrollCnt := 0;
  3107.     UpdateMemoryImage;
  3108.     Invalidate;
  3109.   end;
  3110. end;
  3111.  
  3112. procedure TSecretPanel.CMFontChanged(var Message: TMessage);
  3113. begin
  3114.   inherited;
  3115.   if Active then UpdateMemoryImage;
  3116. end;
  3117.  
  3118. procedure TSecretPanel.CMColorChanged(var Message: TMessage);
  3119. begin
  3120.   inherited;
  3121.   if Active then UpdateMemoryImage;
  3122. end;
  3123.  
  3124. procedure TSecretPanel.WMSize(var Message: TMessage);
  3125. begin
  3126.   inherited;
  3127.   if Active then begin
  3128.     UpdateMemoryImage;
  3129.     Invalidate;
  3130.   end;
  3131. end;
  3132.  
  3133. {$IFDEF RX_D3}
  3134. procedure TSecretPanel.SetAsyncDrawing(Value: Boolean);
  3135. begin
  3136.   if FAsyncDrawing <> Value then begin
  3137.     FTimer.SyncEvent := not Value;
  3138.     FAsyncDrawing := Value;
  3139.   end;
  3140. end;
  3141. {$ENDIF RX_D3}
  3142.  
  3143. procedure TSecretPanel.AlignControls(AControl: TControl; var Rect: TRect);
  3144. begin
  3145.   inherited AlignControls(AControl, Rect);
  3146.   if (AControl = nil) and Active then UpdateMemoryImage;
  3147. end;
  3148.  
  3149. function TSecretPanel.GetInflateWidth: Integer;
  3150. begin
  3151.   Result := BorderWidth;
  3152.   if BevelOuter <> bvNone then Inc(Result, BevelWidth);
  3153.   if BevelInner <> bvNone then Inc(Result, BevelWidth);
  3154. end;
  3155.  
  3156. procedure TSecretPanel.RecalcDrawRect;
  3157. const
  3158.   MinOffset = 3;
  3159. var
  3160.   InflateWidth: Integer;
  3161.   LastLine: Integer;
  3162. begin
  3163.   FTxtRect := GetClientRect;
  3164.   FPaintRect := FTxtRect;
  3165.   InflateWidth := GetInflateWidth;
  3166.   InflateRect(FPaintRect, -InflateWidth, -InflateWidth);
  3167.   Inc(InflateWidth, MinOffset);
  3168.   InflateRect(FTxtRect, -InflateWidth, -InflateWidth);
  3169.   with FGlyphOrigin do begin
  3170.     case FGlyphLayout of
  3171.       glGlyphLeft:
  3172.         begin
  3173.           X := FTxtRect.Left;
  3174.           Y := (FTxtRect.Bottom + FTxtRect.Top - Glyph.Height) div 2;
  3175.           if Y < FTxtRect.Top then Y := FTxtRect.Top;
  3176.           if Glyph.Width > 0 then begin
  3177.             Inc(X, MinOffset);
  3178.             FTxtRect.Left := X + Glyph.Width + InflateWidth;
  3179.           end;
  3180.         end;
  3181.       glGlyphRight:
  3182.         begin
  3183.           Y := (FTxtRect.Bottom + FTxtRect.Top - Glyph.Height) div 2;
  3184.           if Y < FTxtRect.Top then Y := FTxtRect.Top;
  3185.           X := FTxtRect.Right - Glyph.Width;
  3186.           if Glyph.Width > 0 then begin
  3187.             Dec(X, MinOffset);
  3188.             if X < FTxtRect.Left then X := FTxtRect.Left;
  3189.             FTxtRect.Right := X - InflateWidth;
  3190.           end;
  3191.         end;
  3192.       glGlyphTop:
  3193.         begin
  3194.           Y := FTxtRect.Top;
  3195.           X := (FTxtRect.Right + FTxtRect.Left - Glyph.Width) div 2;
  3196.           if X < FTxtRect.Left then X := FTxtRect.Left;
  3197.           if Glyph.Height > 0 then begin
  3198.             Inc(Y, MinOffset);
  3199.             FTxtRect.Top := Y + Glyph.Height + (InflateWidth + MinOffset);
  3200.           end;
  3201.         end;
  3202.       glGlyphBottom:
  3203.         begin
  3204.           X := (FTxtRect.Right + FTxtRect.Left - Glyph.Width) div 2;
  3205.           if X < FTxtRect.Left then X := FTxtRect.Left;
  3206.           Y := FTxtRect.Bottom - Glyph.Height;
  3207.           if Glyph.Height > 0 then begin
  3208.             Dec(Y, MinOffset);
  3209.             if Y < FTxtRect.Top then Y := FTxtRect.Top;
  3210.             FTxtRect.Bottom := Y - (InflateWidth + MinOffset);
  3211.           end;
  3212.         end;
  3213.     end;
  3214.   end;
  3215.   if FDirection = sdHorizontal then begin
  3216.     LastLine := FLines.Count - 1;
  3217.     while (LastLine >= 0) and (Trim(FLines[LastLine]) = '') do
  3218.       Dec(LastLine);
  3219.     InflateWidth := HeightOf(FTxtRect) -
  3220.       (LastLine + 1 - FFirstLine) * FTxtDivider;
  3221.     if InflateWidth > 0 then
  3222.       InflateRect(FTxtRect, 0, - InflateWidth div 2);
  3223.   end;
  3224.   with FTxtRect do
  3225.     if (Left >= Right) or (Top >= Bottom) then FTxtRect := Rect(0, 0, 0, 0);
  3226. end;
  3227.  
  3228. procedure TSecretPanel.PaintGlyph;
  3229. begin
  3230.   if not FGlyph.Empty then begin
  3231.     RecalcDrawRect;
  3232.     DrawBitmapTransparent(Canvas, FGlyphOrigin.X, FGlyphOrigin.Y,
  3233.       FGlyph, FGlyph.TransparentColor and not PaletteMask);
  3234.   end;
  3235. end;
  3236.  
  3237. procedure TSecretPanel.PaintText;
  3238. var
  3239.   STmp: array[0..255] of Char;
  3240.   R: TRect;
  3241.   I: Integer;
  3242.   Flags: Longint;
  3243. begin
  3244.   if (FLines.Count = 0) or IsRectEmpty(FTxtRect) or not HandleAllocated then
  3245.     Exit;
  3246. {$IFDEF RX_D3}
  3247.   FMemoryImage.Canvas.Lock;
  3248.   try
  3249. {$ENDIF}
  3250.     with FMemoryImage.Canvas do begin
  3251.       I := SaveDC(Handle);
  3252.       try
  3253.         with FTxtRect do
  3254.           MoveWindowOrg(Handle, -Left, -Top);
  3255.         Brush.Color := Self.Color;
  3256.         PaintClient(FMemoryImage.Canvas, FPaintRect);
  3257.       finally
  3258.         RestoreDC(Handle, I);
  3259.         SetBkMode(Handle, Transparent);
  3260.       end;
  3261.     end;
  3262.     R := Bounds(0, 0, WidthOf(FTxtRect), HeightOf(FTxtRect));
  3263.     if FDirection = sdHorizontal then begin
  3264. {$IFDEF RX_D4}
  3265.       if IsRightToLeft then begin
  3266.         R.Right := R.Left + FScrollCnt;
  3267.         R.Left := R.Right - (FMaxScroll - WidthOf(FTxtRect));
  3268.       end
  3269.       else begin
  3270.         R.Left := R.Right - FScrollCnt;
  3271.         R.Right := R.Left + (FMaxScroll - WidthOf(FTxtRect));
  3272.       end;
  3273. {$ELSE}
  3274.       R.Left := R.Right - FScrollCnt;
  3275.       R.Right := R.Left + (FMaxScroll - WidthOf(FTxtRect));
  3276. {$ENDIF}
  3277.     end
  3278.     else begin { sdVertical }
  3279.       R.Top := R.Bottom - FScrollCnt;
  3280.     end;
  3281.     R.Bottom := R.Top + FTxtDivider;
  3282.     Flags := DT_EXPANDTABS or Alignments[FAlignment] or DT_SINGLELINE or
  3283.       DT_NOCLIP or DT_NOPREFIX;
  3284. {$IFDEF RX_D4}
  3285.     Flags := DrawTextBiDiModeFlags(Flags);
  3286. {$ENDIF}
  3287.     for I := FFirstLine to FLines.Count do begin
  3288.       if I = FLines.Count then StrCopy(STmp, ' ')
  3289.       else StrPLCopy(STmp, FLines[I], SizeOf(STmp) - 1);
  3290.       if R.Top >= HeightOf(FTxtRect) then Break
  3291.       else if R.Bottom > 0 then begin
  3292.         if FTextStyle <> bvNone then begin
  3293.           FMemoryImage.Canvas.Font.Color := clBtnHighlight;
  3294.           case FTextStyle of
  3295.             bvLowered:
  3296.               begin
  3297.                 OffsetRect(R, 1, 1);
  3298.                 DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
  3299.                 OffsetRect(R, -1, -1);
  3300.               end;
  3301.             bvRaised:
  3302.               begin
  3303.                 OffsetRect(R, -1, -1);
  3304.                 DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
  3305.                 OffsetRect(R, 1, 1);
  3306.               end;
  3307.           end;
  3308.           FMemoryImage.Canvas.Font.Color := Self.Font.Color;
  3309.           SetBkMode(FMemoryImage.Canvas.Handle, Transparent);
  3310.         end;
  3311.         DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
  3312.       end;
  3313.       OffsetRect(R, 0, FTxtDivider);
  3314.     end;
  3315. {$IFDEF RX_D3}
  3316.     Canvas.Lock;
  3317.     try
  3318. {$ENDIF}
  3319.       BitBlt(Canvas.Handle, FTxtRect.Left, FTxtRect.Top, FMemoryImage.Width,
  3320.         FMemoryImage.Height, FMemoryImage.Canvas.Handle, 0, 0, SRCCOPY);
  3321.       ValidateRect(Handle, @FTxtRect);
  3322. {$IFDEF RX_D3}
  3323.     finally
  3324.       Canvas.Unlock;
  3325.     end;
  3326. {$ENDIF}
  3327. {$IFDEF RX_D3}
  3328.   finally
  3329.     FMemoryImage.Canvas.Unlock;
  3330.   end;
  3331. {$ENDIF}
  3332. end;
  3333.  
  3334. procedure TSecretPanel.PaintClient(Canvas: TCanvas; Rect: TRect);
  3335. begin
  3336.   if Assigned(FOnPaintClient) then FOnPaintClient(Self, Canvas, Rect)
  3337.   else Canvas.FillRect(Rect);
  3338. end;
  3339.  
  3340. procedure TSecretPanel.Paint;
  3341. var
  3342.   Rect: TRect;
  3343.   TopColor, BottomColor: TColor;
  3344.   SaveIndex: Integer;
  3345.  
  3346.   procedure AdjustColors(Bevel: TPanelBevel);
  3347.   begin
  3348.     TopColor := clBtnHighlight;
  3349.     if Bevel = bvLowered then TopColor := clBtnShadow;
  3350.     BottomColor := clBtnShadow;
  3351.     if Bevel = bvLowered then BottomColor := clBtnHighlight;
  3352.   end;
  3353.  
  3354. begin
  3355.   Rect := GetClientRect;
  3356.   if BevelOuter <> bvNone then begin
  3357.     AdjustColors(BevelOuter);
  3358.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  3359.   end;
  3360.   Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  3361.   if BevelInner <> bvNone then begin
  3362.     AdjustColors(BevelInner);
  3363.     Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  3364.   end;
  3365.   SaveIndex := SaveDC(Canvas.Handle);
  3366.   try
  3367.     with Rect do
  3368.       IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  3369.     Canvas.Brush.Color := Self.Color;
  3370.     PaintClient(Canvas, Rect);
  3371.   finally
  3372.     RestoreDC(Canvas.Handle, SaveIndex);
  3373.   end;
  3374.   if Active then begin
  3375.     PaintGlyph;
  3376.     {PaintText;}
  3377.   end;
  3378. end;
  3379.  
  3380. procedure TSecretPanel.StartPlay;
  3381. begin
  3382.   if Assigned(FOnStartPlay) then FOnStartPlay(Self);
  3383. end;
  3384.  
  3385. procedure TSecretPanel.StopPlay;
  3386. begin
  3387.   if Assigned(FOnStopPlay) then FOnStopPlay(Self);
  3388. end;
  3389.  
  3390. procedure TSecretPanel.TimerExpired(Sender: TObject);
  3391. begin
  3392.   if (FScrollCnt < FMaxScroll) then begin
  3393.     Inc(FScrollCnt);
  3394.     if Assigned(FMemoryImage) then PaintText;
  3395.   end
  3396.   else if Cycled then begin
  3397.     FScrollCnt := 0;
  3398.     if Assigned(FMemoryImage) then PaintText;
  3399.   end
  3400.   else begin
  3401. {$IFDEF RX_D3}
  3402.     FTimer.Synchronize(Stop);
  3403. {$ELSE}
  3404.     SetActive(False);
  3405. {$ENDIF}
  3406.   end;
  3407. end;
  3408.  
  3409. procedure TSecretPanel.UpdateMemoryImage;
  3410. var
  3411.   Metrics: TTextMetric;
  3412.   I: Integer;
  3413. begin
  3414.   if FMemoryImage = nil then FMemoryImage := TBitmap.Create;
  3415. {$IFDEF RX_D3}
  3416.   FMemoryImage.Canvas.Lock;
  3417.   try
  3418. {$ENDIF}
  3419.     FFirstLine := 0;
  3420.     while (FFirstLine < FLines.Count) and (Trim(FLines[FFirstLine]) = '') do
  3421.       Inc(FFirstLine);
  3422.     Canvas.Font := Self.Font;
  3423.     GetTextMetrics(Canvas.Handle, Metrics);
  3424.     FTxtDivider := Metrics.tmHeight + Metrics.tmExternalLeading;
  3425.     if FTextStyle <> bvNone then Inc(FTxtDivider);
  3426.     RecalcDrawRect;
  3427.     if FDirection = sdHorizontal then begin
  3428.       FMaxScroll := 0;
  3429.       for I := FFirstLine to FLines.Count - 1 do
  3430.         FMaxScroll := Max(FMaxScroll, Canvas.TextWidth(FLines[I]));
  3431.       Inc(FMaxScroll, WidthOf(FTxtRect));
  3432.     end
  3433.     else begin { sdVertical }
  3434.       FMaxScroll := ((FLines.Count - FFirstLine) * FTxtDivider) +
  3435.         HeightOf(FTxtRect);
  3436.     end;
  3437.     FMemoryImage.Width := WidthOf(FTxtRect);
  3438.     FMemoryImage.Height := HeightOf(FTxtRect);
  3439.     with FMemoryImage.Canvas do begin
  3440.       Font := Self.Font;
  3441.       Brush.Color := Self.Color;
  3442.       SetBkMode(Handle, Transparent);
  3443.     end;
  3444. {$IFDEF RX_D3}
  3445.   finally
  3446.     FMemoryImage.Canvas.UnLock;
  3447.   end;
  3448. {$ENDIF}
  3449. end;
  3450.  
  3451. function TSecretPanel.GetInterval: Cardinal;
  3452. begin
  3453.   Result := FTimer.Interval;
  3454. end;
  3455.  
  3456. procedure TSecretPanel.SetInterval(Value: Cardinal);
  3457. begin
  3458.   FTimer.Interval := Value;
  3459. end;
  3460.  
  3461. procedure TSecretPanel.Play;
  3462. begin
  3463.   SetActive(True);
  3464. end;
  3465.  
  3466. procedure TSecretPanel.Stop;
  3467. begin
  3468.   SetActive(False);
  3469. end;
  3470.  
  3471. procedure TSecretPanel.SetActive(Value: Boolean);
  3472. var
  3473.   I: Integer;
  3474. begin
  3475.   if Value <> FActive then begin
  3476.     FActive := Value;
  3477.     if FActive then begin
  3478.       FScrollCnt := 0;
  3479.       UpdateMemoryImage;
  3480.       try
  3481.         FTimer.Enabled := True;
  3482.         StartPlay;
  3483.       except
  3484.         FActive := False;
  3485.         FTimer.Enabled := False;
  3486.         raise;
  3487.       end;
  3488.     end
  3489.     else begin
  3490. {$IFDEF RX_D3}
  3491.       FMemoryImage.Canvas.Lock;
  3492.       { ensure that canvas is locked before timer is disabled }
  3493. {$ENDIF}
  3494.       FTimer.Enabled := False;
  3495.       FScrollCnt := 0;
  3496.       FMemoryImage.Free;
  3497.       FMemoryImage := nil;
  3498.       StopPlay;
  3499.       if (csDesigning in ComponentState) and
  3500.         not (csDestroying in ComponentState) then
  3501.         ValidParentForm(Self).Designer.Modified;
  3502.     end;
  3503.     if not (csDestroying in ComponentState) then
  3504.       for I := 0 to Pred(ControlCount) do begin
  3505.         if FActive then begin
  3506.           if Controls[I].Visible then FHiddenList.Add(Controls[I]);
  3507.           if not (csDesigning in ComponentState) then
  3508.             Controls[I].Visible := False
  3509.         end
  3510.         else if FHiddenList.IndexOf(Controls[I]) >= 0 then begin
  3511.           Controls[I].Visible := True;
  3512.           Controls[I].Invalidate;
  3513.           if (csDesigning in ComponentState) then Controls[I].Update;
  3514.         end;
  3515.       end;
  3516.     if not FActive then FHiddenList.Clear;
  3517.     Invalidate;
  3518.   end;
  3519. end;
  3520.  
  3521. procedure TSecretPanel.SetAlignment(Value: TAlignment);
  3522. begin
  3523.   if FAlignment <> Value then begin
  3524.     FAlignment := Value;
  3525.     if Active then Invalidate;
  3526.   end;
  3527. end;
  3528.  
  3529. procedure TSecretPanel.SetGlyph(Value: TBitmap);
  3530. begin
  3531.   FGlyph.Assign(Value);
  3532. end;
  3533.  
  3534. procedure TSecretPanel.SetDirection(Value: TScrollDirection);
  3535. begin
  3536.   if FDirection <> Value then begin
  3537.     FDirection := Value;
  3538.     if FActive then begin
  3539.       FScrollCnt := 0;
  3540.       UpdateMemoryImage;
  3541.       Invalidate;
  3542.     end;
  3543.   end;
  3544. end;
  3545.  
  3546. procedure TSecretPanel.SetTextStyle(Value: TPanelBevel);
  3547. begin
  3548.   if FTextStyle <> Value then begin
  3549.     FTextStyle := Value;
  3550.     if FActive then begin
  3551.       UpdateMemoryImage;
  3552.       Invalidate;
  3553.     end;
  3554.   end;
  3555. end;
  3556.  
  3557. procedure TSecretPanel.SetGlyphLayout(Value: TGlyphLayout);
  3558. begin
  3559.   if FGlyphLayout <> Value then begin
  3560.     FGlyphLayout := Value;
  3561.     if FActive then begin
  3562.       UpdateMemoryImage;
  3563.       Invalidate;
  3564.     end;
  3565.   end;
  3566. end;
  3567.  
  3568. procedure TSecretPanel.SetLines(Value: TStrings);
  3569. begin
  3570.   FLines.Assign(Value);
  3571. end;
  3572.  
  3573. { TGlyphList }
  3574.  
  3575. type
  3576.   TGlyphList = class(TImageList)
  3577.   private
  3578.     FUsed: TBits;
  3579.     FCount: Integer;
  3580.     function AllocateIndex: Integer;
  3581.   public
  3582.     constructor CreateSize(AWidth, AHeight: Integer);
  3583.     destructor Destroy; override;
  3584.     function Add(Image, Mask: TBitmap): Integer;
  3585.     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  3586. {$IFDEF WIN32}
  3587. {$IFNDEF RX_D3} { Delphi 2.0 bug fix }
  3588.     procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
  3589. {$ENDIF}
  3590. {$ENDIF}
  3591.     procedure Delete(Index: Integer);
  3592.     property Count: Integer read FCount;
  3593.   end;
  3594.  
  3595. { TGlyphCache }
  3596.  
  3597.   TGlyphCache = class
  3598.   private
  3599.     FGlyphLists: TList;
  3600.   public
  3601.     constructor Create;
  3602.     destructor Destroy; override;
  3603.     function GetList(AWidth, AHeight: Integer): TGlyphList;
  3604.     procedure ReturnList(List: TGlyphList);
  3605.     function Empty: Boolean;
  3606.   end;
  3607.  
  3608. { TGlyphList }
  3609.  
  3610. constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
  3611. begin
  3612. {$IFDEF WIN32}
  3613.   inherited CreateSize(AWidth, AHeight);
  3614. {$ELSE}
  3615.   inherited Create(AWidth, AHeight);
  3616. {$ENDIF}
  3617.   FUsed := TBits.Create;
  3618. end;
  3619.  
  3620. destructor TGlyphList.Destroy;
  3621. begin
  3622.   FUsed.Free;
  3623.   inherited Destroy;
  3624. end;
  3625.  
  3626. function TGlyphList.AllocateIndex: Integer;
  3627. begin
  3628.   Result := FUsed.OpenBit;
  3629.   if Result >= FUsed.Size then begin
  3630.     Result := inherited Add(nil, nil);
  3631.     FUsed.Size := Result + 1;
  3632.   end;
  3633.   FUsed[Result] := True;
  3634. end;
  3635.  
  3636. {$IFDEF WIN32}
  3637. {$IFNDEF RX_D3} { Delphi 2.0 bug fix }
  3638. procedure TGlyphList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
  3639. var
  3640.   TempIndex: Integer;
  3641.   Image, Mask: TBitmap;
  3642. begin
  3643.   if HandleAllocated then begin
  3644.     TempIndex := inherited AddMasked(NewImage, MaskColor);
  3645.     if TempIndex <> -1 then
  3646.     try
  3647.       Image := TBitmap.Create;
  3648.       Mask := TBitmap.Create;
  3649.       try
  3650.         with Image do begin
  3651.           Height := Self.Height;
  3652.           Width := Self.Width;
  3653.         end;
  3654.         with Mask do begin
  3655.           Monochrome := True; { fix }
  3656.           Height := Self.Height;
  3657.           Width := Self.Width;
  3658.         end;
  3659.         ImageList_Draw(Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL);
  3660.         ImageList_Draw(Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK);
  3661.         if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then
  3662.           raise EInvalidOperation.Create(LoadStr(SReplaceImage));
  3663.       finally
  3664.         Image.Free;
  3665.         Mask.Free;
  3666.       end;
  3667.     finally
  3668.       inherited Delete(TempIndex);
  3669.     end
  3670.     else raise EInvalidOperation.Create(LoadStr(SReplaceImage));
  3671.   end;
  3672.   Change;
  3673. end;
  3674. {$ENDIF}
  3675. {$ENDIF}
  3676.  
  3677. function TGlyphList.Add(Image, Mask: TBitmap): Integer;
  3678. begin
  3679.   Result := AllocateIndex;
  3680.   Replace(Result, Image, Mask);
  3681.   Inc(FCount);
  3682. end;
  3683.  
  3684. function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  3685. begin
  3686.   Result := AllocateIndex;
  3687.   ReplaceMasked(Result, Image, MaskColor);
  3688.   Inc(FCount);
  3689. end;
  3690.  
  3691. procedure TGlyphList.Delete(Index: Integer);
  3692. begin
  3693.   if FUsed[Index] then begin
  3694.     Dec(FCount);
  3695.     FUsed[Index] := False;
  3696.   end;
  3697. end;
  3698.  
  3699. { TGlyphCache }
  3700.  
  3701. constructor TGlyphCache.Create;
  3702. begin
  3703.   inherited Create;
  3704.   FGlyphLists := TList.Create;
  3705. end;
  3706.  
  3707. destructor TGlyphCache.Destroy;
  3708. begin
  3709.   FGlyphLists.Free;
  3710.   inherited Destroy;
  3711. end;
  3712.  
  3713. function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
  3714. var
  3715.   I: Integer;
  3716. begin
  3717.   for I := FGlyphLists.Count - 1 downto 0 do begin
  3718.     Result := FGlyphLists[I];
  3719.     with Result do
  3720.       if (AWidth = Width) and (AHeight = Height) then Exit;
  3721.   end;
  3722.   Result := TGlyphList.CreateSize(AWidth, AHeight);
  3723.   FGlyphLists.Add(Result);
  3724. end;
  3725.  
  3726. procedure TGlyphCache.ReturnList(List: TGlyphList);
  3727. begin
  3728.   if List = nil then Exit;
  3729.   if List.Count = 0 then begin
  3730.     FGlyphLists.Remove(List);
  3731.     List.Free;
  3732.   end;
  3733. end;
  3734.  
  3735. function TGlyphCache.Empty: Boolean;
  3736. begin
  3737.   Result := FGlyphLists.Count = 0;
  3738. end;
  3739.  
  3740. const
  3741.   GlyphCache: TGlyphCache = nil;
  3742.  
  3743. { TRxButtonGlyph }
  3744.  
  3745. constructor TRxButtonGlyph.Create;
  3746. var
  3747.   I: TRxButtonState;
  3748. begin
  3749.   inherited Create;
  3750.   FOriginal := TBitmap.Create;
  3751.   FOriginal.OnChange := GlyphChanged;
  3752.   FTransparentColor := clFuchsia;
  3753.   FAlignment := taCenter;
  3754.   FNumGlyphs := 1;
  3755.   for I := Low(I) to High(I) do FIndexs[I] := -1;
  3756.   if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  3757. end;
  3758.  
  3759. destructor TRxButtonGlyph.Destroy;
  3760. begin
  3761.   FOriginal.Free;
  3762.   Invalidate;
  3763.   if Assigned(GlyphCache) and GlyphCache.Empty then begin
  3764.     GlyphCache.Free;
  3765.     GlyphCache := nil;
  3766.   end;
  3767.   inherited Destroy;
  3768. end;
  3769.  
  3770. procedure TRxButtonGlyph.Invalidate;
  3771. var
  3772.   I: TRxButtonState;
  3773. begin
  3774.   for I := Low(I) to High(I) do begin
  3775.     if Assigned(FGlyphList) then
  3776.       if (FIndexs[I] <> -1) then TGlyphList(FGlyphList).Delete(FIndexs[I]);
  3777.     FIndexs[I] := -1;
  3778.   end;
  3779.   GlyphCache.ReturnList(TGlyphList(FGlyphList));
  3780.   FGlyphList := nil;
  3781. end;
  3782.  
  3783. procedure TRxButtonGlyph.GlyphChanged(Sender: TObject);
  3784. var
  3785.   Glyphs: Integer;
  3786. begin
  3787.   if Sender = FOriginal then begin
  3788.     Invalidate;
  3789.     if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
  3790.       FTransparentColor := FOriginal.TransparentColor and not PaletteMask;
  3791.       if FOriginal.Width mod FOriginal.Height = 0 then begin
  3792.         Glyphs := FOriginal.Width div FOriginal.Height;
  3793.         if Glyphs > (Ord(High(TRxButtonState)) + 1) then Glyphs := 1;
  3794.         SetNumGlyphs(Glyphs);
  3795.       end;
  3796.     end;
  3797.     if Assigned(FOnChange) then FOnChange(Self);
  3798.   end;
  3799. end;
  3800.  
  3801. procedure TRxButtonGlyph.SetGlyph(Value: TBitmap);
  3802. begin
  3803.   Invalidate;
  3804.   FOriginal.Assign(Value);
  3805. end;
  3806.  
  3807. procedure TRxButtonGlyph.SetNumGlyphs(Value: TRxNumGlyphs);
  3808. begin
  3809.   if (Value <> FNumGlyphs) and (Value > 0) then begin
  3810.     Invalidate;
  3811.     FNumGlyphs := Value;
  3812.   end;
  3813. end;
  3814.  
  3815. function TRxButtonGlyph.MapColor(Color: TColor): TColor;
  3816. var
  3817.   Index: Byte;
  3818. begin
  3819.   if (Color = FTransparentColor) or (ColorToRGB(Color) =
  3820.     ColorToRGB(clBtnFace)) then Result := Color
  3821.   else begin
  3822.     Color := ColorToRGB(Color);
  3823.     Index := Byte(Longint(Word(GetRValue(Color)) * 77 +
  3824.       Word(GetGValue(Color)) * 150 + Word(GetBValue(Color)) * 29) shr 8);
  3825.     Result := RGB(Index, Index, Index);
  3826.   end;
  3827. end;
  3828.  
  3829. {$IFDEF WIN32}
  3830. function TRxButtonGlyph.CreateImageGlyph(State: TRxButtonState;
  3831.   Images: TImageList; Index: Integer): Integer;
  3832. var
  3833.   TmpImage, Mask: TBitmap;
  3834.   IWidth, IHeight, X, Y: Integer;
  3835. begin
  3836.   if (State = rbsDown) then State := rbsUp;
  3837.   Result := FIndexs[State];
  3838.   if (Result <> -1) or (Images.Width = 0) or (Images.Height = 0) or
  3839.     (Images.Count = 0) then Exit;
  3840.   IWidth := Images.Width;
  3841.   IHeight := Images.Height;
  3842.   if FGlyphList = nil then begin
  3843.     if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  3844.     FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  3845.   end;
  3846.   TmpImage := TBitmap.Create;
  3847.   try
  3848.     TmpImage.Width := IWidth;
  3849.     TmpImage.Height := IHeight;
  3850.     case State of
  3851.       rbsUp, rbsDown, rbsExclusive:
  3852.         begin
  3853.           with TmpImage.Canvas do begin
  3854.             FillRect(Rect(0, 0, IWidth, IHeight));
  3855.             ImageList_Draw(Images.Handle, Index, Handle, 0, 0, ILD_NORMAL);
  3856.           end;
  3857.           Mask := TBitmap.Create;
  3858.           try
  3859.             with Mask do begin
  3860.               Monochrome := True;
  3861.               Height := IHeight;
  3862.               Width := IWidth;
  3863.             end;
  3864.             with Mask.Canvas do begin
  3865.               FillRect(Rect(0, 0, IWidth, IHeight));
  3866.               ImageList_Draw(Images.Handle, Index, Handle, 0, 0, ILD_MASK);
  3867.             end;
  3868.             FIndexs[State] := TGlyphList(FGlyphList).Add(TmpImage, Mask);
  3869.           finally
  3870.             Mask.Free;
  3871.           end;
  3872.         end;
  3873.       rbsDisabled:
  3874.         begin
  3875.           TmpImage.Canvas.Brush.Color := clBtnFace;
  3876.           TmpImage.Canvas.FillRect(Rect(0, 0, IWidth, IHeight));
  3877.           ImageListDrawDisabled(Images, TmpImage.Canvas, 0, 0, Index,
  3878.             clBtnHighlight, clBtnShadow, True);
  3879.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage,
  3880.             ColorToRGB(clBtnFace));
  3881.         end;
  3882.       rbsInactive:
  3883.         begin
  3884.           TmpImage.Canvas.Brush.Color := clBtnFace;
  3885.           TmpImage.Canvas.FillRect(Rect(0, 0, IWidth, IHeight));
  3886.           ImageList_Draw(Images.Handle, Index, TmpImage.Canvas.Handle, 0, 0,
  3887.             ILD_NORMAL);
  3888.           with TmpImage do begin
  3889.             for X := 0 to Width - 1 do
  3890.               for Y := 0 to Height - 1 do
  3891.                 Canvas.Pixels[X, Y] := MapColor(Canvas.Pixels[X, Y]);
  3892.           end;
  3893.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage,
  3894.             ColorToRGB(clBtnFace));
  3895.         end;
  3896.     end;
  3897.   finally
  3898.     TmpImage.Free;
  3899.   end;
  3900.   Result := FIndexs[State];
  3901. end;
  3902. {$ENDIF}
  3903.  
  3904. function TRxButtonGlyph.CreateButtonGlyph(State: TRxButtonState): Integer;
  3905. var
  3906.   TmpImage, MonoBmp: TBitmap;
  3907.   IWidth, IHeight, X, Y: Integer;
  3908.   IRect, ORect: TRect;
  3909.   I: TRxButtonState;
  3910. begin
  3911.   if (State = rbsDown) and (NumGlyphs < 3) then State := rbsUp;
  3912.   Result := FIndexs[State];
  3913.   if (Result <> -1) or (FOriginal.Width = 0) or (FOriginal.Height = 0) or
  3914.     FOriginal.Empty then Exit;
  3915.   IWidth := FOriginal.Width div FNumGlyphs;
  3916.   IHeight := FOriginal.Height;
  3917.   if FGlyphList = nil then begin
  3918.     if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
  3919.     FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  3920.   end;
  3921.   TmpImage := TBitmap.Create;
  3922.   try
  3923.     TmpImage.Width := IWidth;
  3924.     TmpImage.Height := IHeight;
  3925.     IRect := Rect(0, 0, IWidth, IHeight);
  3926.     TmpImage.Canvas.Brush.Color := clBtnFace;
  3927.     I := State;
  3928.     if Ord(I) >= NumGlyphs then I := rbsUp;
  3929.     ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
  3930.     case State of
  3931.       rbsUp, rbsDown, rbsExclusive:
  3932.         begin
  3933.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  3934.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
  3935.         end;
  3936.       rbsDisabled:
  3937.         if NumGlyphs > 1 then begin
  3938.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  3939.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
  3940.         end
  3941.         else begin
  3942.           MonoBmp := CreateDisabledBitmap(FOriginal, clBlack);
  3943.           try
  3944.             FIndexs[State] := TGlyphList(FGlyphList).AddMasked(MonoBmp,
  3945.               ColorToRGB(clBtnFace));
  3946.           finally
  3947.             MonoBmp.Free;
  3948.           end;
  3949.         end;
  3950.       rbsInactive:
  3951.         if NumGlyphs > 4 then begin
  3952.           TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
  3953.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
  3954.         end
  3955.         else begin
  3956.           with TmpImage do begin
  3957.             for X := 0 to Width - 1 do
  3958.               for Y := 0 to Height - 1 do
  3959.                 Canvas.Pixels[X, Y] := MapColor(FOriginal.Canvas.Pixels[X, Y]);
  3960.           end;
  3961.           FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
  3962.         end;
  3963.     end;
  3964.   finally
  3965.     TmpImage.Free;
  3966.   end;
  3967.   Result := FIndexs[State];
  3968.   FOriginal.Dormant;
  3969. end;
  3970.  
  3971. procedure TRxButtonGlyph.DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
  3972.   State: TRxButtonState);
  3973. var
  3974.   AColor: TColor;
  3975.  
  3976.   procedure DrawMark;
  3977.   var
  3978.     I: Integer;
  3979.   begin
  3980.     with Canvas do begin
  3981.       for I := 0 to 6 do begin
  3982.         Pixels[X + I, Y - 1] := AColor;
  3983.         if (I > 0) and (I < 6) then begin
  3984.           Pixels[X + I, Y] := AColor;
  3985.           if (I > 1) and (I < 5) then Pixels[X + I, Y + 1] := AColor;
  3986.         end;
  3987.       end;
  3988.       Pixels[X + 3, Y + 2] := AColor;
  3989.     end;
  3990.   end;
  3991.  
  3992. begin
  3993.   if State = rbsDisabled then begin
  3994.     AColor := clBtnHighlight;
  3995.     Inc(X, 1); Inc(Y, 1);
  3996.     DrawMark;
  3997.     Dec(X, 1); Dec(Y, 1);
  3998.     AColor := clBtnShadow;
  3999.   end
  4000.   else AColor := clBtnText;
  4001.   DrawMark;
  4002. end;
  4003.  
  4004. function TRxButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
  4005.   State: TRxButtonState): TPoint;
  4006. var
  4007.   Index: Integer;
  4008. begin
  4009.   Result := Point(0, 0);
  4010.   if (FOriginal = nil) or (FOriginal.Width = 0) or (FOriginal.Height = 0) or
  4011.     FOriginal.Empty then Exit;
  4012.   Index := CreateButtonGlyph(State);
  4013.   if Index >= 0 then begin
  4014. {$IFDEF WIN32}
  4015.     ImageList_Draw(FGlyphList.Handle, Index, Canvas.Handle, X, Y, ILD_NORMAL);
  4016. {$ELSE}
  4017.     FGlyphList.Draw(Canvas, X, Y, Index);
  4018. {$ENDIF}
  4019.     Result := Point(FGlyphList.Width, FGlyphList.Height);
  4020.   end;
  4021. end;
  4022.  
  4023. {$IFDEF WIN32}
  4024. function TRxButtonGlyph.DrawButtonImage(Canvas: TCanvas; X, Y: Integer;
  4025.   Images: TImageList; ImageIndex: Integer; State: TRxButtonState): TPoint;
  4026. var
  4027.   Index: Integer;
  4028. begin
  4029.   Result := Point(0, 0);
  4030.   if (Images = nil) or (ImageIndex < 0) or (ImageIndex >= Images.Count) then
  4031.     Exit;
  4032.   if State = rbsDisabled then begin
  4033.     ImageListDrawDisabled(Images, Canvas, X, Y, ImageIndex, clBtnHighlight,
  4034.       clBtnShadow, True);
  4035.   end
  4036.   else if State = rbsInactive then begin
  4037.     Index := CreateImageGlyph(State, Images, ImageIndex);
  4038.     if Index >= 0 then
  4039.       ImageList_Draw(FGlyphList.Handle, Index, Canvas.Handle, X, Y, ILD_NORMAL);
  4040.   end
  4041.   else
  4042.     ImageList_Draw(Images.Handle, ImageIndex, Canvas.Handle, X, Y, ILD_NORMAL);
  4043.   Result := Point(Images.Width, Images.Height);
  4044. end;
  4045. {$ENDIF}
  4046.  
  4047. procedure TRxButtonGlyph.MinimizeCaption(Canvas: TCanvas; const Caption: string;
  4048.   Buffer: PChar; MaxLen, Width: Integer);
  4049. var
  4050.   I: Integer;
  4051. {$IFNDEF WIN32}
  4052.   P: PChar;
  4053. {$ENDIF}
  4054.   Lines: TStrings;
  4055. begin
  4056.   StrPLCopy(Buffer, Caption, MaxLen);
  4057.   if FWordWrap then Exit;
  4058.   Lines := TStringList.Create;
  4059.   try
  4060. {$IFDEF WIN32}
  4061.     Lines.Text := Caption;
  4062.     for I := 0 to Lines.Count - 1 do
  4063.       Lines[I] := MinimizeText(Lines[I], Canvas, Width);
  4064.     StrPLCopy(Buffer, TrimRight(Lines.Text), MaxLen);
  4065. {$ELSE}
  4066.     Lines.SetText(Buffer);
  4067.     for I := 0 to Lines.Count - 1 do
  4068.       Lines[I] := MinimizeText(Lines[I], Canvas, Width);
  4069.     P := Lines.GetText;
  4070.     try
  4071.       StrPLCopy(Buffer, TrimRight(StrPas(P)), MaxLen);
  4072.     finally
  4073.       StrDispose(P);
  4074.     end;
  4075. {$ENDIF}
  4076.   finally
  4077.     Lines.Free;
  4078.   end;
  4079. end;
  4080.  
  4081. procedure TRxButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  4082.   TextBounds: TRect; State: TRxButtonState; Flags: Word);
  4083. var
  4084.   CString: array[0..255] of Char;
  4085. begin
  4086.   Canvas.Brush.Style := bsClear;
  4087.   StrPLCopy(CString, Caption, SizeOf(CString) - 1);
  4088.   Flags := DT_VCENTER or WordWraps[FWordWrap] or Flags;
  4089.   if State = rbsDisabled then begin
  4090.     with Canvas do begin
  4091.       OffsetRect(TextBounds, 1, 1);
  4092.       Font.Color := clBtnHighlight;
  4093.       DrawText(Handle, CString, Length(Caption), TextBounds, Flags);
  4094.       OffsetRect(TextBounds, -1, -1);
  4095.       Font.Color := clBtnShadow;
  4096.       DrawText(Handle, CString, Length(Caption), TextBounds, Flags);
  4097.     end;
  4098.   end
  4099.   else DrawText(Canvas.Handle, CString, -1, TextBounds, Flags);
  4100. end;
  4101.  
  4102. procedure TRxButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  4103.   var Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  4104.   PopupMark: Boolean; var GlyphPos: TPoint; var TextBounds: TRect; Flags: Word
  4105.   {$IFDEF WIN32}; Images: TImageList; ImageIndex: Integer {$ENDIF});
  4106. var
  4107.   TextPos: TPoint;
  4108.   MaxSize, ClientSize, GlyphSize, TextSize: TPoint;
  4109.   TotalSize: TPoint;
  4110.   CString: array[0..255] of Char;
  4111. begin
  4112.   { calculate the item sizes }
  4113.   ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
  4114. {$IFDEF WIN32}
  4115.   if Assigned(Images) and (Images.Width > 0) and (ImageIndex >= 0) and
  4116.     (ImageIndex < Images.Count) then
  4117.     GlyphSize := Point(Images.Width, Images.Height)
  4118.   else
  4119. {$ENDIF}
  4120.   if FOriginal <> nil then
  4121.     GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height)
  4122.   else GlyphSize := Point(0, 0);
  4123.   if Layout in [blGlyphLeft, blGlyphRight] then begin
  4124.     MaxSize.X := ClientSize.X - GlyphSize.X;
  4125.     if Margin <> -1 then Dec(MaxSize.X, Margin);
  4126.     if Spacing <> -1 then Dec(MaxSize.X, Spacing);
  4127.     if PopupMark then Dec(MaxSize.X, 9);
  4128.     MaxSize.Y := ClientSize.Y;
  4129.   end
  4130.   else { blGlyphTop, blGlyphBottom } begin
  4131.     MaxSize.X := ClientSize.X;
  4132.     MaxSize.Y := ClientSize.Y - GlyphSize.Y;
  4133.     if Margin <> -1 then Dec(MaxSize.Y, Margin);
  4134.     if Spacing <> -1 then Dec(MaxSize.Y, Spacing);
  4135.   end;
  4136.   MaxSize.X := Max(0, MaxSize.X);
  4137.   MaxSize.Y := Max(0, MaxSize.Y);
  4138.   MinimizeCaption(Canvas, Caption, CString, SizeOf(CString) - 1, MaxSize.X);
  4139.   Caption := StrPas(CString);
  4140.   if Length(Caption) > 0 then begin
  4141.     TextBounds := Rect(0, 0, MaxSize.X, 0);
  4142.     DrawText(Canvas.Handle, CString, -1, TextBounds, DT_CALCRECT or DT_CENTER
  4143.       or DT_VCENTER or WordWraps[FWordWrap] or Flags);
  4144.   end
  4145.   else TextBounds := Rect(0, 0, 0, 0);
  4146.   TextBounds.Bottom := Max(TextBounds.Top, TextBounds.Top +
  4147.     Min(MaxSize.Y, HeightOf(TextBounds)));
  4148.   TextBounds.Right := Max(TextBounds.Left, TextBounds.Left +
  4149.     Min(MaxSize.X, WidthOf(TextBounds)));
  4150.   TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
  4151.     TextBounds.Top);
  4152.   if PopupMark then
  4153.     if ((GlyphSize.X = 0) or (GlyphSize.Y = 0)) or (Layout = blGlyphLeft) then
  4154.       Inc(TextSize.X, 9)
  4155.     else if (GlyphSize.X > 0) then
  4156.       Inc(GlyphSize.X, 6);
  4157.   { If the layout has the glyph on the right or the left, then both the
  4158.     text and the glyph are centered vertically.  If the glyph is on the top
  4159.     or the bottom, then both the text and the glyph are centered horizontally.}
  4160.   if Layout in [blGlyphLeft, blGlyphRight] then begin
  4161.     GlyphPos.Y := (ClientSize.Y div 2) - (GlyphSize.Y div 2);
  4162.     TextPos.Y := (ClientSize.Y div 2) - (TextSize.Y div 2);
  4163.   end
  4164.   else begin
  4165.     GlyphPos.X := (ClientSize.X div 2) - (GlyphSize.X div 2);
  4166.     TextPos.X := (ClientSize.X div 2) - (TextSize.X div 2);
  4167.   end;
  4168.   { if there is no text or no bitmap, then Spacing is irrelevant }
  4169.   if (TextSize.X = 0) or (GlyphSize.X = 0) then Spacing := 0;
  4170.   { adjust Margin and Spacing }
  4171.   if Margin = -1 then begin
  4172.     if Spacing = -1 then begin
  4173.       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
  4174.       if Layout in [blGlyphLeft, blGlyphRight] then
  4175.         Margin := (ClientSize.X - TotalSize.X) div 3
  4176.       else Margin := (ClientSize.Y - TotalSize.Y) div 3;
  4177.       Spacing := Margin;
  4178.     end
  4179.     else begin
  4180.       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
  4181.         Spacing + TextSize.Y);
  4182.       if Layout in [blGlyphLeft, blGlyphRight] then
  4183.         Margin := (ClientSize.X div 2) - (TotalSize.X div 2)
  4184.       else Margin := (ClientSize.Y div 2) - (TotalSize.Y div 2);
  4185.     end;
  4186.   end
  4187.   else begin
  4188.     if Spacing = -1 then begin
  4189.       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
  4190.         (Margin + GlyphSize.Y));
  4191.       if Layout in [blGlyphLeft, blGlyphRight] then
  4192.         Spacing := (TotalSize.X div 2) - (TextSize.X div 2)
  4193.       else Spacing := (TotalSize.Y div 2) - (TextSize.Y div 2);
  4194.     end;
  4195.   end;
  4196.   case Layout of
  4197.     blGlyphLeft:
  4198.       begin
  4199.         GlyphPos.X := Margin;
  4200.         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
  4201.       end;
  4202.     blGlyphRight:
  4203.       begin
  4204.         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
  4205.         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
  4206.       end;
  4207.     blGlyphTop:
  4208.       begin
  4209.         GlyphPos.Y := Margin;
  4210.         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
  4211.       end;
  4212.     blGlyphBottom:
  4213.       begin
  4214.         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
  4215.         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
  4216.       end;
  4217.   end;
  4218.   { fixup the result variables }
  4219.   Inc(GlyphPos.X, Client.Left);
  4220.   Inc(GlyphPos.Y, Client.Top);
  4221.   OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top);
  4222. end;
  4223.  
  4224. {$IFDEF WIN32}
  4225. function TRxButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
  4226.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  4227.   PopupMark: Boolean; State: TRxButtonState; Flags: Word): TRect;
  4228. begin
  4229.   Result := DrawEx(Canvas, Client, Caption, Layout, Margin, Spacing,
  4230.     PopupMark, nil, -1, State, Flags);
  4231. end;
  4232. {$ENDIF}
  4233.  
  4234. {$IFDEF WIN32}
  4235. function TRxButtonGlyph.DrawEx(Canvas: TCanvas; const Client: TRect;
  4236.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  4237.   PopupMark: Boolean; Images: TImageList; ImageIndex: Integer;
  4238.   State: TRxButtonState; Flags: Word): TRect;
  4239. {$ELSE}
  4240. function TRxButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
  4241.   const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
  4242.   PopupMark: Boolean; State: TRxButtonState; Flags: Word): TRect;
  4243. {$ENDIF}
  4244. var
  4245. {$IFDEF WIN32}
  4246.   UseImages: Boolean;
  4247. {$ENDIF}
  4248.   GlyphPos, PopupPos: TPoint;
  4249.   TextBounds: TRect;
  4250.   CaptionText: string;
  4251. begin
  4252.   CaptionText := Caption;
  4253.   CalcButtonLayout(Canvas, Client, CaptionText, Layout, Margin, Spacing,
  4254.     PopupMark, GlyphPos, TextBounds, Flags {$IFDEF WIN32}, Images,
  4255.     ImageIndex {$ENDIF});
  4256. {$IFDEF WIN32}
  4257.   UseImages := False;
  4258.   if Assigned(Images) and (ImageIndex >= 0) and (ImageIndex < Images.Count) and
  4259.     (Images.Width > 0) then
  4260.   begin
  4261.     UseImages := True;
  4262.     PopupPos := DrawButtonImage(Canvas, GlyphPos.X, GlyphPos.Y, Images,
  4263.       ImageIndex, State);
  4264.   end else
  4265. {$ENDIF}
  4266.   PopupPos := DrawButtonGlyph(Canvas, GlyphPos.X, GlyphPos.Y, State);
  4267.   DrawButtonText(Canvas, CaptionText, TextBounds, State, Flags);
  4268.   if PopupMark then
  4269.     if (Layout <> blGlyphLeft) and (((FOriginal <> nil) and
  4270.       (FOriginal.Width > 0)) {$IFDEF WIN32} or UseImages {$ENDIF}) then
  4271.     begin
  4272.       PopupPos.X := GlyphPos.X + PopupPos.X + 1;
  4273.       PopupPos.Y := GlyphPos.Y + PopupPos.Y div 2;
  4274.       DrawPopupMark(Canvas, PopupPos.X, PopupPos.Y, State);
  4275.     end
  4276.     else begin
  4277.       if CaptionText <> '' then
  4278.         PopupPos.X := TextBounds.Right + 3
  4279.       else
  4280.         PopupPos.X := (Client.Left + Client.Right - 7) div 2;
  4281.       PopupPos.Y := TextBounds.Top  + HeightOf(TextBounds) div 2;
  4282.       DrawPopupMark(Canvas, PopupPos.X, PopupPos.Y, State);
  4283.     end;
  4284.   Result := TextBounds;
  4285. end;
  4286.  
  4287. const
  4288. {$IFNDEF RX_D4}
  4289.   Pattern: TBitmap = nil;
  4290. {$ENDIF}
  4291.   ButtonCount: Integer = 0;
  4292.  
  4293. { DrawButtonFrame - returns the remaining usable area inside the Client rect }
  4294.  
  4295. function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
  4296.   IsDown, IsFlat: Boolean; Style: TButtonStyle): TRect;
  4297. var
  4298.   NewStyle: Boolean;
  4299. begin
  4300.   Result := Client;
  4301.   NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
  4302.   if IsDown then begin
  4303.     if NewStyle then begin
  4304.       Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1);
  4305.       if not IsFlat then
  4306.         Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
  4307.     end
  4308.     else begin
  4309.       if IsFlat then
  4310.         Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1)
  4311.       else begin
  4312.         Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
  4313.         Canvas.Pen.Color := clBtnShadow;
  4314.         Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
  4315.           Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
  4316.       end;
  4317.     end;
  4318.   end
  4319.   else begin
  4320.     if NewStyle then begin
  4321.       if IsFlat then 
  4322.         Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1)
  4323.       else begin
  4324.         Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1);
  4325.         Frame3D(Canvas, Result, clBtnFace, clBtnShadow, 1);
  4326.       end; 
  4327.     end
  4328.     else begin
  4329.       if IsFlat then
  4330.         Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1)
  4331.       else begin
  4332.         Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
  4333.         Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1);
  4334.       end;
  4335.     end;
  4336.   end;
  4337.   InflateRect(Result, -1, -1);
  4338. end;
  4339.  
  4340. { TButtonImage }
  4341.  
  4342. constructor TButtonImage.Create;
  4343. begin
  4344.   FGlyph := TRxButtonGlyph.Create;
  4345.   NumGlyphs := 1;
  4346.   FButtonSize := Point(24, 23);
  4347. end;
  4348.  
  4349. destructor TButtonImage.Destroy;
  4350. begin
  4351.   FGlyph.Free;
  4352.   inherited Destroy;
  4353. end;
  4354.  
  4355. procedure TButtonImage.Invalidate;
  4356. begin
  4357.   TRxButtonGlyph(FGlyph).Invalidate;
  4358. end;
  4359.  
  4360. function TButtonImage.GetNumGlyphs: TRxNumGlyphs;
  4361. begin
  4362.   Result := TRxButtonGlyph(FGlyph).NumGlyphs;
  4363. end;
  4364.  
  4365. procedure TButtonImage.SetNumGlyphs(Value: TRxNumGlyphs);
  4366. begin
  4367.   TRxButtonGlyph(FGlyph).NumGlyphs := Value;
  4368. end;
  4369.  
  4370. function TButtonImage.GetWordWrap: Boolean;
  4371. begin
  4372.   Result := TRxButtonGlyph(FGlyph).WordWrap;
  4373. end;
  4374.  
  4375. procedure TButtonImage.SetWordWrap(Value: Boolean);
  4376. begin
  4377.   TRxButtonGlyph(FGlyph).WordWrap := Value;
  4378. end;
  4379.  
  4380. function TButtonImage.GetGlyph: TBitmap;
  4381. begin
  4382.   Result := TRxButtonGlyph(FGlyph).Glyph;
  4383. end;
  4384.  
  4385. procedure TButtonImage.SetGlyph(Value: TBitmap);
  4386. begin
  4387.   TRxButtonGlyph(FGlyph).Glyph := Value;
  4388. end;
  4389.  
  4390. function TButtonImage.GetAlignment: TAlignment;
  4391. begin
  4392.   Result := TRxButtonGlyph(FGlyph).Alignment;
  4393. end;
  4394.  
  4395. procedure TButtonImage.SetAlignment(Value: TAlignment);
  4396. begin
  4397.   TRxButtonGlyph(FGlyph).Alignment := Value;
  4398. end;
  4399.  
  4400. {$IFDEF WIN32}
  4401. procedure TButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  4402.   Layout: TButtonLayout; AFont: TFont; Flags: Word);
  4403. begin
  4404.   DrawEx(Canvas, X, Y, Margin, Spacing, Layout, AFont, nil, -1, Flags);
  4405. end;
  4406. {$ENDIF}
  4407.  
  4408. {$IFDEF WIN32}
  4409. procedure TButtonImage.DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  4410.   Layout: TButtonLayout; AFont: TFont; Images: TImageList; ImageIndex: Integer;
  4411.   Flags: Word);
  4412. {$ELSE}
  4413. procedure TButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
  4414.   Layout: TButtonLayout; AFont: TFont; Flags: Word);
  4415. {$ENDIF}
  4416. var
  4417.   Target: TRect;
  4418.   SaveColor: Integer;
  4419.   SaveFont: TFont;
  4420. begin
  4421.   SaveColor := Canvas.Brush.Color;
  4422.   SaveFont := TFont.Create;
  4423.   SaveFont.Assign(Canvas.Font);
  4424.   try
  4425.     Target := Bounds(X, Y, FButtonSize.X, FButtonSize.Y);
  4426.     Canvas.Brush.Color := clBtnFace;
  4427.     Canvas.FillRect(Target);
  4428.     Frame3D(Canvas, Target, clBtnShadow, clWindowFrame, 1);
  4429.     Frame3D(Canvas, Target, clBtnHighlight, clBtnShadow, 1);
  4430.     if AFont <> nil then Canvas.Font := AFont;
  4431. {$IFDEF WIN32}
  4432.     TRxButtonGlyph(FGlyph).DrawEx(Canvas, Target, Caption, Layout, Margin,
  4433.       Spacing, False, Images, ImageIndex, rbsUp, Flags);
  4434. {$ELSE}
  4435.     TRxButtonGlyph(FGlyph).Draw(Canvas, Target, Caption, Layout, Margin,
  4436.       Spacing, False, rbsUp, Flags);
  4437. {$ENDIF}
  4438.   finally
  4439.     Canvas.Font.Assign(SaveFont);
  4440.     SaveFont.Free;
  4441.     Canvas.Brush.Color := SaveColor;
  4442.   end;
  4443. end;
  4444.  
  4445. { TRxSpeedButton }
  4446.  
  4447. constructor TRxSpeedButton.Create(AOwner: TComponent);
  4448. begin
  4449.   inherited Create(AOwner);
  4450.   SetBounds(0, 0, 25, 25);
  4451.   ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  4452. {$IFDEF WIN32}
  4453.   ControlStyle := ControlStyle + [csReplicatable];
  4454. {$ENDIF}
  4455.   FInactiveGrayed := True;
  4456.   FDrawImage := TBitmap.Create;
  4457.   FGlyph := TRxButtonGlyph.Create;
  4458.   TRxButtonGlyph(FGlyph).OnChange := GlyphChanged;
  4459.   ParentFont := True;
  4460.   ParentShowHint := False;
  4461.   ShowHint := True;
  4462.   FSpacing := 1;
  4463.   FMargin := -1;
  4464.   FInitRepeatPause := 500;
  4465.   FRepeatPause := 100;
  4466.   FStyle := bsAutoDetect;
  4467.   FLayout := blGlyphTop;
  4468.   FMarkDropDown := True;
  4469.   Inc(ButtonCount);
  4470. end;
  4471.  
  4472. destructor TRxSpeedButton.Destroy;
  4473. begin
  4474.   TRxButtonGlyph(FGlyph).Free;
  4475.   Dec(ButtonCount);
  4476. {$IFNDEF RX_D4}
  4477.   if ButtonCount = 0 then begin
  4478.     Pattern.Free;
  4479.     Pattern := nil;
  4480.   end;
  4481. {$ENDIF}
  4482.   FDrawImage.Free;
  4483.   FDrawImage := nil;
  4484.   if FRepeatTimer <> nil then FRepeatTimer.Free;
  4485.   inherited Destroy;
  4486. end;
  4487.  
  4488. procedure TRxSpeedButton.Loaded;
  4489. var
  4490.   State: TRxButtonState;
  4491. begin
  4492.   inherited Loaded;
  4493.   if Enabled then begin
  4494.     if Flat then State := rbsInactive
  4495.     else State := rbsUp;
  4496.   end
  4497.   else State := rbsDisabled;
  4498.   TRxButtonGlyph(FGlyph).CreateButtonGlyph(State);
  4499. end;
  4500.  
  4501. procedure TRxSpeedButton.PaintGlyph(Canvas: TCanvas; ARect: TRect;
  4502.   AState: TRxButtonState; DrawMark: Boolean);
  4503. begin
  4504.   TRxButtonGlyph(FGlyph).Draw(Canvas, ARect, Caption, FLayout,
  4505.     FMargin, FSpacing, DrawMark, AState,
  4506.     {$IFDEF RX_D4} DrawTextBiDiModeFlags(Alignments[Alignment]) {$ELSE}
  4507.     Alignments[Alignment] {$ENDIF});
  4508. end;
  4509.  
  4510. procedure TRxSpeedButton.Paint;
  4511. var
  4512.   PaintRect: TRect;
  4513.   AState: TRxButtonState;
  4514. begin
  4515.   if not Enabled {and not (csDesigning in ComponentState)} then begin
  4516.     FState := rbsDisabled;
  4517.     FDragging := False;
  4518.   end
  4519.   else if FState = rbsDisabled then
  4520.     if FDown and (GroupIndex <> 0) then FState := rbsExclusive
  4521.     else FState := rbsUp;
  4522.   AState := FState;
  4523.   if FFlat and not FMouseInControl and not (csDesigning in ComponentState) then
  4524.     AState := rbsInactive;
  4525.   PaintRect := Rect(0, 0, Width, Height);
  4526.   FDrawImage.Width := Self.Width;
  4527.   FDrawImage.Height := Self.Height;
  4528.   with FDrawImage.Canvas do begin
  4529.     Font := Self.Font;
  4530.     Brush.Color := clBtnFace;
  4531.     Brush.Style := bsSolid;
  4532.     FillRect(PaintRect);
  4533.     if FTransparent then CopyParentImage(Self, FDrawImage.Canvas);
  4534.     if (AState <> rbsInactive) or (FState = rbsExclusive) then
  4535.       PaintRect := DrawButtonFrame(FDrawImage.Canvas, PaintRect,
  4536.         FState in [rbsDown, rbsExclusive], FFlat, FStyle)
  4537.     else if FFlat then
  4538.       InflateRect(PaintRect, -2, -2);
  4539.   end;
  4540.   if (FState = rbsExclusive) and not Transparent and
  4541.     (not FFlat or (AState = rbsInactive)) then
  4542.   begin
  4543. {$IFDEF RX_D4}
  4544.     FDrawImage.Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
  4545. {$ELSE}
  4546.     if Pattern = nil then
  4547.       Pattern := CreateTwoColorsBrushPattern(clBtnFace, clBtnHighlight);
  4548.     FDrawImage.Canvas.Brush.Bitmap := Pattern;
  4549. {$ENDIF}
  4550.     InflateRect(PaintRect, 1, 1);
  4551.     FDrawImage.Canvas.FillRect(PaintRect);
  4552.     InflateRect(PaintRect, -1, -1);
  4553.   end;
  4554.   if FState in [rbsDown, rbsExclusive] then OffsetRect(PaintRect, 1, 1);
  4555.   if (FState = rbsDisabled) or not FInactiveGrayed then AState := FState;
  4556.   PaintGlyph(FDrawImage.Canvas, PaintRect, AState, FMarkDropDown and
  4557.     Assigned(FDropDownMenu));
  4558.   Canvas.Draw(0, 0, FDrawImage);
  4559. end;
  4560.  
  4561. procedure TRxSpeedButton.Notification(AComponent: TComponent;
  4562.   Operation: TOperation);
  4563. begin
  4564.   inherited Notification(AComponent, Operation);
  4565.   if (AComponent = DropDownMenu) and (Operation = opRemove) then
  4566.     DropDownMenu := nil;
  4567. end;
  4568.  
  4569. function TRxSpeedButton.GetDropDownMenuPos: TPoint;
  4570. begin
  4571.   if Assigned(FDropDownMenu) then begin
  4572.     if MenuPosition = dmpBottom then begin
  4573.       case FDropDownMenu.Alignment of
  4574.         paLeft: Result := Point(-1, Height);
  4575.         paRight: Result := Point(Width + 1, Height);
  4576.         else {paCenter} Result := Point(Width div 2, Height);
  4577.       end;
  4578.     end
  4579.     else { dmpRight } begin
  4580.       case FDropDownMenu.Alignment of
  4581.         paLeft: Result := Point(Width, -1);
  4582.         paRight: Result := Point(-1, -1);
  4583.         else {paCenter} Result := Point(Width div 2, Height);
  4584.       end;
  4585.     end;
  4586.   end else Result := Point(0, 0);
  4587. end;
  4588.  
  4589. function TRxSpeedButton.CheckBtnMenuDropDown: Boolean;
  4590. begin
  4591.   Result := CheckMenuDropDown(
  4592.     {$IFDEF WIN32}PointToSmallPoint(GetDropDownMenuPos){$ELSE}
  4593.     GetDropDownMenuPos{$ENDIF}, True);
  4594. end;
  4595.  
  4596. function TRxSpeedButton.CheckMenuDropDown(const Pos: TSmallPoint;
  4597.   Manual: Boolean): Boolean;
  4598. var
  4599.   Form: TCustomForm;
  4600. begin
  4601.   Result := False;
  4602.   if csDesigning in ComponentState then Exit;
  4603.   if Assigned(FDropDownMenu) and (DropDownMenu.AutoPopup or Manual) then
  4604.   begin
  4605.     Form := GetParentForm(Self);
  4606.     if Form <> nil then Form.SendCancelMode(nil);
  4607.     DropDownMenu.PopupComponent := Self;
  4608.     with ClientToScreen(SmallPointToPoint(Pos)) do DropDownMenu.Popup(X, Y);
  4609.     Result := True;
  4610.   end;
  4611. end;
  4612.  
  4613. procedure TRxSpeedButton.MouseEnter;
  4614. begin
  4615.   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  4616. end;
  4617.  
  4618. procedure TRxSpeedButton.MouseLeave;
  4619. begin
  4620.   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  4621. end;
  4622.  
  4623. procedure TRxSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  4624.   X, Y: Integer);
  4625. var
  4626.   P: TPoint;
  4627.   Msg: TMsg;
  4628. begin
  4629.   if FMenuTracking then Exit;
  4630.   inherited MouseDown(Button, Shift, X, Y);
  4631.   if (not FMouseInControl) and Enabled then begin
  4632.     FMouseInControl := True;
  4633.     Repaint;
  4634.   end;
  4635.   if (Button = mbLeft) and Enabled {and not (ssDouble in Shift)} then begin
  4636.     if not FDown then begin
  4637.       FState := rbsDown;
  4638.       Repaint;
  4639.     end;
  4640.     FDragging := True;
  4641.     FMenuTracking := True;
  4642.     try
  4643.       P := GetDropDownMenuPos;
  4644.       if CheckMenuDropDown(PointToSmallPoint(P), False) then
  4645.         DoMouseUp(Button, Shift, X, Y);
  4646.       if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin
  4647.         if (Msg.Message = WM_LBUTTONDOWN) or (Msg.Message = WM_LBUTTONDBLCLK) then
  4648.         begin
  4649.           P := ScreenToClient(Msg.Pt);
  4650.           if (P.X >= 0) and (P.X < ClientWidth) and (P.Y >= 0)
  4651.             and (P.Y <= ClientHeight) then KillMessage(0, Msg.Message);
  4652.               {PeekMessage(Msg, 0, 0, 0, PM_REMOVE);}
  4653.         end;
  4654.       end;
  4655.     finally
  4656.       FMenuTracking := False;
  4657.     end;
  4658.     if FAllowTimer then begin
  4659.       if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self);
  4660.       FRepeatTimer.Interval := InitPause;
  4661.       FRepeatTimer.OnTimer := TimerExpired;
  4662.       FRepeatTimer.Enabled  := True;
  4663.     end;
  4664.   end;
  4665. end;
  4666.  
  4667. procedure TRxSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  4668. var
  4669.   NewState: TRxButtonState;
  4670. begin
  4671.   inherited MouseMove(Shift, X, Y);
  4672.   if FDragging then begin
  4673.     if not FDown then NewState := rbsUp
  4674.     else NewState := rbsExclusive;
  4675.     if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
  4676.       if FDown then NewState := rbsExclusive else NewState := rbsDown;
  4677.     if NewState <> FState then begin
  4678.       FState := NewState;
  4679.       Repaint;
  4680.     end;
  4681.   end;
  4682. end;
  4683.  
  4684. procedure TRxSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  4685.   X, Y: Integer);
  4686. begin
  4687.   inherited MouseUp(Button, Shift, X, Y);
  4688.   DoMouseUp(Button, Shift, X, Y);
  4689.   if FRepeatTimer <> nil then FRepeatTimer.Enabled  := False;
  4690. end;
  4691.  
  4692. procedure TRxSpeedButton.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
  4693.   X, Y: Integer);
  4694. var
  4695.   DoClick: Boolean;
  4696. begin
  4697.   if FDragging and (Button = mbLeft) then begin
  4698.     FDragging := False;
  4699.     DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
  4700.     if FGroupIndex = 0 then begin
  4701.       FState := rbsUp;
  4702.       FMouseInControl := False;
  4703.       if DoClick and not (FState in [rbsExclusive, rbsDown]) then
  4704.         Repaint
  4705.       else Invalidate;
  4706.     end
  4707.     else if DoClick then begin
  4708.       SetDown(not FDown);
  4709.       if FDown then Repaint;
  4710.     end
  4711.     else begin
  4712.       if FDown then FState := rbsExclusive;
  4713.       Repaint;
  4714.     end;
  4715.     if DoClick and not FMenuTracking then Click;
  4716.   end;
  4717.   UpdateTracking;
  4718. end;
  4719.  
  4720. procedure TRxSpeedButton.ButtonClick;
  4721. var
  4722.   FirstTickCount, Now: Longint;
  4723. begin
  4724.   if FMenuTracking or (not Enabled) or (Assigned(FDropDownMenu) and
  4725.     DropDownMenu.AutoPopup) then Exit;
  4726.   if not FDown then begin
  4727.     FState := rbsDown;
  4728.     Repaint;
  4729.   end;
  4730.   try
  4731.     FirstTickCount := GetTickCount;
  4732.     repeat
  4733.       Now := GetTickCount;
  4734.     until (Now - FirstTickCount >= 20) or (Now < FirstTickCount);
  4735.     if FGroupIndex = 0 then Click;
  4736.   finally
  4737.     FState := rbsUp;
  4738.     if FGroupIndex = 0 then Repaint
  4739.     else begin
  4740.       SetDown(not FDown);
  4741.       Click;
  4742.     end;
  4743.   end;
  4744. end;
  4745.  
  4746. procedure TRxSpeedButton.Click;
  4747. var
  4748.   Form: TCustomForm;
  4749. begin
  4750.   Form := GetParentForm(Self);
  4751.   if Form <> nil then Form.ModalResult := ModalResult;
  4752.   inherited Click;
  4753. end;
  4754.  
  4755. function TRxSpeedButton.GetPalette: HPALETTE;
  4756. begin
  4757.   Result := Glyph.Palette;
  4758. end;
  4759.  
  4760. function TRxSpeedButton.GetWordWrap: Boolean;
  4761. begin
  4762.   Result := TRxButtonGlyph(FGlyph).WordWrap;
  4763. end;
  4764.  
  4765. procedure TRxSpeedButton.SetWordWrap(Value: Boolean);
  4766. begin
  4767.   if Value <> WordWrap then begin
  4768.     TRxButtonGlyph(FGlyph).WordWrap := Value;
  4769.     Invalidate;
  4770.   end;
  4771. end;
  4772.  
  4773. function TRxSpeedButton.GetAlignment: TAlignment;
  4774. begin
  4775.   Result := TRxButtonGlyph(FGlyph).Alignment;
  4776. end;
  4777.  
  4778. procedure TRxSpeedButton.SetAlignment(Value: TAlignment);
  4779. begin
  4780.   if Alignment <> Value then begin
  4781.     TRxButtonGlyph(FGlyph).Alignment := Value;
  4782.     Invalidate;
  4783.   end;
  4784. end;
  4785.  
  4786. function TRxSpeedButton.GetGlyph: TBitmap;
  4787. begin
  4788.   Result := TRxButtonGlyph(FGlyph).Glyph;
  4789. end;
  4790.  
  4791. procedure TRxSpeedButton.SetGlyph(Value: TBitmap);
  4792. begin
  4793.   TRxButtonGlyph(FGlyph).Glyph := Value;
  4794.   Invalidate;
  4795. end;
  4796.  
  4797. function TRxSpeedButton.GetNumGlyphs: TRxNumGlyphs;
  4798. begin
  4799.   Result := TRxButtonGlyph(FGlyph).NumGlyphs;
  4800. end;
  4801.  
  4802. procedure TRxSpeedButton.SetNumGlyphs(Value: TRxNumGlyphs);
  4803. begin
  4804.   if Value < 0 then Value := 1
  4805.   else if Value > Ord(High(TRxButtonState)) + 1 then
  4806.     Value := Ord(High(TRxButtonState)) + 1;
  4807.   if Value <> TRxButtonGlyph(FGlyph).NumGlyphs then begin
  4808.     TRxButtonGlyph(FGlyph).NumGlyphs := Value;
  4809.     Invalidate;
  4810.   end;
  4811. end;
  4812.  
  4813. procedure TRxSpeedButton.GlyphChanged(Sender: TObject);
  4814. begin
  4815.   Invalidate;
  4816. end;
  4817.  
  4818. procedure TRxSpeedButton.UpdateExclusive;
  4819. var
  4820.   Msg: TMessage;
  4821. begin
  4822.   if (FGroupIndex <> 0) and (Parent <> nil) then begin
  4823.     Msg.Msg := CM_RXBUTTONPRESSED;
  4824.     Msg.WParam := FGroupIndex;
  4825.     Msg.LParam := Longint(Self);
  4826.     Msg.Result := 0;
  4827.     Parent.Broadcast(Msg);
  4828.   end;
  4829. end;
  4830.  
  4831. procedure TRxSpeedButton.SetDown(Value: Boolean);
  4832. begin
  4833.   if FGroupIndex = 0 then Value := False;
  4834.   if Value <> FDown then begin
  4835.     if FDown and (not FAllowAllUp) then Exit;
  4836.     FDown := Value;
  4837.     if Value then begin
  4838.       if FState = rbsUp then Invalidate;
  4839.       FState := rbsExclusive;
  4840.     end
  4841.     else begin
  4842.       FState := rbsUp;
  4843.     end;
  4844.     Repaint;
  4845.     if Value then UpdateExclusive;
  4846.     Invalidate;
  4847.   end;
  4848. end;
  4849.  
  4850. procedure TRxSpeedButton.SetGroupIndex(Value: Integer);
  4851. begin
  4852.   if FGroupIndex <> Value then begin
  4853.     FGroupIndex := Value;
  4854.     UpdateExclusive;
  4855.   end;
  4856. end;
  4857.  
  4858. procedure TRxSpeedButton.SetLayout(Value: TButtonLayout);
  4859. begin
  4860.   if FLayout <> Value then begin
  4861.     FLayout := Value;
  4862.     Invalidate;
  4863.   end;
  4864. end;
  4865.  
  4866. procedure TRxSpeedButton.SetMargin(Value: Integer);
  4867. begin
  4868.   if (Value <> FMargin) and (Value >= -1) then begin
  4869.     FMargin := Value;
  4870.     Invalidate;
  4871.   end;
  4872. end;
  4873.  
  4874. procedure TRxSpeedButton.SetSpacing(Value: Integer);
  4875. begin
  4876.   if Value <> FSpacing then begin
  4877.     FSpacing := Value;
  4878.     Invalidate;
  4879.   end;
  4880. end;
  4881.  
  4882. procedure TRxSpeedButton.SetAllowAllUp(Value: Boolean);
  4883. begin
  4884.   if FAllowAllUp <> Value then begin
  4885.     FAllowAllUp := Value;
  4886.     UpdateExclusive;
  4887.   end;
  4888. end;
  4889.  
  4890. procedure TRxSpeedButton.SetAllowTimer(Value: Boolean);
  4891. begin
  4892.   FAllowTimer := Value;
  4893.   if not FAllowTimer and (FRepeatTimer <> nil) then begin
  4894.     FRepeatTimer.Enabled := False;
  4895.     FRepeatTimer.Free;
  4896.     FRepeatTimer := nil;
  4897.   end;
  4898. end;
  4899.  
  4900. procedure TRxSpeedButton.SetDropDownMenu(Value: TPopupMenu);
  4901. begin
  4902.   FDropDownMenu := Value;
  4903. {$IFDEF WIN32}
  4904.   if Value <> nil then Value.FreeNotification(Self);
  4905. {$ENDIF}
  4906.   if FMarkDropDown then Invalidate;
  4907. end;
  4908.  
  4909. procedure TRxSpeedButton.SetInactiveGrayed(Value: Boolean);
  4910. begin
  4911.   if Value <> FInactiveGrayed then begin
  4912.     FInactiveGrayed := Value;
  4913.     Invalidate;
  4914.   end;
  4915. end;
  4916.  
  4917. procedure TRxSpeedButton.SetFlat(Value: Boolean);
  4918. begin
  4919.   if Value <> FFlat then begin
  4920.     FFlat := Value;
  4921.     Invalidate;
  4922.   end;
  4923. end;
  4924.  
  4925. procedure TRxSpeedButton.SetStyle(Value: TButtonStyle);
  4926. begin
  4927.   if Style <> Value then begin
  4928.     FStyle := Value;
  4929.     Invalidate;
  4930.   end;
  4931. end;
  4932.  
  4933. procedure TRxSpeedButton.SetMarkDropDown(Value: Boolean);
  4934. begin
  4935.   if Value <> FMarkDropDown then begin
  4936.     FMarkDropDown := Value;
  4937.     Invalidate;
  4938.   end;
  4939. end;
  4940.  
  4941. procedure TRxSpeedButton.SetTransparent(Value: Boolean);
  4942. begin
  4943.   if Value <> FTransparent then begin
  4944.     FTransparent := Value;
  4945.     Invalidate;
  4946.   end;
  4947. end;
  4948.  
  4949. procedure TRxSpeedButton.WMRButtonDown(var Message: TWMRButtonDown);
  4950. begin
  4951.   inherited;
  4952.   UpdateTracking;
  4953. end;
  4954.  
  4955. procedure TRxSpeedButton.WMRButtonUp(var Message: TWMRButtonUp);
  4956. begin
  4957.   inherited;
  4958.   UpdateTracking;
  4959. end;
  4960.  
  4961. procedure TRxSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
  4962. begin
  4963.   if not FMenuTracking then begin
  4964.     inherited;
  4965.     if FDown then DblClick;
  4966.   end;
  4967. end;
  4968.  
  4969. procedure TRxSpeedButton.CMEnabledChanged(var Message: TMessage);
  4970. var
  4971.   State: TRxButtonState;
  4972. begin
  4973.   inherited;
  4974.   if Enabled then begin
  4975.     if Flat then State := rbsInactive
  4976.     else State := rbsUp;
  4977.   end else State := rbsDisabled;
  4978.   TRxButtonGlyph(FGlyph).CreateButtonGlyph(State);
  4979.   UpdateTracking;
  4980.   Repaint;
  4981. end;
  4982.  
  4983. procedure TRxSpeedButton.CMVisibleChanged(var Message: TMessage);
  4984. begin
  4985.   inherited;
  4986.   if Visible then UpdateTracking;
  4987. end;
  4988.  
  4989. procedure TRxSpeedButton.CMMouseEnter(var Message: TMessage);
  4990. begin
  4991.   inherited;
  4992.   if (not FMouseInControl) and Enabled and IsForegroundTask then begin
  4993.     FMouseInControl := True;
  4994.     if FFlat then Repaint;
  4995.     MouseEnter;
  4996.   end;
  4997. end;
  4998.  
  4999. procedure TRxSpeedButton.CMMouseLeave(var Message: TMessage);
  5000. begin
  5001.   inherited;
  5002.   if FMouseInControl and Enabled and not FDragging then begin
  5003.     FMouseInControl := False;
  5004.     if FFlat then Invalidate;
  5005.     MouseLeave;
  5006.   end;
  5007. end;
  5008.  
  5009. procedure TRxSpeedButton.WMMouseMove(var Message: TMessage);
  5010. begin
  5011.   inherited;
  5012. end;
  5013.  
  5014. procedure TRxSpeedButton.CMButtonPressed(var Message: TMessage);
  5015. var
  5016.   Sender: TControl;
  5017. begin
  5018.   if (Message.WParam = FGroupIndex) and Parent.HandleAllocated then begin
  5019.     Sender := TControl(Message.LParam);
  5020.     if (Sender <> nil) and (Sender is TRxSpeedButton) then
  5021.       if Sender <> Self then begin
  5022.         if TRxSpeedButton(Sender).Down and FDown then begin
  5023.           FDown := False;
  5024.           FState := rbsUp;
  5025.           Repaint;
  5026.         end;
  5027.         FAllowAllUp := TRxSpeedButton(Sender).AllowAllUp;
  5028.       end;
  5029.   end;
  5030. end;
  5031.  
  5032. procedure TRxSpeedButton.CMDialogChar(var Message: TCMDialogChar);
  5033. begin
  5034.   with Message do
  5035.     if IsAccel(CharCode, Caption) and Enabled then begin
  5036.       Click;
  5037.       Result := 1;
  5038.     end
  5039.     else inherited;
  5040. end;
  5041.  
  5042. procedure TRxSpeedButton.CMFontChanged(var Message: TMessage);
  5043. begin
  5044.   Invalidate;
  5045. end;
  5046.  
  5047. procedure TRxSpeedButton.CMTextChanged(var Message: TMessage);
  5048. begin
  5049.   Invalidate;
  5050. end;
  5051.  
  5052. procedure TRxSpeedButton.CMSysColorChange(var Message: TMessage);
  5053. begin
  5054.   TRxButtonGlyph(FGlyph).Invalidate;
  5055.   Invalidate;
  5056. end;
  5057.  
  5058. procedure TRxSpeedButton.UpdateTracking;
  5059. var
  5060.   P: TPoint;
  5061.   OldValue: Boolean;
  5062. begin
  5063.   OldValue := FMouseInControl;
  5064.   GetCursorPos(P);
  5065.   FMouseInControl := Enabled and (FindDragTarget(P, True) = Self) and
  5066.     IsForegroundTask;
  5067.   if (FMouseInControl <> OldValue) then
  5068.     if FMouseInControl then begin
  5069.       if Flat then Repaint;
  5070.       MouseEnter;
  5071.     end
  5072.     else begin
  5073.       if Flat then Invalidate;
  5074.       MouseLeave;
  5075.     end;
  5076. end;
  5077.  
  5078. procedure TRxSpeedButton.TimerExpired(Sender: TObject);
  5079. begin
  5080.   FRepeatTimer.Interval := RepeatInterval;
  5081.   if (FState = rbsDown) and MouseCapture then
  5082.     try
  5083.       Click;
  5084.     except
  5085.       FRepeatTimer.Enabled := False;
  5086.       raise;
  5087.     end;
  5088. end;
  5089.  
  5090. {$IFDEF RX_D4}
  5091. procedure TRxSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  5092.  
  5093.   procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  5094.   begin
  5095.     with Glyph do begin
  5096.       Width := ImageList.Width;
  5097.       Height := ImageList.Height;
  5098.       Canvas.Brush.Color := clFuchsia;
  5099.       Canvas.FillRect(Rect(0, 0, Width, Height));
  5100.       ImageList.Draw(Canvas, 0, 0, Index);
  5101.       TransparentColor := clFuchsia;
  5102.     end;
  5103.   end;
  5104.  
  5105. begin
  5106.   inherited ActionChange(Sender, CheckDefaults);
  5107.   if Sender is TCustomAction then
  5108.     with TCustomAction(Sender) do begin
  5109.       if (not CheckDefaults or (Self.Down = False)) and (FGroupIndex <> 0) then
  5110.         Self.Down := Checked;
  5111.       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
  5112.         (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
  5113.         CopyImage(ActionList.Images, ImageIndex);
  5114.     end;
  5115. end;
  5116. {$ENDIF RX_D4}
  5117.  
  5118. {$IFDEF WIN32}
  5119. initialization
  5120.   FCheckBitmap := nil;
  5121. finalization
  5122.   DestroyLocals;
  5123. {$ELSE}
  5124. initialization
  5125.   FCheckBitmap := nil;
  5126.   AddExitProc(DestroyLocals);
  5127. {$ENDIF}
  5128. end.