speedbar.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit SpeedBar;

{$I RX.INC}
{$S-,W-,R-}

interface

uses Windows, Registry, RTLConsts, SysUtils, Classes, Messages, Menus, Buttons, Controls, Graphics, Forms,
  {$IFDEF RX_D4} ImgList, ActnList, {$ENDIF} ExtCtrls, Grids, IniFiles,
  RxCtrls, Placemnt;

const
  DefButtonWidth = 24;
  DefButtonHeight = 23;

type
  TSpeedItem = class;
  TSpeedbarSection = class;
  ESpeedbarError = class(Exception);

{ TSpeedBar }

  TBarOrientation = (boHorizontal, boVertical);
  TBarPosition = (bpAuto, bpCustom);
  TSpeedbarOption = (sbAllowDrag, sbAllowResize, sbFlatBtns, sbGrayedBtns,
    sbTransparentBtns, sbStretchBitmap);
  TSpeedbarOptions = set of TSpeedbarOption;
  TBoundLine = (blTop, blBottom, blLeft, blRight);
  TBoundLines = set of TBoundLine;
  TSbScaleFlags = set of (sfOffsetX, sfOffsetY, sfBtnSizeX, sfBtnSizeY);
  TForEachItem = procedure (Item: TSpeedItem; Data: Longint) of object;
  TApplyAlignEvent = procedure (Sender: TObject; Align: TAlign;
    var Apply: Boolean) of object;

  TSpeedBar = class(TCustomPanel)
  private
    FSections: TList;
    FPosition: TBarPosition;
    FOrientation: TBarOrientation;
    FAlign: TAlign;
    FButtonSize: TPoint;
    FButtonStyle: TButtonStyle;
    FGridSize: TPoint;
    FOffset: TPoint;
    FEditWin: HWnd;
    FRowCount: Integer;
    FPrevRect: TRect;
    FPrevAlign: TAlign;
    FOptions: TSpeedbarOptions;
    FLocked: Boolean;
    FVersion: Integer;
    FDrag: Boolean;
    FResizing: Boolean;
    FStartDrag: TPoint;
    FWallpaper: TPicture;
    FBoundLines: TBoundLines;
    FIniLink: TIniLink;
    FReserved: Integer;
    FFix: Boolean;
    FDesignStyle: Boolean;
    FScaleFlags: TSbScaleFlags;
    FOnAddItem: TNotifyEvent;
    FOnApplyAlign: TApplyAlignEvent;
    FOnPosChanged: TNotifyEvent;
    FOnVisibleChanged: TNotifyEvent;
    FOnCustomize: TNotifyEvent;
{$IFDEF WIN32}
    FImages: TImageList;
    FImageChangeLink: TChangeLink;
    procedure ImageListChange(Sender: TObject);
    procedure SetImages(Value: TImageList);
    procedure InvalidateItem(Item: TSpeedItem; Data: Longint);
{$ENDIF}
    function GetOrientation: TBarOrientation;
    procedure SetOrientation(Value: TBarOrientation);
    procedure ApplyOrientation(Value: TBarOrientation);
    procedure ApplyButtonSize;
    procedure UpdateGridSize;
    procedure ClearSections;
    function GetAlign: TAlign;
    procedure SetAlign(Value: TAlign);
    function GetButtonSize(Index: Integer): Integer;
    procedure SetButtonSize(Index, Value: Integer);
    function GetButtonsOffset(Index: Integer): Integer;
    procedure SetButtonsOffset(Index: Integer; Value: Integer);
    procedure SetOptions(Value: TSpeedbarOptions);
    procedure SetBoundLines(Value: TBoundLines);
    function MinButtonsOffset: Integer;
    procedure WallpaperChanged(Sender: TObject);
    procedure SetWallpaper(Value: TPicture);
    procedure SetItemParams(Item: TSpeedItem; InitBounds: Boolean);
    procedure SetItemVisible(Item: TSpeedItem; Data: Longint);
    procedure SetItemEnabled(Item: TSpeedItem; Data: Longint);
    procedure SetItemButtonSize(Item: TSpeedItem; Data: Longint);
    procedure OffsetItem(Item: TSpeedItem; Data: Longint);
    procedure ApplyItemSize(Item: TSpeedItem; Data: Longint);
    procedure AlignItemToGrid(Item: TSpeedItem; Data: Longint);
    procedure SwapItemBounds(Item: TSpeedItem; Data: Longint);
    procedure SetItemEditing(Item: TSpeedItem; Data: Longint);
    procedure HideItem(Item: TSpeedItem; Data: Longint);
    procedure WriteItemLayout(Item: TSpeedItem; Data: Longint);
    procedure FlatItem(Item: TSpeedItem; Data: Longint);
    procedure TransparentItem(Item: TSpeedItem; Data: Longint);
    function GetSection(Index: Integer): TSpeedbarSection;
    function GetSectionCount: Integer;
    procedure GrayedItem(Item: TSpeedItem; Data: Longint);
    function GetFramePos(X, Y: Integer; var Apply: Boolean): Integer;
    function GetFrameRect(X, Y: Integer): TRect;
    procedure StartDragFrame;
    procedure DragFrame(X, Y: Integer);
    procedure StopDragFrame(X, Y: Integer);
    function CheckResize(Shift: TShiftState; X, Y: Integer): Boolean;
    procedure ReadSections(Reader: TReader);
    procedure WriteSections(Writer: TWriter);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    procedure ReadDesignStyle(Reader: TReader);
    procedure ReadAllowDrag(Reader: TReader);
    procedure WriteDesignStyle(Writer: TWriter);
    function GetStorage: TFormPlacement;
    procedure SetStorage(Value: TFormPlacement);
    procedure IniSave(Sender: TObject);
    procedure IniLoad(Sender: TObject);
    procedure InternalSaveLayout(IniFile: TObject; const Section: string);
    procedure InternalRestoreLayout(IniFile: TObject; const Section: string);
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    function AppendSection(Value: TSpeedbarSection): Integer; virtual;
    procedure AlignItemsToGrid;
    procedure ChangeScale(M, D: Integer); override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DefineProperties(Filer: TFiler); override;
{$IFDEF WIN32}
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
      Root: TComponent {$ENDIF}); override;
    procedure SetChildOrder(Component: TComponent; Order: Integer); override;
{$ELSE}
    procedure WriteComponents(Writer: TWriter); override;
{$ENDIF}
    procedure ForEachItem(Proc: TForEachItem; Data: Longint); virtual;
    procedure PosChanged; dynamic;
    procedure AfterCustomize; dynamic;
    property ScaleFlags: TSbScaleFlags read FScaleFlags write FScaleFlags;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetFontDefault; virtual;
    procedure RemoveItem(Item: TSpeedItem);
    procedure RemoveSection(Section: Integer); { delete and free section and items }
    procedure DeleteSection(Section: Integer); { delete section }
    function AddSection(const ACaption: string): Integer;
    procedure AddItem(Section: Integer; Item: TSpeedItem);
    function NewItem(AOwner: TComponent; Section: Integer;
      const AName: string): TSpeedItem;
    function AcceptDropItem(Item: TSpeedItem; X, Y: Integer): Boolean;
    procedure SetEditing(Win: HWnd);
    function GetEditing: Boolean;
    function SearchItem(const ItemName: string): TSpeedItem;
    function FindItem(Item: TSpeedItem; var Section, Index: Integer): Boolean;
    function SearchSection(const ACaption: string): Integer;
    procedure Customize(HelpCtx: THelpContext);
{$IFDEF WIN32}
    procedure SaveLayoutReg(IniFile: TRegIniFile);
    procedure RestoreLayoutReg(IniFile: TRegIniFile);
{$ENDIF WIN32}
    procedure SaveLayout(IniFile: TIniFile);
    procedure RestoreLayout(IniFile: TIniFile);
    function ItemsCount(Section: Integer): Integer;
    function Items(Section, Index: Integer): TSpeedItem;
    property EditMode: Boolean read GetEditing;
    property SectionCount: Integer read GetSectionCount;
    property Sections[Index: Integer]: TSpeedbarSection read GetSection;
    property Orientation: TBarOrientation read GetOrientation write SetOrientation
      default boHorizontal;
    property OnAddItem: TNotifyEvent read FOnAddItem write FOnAddItem; { for internal use only }
  published
    property Font;
    property ParentFont default False;
    property BoundLines: TBoundLines read FBoundLines write SetBoundLines default [];
    property Position: TBarPosition read FPosition write FPosition default bpAuto;
    { ensure Position is declared before Align }
    property Align: TAlign read GetAlign write SetAlign default alTop;
    { ensure Options is declared before BtnOffset... }
    property Options: TSpeedbarOptions read FOptions write SetOptions
      default [sbAllowDrag, sbGrayedBtns];
    property BtnOffsetHorz: Integer index 0 read GetButtonsOffset write SetButtonsOffset
      stored True;
    property BtnOffsetVert: Integer index 1 read GetButtonsOffset write SetButtonsOffset
      stored True;
    property BtnWidth: Integer index 0 read GetButtonSize write SetButtonSize;
    property BtnHeight: Integer index 1 read GetButtonSize write SetButtonSize;
    property IniStorage: TFormPlacement read GetStorage write SetStorage;
    property Version: Integer read FVersion write FVersion default 0;
    property Wallpaper: TPicture read FWallpaper write SetWallpaper;
{$IFDEF WIN32}
    property Images: TImageList read FImages write SetImages;
{$ENDIF}
{$IFDEF RX_D4}
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode;
{$ENDIF}
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Locked;
    property ParentColor;
    property ParentCtl3D;
    property ParentShowHint default False;
    property PopupMenu;
    property ShowHint default True;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnApplyAlign: TApplyAlignEvent read FOnApplyAlign write FOnApplyAlign;
    property OnCustomize: TNotifyEvent read FOnCustomize write FOnCustomize;
    property OnPosChanged: TNotifyEvent read FOnPosChanged write FOnPosChanged;
    property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF WIN32}
    property OnStartDrag;
{$ENDIF}
{$IFDEF RX_D5}
    property OnContextPopup;
{$ENDIF}
{$IFDEF RX_D4}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
    property OnResize;
  end;

