Speedbar.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:86k
源码类别:

Delphi控件源码

开发平台:

Delphi

  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. unit SpeedBar;
  10. {$I RX.INC}
  11. {$S-,W-,R-}
  12. interface
  13. uses Windows, Registry, RTLConsts, SysUtils, Classes, Messages, Menus, Buttons, Controls, Graphics, Forms,
  14.   {$IFDEF RX_D4} ImgList, ActnList, {$ENDIF} ExtCtrls, Grids, IniFiles,
  15.   RxCtrls, Placemnt;
  16. const
  17.   DefButtonWidth = 24;
  18.   DefButtonHeight = 23;
  19. type
  20.   TSpeedItem = class;
  21.   TSpeedbarSection = class;
  22.   ESpeedbarError = class(Exception);
  23. { TSpeedBar }
  24.   TBarOrientation = (boHorizontal, boVertical);
  25.   TBarPosition = (bpAuto, bpCustom);
  26.   TSpeedbarOption = (sbAllowDrag, sbAllowResize, sbFlatBtns, sbGrayedBtns,
  27.     sbTransparentBtns, sbStretchBitmap);
  28.   TSpeedbarOptions = set of TSpeedbarOption;
  29.   TBoundLine = (blTop, blBottom, blLeft, blRight);
  30.   TBoundLines = set of TBoundLine;
  31.   TSbScaleFlags = set of (sfOffsetX, sfOffsetY, sfBtnSizeX, sfBtnSizeY);
  32.   TForEachItem = procedure (Item: TSpeedItem; Data: Longint) of object;
  33.   TApplyAlignEvent = procedure (Sender: TObject; Align: TAlign;
  34.     var Apply: Boolean) of object;
  35.   TSpeedBar = class(TCustomPanel)
  36.   private
  37.     FSections: TList;
  38.     FPosition: TBarPosition;
  39.     FOrientation: TBarOrientation;
  40.     FAlign: TAlign;
  41.     FButtonSize: TPoint;
  42.     FButtonStyle: TButtonStyle;
  43.     FGridSize: TPoint;
  44.     FOffset: TPoint;
  45.     FEditWin: HWnd;
  46.     FRowCount: Integer;
  47.     FPrevRect: TRect;
  48.     FPrevAlign: TAlign;
  49.     FOptions: TSpeedbarOptions;
  50.     FLocked: Boolean;
  51.     FVersion: Integer;
  52.     FDrag: Boolean;
  53.     FResizing: Boolean;
  54.     FStartDrag: TPoint;
  55.     FWallpaper: TPicture;
  56.     FBoundLines: TBoundLines;
  57.     FIniLink: TIniLink;
  58.     FReserved: Integer;
  59.     FFix: Boolean;
  60.     FDesignStyle: Boolean;
  61.     FScaleFlags: TSbScaleFlags;
  62.     FOnAddItem: TNotifyEvent;
  63.     FOnApplyAlign: TApplyAlignEvent;
  64.     FOnPosChanged: TNotifyEvent;
  65.     FOnVisibleChanged: TNotifyEvent;
  66.     FOnCustomize: TNotifyEvent;
  67. {$IFDEF WIN32}
  68.     FImages: TImageList;
  69.     FImageChangeLink: TChangeLink;
  70.     procedure ImageListChange(Sender: TObject);
  71.     procedure SetImages(Value: TImageList);
  72.     procedure InvalidateItem(Item: TSpeedItem; Data: Longint);
  73. {$ENDIF}
  74.     function GetOrientation: TBarOrientation;
  75.     procedure SetOrientation(Value: TBarOrientation);
  76.     procedure ApplyOrientation(Value: TBarOrientation);
  77.     procedure ApplyButtonSize;
  78.     procedure UpdateGridSize;
  79.     procedure ClearSections;
  80.     function GetAlign: TAlign;
  81.     procedure SetAlign(Value: TAlign);
  82.     function GetButtonSize(Index: Integer): Integer;
  83.     procedure SetButtonSize(Index, Value: Integer);
  84.     function GetButtonsOffset(Index: Integer): Integer;
  85.     procedure SetButtonsOffset(Index: Integer; Value: Integer);
  86.     procedure SetOptions(Value: TSpeedbarOptions);
  87.     procedure SetBoundLines(Value: TBoundLines);
  88.     function MinButtonsOffset: Integer;
  89.     procedure WallpaperChanged(Sender: TObject);
  90.     procedure SetWallpaper(Value: TPicture);
  91.     procedure SetItemParams(Item: TSpeedItem; InitBounds: Boolean);
  92.     procedure SetItemVisible(Item: TSpeedItem; Data: Longint);
  93.     procedure SetItemEnabled(Item: TSpeedItem; Data: Longint);
  94.     procedure SetItemButtonSize(Item: TSpeedItem; Data: Longint);
  95.     procedure OffsetItem(Item: TSpeedItem; Data: Longint);
  96.     procedure ApplyItemSize(Item: TSpeedItem; Data: Longint);
  97.     procedure AlignItemToGrid(Item: TSpeedItem; Data: Longint);
  98.     procedure SwapItemBounds(Item: TSpeedItem; Data: Longint);
  99.     procedure SetItemEditing(Item: TSpeedItem; Data: Longint);
  100.     procedure HideItem(Item: TSpeedItem; Data: Longint);
  101.     procedure WriteItemLayout(Item: TSpeedItem; Data: Longint);
  102.     procedure FlatItem(Item: TSpeedItem; Data: Longint);
  103.     procedure TransparentItem(Item: TSpeedItem; Data: Longint);
  104.     function GetSection(Index: Integer): TSpeedbarSection;
  105.     function GetSectionCount: Integer;
  106.     procedure GrayedItem(Item: TSpeedItem; Data: Longint);
  107.     function GetFramePos(X, Y: Integer; var Apply: Boolean): Integer;
  108.     function GetFrameRect(X, Y: Integer): TRect;
  109.     procedure StartDragFrame;
  110.     procedure DragFrame(X, Y: Integer);
  111.     procedure StopDragFrame(X, Y: Integer);
  112.     function CheckResize(Shift: TShiftState; X, Y: Integer): Boolean;
  113.     procedure ReadSections(Reader: TReader);
  114.     procedure WriteSections(Writer: TWriter);
  115.     procedure ReadData(Reader: TReader);
  116.     procedure WriteData(Writer: TWriter);
  117.     procedure ReadDesignStyle(Reader: TReader);
  118.     procedure ReadAllowDrag(Reader: TReader);
  119.     procedure WriteDesignStyle(Writer: TWriter);
  120.     function GetStorage: TFormPlacement;
  121.     procedure SetStorage(Value: TFormPlacement);
  122.     procedure IniSave(Sender: TObject);
  123.     procedure IniLoad(Sender: TObject);
  124.     procedure InternalSaveLayout(IniFile: TObject; const Section: string);
  125.     procedure InternalRestoreLayout(IniFile: TObject; const Section: string);
  126.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  127.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  128.   protected
  129.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  130.     function AppendSection(Value: TSpeedbarSection): Integer; virtual;
  131.     procedure AlignItemsToGrid;
  132.     procedure ChangeScale(M, D: Integer); override;
  133.     procedure Loaded; override;
  134.     procedure Paint; override;
  135.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  136.       X, Y: Integer); override;
  137.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  138.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  139.       X, Y: Integer); override;
  140.     procedure DefineProperties(Filer: TFiler); override;
  141. {$IFDEF WIN32}
  142.     procedure Notification(AComponent: TComponent;
  143.       Operation: TOperation); override;
  144.     procedure GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
  145.       Root: TComponent {$ENDIF}); override;
  146.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  147. {$ELSE}
  148.     procedure WriteComponents(Writer: TWriter); override;
  149. {$ENDIF}
  150.     procedure ForEachItem(Proc: TForEachItem; Data: Longint); virtual;
  151.     procedure PosChanged; dynamic;
  152.     procedure AfterCustomize; dynamic;
  153.     property ScaleFlags: TSbScaleFlags read FScaleFlags write FScaleFlags;
  154.   public
  155.     constructor Create(AOwner: TComponent); override;
  156.     destructor Destroy; override;
  157.     procedure SetFontDefault; virtual;
  158.     procedure RemoveItem(Item: TSpeedItem);
  159.     procedure RemoveSection(Section: Integer); { delete and free section and items }
  160.     procedure DeleteSection(Section: Integer); { delete section }
  161.     function AddSection(const ACaption: string): Integer;
  162.     procedure AddItem(Section: Integer; Item: TSpeedItem);
  163.     function NewItem(AOwner: TComponent; Section: Integer;
  164.       const AName: string): TSpeedItem;
  165.     function AcceptDropItem(Item: TSpeedItem; X, Y: Integer): Boolean;
  166.     procedure SetEditing(Win: HWnd);
  167.     function GetEditing: Boolean;
  168.     function SearchItem(const ItemName: string): TSpeedItem;
  169.     function FindItem(Item: TSpeedItem; var Section, Index: Integer): Boolean;
  170.     function SearchSection(const ACaption: string): Integer;
  171.     procedure Customize(HelpCtx: THelpContext);
  172. {$IFDEF WIN32}
  173.     procedure SaveLayoutReg(IniFile: TRegIniFile);
  174.     procedure RestoreLayoutReg(IniFile: TRegIniFile);
  175. {$ENDIF WIN32}
  176.     procedure SaveLayout(IniFile: TIniFile);
  177.     procedure RestoreLayout(IniFile: TIniFile);
  178.     function ItemsCount(Section: Integer): Integer;
  179.     function Items(Section, Index: Integer): TSpeedItem;
  180.     property EditMode: Boolean read GetEditing;
  181.     property SectionCount: Integer read GetSectionCount;
  182.     property Sections[Index: Integer]: TSpeedbarSection read GetSection;
  183.     property Orientation: TBarOrientation read GetOrientation write SetOrientation
  184.       default boHorizontal;
  185.     property OnAddItem: TNotifyEvent read FOnAddItem write FOnAddItem; { for internal use only }
  186.   published
  187.     property Font;
  188.     property ParentFont default False;
  189.     property BoundLines: TBoundLines read FBoundLines write SetBoundLines default [];
  190.     property Position: TBarPosition read FPosition write FPosition default bpAuto;
  191.     { ensure Position is declared before Align }
  192.     property Align: TAlign read GetAlign write SetAlign default alTop;
  193.     { ensure Options is declared before BtnOffset... }
  194.     property Options: TSpeedbarOptions read FOptions write SetOptions
  195.       default [sbAllowDrag, sbGrayedBtns];
  196.     property BtnOffsetHorz: Integer index 0 read GetButtonsOffset write SetButtonsOffset
  197.       stored True;
  198.     property BtnOffsetVert: Integer index 1 read GetButtonsOffset write SetButtonsOffset
  199.       stored True;
  200.     property BtnWidth: Integer index 0 read GetButtonSize write SetButtonSize;
  201.     property BtnHeight: Integer index 1 read GetButtonSize write SetButtonSize;
  202.     property IniStorage: TFormPlacement read GetStorage write SetStorage;
  203.     property Version: Integer read FVersion write FVersion default 0;
  204.     property Wallpaper: TPicture read FWallpaper write SetWallpaper;
  205. {$IFDEF WIN32}
  206.     property Images: TImageList read FImages write SetImages;
  207. {$ENDIF}
  208. {$IFDEF RX_D4}
  209.     property BiDiMode;
  210.     property Constraints;
  211.     property ParentBiDiMode;
  212. {$ENDIF}
  213.     property BevelInner;
  214.     property BevelOuter;
  215.     property BevelWidth;
  216.     property BorderWidth;
  217.     property BorderStyle;
  218.     property Color;
  219.     property Ctl3D;
  220.     property DragCursor;
  221.     property DragMode;
  222.     property Enabled;
  223.     property Locked;
  224.     property ParentColor;
  225.     property ParentCtl3D;
  226.     property ParentShowHint default False;
  227.     property PopupMenu;
  228.     property ShowHint default True;
  229.     property TabOrder;
  230.     property TabStop;
  231.     property Visible;
  232.     property OnApplyAlign: TApplyAlignEvent read FOnApplyAlign write FOnApplyAlign;
  233.     property OnCustomize: TNotifyEvent read FOnCustomize write FOnCustomize;
  234.     property OnPosChanged: TNotifyEvent read FOnPosChanged write FOnPosChanged;
  235.     property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;
  236.     property OnClick;
  237.     property OnDblClick;
  238.     property OnDragDrop;
  239.     property OnDragOver;
  240.     property OnEndDrag;
  241.     property OnEnter;
  242.     property OnExit;
  243.     property OnMouseDown;
  244.     property OnMouseMove;
  245.     property OnMouseUp;
  246. {$IFDEF WIN32}
  247.     property OnStartDrag;
  248. {$ENDIF}
  249. {$IFDEF RX_D5}
  250.     property OnContextPopup;
  251. {$ENDIF}
  252. {$IFDEF RX_D4}
  253.     property OnEndDock;
  254.     property OnStartDock;
  255. {$ENDIF}
  256.     property OnResize;
  257.   end;
  258. { TSpeedItem }
  259.   TSpeedItem = class(TComponent)
  260.   private
  261.     FCaption: PString;
  262.     FEditing: Boolean;
  263.     FEnabled: Boolean;
  264.     FButton: TRxSpeedButton;
  265.     FVisible: Boolean;
  266.     FStored: Boolean;
  267.     FParent: TSpeedBar;
  268.     FSection: Integer;
  269.     FSectionName: string;
  270. {$IFDEF WIN32}
  271.     FImageIndex: Integer;
  272.     procedure SetImageIndex(Value: Integer);
  273. {$ENDIF}
  274. {$IFDEF RX_D4}
  275.     function GetAction: TBasicAction;
  276.     procedure SetAction(Value: TBasicAction);
  277. {$ENDIF}
  278.     function GetAllowAllUp: Boolean;
  279.     procedure SetAllowAllUp(Value: Boolean);
  280.     function GetAllowTimer: Boolean;
  281.     procedure SetAllowTimer(Value: Boolean);
  282.     function GetBtnCaption: TCaption;
  283.     procedure SetBtnCaption(const Value: TCaption);
  284.     function GetGroupIndex: Integer;
  285.     procedure SetGroupIndex(Value: Integer);
  286.     function GetDown: Boolean;
  287.     procedure SetDown(Value: Boolean);
  288.     function GetGlyph: TBitmap;
  289.     procedure SetGlyph(Value: TBitmap);
  290.     function GetLayout: TButtonLayout;
  291.     procedure SetLayout(Value: TButtonLayout);
  292.     function GetMargin: Integer;
  293.     procedure SetMargin(Value: Integer);
  294.     function GetNumGlyphs: TRxNumGlyphs;
  295.     procedure SetNumGlyphs(Value: TRxNumGlyphs);
  296.     function GetParentShowHint: Boolean;
  297.     procedure SetParentShowHint(Value: Boolean);
  298.     function GetFont: TFont;
  299.     procedure SetFont(Value: TFont);
  300.     function GetParentFont: Boolean;
  301.     procedure SetParentFont(Value: Boolean);
  302.     function IsFontStored: Boolean;
  303.     function GetShowHint: Boolean;
  304.     procedure SetShowHint(Value: Boolean);
  305.     function IsShowHintStored: Boolean;
  306.     function GetSpacing: Integer;
  307.     procedure SetSpacing(Value: Integer);
  308.     function GetCursor: TCursor;
  309.     procedure SetCursor(Value: TCursor);
  310.     function GetHint: string;
  311.     procedure SetHint(const Value: string);
  312.     function GetTag: Longint;
  313.     procedure SetTag(Value: Longint);
  314.     function GetDropDownMenu: TPopupMenu;
  315.     procedure SetDropDownMenu(Value: TPopupMenu);
  316.     function GetMarkDropDown: Boolean;
  317.     procedure SetMarkDropDown(Value: Boolean);
  318.     function GetWordWrap: Boolean;
  319.     procedure SetWordWrap(Value: Boolean);
  320.     function GetOnClick: TNotifyEvent;
  321.     procedure SetOnClick(Value: TNotifyEvent);
  322.     function GetOnDblClick: TNotifyEvent;
  323.     procedure SetOnDblClick(Value: TNotifyEvent);
  324.     function GetOnMouseDown: TMouseEvent;
  325.     procedure SetOnMouseDown(Value: TMouseEvent);
  326.     function GetOnMouseMove: TMouseMoveEvent;
  327.     procedure SetOnMouseMove(Value: TMouseMoveEvent);
  328.     function GetOnMouseUp: TMouseEvent;
  329.     procedure SetOnMouseUp(Value: TMouseEvent);
  330.     function GetOnMouseEnter: TNotifyEvent;
  331.     procedure SetOnMouseEnter(Value: TNotifyEvent);
  332.     function GetOnMouseLeave: TNotifyEvent;
  333.     procedure SetOnMouseLeave(Value: TNotifyEvent);
  334.     function GetCaption: TCaption;
  335.     procedure SetCaption(const Value: TCaption);
  336.     procedure SetEditing(Value: Boolean);
  337.     function GetLeft: Integer;
  338.     function GetTop: Integer;
  339.     procedure SetLeft(Value: Integer);
  340.     procedure SetTop(Value: Integer);
  341.     function GetSection: Integer;
  342.     procedure SetSection(Value: Integer);
  343.     function GetSectionName: string;
  344.     {procedure SetSectionName(const Value: string);}
  345.     procedure ReadSection(Reader: TReader);
  346.     procedure WriteSection(Writer: TWriter);
  347.     procedure ReadSectionName(Reader: TReader);
  348.     procedure WriteSectionName(Writer: TWriter);
  349.   protected
  350.     procedure ReadState(Reader: TReader); override;
  351.     procedure SetName(const Value: TComponentName); override;
  352.     procedure SetEnabled(Value: Boolean);
  353.     procedure SetVisible(Value: Boolean);
  354.     procedure DefineProperties(Filer: TFiler); override;
  355.   public
  356.     constructor Create(AOwner: TComponent); override;
  357.     destructor Destroy; override;
  358.     function HasParent: Boolean; override;
  359. {$IFDEF WIN32}
  360.     function GetParentComponent: TComponent; override;
  361.     procedure SetParentComponent(Value: TComponent); override;
  362. {$ENDIF}
  363.     procedure ButtonClick;
  364.     function CheckBtnMenuDropDown: Boolean;
  365.     procedure Click; virtual;
  366.     procedure UpdateSection;
  367.     procedure InvalidateItem;
  368.     property ASection: Integer read GetSection write SetSection;
  369.     property SpeedBar: TSpeedBar read FParent;
  370.     property Button: TRxSpeedButton read FButton;
  371.   published
  372. {$IFDEF RX_D4}
  373.     property Action: TBasicAction read GetAction write SetAction;
  374. {$ENDIF}
  375.     property AllowAllUp: Boolean read GetAllowAllUp write SetAllowAllUp default False;
  376.     property AllowTimer: Boolean read GetAllowTimer write SetAllowTimer default False;
  377.     property BtnCaption: TCaption read GetBtnCaption write SetBtnCaption;
  378.     property Caption: TCaption read GetCaption write SetCaption;
  379.     property GroupIndex: Integer read GetGroupIndex write SetGroupIndex default 0;
  380.     property Down: Boolean read GetDown write SetDown default False;
  381.     property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
  382.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  383.     property Font: TFont read GetFont write SetFont stored IsFontStored;
  384.     property Cursor: TCursor read GetCursor write SetCursor default crDefault;
  385.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  386.     property Hint: string read GetHint write SetHint;
  387. {$IFDEF WIN32}
  388.     property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
  389. {$ENDIF}
  390.     property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphTop;
  391.     property Margin: Integer read GetMargin write SetMargin default -1;
  392.     property MarkDropDown: Boolean read GetMarkDropDown write SetMarkDropDown default True;
  393.     property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
  394.     property ParentShowHint: Boolean read GetParentShowHint write SetParentShowHint default True;
  395.     property ParentFont: Boolean read GetParentFont write SetParentFont default True;
  396.     property ShowHint: Boolean read GetShowHint write SetShowHint stored IsShowHintStored;
  397.     property Spacing: Integer read GetSpacing write SetSpacing default 4;
  398.     property Stored: Boolean read FStored write FStored default True;
  399.     property Tag: Longint read GetTag write SetTag default 0;
  400.     property Left: Integer read GetLeft write SetLeft default 0;
  401.     property Top: Integer read GetTop write SetTop default 0;
  402.     property Visible: Boolean read FVisible write SetVisible default False;
  403.     property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
  404.     property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
  405.     property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
  406.     property OnMouseDown: TMouseEvent read GetOnMouseDown write SetOnMouseDown;
  407.     property OnMouseMove: TMouseMoveEvent read GetOnMouseMove write SetOnMouseMove;
  408.     property OnMouseUp: TMouseEvent read GetOnMouseUp write SetOnMouseUp;
  409.     property OnMouseEnter: TNotifyEvent read GetOnMouseEnter write SetOnMouseEnter;
  410.     property OnMouseLeave: TNotifyEvent read GetOnMouseLeave write SetOnMouseLeave;
  411.   end;
  412. { TSpeedbarSection }
  413.   TSpeedbarSection = class(TComponent)
  414.   private
  415.     FList: TList;
  416.     FTitle: PString;
  417.     FParent: TSpeedBar;
  418.     function Get(Index: Integer): TSpeedItem;
  419.     procedure Put(Index: Integer; Item: TSpeedItem);
  420.     function GetCount: Integer;
  421.     function GetTitle: string;
  422.     procedure SetTitle(const Value: string);
  423.     function GetIndex: Integer;
  424.     procedure SetIndex(Value: Integer);
  425.     procedure SetSpeedbar(Value: TSpeedBar);
  426.     procedure ValidateCaption(const NewCaption: string);
  427.   protected
  428. {$IFDEF WIN32}
  429.     procedure SetParentComponent(Value: TComponent); override;
  430. {$ELSE}
  431.     procedure ReadState(Reader: TReader); override;
  432. {$ENDIF}
  433.   public
  434.     constructor Create(AOwner: TComponent); override;
  435.     destructor Destroy; override;
  436.     function HasParent: Boolean; override;
  437. {$IFDEF WIN32}
  438.     function GetParentComponent: TComponent; override;
  439. {$ENDIF}
  440.     procedure Clear;
  441.     procedure RemoveItem(Item: TSpeedItem);
  442.     property Count: Integer read GetCount;
  443.     property Items[Index: Integer]: TSpeedItem read Get write Put; default;
  444.     property List: TList read FList; { for internal use only }
  445.     property SpeedBar: TSpeedBar read FParent write SetSpeedbar stored False;
  446.   published
  447.     property Caption: string read GetTitle write SetTitle;
  448.     property Index: Integer read GetIndex write SetIndex stored False;
  449.   end;
  450. { TBtnControl }
  451.   TBtnControl = class(TCustomControl)
  452.   private
  453.     FImage: TButtonImage;
  454.     FSpacing, FMargin: Integer;
  455.     FLayout: TButtonLayout;
  456. {$IFDEF WIN32}
  457.     FImageIndex: Integer;
  458.     FImages: TImageList;
  459. {$ENDIF}
  460.     function GetCaption: TCaption;
  461.     function GetGlyph: TBitmap;
  462.     function GetNumGlyphs: TRxNumGlyphs;
  463.     function GetWordWrap: Boolean;
  464.     function GetAlignment: TAlignment;
  465.     procedure SetAlignment(Value: TAlignment);
  466.     procedure SetCaption(const Value: TCaption);
  467.     procedure SetNumGlyphs(Value: TRxNumGlyphs);
  468.     procedure SetGlyph(Value: TBitmap);
  469.     procedure SetWordWrap(Value: Boolean);
  470.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  471.   protected
  472.     procedure CreateParams(var Params: TCreateParams); override;
  473.     procedure Paint; override;
  474.   public
  475.     constructor Create(AOwner: TComponent); override;
  476.     destructor Destroy; override;
  477.     procedure AssignSpeedItem(Item: TSpeedItem);
  478.     procedure Activate(Rect: TRect);
  479.     procedure ReleaseHandle;
  480.     property Alignment: TAlignment read GetAlignment write SetAlignment;
  481.     property Caption: TCaption read GetCaption write SetCaption;
  482.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  483.     property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs;
  484.     property Spacing: Integer read FSpacing write FSpacing;
  485. {$IFDEF WIN32}
  486.     property ImageIndex: Integer read FImageIndex write FImageIndex;
  487.     property Images: TImageList read FImages write FImages;
  488. {$ENDIF}
  489.     property Margin: Integer read FMargin write FMargin;
  490.     property Layout: TButtonLayout read FLayout write FLayout;
  491.     property WordWrap: Boolean read GetWordWrap write SetWordWrap;
  492.     property Font;
  493.   end;
  494. const
  495. { Values for WParam for CM_SPEEDBARCHANGED message }
  496.   SBR_CHANGED        = 0; { change buttons properties  }
  497.   SBR_DESTROYED      = 1; { destroy speedbar           }
  498.   SBR_BTNSELECT      = 2; { select button in speedbar  }
  499.   SBR_BTNSIZECHANGED = 3; { button size changed        }
  500. { Utility routines for Speedbar Editors }
  501. function FindSpeedBar(const Pos: TPoint): TSpeedBar;
  502. procedure DrawCellButton(Grid: TDrawGrid; R: TRect; Item: TSpeedItem;
  503.   Image: TButtonImage {$IFDEF RX_D4}; ARightToLeft: Boolean = False {$ENDIF});
  504. function NewSpeedSection(ASpeedbar: TSpeedBar; const ACaption: string): Integer;
  505. function NewSpeedItem(AOwner: TComponent; ASpeedbar: TSpeedBar; Section: Integer;
  506.   const AName: string): TSpeedItem;
  507. implementation
  508. uses Dialogs, MaxMin, VCLUtils, AppUtils, rxStrUtils, Consts, RxConst, SbSetup;
  509. { SpeedBar exceptions }
  510. {$IFDEF RX_D3}
  511. resourcestring
  512. {$ELSE}
  513. const
  514. {$ENDIF}
  515.   SAutoSpeedbarMode = 'Cannot set this property value while Position is bpAuto';
  516. const
  517.   DefaultButtonSize: TPoint = (X: DefButtonWidth; Y: DefButtonHeight);
  518.   DragFrameWidth = 3;
  519.   StartDragOffset = 4;
  520.   Registered: Boolean = False;
  521. const
  522.   Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  523. { TSpeedbarSection }
  524. constructor TSpeedbarSection.Create(AOwner: TComponent);
  525. begin
  526.   inherited Create(AOwner);
  527.   FList := TList.Create;
  528.   FTitle := NullStr;
  529. end;
  530. destructor TSpeedbarSection.Destroy;
  531. begin
  532.   Clear;
  533.   if FParent <> nil then FParent.DeleteSection(Index);
  534.   DisposeStr(FTitle);
  535.   FTitle := NullStr;
  536.   FList.Free;
  537.   inherited Destroy;
  538. end;
  539. procedure TSpeedbarSection.Clear;
  540. begin
  541.   while FList.Count > 0 do begin
  542.     TSpeedItem(FList[0]).Free;
  543.     FList.Delete(0);
  544.   end;
  545. end;
  546. function TSpeedbarSection.Get(Index: Integer): TSpeedItem;
  547. begin
  548.   Result := TSpeedItem(FList[Index]);
  549. end;
  550. procedure TSpeedbarSection.Put(Index: Integer; Item: TSpeedItem);
  551. begin
  552.   FList[Index] := Item;
  553. end;
  554. function TSpeedbarSection.GetCount: Integer;
  555. begin
  556.   Result := FList.Count;
  557. end;
  558. function TSpeedbarSection.GetIndex: Integer;
  559. begin
  560.   if FParent <> nil then Result := FParent.FSections.IndexOf(Self)
  561.   else Result := -1;
  562. end;
  563. procedure TSpeedbarSection.SetIndex(Value: Integer);
  564. var
  565.   CurIndex, Count: Integer;
  566. begin
  567.   CurIndex := GetIndex;
  568.   if CurIndex >= 0 then begin
  569.     Count := FParent.FSections.Count;
  570.     if Value < 0 then Value := 0;
  571.     if Value >= Count then Value := Count - 1;
  572.     if Value <> CurIndex then begin
  573.       FParent.FSections.Delete(CurIndex);
  574.       FParent.FSections.Insert(Value, Self);
  575.     end;
  576.   end;
  577. end;
  578. function TSpeedbarSection.HasParent: Boolean;
  579. begin
  580.   Result := True;
  581. end;
  582. procedure TSpeedbarSection.SetSpeedbar(Value: TSpeedBar);
  583. var
  584.   CurIndex: Integer;
  585. begin
  586.   CurIndex := GetIndex;
  587.   if FParent <> nil then FParent.DeleteSection(Index);
  588.   if Value <> nil then Value.AppendSection(Self);
  589.   if CurIndex >= 0 then Index := CurIndex;
  590. end;
  591. {$IFDEF WIN32}
  592. function TSpeedbarSection.GetParentComponent: TComponent;
  593. begin
  594.   Result := FParent;
  595. end;
  596. procedure TSpeedbarSection.SetParentComponent(Value: TComponent);
  597. begin
  598.   SpeedBar := Value as TSpeedBar;
  599. end;
  600. {$ELSE}
  601. procedure TSpeedbarSection.ReadState(Reader: TReader);
  602. begin
  603.   inherited ReadState(Reader);
  604.   if Reader.Parent is TSpeedBar then SpeedBar := TSpeedBar(Reader.Parent);
  605. end;
  606. {$ENDIF}
  607. procedure TSpeedbarSection.RemoveItem(Item: TSpeedItem);
  608. var
  609.   I: Integer;
  610. begin
  611.   I := FList.IndexOf(Item);
  612.   if I >= 0 then begin
  613.     Item.FButton.Parent := nil;
  614.     Item.FParent := nil;
  615.     Item.FSection := -1;
  616.     FList.Delete(I);
  617.   end;
  618. end;
  619. procedure TSpeedbarSection.ValidateCaption(const NewCaption: string);
  620. var
  621.   I: Integer;
  622. begin
  623.   if FParent <> nil then begin
  624.     I := FParent.SearchSection(NewCaption);
  625.     if (I <> Index) and (I >= 0) then
  626.       raise ESpeedbarError.Create(ResStr(SDuplicateString));
  627.   end;
  628. end;
  629. procedure TSpeedbarSection.SetTitle(const Value: string);
  630. begin
  631.   if not (csLoading in ComponentState) then ValidateCaption(Value);
  632.   AssignStr(FTitle, Value);
  633. end;
  634. function TSpeedbarSection.GetTitle: string;
  635. begin
  636.   Result := FTitle^;
  637. end;
  638. { TSpeedbarButton }
  639. type
  640.   TSpeedbarButton = class(TRxSpeedButton)
  641.   private
  642.     FItem: TSpeedItem;
  643.     FBtn: TBtnControl;
  644.     procedure InvalidateGlyph;
  645.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  646.   protected
  647.     procedure WndProc(var Message: TMessage); override;
  648.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  649.       X, Y: Integer); override;
  650.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  651.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  652.       X, Y: Integer); override;
  653.     procedure PaintGlyph(Canvas: TCanvas; ARect: TRect; AState: TRxButtonState;
  654.       DrawMark: Boolean); override;
  655.     procedure Paint; override;
  656.   public
  657.     constructor Create(AOwner: TComponent); override;
  658.     destructor Destroy; override;
  659.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  660.   end;
  661. constructor TSpeedbarButton.Create(AOwner: TComponent);
  662. begin
  663.   FItem := TSpeedItem(AOwner);
  664.   { Ensure FItem is assigned before inherited Create }
  665.   inherited Create(AOwner);
  666.   Visible := False;
  667.   Style := bsNew;
  668.   ParentShowHint := True;
  669.   ParentFont := True;
  670. end;
  671. destructor TSpeedbarButton.Destroy;
  672. begin
  673.   FBtn.Free;
  674.   inherited Destroy;
  675. end;
  676. procedure TSpeedbarButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  677. begin
  678.   if (FItem.Speedbar <> nil) then begin
  679.     case FItem.Speedbar.Orientation of
  680.       boHorizontal: ATop := Max(FItem.Speedbar.FOffset.Y, ATop);
  681.       boVertical: ALeft := Max(FItem.Speedbar.FOffset.X, ALeft);
  682.     end;
  683.   end;
  684.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  685. end;
  686. procedure TSpeedbarButton.CMVisibleChanged(var Message: TMessage);
  687. begin
  688.   if Visible then ControlStyle := ControlStyle + [csOpaque]
  689.   else ControlStyle := ControlStyle - [csOpaque];
  690.   inherited;
  691. end;
  692. procedure TSpeedbarButton.WndProc(var Message: TMessage);
  693. begin
  694.   if FItem.FEditing and (csDesigning in ComponentState) and
  695.     (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
  696.   begin
  697.     if (Message.Msg = WM_LBUTTONDOWN) and not Visible then
  698.       inherited WndProc(Message)
  699.     else Dispatch(Message);
  700.   end
  701.   else inherited WndProc(Message);
  702. end;
  703. procedure TSpeedbarButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  704.   X, Y: Integer);
  705. var
  706.   P: TPoint;
  707. begin
  708.   if FItem.FEditing and Visible and (Button = mbLeft) and
  709.     (FItem.Speedbar <> nil) then
  710.   begin
  711.     P := ClientToScreen(Point(FItem.Speedbar.BtnWidth {div 2},
  712.       FItem.Speedbar.BtnHeight {div 2}));
  713.     X := P.X; Y := P.Y;
  714.     if FBtn = nil then begin
  715.       SetCursorPos(X, Y);
  716.       FBtn := TBtnControl.Create(Self);
  717.       FBtn.AssignSpeedItem(FItem);
  718.     end;
  719.     BringToFront;
  720.   end
  721.   else inherited MouseDown(Button, Shift, X, Y);
  722. end;
  723. procedure TSpeedbarButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  724. var
  725.   P: TPoint;
  726.   R: TRect;
  727. begin
  728.   if FItem.FEditing and (FBtn <> nil) then begin
  729.     P := ClientToScreen(Point(X - (FBtn.Width {div 2}),
  730.       Y - (FBtn.Height {div 2})));
  731.     X := P.X; Y := P.Y;
  732.     if FItem.SpeedBar <> nil then begin
  733.       Visible := False;
  734.       if (csDesigning in ComponentState) then begin
  735.         R := BoundsRect;
  736.         InvalidateRect(FItem.Speedbar.Handle, @R, True);
  737.       end;
  738.       P := FItem.SpeedBar.ScreenToClient(P);
  739.       if PtInRect(FItem.SpeedBar.ClientRect, P) then begin
  740.         FBtn.Activate(Bounds(X, Y, FBtn.Width, FBtn.Height));
  741.       end
  742.       else FBtn.ReleaseHandle;
  743.     end;
  744.   end
  745.   else inherited MouseMove(Shift, X, Y);
  746. end;
  747. procedure TSpeedbarButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  748.   X, Y: Integer);
  749. var
  750.   P: TPoint;
  751. begin
  752.   if FItem.FEditing and (FBtn <> nil) then begin
  753.     X := X - (FBtn.Width {div 2});
  754.     Y := Y - (FBtn.Height {div 2});
  755.     FBtn.Free;
  756.     FBtn := nil;
  757.     P := ClientToScreen(Point(X, Y));
  758.     if FItem.SpeedBar <> nil then begin
  759.       P := FItem.SpeedBar.ScreenToClient(P);
  760.       if PtInRect(FItem.SpeedBar.ClientRect, P) then begin
  761.         if not FItem.SpeedBar.AcceptDropItem(FItem, P.X, P.Y) then begin
  762.           SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_CHANGED,
  763.             Longint(FItem.Speedbar));
  764.         end
  765.         else begin
  766.           SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSELECT,
  767.             Longint(FItem));
  768.           Invalidate;
  769.         end;
  770.       end
  771.       else begin
  772.         SendToBack;
  773.         FItem.Visible := False;
  774.         SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_CHANGED,
  775.           Longint(FItem.Speedbar));
  776.       end;
  777.     end;
  778.   end
  779.   else inherited MouseUp(Button, Shift, X, Y);
  780. end;
  781. procedure TSpeedbarButton.InvalidateGlyph;
  782. begin
  783.   TRxButtonGlyph(ButtonGlyph).Invalidate;
  784. end;
  785. procedure TSpeedbarButton.PaintGlyph(Canvas: TCanvas; ARect: TRect;
  786.   AState: TRxButtonState; DrawMark: Boolean);
  787. begin
  788. {$IFDEF WIN32}
  789.   if (FItem.Speedbar <> nil) then begin
  790.     TRxButtonGlyph(ButtonGlyph).DrawEx(Canvas, ARect, Caption, Layout,
  791.       Margin, Spacing, DrawMark, FItem.Speedbar.Images, FItem.FImageIndex,
  792.       AState, {$IFDEF RX_D4} DrawTextBiDiModeFlags(Alignments[Alignment])
  793.       {$ELSE} Alignments[Alignment] {$ENDIF});
  794.   end else
  795. {$ENDIF}
  796.   inherited PaintGlyph(Canvas, ARect, AState, DrawMark);
  797. end;
  798. procedure TSpeedbarButton.Paint;
  799. begin
  800.   if Visible then inherited Paint;
  801. end;
  802. { TSpeedItem }
  803. constructor TSpeedItem.Create(AOwner: TComponent);
  804. begin
  805.   inherited Create(AOwner);
  806.   FButton := TSpeedbarButton.Create(Self);
  807.   FButton.Visible := False;
  808.   FButton.SetBounds(0, 0, DefaultButtonSize.X, DefaultButtonSize.Y);
  809.   FCaption := NullStr;
  810.   ShowHint := True;
  811.   ParentShowHint := True;
  812.   FVisible := False;
  813.   FStored := True;
  814.   FEnabled := True;
  815.   FEditing := False;
  816.   FParent := nil;
  817. {$IFDEF WIN32}
  818.   FImageIndex := -1;
  819. {$ENDIF}
  820. end;
  821. destructor TSpeedItem.Destroy;
  822. begin
  823.   FVisible := False;
  824.   if FParent <> nil then FParent.RemoveItem(Self);
  825.   FButton.Free;
  826.   DisposeStr(FCaption);
  827.   FCaption := NullStr;
  828.   inherited Destroy;
  829. end;
  830. function TSpeedItem.GetCaption: TCaption;
  831. begin
  832.   Result := TCaption(FCaption^);
  833. end;
  834. procedure TSpeedItem.SetCaption(const Value: TCaption);
  835. var
  836.   ChangeHint: Boolean;
  837. begin
  838.   ChangeHint := (Owner = nil) or not (Owner is TControl) or
  839.     not (csLoading in TControl(Owner).ComponentState) and
  840.     (Caption = GetShortHint(Hint));
  841.   AssignStr(FCaption, Value);
  842.   if ChangeHint then begin
  843.     if Pos('|', Value) = 0 then begin
  844.       if Pos('|', Hint) = 0 then Hint := Value + '|'
  845.       else Hint := Value + '|' + GetLongHint(Hint);
  846.     end
  847.     else begin
  848.       if GetLongHint(Value) = '' then
  849.         Hint := GetShortHint(Value) + '|' + GetLongHint(Hint)
  850.       else Hint := Value;
  851.     end;
  852.   end;
  853. end;
  854. procedure TSpeedItem.SetName(const Value: TComponentName);
  855. var
  856.   ChangeText: Boolean;
  857. begin
  858.   ChangeText := (Name = Caption) and
  859.     ((Owner = nil) or not (Owner is TControl) or
  860.     not (csLoading in TControl(Owner).ComponentState));
  861.   inherited SetName(Value);
  862.   if ChangeText then Caption := Value;
  863. end;
  864. procedure TSpeedItem.SetEditing(Value: Boolean);
  865. begin
  866.   FEditing := Value;
  867.   if FEditing then begin
  868.     FButton.Enabled := True;
  869.     FButton.Flat := False;
  870.   end
  871.   else begin
  872.     SetEnabled(FEnabled);
  873.     if SpeedBar <> nil then
  874.       FButton.Flat := (sbFlatBtns in SpeedBar.Options);
  875.   end;
  876. end;
  877. function TSpeedItem.HasParent: Boolean;
  878. begin
  879.   Result := True;
  880. end;
  881. procedure TSpeedItem.DefineProperties(Filer: TFiler);
  882. {$IFDEF WIN32}
  883.   function DoWrite: Boolean;
  884.   begin
  885.     if Assigned(Filer.Ancestor) then
  886.       Result := GetSectionName <> TSpeedItem(Filer.Ancestor).GetSectionName
  887.     else Result := True;
  888.   end;
  889. {$ENDIF}
  890. begin
  891.   inherited DefineProperties(Filer);
  892.   Filer.DefineProperty('Section', ReadSection, WriteSection, False);
  893.   Filer.DefineProperty('SectionName', ReadSectionName, WriteSectionName,
  894.     {$IFDEF WIN32} DoWrite {$ELSE} True {$ENDIF});
  895. end;
  896. procedure TSpeedItem.ReadSectionName(Reader: TReader);
  897. begin
  898.   FSectionName := Reader.ReadString;
  899. end;
  900. procedure TSpeedItem.WriteSectionName(Writer: TWriter);
  901. begin
  902.   Writer.WriteString(GetSectionName);
  903. end;
  904. procedure TSpeedItem.ReadSection(Reader: TReader);
  905. begin
  906.   FSection := Reader.ReadInteger;
  907. end;
  908. procedure TSpeedItem.WriteSection(Writer: TWriter);
  909. begin
  910.   UpdateSection;
  911.   Writer.WriteInteger(FSection);
  912. end;
  913. {$IFDEF WIN32}
  914. function TSpeedItem.GetParentComponent: TComponent;
  915. begin
  916.   Result := FParent;
  917. end;
  918. procedure TSpeedItem.SetParentComponent(Value: TComponent);
  919. var
  920.   I: Integer;
  921. begin
  922.   if not (csLoading in ComponentState) then begin
  923.     if FParent <> nil then FParent.RemoveItem(Self);
  924.     if (Value <> nil) and (Value is TSpeedBar) then begin
  925.       I := TSpeedBar(Value).SearchSection(FSectionName);
  926.       if I >= 0 then FSection := I;
  927.       TSpeedBar(Value).AddItem(FSection, Self);
  928.     end;
  929.   end;
  930. end;
  931. procedure TSpeedItem.SetImageIndex(Value: Integer);
  932. begin
  933.   if Value <> FImageIndex then begin
  934.     FImageIndex := Value;
  935.     TSpeedbarButton(FButton).InvalidateGlyph;
  936.     FButton.Invalidate;
  937.   end;
  938. end;
  939. {$ENDIF}
  940. procedure TSpeedItem.ReadState(Reader: TReader);
  941. begin
  942.   inherited ReadState(Reader);
  943.   if Reader.Parent is TSpeedBar then begin
  944.     if FSectionName <> '' then
  945.       FSection := TSpeedBar(Reader.Parent).SearchSection(FSectionName);
  946.     TSpeedBar(Reader.Parent).AddItem(Max(FSection, 0), Self);
  947.   end;
  948. end;
  949. function TSpeedItem.GetSection: Integer;
  950. begin
  951.   UpdateSection;
  952.   Result := FSection;
  953. end;
  954. procedure TSpeedItem.SetSection(Value: Integer);
  955. begin
  956.   if Speedbar = nil then FSection := Value;
  957. end;
  958. function TSpeedItem.GetSectionName: string;
  959. begin
  960.   UpdateSection;
  961.   if FSection >= 0 then Result := FParent.Sections[FSection].Caption
  962.   else Result := FSectionName;
  963. end;
  964. {
  965. procedure TSpeedItem.SetSectionName(const Value: string);
  966. begin
  967.   if FParent <> nil then FSection := FParent.SearchSection(Value)
  968.   else FSection := -1;
  969.   FSectionName := Value;
  970. end;
  971. }
  972. procedure TSpeedItem.InvalidateItem;
  973. begin
  974.   FSection := -1;
  975. end;
  976. procedure TSpeedItem.UpdateSection;
  977. var
  978.   I: Integer;
  979. begin
  980.   if FParent <> nil then FParent.FindItem(Self, FSection, I)
  981.   else FSection := -1;
  982. end;
  983. procedure TSpeedItem.SetEnabled(Value: Boolean);
  984. begin
  985.   if ((FButton.Enabled <> Value) or (FEnabled <> Value)) then begin
  986.     FEnabled := Value;
  987.     if not FEditing then begin
  988.       if (SpeedBar <> nil) and Value then
  989.         FButton.Enabled := (Value and SpeedBar.Enabled)
  990.       else FButton.Enabled := Value;
  991.     end;
  992.   end;
  993. end;
  994. procedure TSpeedItem.SetVisible(Value: Boolean);
  995. begin
  996.   if (FButton.Visible <> Value) or (FVisible <> Value) or
  997.     (Value and (FButton.Parent = nil)) then
  998.   begin
  999.     FVisible := Value;
  1000.     if (SpeedBar <> nil) and Value then
  1001.       FButton.Visible := Value and SpeedBar.Visible
  1002.     else FButton.Visible := Value;
  1003.     if Value then FButton.Parent := Speedbar;
  1004.   end;
  1005. end;
  1006. function TSpeedItem.GetAllowAllUp: Boolean;
  1007. begin
  1008.   Result := FButton.AllowAllUp;
  1009. end;
  1010. procedure TSpeedItem.SetAllowAllUp(Value: Boolean);
  1011. begin
  1012.   FButton.AllowAllUp := Value;
  1013. end;
  1014. function TSpeedItem.GetAllowTimer: Boolean;
  1015. begin
  1016.   Result := FButton.AllowTimer;
  1017. end;
  1018. procedure TSpeedItem.SetAllowTimer(Value: Boolean);
  1019. begin
  1020.   FButton.AllowTimer := Value;
  1021. end;
  1022. function TSpeedItem.GetBtnCaption: TCaption;
  1023. begin
  1024.   Result := FButton.Caption;
  1025. end;
  1026. procedure TSpeedItem.SetBtnCaption(const Value: TCaption);
  1027. begin
  1028.   FButton.Caption := Value;
  1029. end;
  1030. function TSpeedItem.GetGroupIndex: Integer;
  1031. begin
  1032.   Result := FButton.GroupIndex;
  1033. end;
  1034. procedure TSpeedItem.SetGroupIndex(Value: Integer);
  1035. begin
  1036.   FButton.GroupIndex := Value;
  1037. end;
  1038. function TSpeedItem.GetOnClick: TNotifyEvent;
  1039. begin
  1040.   Result := FButton.OnClick;
  1041. end;
  1042. procedure TSpeedItem.SetOnClick(Value: TNotifyEvent);
  1043. begin
  1044.   FButton.OnClick := Value;
  1045. end;
  1046. function TSpeedItem.GetOnDblClick: TNotifyEvent;
  1047. begin
  1048.   Result := FButton.OnDblClick;
  1049. end;
  1050. procedure TSpeedItem.SetOnDblClick(Value: TNotifyEvent);
  1051. begin
  1052.   FButton.OnDblClick := Value;
  1053. end;
  1054. function TSpeedItem.GetOnMouseDown: TMouseEvent;
  1055. begin
  1056.   Result := FButton.OnMouseDown;
  1057. end;
  1058. procedure TSpeedItem.SetOnMouseDown(Value: TMouseEvent);
  1059. begin
  1060.   FButton.OnMouseDown := Value;
  1061. end;
  1062. function TSpeedItem.GetOnMouseMove: TMouseMoveEvent;
  1063. begin
  1064.   Result := FButton.OnMouseMove;
  1065. end;
  1066. procedure TSpeedItem.SetOnMouseMove(Value: TMouseMoveEvent);
  1067. begin
  1068.   FButton.OnMouseMove := Value;
  1069. end;
  1070. function TSpeedItem.GetOnMouseUp: TMouseEvent;
  1071. begin
  1072.   Result := FButton.OnMouseUp;
  1073. end;
  1074. procedure TSpeedItem.SetOnMouseUp(Value: TMouseEvent);
  1075. begin
  1076.   FButton.OnMouseUp := Value;
  1077. end;
  1078. function TSpeedItem.GetOnMouseEnter: TNotifyEvent;
  1079. begin
  1080.   Result := FButton.OnMouseEnter;
  1081. end;
  1082. procedure TSpeedItem.SetOnMouseEnter(Value: TNotifyEvent);
  1083. begin
  1084.   FButton.OnMouseEnter := Value;
  1085. end;
  1086. function TSpeedItem.GetOnMouseLeave: TNotifyEvent;
  1087. begin
  1088.   Result := FButton.OnMouseLeave;
  1089. end;
  1090. procedure TSpeedItem.SetOnMouseLeave(Value: TNotifyEvent);
  1091. begin
  1092.   FButton.OnMouseLeave := Value;
  1093. end;
  1094. function TSpeedItem.GetDown: Boolean;
  1095. begin
  1096.   Result := FButton.Down;
  1097. end;
  1098. procedure TSpeedItem.SetDown(Value: Boolean);
  1099. begin
  1100.   FButton.Down := Value;
  1101. end;
  1102. function TSpeedItem.GetGlyph: TBitmap;
  1103. begin
  1104.   Result := FButton.Glyph;
  1105. end;
  1106. procedure TSpeedItem.SetGlyph(Value: TBitmap);
  1107. begin
  1108.   FButton.Glyph := Value;
  1109. end;
  1110. function TSpeedItem.GetLayout: TButtonLayout;
  1111. begin
  1112.   Result := FButton.Layout;
  1113. end;
  1114. procedure TSpeedItem.SetLayout(Value: TButtonLayout);
  1115. begin
  1116.   FButton.Layout := Value;
  1117. end;
  1118. function TSpeedItem.GetMargin: Integer;
  1119. begin
  1120.   Result := FButton.Margin;
  1121. end;
  1122. procedure TSpeedItem.SetMargin(Value: Integer);
  1123. begin
  1124.   FButton.Margin := Value;
  1125. end;
  1126. function TSpeedItem.GetNumGlyphs: TRxNumGlyphs;
  1127. begin
  1128.   Result := FButton.NumGlyphs;
  1129. end;
  1130. procedure TSpeedItem.SetNumGlyphs(Value: TRxNumGlyphs);
  1131. begin
  1132.   FButton.NumGlyphs := Value;
  1133. end;
  1134. function TSpeedItem.GetParentShowHint: Boolean;
  1135. begin
  1136.   Result := FButton.ParentShowHint;
  1137. end;
  1138. procedure TSpeedItem.SetParentShowHint(Value: Boolean);
  1139. begin
  1140.   FButton.ParentShowHint := Value;
  1141. end;
  1142. function TSpeedItem.GetShowHint: Boolean;
  1143. begin
  1144.   Result := FButton.ShowHint;
  1145. end;
  1146. procedure TSpeedItem.SetShowHint(Value: Boolean);
  1147. begin
  1148.   FButton.ShowHint := Value;
  1149. end;
  1150. function TSpeedItem.GetFont: TFont;
  1151. begin
  1152.   Result := FButton.Font;
  1153. end;
  1154. procedure TSpeedItem.SetFont(Value: TFont);
  1155. begin
  1156.   FButton.Font := Value;
  1157. end;
  1158. function TSpeedItem.GetParentFont: Boolean;
  1159. begin
  1160.   Result := FButton.ParentFont;
  1161. end;
  1162. procedure TSpeedItem.SetParentFont(Value: Boolean);
  1163. begin
  1164.   FButton.ParentFont := Value;
  1165. end;
  1166. function TSpeedItem.IsFontStored: Boolean;
  1167. begin
  1168.   Result := not ParentFont;
  1169. end;
  1170. function TSpeedItem.IsShowHintStored: Boolean;
  1171. begin
  1172.   Result := not ParentShowHint;
  1173. end;
  1174. function TSpeedItem.GetSpacing: Integer;
  1175. begin
  1176.   Result := FButton.Spacing;
  1177. end;
  1178. procedure TSpeedItem.SetSpacing(Value: Integer);
  1179. begin
  1180.   FButton.Spacing := Value;
  1181. end;
  1182. function TSpeedItem.GetCursor: TCursor;
  1183. begin
  1184.   Result := FButton.Cursor;
  1185. end;
  1186. procedure TSpeedItem.SetCursor(Value: TCursor);
  1187. begin
  1188.   FButton.Cursor := Value;
  1189. end;
  1190. function TSpeedItem.GetHint: string;
  1191. begin
  1192.   Result := FButton.Hint;
  1193. end;
  1194. procedure TSpeedItem.SetHint(const Value: string);
  1195. begin
  1196.   FButton.Hint := Value;
  1197. end;
  1198. {$IFDEF RX_D4}
  1199. function TSpeedItem.GetAction: TBasicAction;
  1200. begin
  1201.   Result := FButton.Action;
  1202. end;
  1203. procedure TSpeedItem.SetAction(Value: TBasicAction);
  1204. begin
  1205.   FButton.Action := Value;
  1206. end;
  1207. {$ENDIF}
  1208. procedure TSpeedItem.ButtonClick;
  1209. begin
  1210.   FButton.ButtonClick;
  1211. end;
  1212. function TSpeedItem.CheckBtnMenuDropDown: Boolean;
  1213. begin
  1214.   Result := FButton.CheckBtnMenuDropDown;
  1215. end;
  1216. procedure TSpeedItem.Click;
  1217. begin
  1218.   FButton.Click;
  1219. end;
  1220. function TSpeedItem.GetTag: Longint;
  1221. begin
  1222.   Result := inherited Tag;
  1223. end;
  1224. procedure TSpeedItem.SetTag(Value: Longint);
  1225. begin
  1226.   inherited Tag := Value;
  1227.   FButton.Tag := Value;
  1228. end;
  1229. function TSpeedItem.GetDropDownMenu: TPopupMenu;
  1230. begin
  1231.   Result := FButton.DropDownMenu;
  1232. end;
  1233. procedure TSpeedItem.SetDropDownMenu(Value: TPopupMenu);
  1234. begin
  1235.   FButton.DropDownMenu := Value;
  1236. end;
  1237. function TSpeedItem.GetMarkDropDown: Boolean;
  1238. begin
  1239.   Result := FButton.MarkDropDown;
  1240. end;
  1241. procedure TSpeedItem.SetMarkDropDown(Value: Boolean);
  1242. begin
  1243.   FButton.MarkDropDown := Value;
  1244. end;
  1245. function TSpeedItem.GetWordWrap: Boolean;
  1246. begin
  1247.   Result := FButton.WordWrap;
  1248. end;
  1249. procedure TSpeedItem.SetWordWrap(Value: Boolean);
  1250. begin
  1251.   FButton.WordWrap := Value;
  1252. end;
  1253. function TSpeedItem.GetLeft: Integer;
  1254. begin
  1255.   Result := FButton.Left;
  1256. end;
  1257. function TSpeedItem.GetTop: Integer;
  1258. begin
  1259.   Result := FButton.Top;
  1260. end;
  1261. procedure TSpeedItem.SetLeft(Value: Integer);
  1262. begin
  1263.   FButton.Left := Value;
  1264. end;
  1265. procedure TSpeedItem.SetTop(Value: Integer);
  1266. begin
  1267.   FButton.Top := Value;
  1268. end;
  1269. { TSpeedBar }
  1270. const
  1271.   InternalVer = 1;
  1272. constructor TSpeedBar.Create(AOwner: TComponent);
  1273. begin
  1274.   inherited Create(AOwner);
  1275.   FSections := TList.Create;
  1276.   FButtonSize := DefaultButtonSize;
  1277.   FButtonStyle := bsNew;
  1278.   FWallpaper := TPicture.Create;
  1279.   FWallpaper.OnChange := WallpaperChanged;
  1280.   FIniLink := TIniLink.Create;
  1281.   FIniLink.OnSave := IniSave;
  1282.   FIniLink.OnLoad := IniLoad;
  1283.   FOffset.X := MinButtonsOffset;
  1284.   FOffset.Y := FOffset.X;
  1285.   Height := 2 * FOffset.Y + DefaultButtonSize.Y;
  1286.   FRowCount := 1;
  1287.   FEditWin := 0;
  1288.   FOptions := [sbAllowDrag, sbGrayedBtns];
  1289.   ControlStyle := ControlStyle - [csSetCaption
  1290.     {$IFDEF WIN32}, csReplicatable {$ENDIF}];
  1291.   ParentShowHint := False;
  1292.   ShowHint := True;
  1293.   SetFontDefault;
  1294.   inherited Align := alTop;
  1295.   FAlign := alTop;
  1296.   UpdateGridSize;
  1297. {$IFDEF WIN32}
  1298.   FImageChangeLink := TChangeLink.Create;
  1299.   FImageChangeLink.OnChange := ImageListChange;
  1300. {$ENDIF}
  1301.   if not Registered then begin
  1302.     RegisterClasses([TSpeedItem, TSpeedbarSection, TSpeedbarButton]);
  1303.     Registered := True;
  1304.   end;
  1305. end;
  1306. destructor TSpeedBar.Destroy;
  1307. begin
  1308.   FOnVisibleChanged := nil;
  1309.   FOnApplyAlign := nil;
  1310.   FOnPosChanged := nil;
  1311.   FIniLink.Free;
  1312.   FWallpaper.OnChange := nil;
  1313.   FWallpaper.Free;
  1314.   FWallpaper := nil;
  1315.   if FEditWin <> 0 then begin
  1316.     SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_DESTROYED, Longint(Self));
  1317.     FEditWin := 0;
  1318.   end;
  1319.   ClearSections;
  1320.   FSections.Free;
  1321. {$IFDEF WIN32}
  1322.   FImageChangeLink.Free;
  1323. {$ENDIF}
  1324.   inherited Destroy;
  1325. end;
  1326. procedure TSpeedBar.Loaded;
  1327. begin
  1328.   inherited Loaded;
  1329.   if (FReserved = 0) and FFix then begin { fix previous version error }
  1330.     inherited Align := alTop;
  1331.     FAlign := alTop;
  1332.   end;
  1333.   UpdateGridSize;
  1334.   ForEachItem(SetItemButtonSize, 0);
  1335. end;
  1336. procedure TSpeedBar.ReadData(Reader: TReader);
  1337. begin
  1338.   FReserved := Reader.ReadInteger;
  1339. end;
  1340. procedure TSpeedBar.WriteData(Writer: TWriter);
  1341. begin
  1342.   Writer.WriteInteger(InternalVer);
  1343. end;
  1344. procedure TSpeedBar.ReadAllowDrag(Reader: TReader);
  1345. begin
  1346.   if Reader.ReadBoolean then Options := Options + [sbAllowDrag]
  1347.   else Options := Options - [sbAllowDrag];
  1348. end;
  1349. procedure TSpeedBar.ReadDesignStyle(Reader: TReader);
  1350. begin
  1351.   FDesignStyle := Reader.ReadBoolean;
  1352. end;
  1353. procedure TSpeedBar.WriteDesignStyle(Writer: TWriter);
  1354. begin
  1355.   Writer.WriteBoolean(NewStyleControls);
  1356. end;
  1357. procedure TSpeedBar.ReadSections(Reader: TReader);
  1358. var
  1359. {$IFDEF WIN32}
  1360.   TmpList: TStrings;
  1361.   I: Integer;
  1362. {$ELSE}
  1363.   S: string;
  1364. {$ENDIF}
  1365. begin
  1366. {$IFDEF WIN32}
  1367.   TmpList := TStringList.Create;
  1368.   try
  1369.     Reader.ReadListBegin;
  1370.     while not Reader.EndOfList do
  1371.       TmpList.AddObject(Reader.ReadString, nil);
  1372.     Reader.ReadListEnd;
  1373.     if (Reader.Ancestor = nil) or (TmpList.Count > 0) then begin
  1374.       for I := 0 to TmpList.Count - 1 do begin
  1375.         if SearchSection(TmpList[I]) < 0 then AddSection(TmpList[I]);
  1376.       end;
  1377.     end;
  1378.   finally
  1379.     TmpList.Free;
  1380.   end;
  1381. {$ELSE}
  1382.   Reader.ReadListBegin;
  1383.   FSections.Clear;
  1384.   while not Reader.EndOfList do begin
  1385.     S := Reader.ReadString;
  1386.     if SearchSection(S) < 0 then AddSection(S);
  1387.   end;
  1388.   Reader.ReadListEnd;
  1389. {$ENDIF}
  1390. end;
  1391. procedure TSpeedBar.WriteSections(Writer: TWriter);
  1392. var
  1393.   I: Integer;
  1394. begin
  1395.   Writer.WriteListBegin;
  1396.   for I := 0 to FSections.Count - 1 do
  1397.     Writer.WriteString(Sections[I].Caption);
  1398.   Writer.WriteListEnd;
  1399. end;
  1400. procedure TSpeedBar.DefineProperties(Filer: TFiler);
  1401. begin
  1402.   inherited DefineProperties(Filer);
  1403.   Filer.DefineProperty('Sections', ReadSections, WriteSections, False);
  1404.   Filer.DefineProperty('NewStyle', ReadDesignStyle, WriteDesignStyle, False);
  1405.   Filer.DefineProperty('InternalVer', ReadData, WriteData,
  1406.     {$IFDEF WIN32} Filer.Ancestor = nil {$ELSE} True {$ENDIF});
  1407.   { AllowDrag reading for backward compatibility only }
  1408.   Filer.DefineProperty('AllowDrag', ReadAllowDrag, nil, False);
  1409. end;
  1410. function TSpeedBar.GetSection(Index: Integer): TSpeedbarSection;
  1411. begin
  1412.   Result := TSpeedbarSection(FSections[Index]);
  1413. end;
  1414. function TSpeedBar.GetSectionCount: Integer;
  1415. begin
  1416.   Result := FSections.Count;
  1417. end;
  1418. procedure TSpeedBar.ForEachItem(Proc: TForEachItem; Data: Longint);
  1419. var
  1420.   I, Idx: Integer;
  1421.   Sect: TSpeedbarSection;
  1422. begin
  1423.   for I := 0 to FSections.Count - 1 do
  1424.     if FSections[I] <> nil then begin
  1425.       Sect := TSpeedbarSection(FSections[I]);
  1426.       for Idx := 0 to Sect.Count - 1 do begin
  1427.         if (Sect[Idx] <> nil) and Assigned(Proc) then
  1428.           Proc(TSpeedItem(Sect[Idx]), Data);
  1429.       end;
  1430.     end;
  1431. end;
  1432. function TSpeedBar.MinButtonsOffset: Integer;
  1433. begin
  1434.   Result := BorderWidth + 2 * Ord(not (sbFlatBtns in Options));
  1435.   if BevelOuter <> bvNone then Inc(Result, BevelWidth);
  1436.   if BevelInner <> bvNone then Inc(Result, BevelWidth);
  1437. end;
  1438. procedure TSpeedBar.SetItemVisible(Item: TSpeedItem; Data: Longint);
  1439. var
  1440.   ItemVisible: Boolean;
  1441. begin
  1442.   ItemVisible := Item.Visible and Self.Visible;
  1443.   Item.FButton.Visible := ItemVisible;
  1444.   if (Item.FButton.Parent <> Self) and ItemVisible then
  1445.     Item.FButton.Parent := Self;
  1446. end;
  1447. procedure TSpeedBar.SetItemEnabled(Item: TSpeedItem; Data: Longint);
  1448. begin
  1449.   Item.FButton.Enabled := Item.Enabled and Self.Enabled;
  1450. end;
  1451. procedure TSpeedBar.SetItemButtonSize(Item: TSpeedItem; Data: Longint);
  1452. begin
  1453.   ApplyItemSize(Item, Data);
  1454.   Item.Visible := Item.Visible; { update visible and parent after loading }
  1455. end;
  1456. procedure TSpeedBar.SwapItemBounds(Item: TSpeedItem; Data: Longint);
  1457. begin
  1458.   Item.FButton.SetBounds(Item.Top, Item.Left, FButtonSize.X, FButtonSize.Y);
  1459. end;
  1460. procedure TSpeedBar.SetFontDefault;
  1461. {$IFDEF WIN32}
  1462. var
  1463.   NCMetrics: TNonClientMetrics;
  1464. {$ENDIF}
  1465. begin
  1466.   ParentFont := False;
  1467.   with Font do begin
  1468. {$IFDEF WIN32}
  1469.     NCMetrics.cbSize := SizeOf(TNonClientMetrics);
  1470.     if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
  1471.     begin
  1472.       Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
  1473.   {$IFNDEF VER90}
  1474.       Charset := DEFAULT_CHARSET;
  1475.   {$ENDIF}
  1476.     end
  1477.     else begin
  1478. {$ENDIF}
  1479.       Name := 'MS Sans Serif';
  1480.       Size := 8;
  1481.       Style := [];
  1482.       Color := clBtnText;
  1483. {$IFDEF WIN32}
  1484.     end;
  1485. {$ENDIF}
  1486.   end;
  1487. end;
  1488. procedure TSpeedBar.CMVisibleChanged(var Message: TMessage);
  1489. begin
  1490.   inherited;
  1491.   if not (csLoading in ComponentState) then ForEachItem(SetItemVisible, 0);
  1492.   if Assigned(FOnVisibleChanged) then FOnVisibleChanged(Self);
  1493. end;
  1494. procedure TSpeedBar.CMEnabledChanged(var Message: TMessage);
  1495. begin
  1496.   inherited;
  1497.   if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
  1498.     ForEachItem(SetItemEnabled, 0);
  1499. end;
  1500. procedure TSpeedBar.WallpaperChanged(Sender: TObject);
  1501. begin
  1502.   Invalidate;
  1503. end;
  1504. procedure TSpeedBar.SetWallpaper(Value: TPicture);
  1505. begin
  1506.   FWallpaper.Assign(Value);
  1507. end;
  1508. procedure TSpeedBar.ClearSections;
  1509. begin
  1510.   while FSections.Count > 0 do RemoveSection(FSections.Count - 1);
  1511.   FSections.Clear;
  1512. end;
  1513. function TSpeedBar.Items(Section, Index: Integer): TSpeedItem;
  1514. var
  1515.   List: TSpeedbarSection;
  1516. begin
  1517.   Result := nil;
  1518.   if (Section >= 0) and (Section < FSections.Count) then begin
  1519.     List := Sections[Section];
  1520.     if List <> nil then
  1521.       if (Index >= 0) and (Index < List.Count) then
  1522.         Result := List[Index];
  1523.   end;
  1524. end;
  1525. function TSpeedBar.ItemsCount(Section: Integer): Integer;
  1526. begin
  1527.   Result := 0;
  1528.   if (Section >= 0) and (Section < FSections.Count) then begin
  1529.     if FSections[Section] <> nil then
  1530.       Result := Sections[Section].Count;
  1531.   end;
  1532. end;
  1533. procedure TSpeedBar.RemoveSection(Section: Integer);
  1534. var
  1535.   Sect: TSpeedbarSection;
  1536.   Item: TSpeedItem;
  1537. begin
  1538.   Sect := Sections[Section];
  1539.   if Sect <> nil then begin
  1540.     while Sect.Count > 0 do begin
  1541.       Item := Sect[0];
  1542.       Item.Free;
  1543.     end;
  1544.     Sect.FParent := nil;
  1545.     Sect.Free;
  1546.     FSections[Section] := nil;
  1547.   end;
  1548.   FSections.Delete(Section);
  1549. end;
  1550. procedure TSpeedBar.DeleteSection(Section: Integer);
  1551. var
  1552.   Sect: TSpeedbarSection;
  1553.   I: Integer;
  1554. begin
  1555.   Sect := Sections[Section];
  1556.   if Sect <> nil then begin
  1557.     for I := 0 to Sect.Count - 1 do RemoveItem(TSpeedItem(Sect[I]));
  1558.     Sect.FParent := nil;
  1559.     FSections[Section] := nil;
  1560.   end;
  1561.   FSections.Delete(Section);
  1562. end;
  1563. procedure TSpeedBar.RemoveItem(Item: TSpeedItem);
  1564. var
  1565.   I, Index: Integer;
  1566. begin
  1567.   if FindItem(Item, I, Index) then begin
  1568.     Item.FButton.Parent := nil;
  1569.     Item.FParent := nil;
  1570.     Item.FSection := -1;
  1571.     Sections[I].FList.Delete(Index);
  1572.   end;
  1573. end;
  1574. function TSpeedBar.SearchSection(const ACaption: string): Integer;
  1575. var
  1576.   I: Integer;
  1577. begin
  1578.   Result := -1;
  1579.   for I := 0 to FSections.Count - 1 do
  1580.     if Sections[I].Caption = ACaption then begin
  1581.       Result := I;
  1582.       Exit;
  1583.     end;
  1584. end;
  1585. function TSpeedBar.AppendSection(Value: TSpeedbarSection): Integer;
  1586. var
  1587.   UniqueName: string;
  1588.   I: Integer;
  1589. begin
  1590.   I := 0;
  1591.   UniqueName := Value.Caption;
  1592.   while SearchSection(UniqueName) >= 0 do begin
  1593.     Inc(I);
  1594.     UniqueName := Value.Caption + Format(' (%d)', [I]);
  1595.   end;
  1596.   Value.Caption := UniqueName;
  1597.   Result := FSections.Add(Value);
  1598.   if Result >= 0 then begin
  1599.     Value.FParent := Self;
  1600.     for I := 0 to Value.Count - 1 do begin
  1601.       Value[I].FSection := Result;
  1602.       SetItemParams(Value[I], not (csLoading in ComponentState));
  1603.     end;
  1604.   end;
  1605. end;
  1606. function TSpeedBar.AddSection(const ACaption: string): Integer;
  1607. var
  1608.   Section: TSpeedbarSection;
  1609. begin
  1610.   if Owner <> nil then Section := TSpeedbarSection.Create(Owner)
  1611.   else Section := TSpeedbarSection.Create(Self);
  1612.   Section.Caption := ACaption;
  1613.   Result := AppendSection(Section);
  1614. end;
  1615. procedure TSpeedBar.SetItemParams(Item: TSpeedItem; InitBounds: Boolean);
  1616. begin
  1617.   with Item do begin
  1618.     FParent := Self;
  1619.     with FButton do begin
  1620.       if InitBounds then SetBounds(0, 0, BtnWidth, BtnHeight);
  1621.       Style := FButtonStyle;
  1622.       Flat := (sbFlatBtns in Options);
  1623.       Transparent := (sbTransparentBtns in Options);
  1624.       GrayedInactive := (sbGrayedBtns in Options);
  1625.     end;
  1626.     SetEditing(FEditWin <> 0);
  1627.   end;
  1628. end;
  1629. function TSpeedBar.NewItem(AOwner: TComponent; Section: Integer;
  1630.   const AName: string): TSpeedItem;
  1631. begin
  1632.   Result := nil;
  1633.   if (Section >= 0) and (Section < FSections.Count) then begin
  1634.     Result := TSpeedItem.Create(AOwner);
  1635.     try
  1636.       Sections[Section].FList.Add(Result);
  1637.       Result.FSection := Section;
  1638.       SetItemParams(Result, True);
  1639.       if AName <> '' then
  1640.         with Result do begin
  1641.           Name := AName;
  1642.           Caption := AName;
  1643.           FButton.Visible := False;
  1644.           FButton.Parent := Self;
  1645.         end;
  1646.     except
  1647.       Result.Free;
  1648.       raise;
  1649.     end;
  1650.   end;
  1651. end;
  1652. procedure TSpeedBar.AddItem(Section: Integer; Item: TSpeedItem);
  1653. var
  1654.   I, Index: Integer;
  1655. begin
  1656.   if FindItem(Item, I, Index) then begin
  1657.     Sections[I].FList.Delete(Index);
  1658.     if Section >= FSections.Count then Section := FSections.Count - 1;
  1659.     Sections[Section].FList.Add(Item);
  1660.     Item.FSection := Section;
  1661.     Exit;
  1662.   end;
  1663.   if (Section >= 0) and (Item <> nil) then begin
  1664.     if Assigned(FOnAddItem) then begin
  1665.       FOnAddItem(Item);
  1666.       Section := Item.FSection;
  1667.     end;
  1668.     if FSections.Count = 0 then Section := AddSection('')
  1669.     else if Section >= FSections.Count then Section := FSections.Count - 1;
  1670.     Sections[Section].FList.Add(Item);
  1671.     Item.FSection := Section;
  1672.     SetItemParams(Item, not (csLoading in ComponentState));
  1673.     Item.FButton.Visible := False;
  1674.     Item.FButton.Parent := Self;
  1675.   end;
  1676. end;
  1677. function TSpeedBar.FindItem(Item: TSpeedItem; var Section,
  1678.   Index: Integer): Boolean;
  1679. var
  1680.   I: Integer;
  1681. begin
  1682.   Result := False;
  1683.   Section := -1;
  1684.   for I := 0 to FSections.Count - 1 do
  1685.     if FSections[I] <> nil then begin
  1686.       Index := Sections[I].FList.IndexOf(Item);
  1687.       if Index >= 0 then begin
  1688.         Section := I;
  1689.         Result := True;
  1690.         Exit;
  1691.       end;
  1692.     end;
  1693. end;
  1694. procedure TSpeedBar.AlignItemsToGrid;
  1695. begin
  1696.   ForEachItem(AlignItemToGrid, 0);
  1697. end;
  1698. procedure TSpeedBar.AlignItemToGrid(Item: TSpeedItem; Data: Longint);
  1699. begin
  1700.   if Item.Visible then begin
  1701.     if GetOrientation = boVertical then begin
  1702.       Item.Left := Trunc((Item.Left - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
  1703.       Item.Top := Round((Item.Top - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
  1704.     end
  1705.     else begin
  1706.       Item.Left := Round((Item.Left - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
  1707.       Item.Top := Trunc((Item.Top - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
  1708.     end;
  1709.   end;
  1710. end;
  1711. function TSpeedBar.AcceptDropItem(Item: TSpeedItem; X, Y: Integer): Boolean;
  1712. var
  1713.   I, Sect: Integer;
  1714. begin
  1715.   Result := False;
  1716.   if FindItem(Item, Sect, I) then begin
  1717.     if GetOrientation = boVertical then begin
  1718.       X := Trunc((X - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
  1719.       Y := Round((Y - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
  1720.     end
  1721.     else begin
  1722.       X := Round((X - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
  1723.       Y := Trunc((Y - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
  1724.     end;
  1725.     Item.Left := X;
  1726.     Item.Top := Y;
  1727.     Result := PtInRect(ClientRect, Point(X, Y));
  1728.     if Result then Item.FButton.BringToFront
  1729.     else Item.FButton.SendToBack;
  1730.     Item.Visible := Result;
  1731.   end;
  1732. end;
  1733. procedure TSpeedBar.SetItemEditing(Item: TSpeedItem; Data: Longint);
  1734. begin
  1735.   Item.SetEditing(FEditWin <> 0);
  1736. end;
  1737. function TSpeedBar.GetEditing: Boolean;
  1738. begin
  1739.   Result := (FEditWin <> 0);
  1740. end;
  1741. procedure TSpeedBar.SetEditing(Win: HWnd);
  1742. begin
  1743.   FEditWin := Win;
  1744.   ForEachItem(SetItemEditing, 0);
  1745.   if (FEditWin = 0) and not (csDesigning in ComponentState) then
  1746.     AfterCustomize;
  1747. end;
  1748. procedure TSpeedBar.Paint;
  1749. var
  1750.   XCnt, YCnt, X, Y: Integer;
  1751.   BevelSize, SaveIndex: Integer;
  1752.   Rect: TRect;
  1753.   C1, C2: TColor;
  1754.   procedure BevelLine(C: TColor; X1, Y1, X2, Y2: Integer);
  1755.   begin
  1756.     with Canvas do begin
  1757.       Pen.Color := C;
  1758.       MoveTo(X1, Y1);
  1759.       LineTo(X2, Y2);
  1760.     end;
  1761.   end;
  1762. begin
  1763.   if not FLocked then begin
  1764.     Rect := ClientRect;
  1765.     BevelSize := BorderWidth;
  1766.     if BevelOuter <> bvNone then Inc(BevelSize, BevelWidth);
  1767.     if BevelInner <> bvNone then Inc(BevelSize, BevelWidth);
  1768.     InflateRect(Rect, -BevelSize, -BevelSize);
  1769.     inherited Paint;
  1770.     if (FWallpaper.Graphic <> nil) and (FWallpaper.Width > 0) and
  1771.       (FWallpaper.Height > 0) then
  1772.     begin
  1773.       SaveIndex := SaveDC(Canvas.Handle);
  1774.       try
  1775.         with Rect do
  1776.           IntersectClipRect(Canvas.Handle, Left, Top, Right - Left +
  1777.             BevelSize, Bottom - Top + BevelSize);
  1778.         if sbStretchBitmap in Options then
  1779.           Canvas.StretchDraw(Rect, FWallpaper.Graphic)
  1780.         else begin
  1781.           XCnt := (ClientWidth - 2 * BevelSize) div FWallpaper.Width;
  1782.           YCnt := (ClientHeight - 2 * BevelSize) div FWallpaper.Height;
  1783.           for X := 0 to XCnt do
  1784.             for Y := 0 to YCnt do
  1785.               Canvas.Draw(Rect.Left + X * FWallpaper.Width,
  1786.                 Rect.Top + Y * FWallpaper.Height, FWallpaper.Graphic);
  1787.         end;
  1788.       finally
  1789.         RestoreDC(Canvas.Handle, SaveIndex);
  1790.       end;
  1791.     end;
  1792.     if FBoundLines <> [] then begin
  1793.       C1 := clBtnShadow;
  1794.       C2 := clBtnHighlight;
  1795.       if blTop in FBoundLines then begin
  1796.         BevelLine(C1, Rect.Left, Rect.Top, Rect.Right, Rect.Top);
  1797.         BevelLine(C2, Rect.Left, Rect.Top + 1, Rect.Right, Rect.Top + 1);
  1798.       end;
  1799.       if blLeft in FBoundLines then begin
  1800.         BevelLine(C1, Rect.Left, Rect.Top, Rect.Left, Rect.Bottom);
  1801.         BevelLine(C2, Rect.Left + 1, Rect.Top + Integer(blTop in FBoundLines), Rect.Left + 1, Rect.Bottom);
  1802.       end;
  1803.       if blBottom in FBoundLines then begin
  1804.         BevelLine(C1, Rect.Left, Rect.Bottom - 2, Rect.Right, Rect.Bottom - 2);
  1805.         BevelLine(C2, Rect.Left, Rect.Bottom - 1, Rect.Right, Rect.Bottom - 1);
  1806.       end;
  1807.       if blRight in FBoundLines then begin
  1808.         BevelLine(C1, Rect.Right - 2, Rect.Top, Rect.Right - 2, Rect.Bottom - Integer(blBottom in FBoundLines));
  1809.         BevelLine(C2, Rect.Right - 1, Rect.Top, Rect.Right - 1, Rect.Bottom);
  1810.       end;
  1811.     end;
  1812.   end;
  1813. end;
  1814. procedure TSpeedBar.ApplyOrientation(Value: TBarOrientation);
  1815. begin
  1816.   if (GetOrientation <> Value) and not (csReading in ComponentState) then begin
  1817.     FLocked := True;
  1818.     try
  1819.       FOrientation := Value;
  1820.       SwapInt(Integer(FButtonSize.X), Integer(FButtonSize.Y));
  1821.       SwapInt(Integer(FGridSize.X), Integer(FGridSize.Y));
  1822.       SwapInt(Integer(FOffset.X), Integer(FOffset.Y));
  1823.       ForEachItem(SwapItemBounds, 0);
  1824.     finally
  1825.       FLocked := False;
  1826.       Invalidate;
  1827.     end;
  1828.     if FEditWin <> 0 then
  1829.       SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSIZECHANGED, Longint(Self));
  1830.   end;
  1831. end;
  1832. procedure TSpeedBar.SetOrientation(Value: TBarOrientation);
  1833. begin
  1834.   if GetOrientation <> Value then begin
  1835.     if (FPosition = bpAuto) then
  1836.       raise ESpeedbarError.Create(SAutoSpeedbarMode);
  1837.     ApplyOrientation(Value);
  1838.   end;
  1839. end;
  1840. function TSpeedBar.GetOrientation: TBarOrientation;
  1841. begin
  1842.   if FPosition = bpCustom then Result := FOrientation
  1843.   else
  1844.     case Align of
  1845.       alLeft, alRight: Result := boVertical;
  1846.       alTop, alBottom: Result := boHorizontal;
  1847.       else Result := FOrientation;
  1848.     end;
  1849. end;
  1850. function TSpeedBar.GetAlign: TAlign;
  1851. begin
  1852.   Result := FAlign;
  1853. end;
  1854. procedure TSpeedBar.SetAlign(Value: TAlign);
  1855. var
  1856.   X, Y: Integer;
  1857. begin
  1858.   { fix previous version error }
  1859.   if (csLoading in ComponentState) and (Value = alNone) and
  1860.     (Position = bpAuto) then FFix := True;
  1861.   if Align <> Value then begin
  1862.     X := Width; Y := Height;
  1863.     if (FPosition = bpAuto) and (Value in [alClient, alNone]) then
  1864.       raise ESpeedbarError.Create(SAutoSpeedbarMode);
  1865.     inherited Align := Value;
  1866.     if (csLoading in ComponentState) then begin
  1867.       Width := X; Height := Y;
  1868.     end;
  1869.     if FPosition = bpAuto then
  1870.       case Value of
  1871.         alLeft, alRight: ApplyOrientation(boVertical);
  1872.         alTop, alBottom: ApplyOrientation(boHorizontal);
  1873.         else if not (csLoading in ComponentState) then
  1874.           raise ESpeedbarError.Create(SAutoSpeedbarMode);
  1875.       end;
  1876.     FAlign := inherited Align;
  1877.   end;
  1878. end;
  1879. procedure TSpeedBar.ChangeScale(M, D: Integer);
  1880. var
  1881.   Flags: TSbScaleFlags;
  1882. begin
  1883.   DisableAlign;
  1884.   try
  1885.     if csLoading in ComponentState then Flags := ScaleFlags
  1886.     else Flags := [sfOffsetX, sfOffsetY, sfBtnSizeX, sfBtnSizeY];
  1887.     if (sfBtnSizeX in Flags) and not (csFixedWidth in ControlStyle) then
  1888.       FButtonSize.X := MulDiv(FButtonSize.X, M, D);
  1889.     if (sfBtnSizeY in Flags) and not (csFixedHeight in ControlStyle) then
  1890.       FButtonSize.Y := MulDiv(FButtonSize.Y, M, D);
  1891.     if (sfOffsetX in Flags) then
  1892.       FOffset.X := MulDiv(FOffset.X, M, D);
  1893.     if (sfOffsetY in Flags) then
  1894.       FOffset.Y := MulDiv(FOffset.Y, M, D);
  1895.     UpdateGridSize;
  1896.     inherited ChangeScale(M, D);
  1897.     ApplyButtonSize;
  1898.     AlignItemsToGrid;
  1899.     FScaleFlags := [];
  1900.   finally
  1901.     EnableAlign;
  1902.   end;
  1903. end;
  1904. procedure TSpeedBar.AlignControls(AControl: TControl; var Rect: TRect);
  1905. var
  1906.   P: TPoint;
  1907.   Min: Integer;
  1908. begin
  1909.   if FBoundLines <> [] then begin
  1910.     if blTop in FBoundLines then Inc(Rect.Top, 2);
  1911.     if blBottom in FBoundLines then Dec(Rect.Bottom, 2);
  1912.     if blLeft in FBoundLines then Inc(Rect.Left, 2);
  1913.     if blRight in FBoundLines then Dec(Rect.Right, 2);
  1914.   end;
  1915.   inherited AlignControls(AControl, Rect);
  1916.   Min := MinButtonsOffset;
  1917.   if FOffset.X < Min then begin
  1918.     P.X := Min - FOffset.X;
  1919.     FOffset.X := Min;
  1920.   end else P.X := 0;
  1921.   if FOffset.Y < Min then begin
  1922.     P.Y := Min - FOffset.Y;
  1923.     FOffset.Y := Min;
  1924.   end else P.Y := 0;
  1925.   if not (csLoading in ComponentState) and ((P.X <> 0) or (P.Y <> 0)) then
  1926.     ForEachItem(OffsetItem, Longint(@P));
  1927. end;
  1928. procedure TSpeedBar.FlatItem(Item: TSpeedItem; Data: Longint);
  1929. begin
  1930.   Item.FButton.Flat := Boolean(Data);
  1931. end;
  1932. procedure TSpeedBar.GrayedItem(Item: TSpeedItem; Data: Longint);
  1933. begin
  1934.   Item.FButton.GrayedInactive := Boolean(Data);
  1935. end;
  1936. procedure TSpeedBar.TransparentItem(Item: TSpeedItem; Data: Longint);
  1937. begin
  1938.   Item.FButton.Transparent := Boolean(Data);
  1939. end;
  1940. procedure TSpeedBar.SetBoundLines(Value: TBoundLines);
  1941. begin
  1942.   if FBoundLines <> Value then begin
  1943.     FBoundLines := Value;
  1944.     Realign;
  1945.     Invalidate;
  1946.   end;
  1947. end;
  1948. procedure TSpeedBar.SetOptions(Value: TSpeedbarOptions);
  1949. var
  1950.   FlatChanged: Boolean;
  1951. begin
  1952.   if FOptions <> Value then begin
  1953.     FlatChanged := (sbFlatBtns in FOptions) <> (sbFlatBtns in Value);
  1954.     FOptions := Value;
  1955.     ForEachItem(FlatItem, Longint(sbFlatBtns in Options));
  1956.     ForEachItem(TransparentItem, Longint(sbTransparentBtns in Options));
  1957.     ForEachItem(GrayedItem, Longint(sbGrayedBtns in Options));
  1958.     UpdateGridSize;
  1959.     if FlatChanged then Realign;
  1960.     Invalidate;
  1961.   end;
  1962. end;
  1963. procedure TSpeedBar.OffsetItem(Item: TSpeedItem; Data: Longint);
  1964. var
  1965.   P: TPoint;
  1966. begin
  1967.   P := PPoint(Data)^;
  1968.   Item.FButton.SetBounds(Item.Left + P.X, Item.Top + P.Y, FButtonSize.X,
  1969.     FButtonSize.Y);
  1970. end;
  1971. function TSpeedBar.GetButtonsOffset(Index: Integer): Integer;
  1972. begin
  1973.   if Index = 0 then Result := FOffset.X
  1974.   else if Index = 1 then Result := FOffset.Y
  1975.   else Result := 0;
  1976. end;
  1977. procedure TSpeedBar.SetButtonsOffset(Index: Integer; Value: Integer);
  1978. var
  1979.   P: TPoint;
  1980. begin
  1981.   if Value < MinButtonsOffset then Value := MinButtonsOffset;
  1982.   P.X := 0; P.Y := 0;
  1983.   if Index = 0 then begin
  1984.     P.X := Value - FOffset.X;
  1985.     FOffset.X := Value;
  1986.     Include(FScaleFlags, sfOffsetX);
  1987.   end
  1988.   else if Index = 1 then begin
  1989.     P.Y := Value - FOffset.Y;
  1990.     FOffset.Y := Value;
  1991.     Include(FScaleFlags, sfOffsetY);
  1992.   end;
  1993.   if (P.X <> 0) or (P.Y <> 0) then
  1994.     ForEachItem(OffsetItem, Longint(@P));
  1995. end;
  1996. procedure TSpeedBar.UpdateGridSize;
  1997. var
  1998.   Base: Integer;
  1999. begin
  2000.   case Orientation of
  2001.     boHorizontal: Base := FButtonSize.X;
  2002.     else {boVertical:} Base := FButtonSize.Y;
  2003.   end;
  2004.   case Orientation of
  2005.     boHorizontal:
  2006.       begin
  2007.         FGridSize.X := Max(1, Min(8, Base div 3));
  2008.         while (Base mod FGridSize.X <> 0) do Inc(FGridSize.X);
  2009.         if (FGridSize.X = Base) and (Base > 1) then begin
  2010.           Dec(FGridSize.X);
  2011.           while (FGridSize.X > 1) and (Base mod FGridSize.X <> 0) do
  2012.             Dec(FGridSize.X);
  2013.         end;
  2014.         FGridSize.Y := FButtonSize.Y;
  2015.       end;
  2016.     boVertical:
  2017.       begin
  2018.         FGridSize.Y := Max(1, Min(8, Base div 3));
  2019.         while (Base mod FGridSize.Y <> 0) do Inc(FGridSize.Y);
  2020.         if (FGridSize.Y = Base) and (Base > 1) then begin
  2021.           Dec(FGridSize.Y);
  2022.           while (FGridSize.Y > 1) and (Base mod FGridSize.Y <> 0) do
  2023.             Dec(FGridSize.Y);
  2024.         end;
  2025.         FGridSize.X := FButtonSize.X;
  2026.       end;
  2027.   end;
  2028. end;
  2029. procedure TSpeedBar.ApplyItemSize(Item: TSpeedItem; Data: Longint);
  2030. begin
  2031.   with Item do
  2032.     FButton.SetBounds(FButton.Left, FButton.Top, FButtonSize.X, FButtonSize.Y);
  2033. end;
  2034. procedure TSpeedBar.ApplyButtonSize;
  2035. begin
  2036.   ForEachItem(ApplyItemSize, 0);
  2037.   if FEditWin <> 0 then { update speedbar editor }
  2038.     SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSIZECHANGED, Longint(Self));
  2039. end;
  2040. function TSpeedBar.GetButtonSize(Index: Integer): Integer;
  2041. begin
  2042.   if Index = 0 then Result := FButtonSize.X
  2043.   else if Index = 1 then Result := FButtonSize.Y
  2044.   else Result := 0;
  2045. end;
  2046. procedure TSpeedBar.SetButtonSize(Index, Value: Integer);
  2047. var
  2048.   NewSize: TPoint;
  2049. begin
  2050.   NewSize.X := FButtonSize.X;
  2051.   NewSize.Y := FButtonSize.Y;
  2052.   if Index = 0 then begin
  2053.     NewSize.X := Value;
  2054.     Include(FScaleFlags, sfBtnSizeX);
  2055.   end
  2056.   else if Index = 1 then begin
  2057.     NewSize.Y := Value;
  2058.     Include(FScaleFlags, sfBtnSizeY);
  2059.   end
  2060.   else Exit;
  2061.   FButtonSize := NewSize;
  2062.   UpdateGridSize;
  2063.   if not (csReading in ComponentState) then
  2064.     case Orientation of
  2065.       boHorizontal:
  2066.         ClientHeight := Max(ClientHeight, 2 * FOffset.Y + FButtonSize.Y);
  2067.       boVertical:
  2068.         ClientWidth := Max(ClientWidth, 2 * FOffset.X + FButtonSize.X);
  2069.     end;
  2070.   ApplyButtonSize;
  2071. end;
  2072. {$IFDEF WIN32}
  2073. procedure TSpeedBar.GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
  2074.   Root: TComponent {$ENDIF});
  2075. var
  2076.   I, Idx: Integer;
  2077.   Sect: TSpeedbarSection;
  2078.   Item: TSpeedItem;
  2079. begin
  2080.   inherited GetChildren(Proc {$IFDEF RX_D3}, Root {$ENDIF});
  2081.   for I := 0 to FSections.Count - 1 do begin
  2082.     Sect := Sections[I];
  2083.     if Sect <> nil then Proc(Sect);
  2084.   end;
  2085.   for I := 0 to FSections.Count - 1 do begin
  2086.     Sect := Sections[I];
  2087.     if Sect <> nil then
  2088.       for Idx := 0 to Sect.Count - 1 do begin
  2089.         Item := Sect[Idx];
  2090.         if (Item <> nil) and (Item.Owner <> Self) then Proc(Item);
  2091.       end;
  2092.   end;
  2093. end;
  2094. procedure TSpeedBar.SetChildOrder(Component: TComponent; Order: Integer);
  2095. begin
  2096.   if FSections.IndexOf(Component) >= 0 then
  2097.     (Component as TSpeedbarSection).Index := Order;
  2098. end;
  2099. procedure TSpeedBar.Notification(AComponent: TComponent;
  2100.   Operation: TOperation);
  2101. begin
  2102.   inherited Notification(AComponent, Operation);
  2103.   if Operation = opRemove then
  2104.     if AComponent = FImages then SetImages(nil);
  2105. end;
  2106. procedure TSpeedBar.InvalidateItem(Item: TSpeedItem; Data: Longint);
  2107. begin
  2108.   with Item do
  2109.     if (Button <> nil) then begin
  2110.       TSpeedbarButton(Button).InvalidateGlyph;
  2111.       if FImageIndex >= 0 then Button.Invalidate;
  2112.     end;
  2113. end;
  2114. procedure TSpeedBar.ImageListChange(Sender: TObject);
  2115. begin
  2116.   ForEachItem(InvalidateItem, 0);
  2117. end;
  2118. procedure TSpeedBar.SetImages(Value: TImageList);
  2119. begin
  2120.   if Images <> nil then Images.UnRegisterChanges(FImageChangeLink);
  2121.   FImages := Value;
  2122.   if FImages <> nil then begin
  2123.     FImages.RegisterChanges(FImageChangeLink);
  2124.     FImages.FreeNotification(Self);
  2125.   end;
  2126.   ImageListChange(FImages);
  2127. end;
  2128. {$ELSE}
  2129. procedure TSpeedBar.WriteComponents(Writer: TWriter);
  2130. var
  2131.   I, Idx: Integer;
  2132.   Sect: TSpeedbarSection;
  2133.   Item: TSpeedItem;
  2134. begin
  2135.   inherited WriteComponents(Writer);
  2136.   for I := 0 to FSections.Count - 1 do begin
  2137.     Sect := TSpeedbarSection(FSections[I]);
  2138.     if (Sect <> nil) and (Sect.Owner = Writer.Root) then
  2139.       Writer.WriteComponent(Sect);
  2140.   end;
  2141.   for I := 0 to FSections.Count - 1 do begin
  2142.     Sect := TSpeedbarSection(FSections[I]);
  2143.     if Sect <> nil then
  2144.       for Idx := 0 to Sect.Count - 1 do begin
  2145.         Item := TSpeedItem(Sect[Idx]);
  2146.         if (Item <> nil) and (Item.Owner = Writer.Root) then
  2147.           Writer.WriteComponent(Item);
  2148.       end;
  2149.   end;
  2150. end;
  2151. {$ENDIF}
  2152. function TSpeedBar.SearchItem(const ItemName: string): TSpeedItem;
  2153. var
  2154.   I, Idx: Integer;
  2155.   Sect: TSpeedbarSection;
  2156.   Item: TSpeedItem;
  2157. begin
  2158.   Result := nil;
  2159.   for I := 0 to FSections.Count - 1 do
  2160.     if FSections[I] <> nil then begin
  2161.       Sect := TSpeedbarSection(FSections[I]);
  2162.       for Idx := 0 to Sect.Count - 1 do
  2163.         if (Sect[Idx] <> nil) then begin
  2164.           Item := TSpeedItem(Sect[Idx]);
  2165.           if AnsiCompareText(Item.Name, ItemName) = 0 then begin
  2166.             Result := Item;
  2167.             Exit;
  2168.           end;
  2169.         end;
  2170.     end;
  2171. end;
  2172. type
  2173.   TSpeedbarPos = (bpTop, bpBottom, bpLeft, bpRight);
  2174. const
  2175.   PosToAlign: array[TSpeedbarPos] of TAlign = (alTop, alBottom, alLeft, alRight);
  2176. function TSpeedBar.GetFramePos(X, Y: Integer; var Apply: Boolean): Integer;
  2177. var
  2178.   P: TPoint;
  2179.   W, H: Double;
  2180. begin
  2181.   P := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));
  2182.   W := Parent.ClientWidth;
  2183.   H := Parent.ClientHeight;
  2184.   if P.Y <= P.X * (H / W) then begin { top or right }
  2185.     if P.Y >= H * (1 - P.X / W) then Result := Integer(bpRight)
  2186.     else Result := Integer(bpTop);
  2187.   end
  2188.   else begin { left or bottom }
  2189.     if P.Y >= H * (1 - P.X / W) then Result := Integer(bpBottom)
  2190.     else Result := Integer(bpLeft);
  2191.   end;
  2192.   if Assigned(FOnApplyAlign) then
  2193.     FOnApplyAlign(Self, PosToAlign[TSpeedbarPos(Result)], Apply);
  2194. end;
  2195. function TSpeedBar.GetFrameRect(X, Y: Integer): TRect;
  2196. var
  2197.   Pos: TSpeedbarPos;
  2198.   W: Integer;
  2199.   Apply: Boolean;
  2200.   function InsertBefore(C1, C2: TControl; AAlign: TAlign): Boolean;
  2201.   begin
  2202.     Result := False;
  2203.     case AAlign of
  2204.       alTop: Result := C1.Top < C2.Top;
  2205.       alBottom: Result := (C1.Top + C1.Height) > (C2.Top + C2.Height);
  2206.       alLeft: Result := C1.Left < C2.Left;
  2207.       alRight: Result := (C1.Left + C1.Width) > (C2.Left + C2.Width);
  2208.     end;
  2209.   end;
  2210.   function MaxRect: TRect;
  2211.   var
  2212.     I: Integer;
  2213.     Control: TControl;
  2214.   begin
  2215.     Result := Parent.ClientRect;
  2216.     for I := 0 to Parent.ControlCount - 1 do begin
  2217.       Control := Parent.Controls[I];
  2218.       if (Control.Visible) and (Control <> Self) and not
  2219.         (Control.Align in [alNone, alClient]) then
  2220.       begin
  2221.         if (Control.Align > PosToAlign[Pos]) or ((Control.Align = PosToAlign[Pos])
  2222.           and not InsertBefore(Control, Self, Control.Align)) then Continue;
  2223.         case Control.Align of
  2224.           alTop: Inc(Result.Top, Control.Height);
  2225.           alBottom: Dec(Result.Bottom, Control.Height);
  2226.           alLeft: Inc(Result.Left, Control.Width);
  2227.           alRight: Dec(Result.Right, Control.Width);
  2228.         end;
  2229.       end;
  2230.     end;
  2231.   end;
  2232. begin
  2233.   Apply := True;
  2234.   Pos := TSpeedbarPos(GetFramePos(X, Y, Apply));
  2235.   if Apply then begin
  2236.     Result := MaxRect;
  2237.     FPrevAlign := PosToAlign[Pos];
  2238.   end
  2239.   else begin
  2240.     Result := FPrevRect;
  2241.     Exit;
  2242.   end;
  2243.   with Result do begin
  2244.     TopLeft := Parent.ClientToScreen(TopLeft);
  2245.     BottomRight := Parent.ClientToScreen(BottomRight);
  2246.   end;
  2247.   case GetOrientation of
  2248.     boHorizontal: W := Height;
  2249.     boVertical: W := Width;
  2250.     else W := 0;
  2251.   end;
  2252.   case Pos of
  2253.     bpTop: Result.Bottom := Result.Top + W;
  2254.     bpBottom: Result.Top := Result.Bottom - W;
  2255.     bpLeft: Result.Right := Result.Left + W;
  2256.     bpRight: Result.Left := Result.Right - W;
  2257.   end;
  2258. end;
  2259. procedure TSpeedBar.StartDragFrame;
  2260. var
  2261.   Rect: TRect;
  2262. begin
  2263.   with Rect do begin
  2264.     TopLeft := ClientToScreen(Point(0, 0));
  2265.     BottomRight := ClientToScreen(Point(Width, Height));
  2266.   end;
  2267.   FPrevRect := Rect;
  2268.   FPrevAlign := Align;
  2269.   DrawInvertFrame(FPrevRect, DragFrameWidth);
  2270.   SetCursor(Screen.Cursors[crDragHand]);
  2271.   FDrag := True;
  2272. end;
  2273. procedure TSpeedBar.DragFrame(X, Y: Integer);
  2274. var
  2275.   Rect: TRect;
  2276. begin
  2277.   Rect := GetFrameRect(X, Y);
  2278.   if not EqualRect(Rect, FPrevRect) then begin
  2279.     DrawInvertFrame(FPrevRect, DragFrameWidth);
  2280.     SetCursor(Screen.Cursors[crDragHand]);
  2281.     FPrevRect := Rect;
  2282.     DrawInvertFrame(FPrevRect, DragFrameWidth);
  2283.   end;
  2284. end;
  2285. procedure TSpeedBar.StopDragFrame(X, Y: Integer);
  2286. var
  2287.   Pos: TSpeedbarPos;
  2288.   Apply: Boolean;
  2289. begin
  2290.   DrawInvertFrame(FPrevRect, DragFrameWidth);
  2291.   SetCursor(Screen.Cursors[Cursor]);
  2292.   FDrag := False;
  2293.   if Align in [alLeft, alTop, alRight, alBottom] then begin
  2294.     Apply := True;
  2295.     Pos := TSpeedbarPos(GetFramePos(X, Y, Apply));
  2296.     Parent.DisableAlign;
  2297.     try
  2298.       if Apply then Align := PosToAlign[Pos]
  2299.       else Align := FPrevAlign;
  2300.     finally
  2301.       Parent.EnableAlign;
  2302.     end;
  2303.     PosChanged;
  2304.   end;
  2305. end;
  2306. function TSpeedBar.CheckResize(Shift: TShiftState; X, Y: Integer): Boolean;
  2307. begin
  2308.   Result := False;
  2309.   if (FEditWin <> 0) and (sbAllowResize in Options) and not FDrag then begin
  2310.     if (Align in [alTop, alBottom]) and (X > 0) and (X <= ClientWidth) then
  2311.     begin
  2312.       case Align of
  2313.         alTop:
  2314.           Result :=  (Y > ClientHeight - StartDragOffset) and
  2315.             (Y <= ClientHeight + StartDragOffset);
  2316.         alBottom:
  2317.           Result :=  (Y > - StartDragOffset) and (Y <= StartDragOffset);
  2318.       end;
  2319.       if Result then SetCursor(Screen.Cursors[crSizeNS]);
  2320.     end;
  2321.     if (Align in [alLeft, alRight]) and (Y > 0) and (Y <= ClientHeight) then
  2322.     begin
  2323.       case Align of
  2324.         alLeft:
  2325.           Result :=  (X > ClientWidth - StartDragOffset) and
  2326.             (X <= ClientWidth + StartDragOffset);
  2327.         alRight:
  2328.           Result :=  (X > - StartDragOffset) and (X <= StartDragOffset);
  2329.       end;
  2330.       if Result then SetCursor(Screen.Cursors[crSizeWE]);
  2331.     end;
  2332.   end;
  2333. end;
  2334. procedure TSpeedBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2335.   X, Y: Integer);
  2336. begin
  2337.   inherited MouseDown(Button, Shift, X, Y);
  2338.   if (Button = mbLeft) and (Parent <> nil) and CheckResize(Shift, X, Y) then
  2339.   begin
  2340.     FResizing := True;
  2341.     MouseCapture := True;
  2342.     Exit;
  2343.   end;
  2344.   if (Button = mbLeft) and (Parent <> nil) and (sbAllowDrag in Options) and
  2345.     (Align in [alLeft, alTop, alRight, alBottom]) then
  2346.   begin
  2347.     MouseCapture := True;
  2348.     FStartDrag := Point(X, Y);
  2349.   end;
  2350. end;
  2351. procedure TSpeedBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  2352. var
  2353.   Cnt: Integer;
  2354.   P: TPoint;
  2355. begin
  2356.   inherited MouseMove(Shift, X, Y);
  2357.   CheckResize(Shift, X, Y);
  2358.   Cnt := 0;
  2359.   if (GetCapture = Handle) and (csLButtonDown in ControlState) then
  2360.     if FResizing then begin
  2361.       P := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));
  2362.       if not PointInRect(P, Parent.ClientRect) then Exit;
  2363.       case Align of
  2364.         alTop: Cnt := Abs(Y - (2 * FOffset.Y)) div BtnHeight;
  2365.         alLeft: Cnt := Abs(X - (2 * FOffset.X)) div BtnWidth;
  2366.         alBottom: Cnt := Abs(ClientHeight - (2 * FOffset.Y) - Y) div BtnHeight;
  2367.         alRight: Cnt := Abs(ClientWidth - (2 * FOffset.X) - X) div BtnWidth;
  2368.       end;
  2369.       Cnt := Max(1, Cnt);
  2370.       case Align of
  2371.         alTop, alBottom:
  2372.           begin
  2373.             SetCursor(Screen.Cursors[crSizeNS]);
  2374.             Height := Min(BtnHeight * Cnt + (2 * FOffset.Y), Parent.ClientHeight);
  2375.           end;
  2376.         alLeft, alRight:
  2377.           begin
  2378.             SetCursor(Screen.Cursors[crSizeWE]);
  2379.             Width := Min(BtnWidth * Cnt + (2 * FOffset.X), Parent.ClientWidth);
  2380.           end;
  2381.       end;
  2382.     end
  2383.     else if (sbAllowDrag in Options) then begin
  2384.       if FDrag then DragFrame(X, Y)
  2385.       else begin
  2386.         if (Abs(X - FStartDrag.X) > StartDragOffset) or
  2387.           (Abs(Y - FStartDrag.Y) > StartDragOffset) then StartDragFrame;
  2388.       end;
  2389.     end;
  2390. end;
  2391. procedure TSpeedBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2392.   X, Y: Integer);
  2393. begin
  2394.   if (Button = mbLeft) then begin
  2395.     if FResizing then begin
  2396.       FResizing := False;
  2397.       SetCursor(Screen.Cursors[Cursor]);
  2398.     end;
  2399.     if FDrag then StopDragFrame(X, Y);
  2400.     MouseCapture := False;
  2401.   end;
  2402.   inherited MouseUp(Button, Shift, X, Y);
  2403. end;
  2404. procedure TSpeedBar.PosChanged;
  2405. begin
  2406.   if Assigned(FOnPosChanged) then FOnPosChanged(Self);
  2407. end;
  2408. procedure TSpeedBar.AfterCustomize;
  2409. begin
  2410.   if Assigned(FOnCustomize) then FOnCustomize(Self);
  2411. end;
  2412. function TSpeedBar.GetStorage: TFormPlacement;
  2413. begin
  2414.   Result := FIniLink.Storage;
  2415. end;
  2416. procedure TSpeedBar.SetStorage(Value: TFormPlacement);
  2417. begin
  2418.   FIniLink.Storage := Value;
  2419. end;
  2420. procedure TSpeedBar.Customize(HelpCtx: THelpContext);
  2421. begin
  2422.   ShowSpeedbarSetupWindow(Self, HelpCtx);
  2423. end;
  2424. procedure TSpeedBar.IniSave(Sender: TObject);
  2425. begin
  2426.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  2427.     InternalSaveLayout(FIniLink.IniObject, FIniLink.RootSection +
  2428.       GetDefaultSection(Self));
  2429. end;
  2430. procedure TSpeedBar.IniLoad(Sender: TObject);
  2431. begin
  2432.   if (Name <> '') and (FIniLink.IniObject <> nil) then
  2433.     InternalRestoreLayout(FIniLink.IniObject, FIniLink.RootSection +
  2434.       GetDefaultSection(Self));
  2435. end;
  2436. const
  2437.   { The following strings should not be localized }
  2438.   sPosition = 'Position';
  2439.   sCount = 'Count';
  2440.   sBtn = 'Button';
  2441.   sVer = 'Version';
  2442.   sPixelsPerInch = 'PixelsPerInch';
  2443.   sBtnWidth = 'BtnWidth';
  2444.   sBtnHeight = 'BtnHeight';
  2445.   sBarWidth = 'Width';
  2446. type
  2447.   PIniData = ^TIniData;
  2448.   TIniData = record
  2449.     IniFile: TObject;
  2450.     I: Integer;
  2451.     Sect: string;
  2452.   end;
  2453. procedure TSpeedBar.HideItem(Item: TSpeedItem; Data: Longint);
  2454. begin
  2455.   Item.Visible := False;
  2456. end;
  2457. procedure TSpeedBar.WriteItemLayout(Item: TSpeedItem; Data: Longint);
  2458. begin
  2459.   if Item.Visible and Item.Stored then begin
  2460.     Inc(PIniData(Data)^.I);
  2461.     IniWriteString(PIniData(Data)^.IniFile, PIniData(Data)^.Sect,
  2462.       sBtn + IntToStr(PIniData(Data)^.I),
  2463.       Format('%s,%d,%d', [Item.Name, Item.Left, Item.Top]));
  2464.   end;
  2465. end;
  2466. procedure TSpeedBar.InternalSaveLayout(IniFile: TObject;
  2467.   const Section: string);
  2468. var
  2469.   Data: TIniData;
  2470. begin
  2471.   Data.Sect := Section;
  2472.   Data.IniFile := IniFile;
  2473.   Data.I := 0;
  2474.   IniEraseSection(IniFile, Data.Sect);
  2475.   IniWriteInteger(IniFile, Data.Sect, sPosition, Integer(Align));
  2476.   if Align in [alTop, alBottom] then
  2477.     IniWriteInteger(IniFile, Data.Sect, sBarWidth, Height)
  2478.   else if Align in [alLeft, alRight] then
  2479.     IniWriteInteger(IniFile, Data.Sect, sBarWidth, Width);
  2480.   IniWriteInteger(IniFile, Data.Sect, sVer, FVersion);
  2481.   IniWriteInteger(IniFile, Data.Sect, sPixelsPerInch, Screen.PixelsPerInch);
  2482.   IniWriteInteger(IniFile, Data.Sect, sBtnWidth, FButtonSize.X);
  2483.   IniWriteInteger(IniFile, Data.Sect, sBtnHeight, FButtonSize.Y);
  2484.   ForEachItem(WriteItemLayout, Longint(@Data));
  2485.   IniWriteInteger(IniFile, Data.Sect, sCount, Data.I);
  2486. end;
  2487. procedure TSpeedBar.InternalRestoreLayout(IniFile: TObject;
  2488.   const Section: string);
  2489. const
  2490.   Delims = [' ',','];
  2491. var
  2492.   Item: TSpeedItem;
  2493.   Count, I: Integer;
  2494.   Sect, S: string;
  2495. begin
  2496.   Sect := Section;
  2497.   FPrevAlign := Align;
  2498.   if IniReadInteger(IniFile, Sect, sVer, FVersion) < FVersion then Exit;
  2499.   if sbAllowDrag in Options then
  2500.     try
  2501.       Align := TAlign(IniReadInteger(IniFile, Sect, sPosition, Integer(Align)));
  2502.     except
  2503.       Align := alTop;
  2504.     end;
  2505.   if Owner is TCustomForm then I := TForm(Owner).PixelsPerInch
  2506.   else I := 0;
  2507.   if Screen.PixelsPerInch <> IniReadInteger(IniFile, Sect, sPixelsPerInch, I) then
  2508.   begin
  2509.     if FPrevAlign <> Align then PosChanged;
  2510.     Exit;
  2511.   end;
  2512.   if sbAllowResize in Options then begin
  2513.     if Align in [alTop, alBottom] then
  2514.       Height := IniReadInteger(IniFile, Sect, sBarWidth, Height)
  2515.     else if Align in [alLeft, alRight] then
  2516.       Width := IniReadInteger(IniFile, Sect, sBarWidth, Width);
  2517.   end;
  2518.   if FPrevAlign <> Align then PosChanged;
  2519.   {if (IniReadInteger(IniFile, Sect, sBtnWidth, FButtonSize.X) >
  2520.     FButtonSize.X) or (IniReadInteger(IniFile, Sect, sBtnHeight,
  2521.     FButtonSize.Y) > FButtonSize.Y) then Exit;}
  2522.   Count := IniReadInteger(IniFile, Sect, sCount, 0);
  2523.   if Count > 0 then begin
  2524.     ForEachItem(HideItem, 0);
  2525.     for I := 1 to Count do begin
  2526.       S := IniReadString(IniFile, Sect, sBtn + IntToStr(I), '');
  2527.       if S <> '' then begin
  2528.         Item := SearchItem(ExtractWord(1, S, Delims));
  2529.         if (Item <> nil) then begin
  2530.           Item.Left := Max(StrToIntDef(ExtractWord(2, S, Delims), Item.Left),
  2531.             FOffset.X);
  2532.           Item.Top := Max(StrToIntDef(ExtractWord(3, S, Delims), Item.Top),
  2533.             FOffset.Y);
  2534.           Item.Visible := True;
  2535.         end;
  2536.       end;
  2537.     end;
  2538.   end;
  2539.   Repaint;
  2540. end;
  2541. procedure TSpeedBar.SaveLayout(IniFile: TIniFile);
  2542. begin
  2543.   InternalSaveLayout(IniFile, GetDefaultSection(Self));
  2544. end;
  2545. procedure TSpeedBar.RestoreLayout(IniFile: TIniFile);
  2546. begin
  2547.   InternalRestoreLayout(IniFile, GetDefaultSection(Self));
  2548. end;
  2549. {$IFDEF WIN32}
  2550. procedure TSpeedBar.SaveLayoutReg(IniFile: TRegIniFile);
  2551. begin
  2552.   InternalSaveLayout(IniFile, GetDefaultSection(Self));
  2553. end;
  2554. procedure TSpeedBar.RestoreLayoutReg(IniFile: TRegIniFile);
  2555. begin
  2556.   InternalRestoreLayout(IniFile, GetDefaultSection(Self));
  2557. end;
  2558. {$ENDIF WIN32}
  2559. { TBtnControl }
  2560. constructor TBtnControl.Create(AOwner: TComponent);
  2561. begin
  2562.   FImage := TButtonImage.Create;
  2563.   inherited Create(AOwner);
  2564.   Cursor := crDragHand;
  2565.   FSpacing := 1;
  2566.   FMargin := -1;
  2567.   FLayout := blGlyphTop;
  2568. {$IFDEF WIN32}
  2569.   FImageIndex := -1;
  2570. {$ENDIF}
  2571. end;
  2572. destructor TBtnControl.Destroy;
  2573. begin
  2574.   FImage.Free;
  2575.   inherited Destroy;
  2576. end;
  2577. procedure TBtnControl.CreateParams(var Params: TCreateParams);
  2578. begin
  2579.   inherited CreateParams(Params);
  2580.   with Params do begin
  2581.     Style := WS_POPUP or WS_DISABLED;
  2582.     WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  2583. {$IFDEF WIN32}
  2584.     if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW;
  2585. {$ENDIF}
  2586.   end;
  2587. end;
  2588. procedure TBtnControl.AssignSpeedItem(Item: TSpeedItem);
  2589. begin
  2590.   Alignment := Item.FButton.Alignment;
  2591.   Glyph := Item.Glyph;
  2592.   NumGlyphs := Item.NumGlyphs;
  2593.   Spacing := Item.Spacing;
  2594.   Margin := Item.Margin;
  2595.   Layout := Item.Layout;
  2596.   Caption := Item.BtnCaption;
  2597.   WordWrap := Item.WordWrap;
  2598. {$IFDEF WIN32}
  2599.   ImageIndex := Item.ImageIndex;
  2600.   if Item.Speedbar <> nil then Images := Item.Speedbar.Images
  2601.   else Images := nil;
  2602. {$ENDIF}
  2603.   Font := Item.Font;
  2604. {$IFDEF RX_D4}
  2605.   BiDiMode := Item.FButton.BiDiMode;
  2606. {$ENDIF}
  2607.   SetBounds(0, 0, Item.Speedbar.BtnWidth, Item.Speedbar.BtnHeight);
  2608. end;
  2609. function TBtnControl.GetGlyph: TBitmap;
  2610. begin
  2611.   Result := FImage.Glyph;
  2612. end;
  2613. function TBtnControl.GetNumGlyphs: TRxNumGlyphs;
  2614. begin
  2615.   Result := FImage.NumGlyphs;
  2616. end;
  2617. function TBtnControl.GetCaption: TCaption;
  2618. begin
  2619.   Result := FImage.Caption;
  2620. end;
  2621. procedure TBtnControl.SetCaption(const Value: TCaption);
  2622. begin
  2623.   FImage.Caption := Value;
  2624. end;
  2625. procedure TBtnControl.SetNumGlyphs(Value: TRxNumGlyphs);
  2626. begin
  2627.   FImage.NumGlyphs := Value;
  2628. end;
  2629. procedure TBtnControl.SetGlyph(Value: TBitmap);
  2630. begin
  2631.   FImage.Glyph := Value;
  2632. end;
  2633. function TBtnControl.GetWordWrap: Boolean;
  2634. begin
  2635.   Result := FImage.WordWrap;
  2636. end;
  2637. procedure TBtnControl.SetWordWrap(Value: Boolean);
  2638. begin
  2639.   FImage.WordWrap := Value;
  2640. end;
  2641. function TBtnControl.GetAlignment: TAlignment;
  2642. begin
  2643.   Result := FImage.Alignment;
  2644. end;
  2645. procedure TBtnControl.SetAlignment(Value: TAlignment);
  2646. begin
  2647.   FImage.Alignment := Value;
  2648. end;
  2649. procedure TBtnControl.WMSize(var Message: TWMSize);
  2650. begin
  2651.   FImage.ButtonSize := Point(ClientWidth, ClientHeight);
  2652. end;
  2653. procedure TBtnControl.Paint;
  2654. begin
  2655. {$IFDEF WIN32}
  2656.   FImage.DrawEx(Canvas, 0, 0, Margin, Spacing, Layout, Font, Images,
  2657.     ImageIndex, {$IFDEF RX_D4} DrawTextBiDiModeFlags(Alignments[Alignment])
  2658.     {$ELSE} Alignments[Alignment] {$ENDIF});
  2659. {$ELSE}
  2660.   FImage.Draw(Canvas, 0, 0, Margin, Spacing, Layout, Font,
  2661.     Alignments[Alignment]);
  2662. {$ENDIF}
  2663. end;
  2664. procedure TBtnControl.Activate(Rect: TRect);
  2665. begin
  2666.   if IsRectEmpty(BoundsRect) then BoundsRect := Rect;
  2667.   SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, 0,
  2668.     0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
  2669.   SetCursor(Screen.Cursors[Cursor]);
  2670. end;
  2671. procedure TBtnControl.ReleaseHandle;
  2672. begin
  2673.   DestroyHandle;
  2674. end;
  2675. { Utility routines }
  2676. function NewSpeedSection(ASpeedbar: TSpeedBar; const ACaption: string): Integer;
  2677. begin
  2678.   Result := ASpeedbar.AddSection(ACaption);
  2679. end;
  2680. function NewSpeedItem(AOwner: TComponent; ASpeedbar: TSpeedBar; Section: Integer;
  2681.   const AName: string): TSpeedItem;
  2682. begin
  2683.   Result := ASpeedBar.NewItem(AOwner, Section, AName);
  2684. end;
  2685. function FindSpeedBar(const Pos: TPoint): TSpeedBar;
  2686. var
  2687.   Window: TWinControl;
  2688.   Handle: HWnd;
  2689. begin
  2690.   Result := nil;
  2691.   Handle := WindowFromPoint(Pos);
  2692.   Window := nil;
  2693.   while (Handle <> 0) and (Window = nil) do begin
  2694.     Window := FindControl(Handle);
  2695.     if Window = nil then Handle := GetParent(Handle);
  2696.   end;
  2697.   if Window <> nil then begin
  2698.     if Window is TSpeedBar then Result := Window as TSpeedBar;
  2699.   end;
  2700. end;
  2701. procedure DrawCellButton(Grid: TDrawGrid; R: TRect; Item: TSpeedItem;
  2702.   Image: TButtonImage {$IFDEF RX_D4}; ARightToLeft: Boolean = False {$ENDIF});
  2703. var
  2704.   FBar: TSpeedBar;
  2705.   AFont: TFont;
  2706. {$IFDEF WIN32}
  2707.   ImageList: TImageList;
  2708. {$ENDIF}
  2709. begin
  2710.   if Item <> nil then begin
  2711.     FBar := Item.Speedbar;
  2712.     AFont := nil;
  2713. {$IFDEF WIN32}
  2714.     ImageList := nil;
  2715.     if FBar <> nil then begin
  2716.       AFont := FBar.Font;
  2717.       if Item.ImageIndex >= 0 then ImageList := FBar.Images;
  2718.     end;
  2719.     if ImageList = nil then Image.Glyph := Item.Glyph
  2720.     else Image.Glyph := nil;
  2721. {$ELSE}
  2722.     Image.Glyph := Item.Glyph;
  2723.     if FBar <> nil then AFont := FBar.Font;
  2724. {$ENDIF}
  2725.     with Image do begin
  2726.       Alignment := Item.FButton.Alignment;
  2727.       NumGlyphs := Item.NumGlyphs;
  2728.       Caption := Item.BtnCaption;
  2729.       WordWrap := Item.WordWrap;
  2730.       if FBar <> nil then
  2731.         ButtonSize := Point(FBar.BtnWidth, FBar.BtnHeight);
  2732.     end;
  2733. {$IFDEF WIN32}
  2734.     Image.DrawEx(Grid.Canvas, R.Left + 1, R.Top + 1, Item.Margin,
  2735.       Item.Spacing, Item.Layout, AFont, ImageList, Item.ImageIndex,
  2736.       {$IFDEF RX_D4} Item.FButton.DrawTextBiDiModeFlags(Alignments[Image.Alignment])
  2737.       {$ELSE} Alignments[Image.Alignment] {$ENDIF});
  2738. {$ELSE}
  2739.     Image.Draw(Grid.Canvas, R.Left + 1, R.Top + 1, Item.Margin,
  2740.       Item.Spacing, Item.Layout, AFont, Alignments[Image.Alignment]);
  2741. {$ENDIF}
  2742.     Inc(R.Left, Image.ButtonSize.X + 3);
  2743.     DrawCellText(Grid, 0, 0, Item.Caption, R, taLeftJustify, vaCenter
  2744.       {$IFDEF RX_D4}, ARightToLeft {$ENDIF});
  2745.   end;
  2746. end;
  2747. end.