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