{ TSpeedItem }

  TSpeedItem = class(TComponent)
  private
    FCaption: String;
    FEditing: Boolean;
    FEnabled: Boolean;
    FButton: TRxSpeedButton;
    FVisible: Boolean;
    FStored: Boolean;
    FParent: TSpeedBar;
    FSection: Integer;
    FSectionName: string;
{$IFDEF WIN32}
    FImageIndex: Integer;
    procedure SetImageIndex(Value: Integer);
{$ENDIF}
{$IFDEF RX_D4}
    function GetAction: TBasicAction;
    procedure SetAction(Value: TBasicAction);
{$ENDIF}
    function GetAllowAllUp: Boolean;
    procedure SetAllowAllUp(Value: Boolean);
    function GetAllowTimer: Boolean;
    procedure SetAllowTimer(Value: Boolean);
    function GetBtnCaption: TCaption;
    procedure SetBtnCaption(const Value: TCaption);
    function GetGroupIndex: Integer;
    procedure SetGroupIndex(Value: Integer);
    function GetDown: Boolean;
    procedure SetDown(Value: Boolean);
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
    function GetLayout: TButtonLayout;
    procedure SetLayout(Value: TButtonLayout);
    function GetMargin: Integer;
    procedure SetMargin(Value: Integer);
    function GetNumGlyphs: TRxNumGlyphs;
    procedure SetNumGlyphs(Value: TRxNumGlyphs);
    function GetParentShowHint: Boolean;
    procedure SetParentShowHint(Value: Boolean);
    function GetFont: TFont;
    procedure SetFont(Value: TFont);
    function GetParentFont: Boolean;
    procedure SetParentFont(Value: Boolean);
    function IsFontStored: Boolean;
    function GetShowHint: Boolean;
    procedure SetShowHint(Value: Boolean);
    function IsShowHintStored: Boolean;
    function GetSpacing: Integer;
    procedure SetSpacing(Value: Integer);
    function GetCursor: TCursor;
    procedure SetCursor(Value: TCursor);
    function GetHint: string;
    procedure SetHint(const Value: string);
    function GetTag: Longint;
    procedure SetTag(Value: Longint);
    function GetDropDownMenu: TPopupMenu;
    procedure SetDropDownMenu(Value: TPopupMenu);
    function GetMarkDropDown: Boolean;
    procedure SetMarkDropDown(Value: Boolean);
    function GetWordWrap: Boolean;
    procedure SetWordWrap(Value: Boolean);
    function GetOnClick: TNotifyEvent;
    procedure SetOnClick(Value: TNotifyEvent);
    function GetOnDblClick: TNotifyEvent;
    procedure SetOnDblClick(Value: TNotifyEvent);
    function GetOnMouseDown: TMouseEvent;
    procedure SetOnMouseDown(Value: TMouseEvent);
    function GetOnMouseMove: TMouseMoveEvent;
    procedure SetOnMouseMove(Value: TMouseMoveEvent);
    function GetOnMouseUp: TMouseEvent;
    procedure SetOnMouseUp(Value: TMouseEvent);
    function GetOnMouseEnter: TNotifyEvent;
    procedure SetOnMouseEnter(Value: TNotifyEvent);
    function GetOnMouseLeave: TNotifyEvent;
    procedure SetOnMouseLeave(Value: TNotifyEvent);
    function GetCaption: TCaption;
    procedure SetCaption(const Value: TCaption);
    procedure SetEditing(Value: Boolean);
    function GetLeft: Integer;
    function GetTop: Integer;
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    function GetSection: Integer;
    procedure SetSection(Value: Integer);
    function GetSectionName: string;
    {procedure SetSectionName(const Value: string);}
    procedure ReadSection(Reader: TReader);
    procedure WriteSection(Writer: TWriter);
    procedure ReadSectionName(Reader: TReader);
    procedure WriteSectionName(Writer: TWriter);
  protected
    procedure ReadState(Reader: TReader); override;
    procedure SetName(const Value: TComponentName); override;
    procedure SetEnabled(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function HasParent: Boolean; override;
{$IFDEF WIN32}
    function GetParentComponent: TComponent; override;
    procedure SetParentComponent(Value: TComponent); override;
{$ENDIF}
    procedure ButtonClick;
    function CheckBtnMenuDropDown: Boolean;
    procedure Click; virtual;
    procedure UpdateSection;
    procedure InvalidateItem;
    property ASection: Integer read GetSection write SetSection;
    property SpeedBar: TSpeedBar read FParent;
    property Button: TRxSpeedButton read FButton;
  published
{$IFDEF RX_D4}
    property Action: TBasicAction read GetAction write SetAction;
{$ENDIF}
    property AllowAllUp: Boolean read GetAllowAllUp write SetAllowAllUp default False;
    property AllowTimer: Boolean read GetAllowTimer write SetAllowTimer default False;
    property BtnCaption: TCaption read GetBtnCaption write SetBtnCaption;
    property Caption: TCaption read GetCaption write SetCaption;
    property GroupIndex: Integer read GetGroupIndex write SetGroupIndex default 0;
    property Down: Boolean read GetDown write SetDown default False;
    property DropDownMenu: TPopupMenu read GetDropDownMenu write SetDropDownMenu;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Hint: string read GetHint write SetHint;
{$IFDEF WIN32}
    property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
{$ENDIF}
    property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphTop;
    property Margin: Integer read GetMargin write SetMargin default -1;
    property MarkDropDown: Boolean read GetMarkDropDown write SetMarkDropDown default True;
    property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property ParentShowHint: Boolean read GetParentShowHint write SetParentShowHint default True;
    property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    property ShowHint: Boolean read GetShowHint write SetShowHint stored IsShowHintStored;
    property Spacing: Integer read GetSpacing write SetSpacing default 4;
    property Stored: Boolean read FStored write FStored default True;
    property Tag: Longint read GetTag write SetTag default 0;
    property Left: Integer read GetLeft write SetLeft default 0;
    property Top: Integer read GetTop write SetTop default 0;
    property Visible: Boolean read FVisible write SetVisible default False;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
    property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
    property OnMouseDown: TMouseEvent read GetOnMouseDown write SetOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read GetOnMouseMove write SetOnMouseMove;
    property OnMouseUp: TMouseEvent read GetOnMouseUp write SetOnMouseUp;
    property OnMouseEnter: TNotifyEvent read GetOnMouseEnter write SetOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read GetOnMouseLeave write SetOnMouseLeave;
  end;

{ TSpeedbarSection }

  TSpeedbarSection = class(TComponent)
  private
    FList: TList;
    FTitle: String;
    FParent: TSpeedBar;
    function Get(Index: Integer): TSpeedItem;
    procedure Put(Index: Integer; Item: TSpeedItem);
    function GetCount: Integer;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    function GetIndex: Integer;
    procedure SetIndex(Value: Integer);
    procedure SetSpeedbar(Value: TSpeedBar);
    procedure ValidateCaption(const NewCaption: string);
  protected
{$IFDEF WIN32}
    procedure SetParentComponent(Value: TComponent); override;
{$ELSE}
    procedure ReadState(Reader: TReader); override;
{$ENDIF}