{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 3.95                                                }
{                                                                   }
{       Copyright (c) 2000-2004 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

unit bsCategoryButtons;

interface

uses
  Windows, SysUtils, Classes, Controls, ImgList, Forms, Messages,
  Graphics, StdCtrls, ActnList, bsSkinData, bsSkinCtrls;

const
  crDragCopy = TCursor(-23); { New cursor, with a plus for copying }

type
  TbsBaseButtonItem = class;
  TbsBaseButtonItemClass = class of TbsBaseButtonItem;
  TbsButtonItem = class;
  TbsButtonItemClass = class of TbsButtonItem;
  TbsButtonCategory = class;
  TbsButtonCategoryClass = class of TbsButtonCategory;
  TbsButtonCategories = class;
  TbsButtonCategoriesClass = class of TbsButtonCategories;
  TbsButtonItemActionLink = class;
  TbsButtonItemActionLinkClass = class of TbsButtonItemActionLink;

  { TButtonDrawState }
  {
    bsbdsSelected:    Item is selected and in the "down" state
    bsbdsHot:         Item has the mouse over it
    bsbdsFocused:     Item should show focus
    bsbdsDown:        Item is being pressed by the user
    bsbdsDragged:     The drag image for that button is being drawn
    bsbdsInsertLeft:  Show that an item can be inserted to the left of this item
    bdsInsertTop:   Show that an item can be inserted above this item
    bsbdsInsertRight: Show that an item can be inserted to the right of this item
    bsbdsInsertBottom: Show that an item can be inserted below this item
  }
  
  TbsButtonDrawState = set of (bsbdsSelected, bsbdsHot, bsbdsFocused, bsbdsDown,
    bsbdsDragged, bsbdsInsertLeft, bsbdsInsertTop, bsbdsInsertRight, bsbdsInsertBottom);

  TbsCatButtonOptions = set of (bsboAllowReorder, bsboAllowCopyingButtons,
    bsboFullSize, bsboShowCaptions, bsboVerticalCategoryCaptions, bsboBoldCaptions,
    bsboUsePlusMinus);

  TbsCatButtonEvent = procedure(Sender: TObject; const Button: TbsButtonItem) of object;
  TbsCatButtonGetHint = procedure(Sender: TObject; const Button: TbsButtonItem;
    const Category: TbsButtonCategory; var HintStr: string; var Handled: Boolean) of object;

  TbsCatButtonDrawEvent = procedure(Sender: TObject;
    const Button: TbsButtonItem; Canvas: TCanvas; Rect: TRect;
    State: TbsButtonDrawState) of object;
  TbsCatButtonDrawIconEvent = procedure(Sender: TObject;
    const Button: TbsButtonItem; Canvas: TCanvas; Rect: TRect;
    State: TbsButtonDrawState; var TextOffset: Integer) of object;
  TbsCatButtonReorderEvent = procedure(Sender: TObject; const Button: TbsButtonItem;
    const SourceCategory, TargetCategory: TbsButtonCategory) of object;
  TbsCatButtonCopyEvent = procedure(Sender: TObject;
    const SourceButton, CopiedButton: TbsButtonItem) of object;
  TbsCategoryReorderEvent = procedure(Sender: TObject; const SourceCategory,
    TargetCategory: TbsButtonCategory) of object;
  TbsCategoryCollapseEvent = procedure(Sender: TObject;
    const Category: TbsButtonCategory) of object;

  TbsCatButtonFlow = (bscbfVertical, bscbfHorizontal);

  TbsSkinCategoryButtons = class(TbsSkinControl)
  private
    FShowBorder: Boolean;
    FSkinScrollBar: TbsSkinScrollBar;
    FButtonFlow: TbsCatButtonFlow;
    FCollapsedHeight: Integer;
    FDownButton: TbsButtonItem;
    FDragButton: TbsButtonItem;
    FDragCategory: TbsButtonCategory;
    FDragStartPos: TPoint;
    FDragStarted: Boolean;
    FDragImageList: TDragImageList;
    FGutterSize: Integer; { Also, used as the scroll size }
    FSideBufferSize: Integer;
    FHotButton: TbsButtonItem;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FInsertLeft, FInsertTop, FInsertRight, FInsertBottom: TbsButtonItem;
    FIgnoreUpdate: Boolean;
    FScrollBarMax: Integer;
    FSCROLLBARPOS: Integer;
    FPageAmount: Integer;
    FButtonCategories: TbsButtonCategories;
    FButtonOptions: TbsCatButtonOptions;
    FButtonWidth, FButtonHeight: Integer;
    FSelectedItem: TbsButtonItem;
    FFocusedItem: TbsButtonItem;
    FMouseInControl: Boolean;
    FOnButtonClicked: TbsCatButtonEvent;
    FOnCopyButton: TbsCatButtonCopyEvent;
    FOnSelectedItemChange: TbsCatButtonEvent;
    FOnHotButton: TbsCatButtonEvent;
    FOnGetHint: TbsCatButtonGetHint;
    FOnDrawButton: TbsCatButtonDrawEvent;
    FOnBeforeDrawButton: TbsCatButtonDrawEvent;
    FOnAfterDrawButton: TbsCatButtonDrawEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnReorderButton: TbsCatButtonReorderEvent;
    FOnReorderCategory: TbsCategoryReorderEvent;
    FOnCategoryCollapase: TbsCategoryCollapseEvent;
    FOnClick: TNotifyEvent;
    FHotButtonColor, FSelectedButtonColor, FRegularButtonColor: TColor;
    //
    procedure AdjustScrollBar;
    function GetScrollSize: Integer;
    procedure SBChange(Sender: TObject);
    procedure SBUpClick(Sender: TObject);
    procedure SBDownClick(Sender: TObject);
    procedure SBPageUp(Sender: TObject);
    procedure SBPageDown(Sender: TObject);
    //
    procedure AutoScroll(ScrollCode: TScrollCode);
    procedure ImageListChange(Sender: TObject);
    function CalcButtonsPerRow: Integer;
    function CalcButtonsPerCol: Integer;
    procedure CalcBufferSizes;
    function CalcCategoryHeight(const Category: TbsButtonCategory;
      const ButtonsPerRow: Integer): Integer;
    function CalcCategoryWidth(const Category: TbsButtonCategory;
      const ButtonsPerCol: Integer): Integer;

    procedure DrawCategory(const Category: TbsButtonCategory;
      const Canvas: TCanvas; StartingPos: Integer);

    procedure DrawSkinCategory(const Category: TbsButtonCategory;
      const Canvas: TCanvas; StartingPos: Integer);

    procedure GetCategoryBounds(const Category: TbsButtonCategory;
      const StartingPos: Integer; var CategoryBounds,
      ButtonBounds: TRect);
    function GetChevronBounds(const CategoryBounds: TRect): TRect;
    function GetIndexOfFirstCategory: Integer;
    function GetNextButtonInGroup(const StartingButton: TbsButtonItem;
      GoForward: Boolean): TbsButtonItem;
    function GetNextButton(const StartingButton: TbsButtonItem;
      GoForward: Boolean): TbsButtonItem;
    function GetScrollOffset: Integer;
    function GetScrollBuffer: Integer;
    procedure ScrollPosChanged(ScrollCode: TScrollCode;
      ScrollPos: Integer);
    procedure SetOnDrawButton(const Value: TbsCatButtonDrawEvent);
    procedure SetButtonCategories(const Value: TbsButtonCategories);
    procedure SetButtonHeight(const Value: Integer);
    procedure SetCatButtonOptions(const Value: TbsCatButtonOptions);
    procedure SetButtonWidth(const Value: Integer);
    procedure SetFocusedItem(const Value: TbsButtonItem);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetSelectedItem(const Value: TbsButtonItem);
    procedure ShowSkinScrollBar(const Visible: Boolean);
    procedure SetHotButtonColor(const Value: TColor);
    procedure SetRegularButtonColor(const Value: TColor);
    procedure SetSelectedButtonColor(const Value: TColor);
    procedure SetButtonFlow(const Value: TbsCatButtonFlow);
    function ShouldScrollDown(out Delay: Integer): Boolean;
    function ShouldScrollUp(out Delay: Integer): Boolean;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CNKeydown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure SetDragButton(const Value: TbsButtonItem);
    procedure SetShowBorder(Value: Boolean);
  protected
    procedure PaintBorder;
    procedure PaintSkinBorder;
    procedure PaintDefaultBorder;
    procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
    procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
    procedure BeginAutoDrag; override;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoBeginDrag(Immediate: Boolean; Threshold: Integer); virtual;
    procedure DoCopyButton(const Button: TbsButtonItem;
      const TargetCategory: TbsButtonCategory; const TargetButton: TbsButtonItem); dynamic;
    procedure DoEndDrag(Target: TObject; X: Integer; Y: Integer); override;
    procedure DoHotButton; dynamic;
    procedure DoMouseLeave; dynamic;
    procedure DoReorderButton(const Button: TbsButtonItem;
      const TargetCategory: TbsButtonCategory; const TargetButton: TbsButtonItem); dynamic;
    procedure DoReorderCategory(const SourceCategory,
      TargetCategory: TbsButtonCategory); dynamic;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DragOver(Source: TObject; X: Integer; Y: Integer;
      State: TDragState; var Accept: Boolean); override;
    procedure DrawButton(const Button: TbsButtonItem; Canvas: TCanvas;
      Rect: TRect; State: TbsButtonDrawState); virtual;
    procedure DrawSkinButton(const Button: TbsButtonItem; Canvas: TCanvas;
      Rct: TRect; State: TbsButtonDrawState);
    procedure DoItemClicked(const Button: TbsButtonItem); dynamic;
    procedure DoSelectedItemChanged(const Button: TbsButtonItem); dynamic;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function GetAllowReorder: Boolean; dynamic;
    function GetDragImages: TDragImageList; override;
    function GetButtonCategoriesClass: TbsButtonCategoriesClass; virtual;
    function GetButtonCategoryClass: TbsButtonCategoryClass; virtual;
    function GetButtonItemClass: TbsButtonItemClass; virtual;
    function GetScrollPos: Integer;
    procedure SetScrollPos(const Value: Integer);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Resize; override;
    procedure ScrollRectIntoView(const Rect: TRect);
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Assign(Source: TPersistent); override;
    procedure ChangeSkinData; override;
    { DragButton: If a drag operation is coming from this control, it is
      becuase they are dragging this item, or the category. One can
      write to it if they want to control what button is being dragged. }
    property DragButton: TbsButtonItem read FDragButton write SetDragButton;
    property DragCategory: TbsButtonCategory read FDragCategory write FDragCategory;
    property DragImageList: TDragImageList read FDragImageList;
    procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override;
    function GetButtonRect(const Button: TbsButtonItem): TRect;
    function GetCategoryRect(const Category: TbsButtonCategory): TRect;
    function GetButtonAt(X, Y: Integer;
      Category: TbsButtonCategory = nil): TbsButtonItem;
    function GetCategoryAt(X, Y: Integer): TbsButtonCategory;
    procedure RemoveInsertionPoints;
    procedure ScrollIntoView(const Button: TbsButtonItem); overload;
    procedure ScrollIntoView(const Category: TbsButtonCategory); overload;
    { SetInsertionButton: Call this to set the current insertion "marks".
      Call RemoveInsertionPoints to remove the "marks". }
    procedure SetInsertionButton(InsertionButton: TbsButtonItem;
      InsertionCategory: TbsButtonCategory);
    { GetTargetAt: Gives you the target insertion point in the given group.
      TargetButton may be nil, while the TargetCategory is not (or, both may be nil)}
    procedure GetTargetAt(X, Y: Integer; var TargetButton: TbsButtonItem;
      var TargetCategory: TbsButtonCategory);
    procedure UpdateButton(const Button: TbsButtonItem);
    procedure UpdateAllButtons;
    property SelectedItem: TbsButtonItem read FSelectedItem write SetSelectedItem;
    property FocusedItem: TbsButtonItem read FFocusedItem write SetFocusedItem;
  published
    property Align;
    property Anchors;
    property ShowBoder: Boolean read FShowBorder write SetShowBorder;
    property ButtonFlow: TbsCatButtonFlow read FButtonFlow write SetButtonFlow;
    property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 24;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 24;
    property ButtonOptions: TbsCatButtonOptions read FButtonOptions
      write SetCatButtonOptions default [bsboShowCaptions, bsboVerticalCategoryCaptions];
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height default 100;
    property Images: TCustomImageList read FImages write SetImages;
    property Categories: TbsButtonCategories read FButtonCategories write SetButtonCategories;
    property Color default clWindow;
    property Cursor;
    property HotButtonColor: TColor read FHotButtonColor write SetHotButtonColor default $00EFD3C6;
    property PopupMenu;
    property RegularButtonColor: TColor read FRegularButtonColor write SetRegularButtonColor nodefault;
    property SelectedButtonColor: TColor read FSelectedButtonColor write SetSelectedButtonColor nodefault;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Width default 100;
    property Visible;
    property OnAfterDrawButton: TbsCatButtonDrawEvent read FOnAfterDrawButton write FOnAfterDrawButton;
    property OnBeforeDrawButton: TbsCatButtonDrawEvent read FOnBeforeDrawButton write FOnBeforeDrawButton;
    property OnButtonClicked: TbsCatButtonEvent read FOnButtonClicked write FOnButtonClicked;
    property OnCategoryCollapase: TbsCategoryCollapseEvent read FOnCategoryCollapase write FOnCategoryCollapase;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnContextPopup;
    property OnCopyButton: TbsCatButtonCopyEvent read FOnCopyButton write FOnCopyButton;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawButton: TbsCatButtonDrawEvent read FOnDrawButton write SetOnDrawButton;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetHint: TbsCatButtonGetHint read FOnGetHint write FOnGetHint;
    property OnHotButton: TbsCatButtonEvent read FOnHotButton write FOnHotButton;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnReorderButton: TbsCatButtonReorderEvent read FOnReorderButton write FOnReorderButton;
    property OnReorderCategory: TbsCategoryReorderEvent read FOnReorderCategory write FOnReorderCategory;
    property OnMouseDown;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnSelectedItemChange: TbsCatButtonEvent read FOnSelectedItemChange write FOnSelectedItemChange;
    property OnStartDock;
    property OnStartDrag;
  end;

  TbsBaseButtonItem = class(TCollectionItem)
  private
    FActionLink: TbsButtonItemActionLink;
    FImageIndex: TImageIndex;
    FCaption: string;
    FData: Pointer;
    FHint: string;
    FOnClick: TNotifyEvent;
    procedure SetAction(const Value: TBasicAction);
    procedure SetCaption(const Value: string);
    procedure SetImageIndex(const Value: TImageIndex);
    function GetAction: TBasicAction;
    procedure DoActionChange(Sender: TObject);
    function IsCaptionStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsOnClickStored: Boolean;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
    function GetNotifyTarget: TComponent; virtual; abstract;
    function GetDisplayName: string; override;
    function GetActionLinkClass: TbsButtonItemActionLinkClass; virtual;
    property ActionLink: TbsButtonItemActionLink read FActionLink write FActionLink;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    property Data: Pointer read FData write FData;
    procedure ScrollIntoView; virtual; abstract;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property Caption: string read FCaption write SetCaption stored IsCaptionStored;
    property Hint: string read FHint write FHint stored IsHintStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored;
    property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
  end;

  TbsButtonItem = class(TbsBaseButtonItem)
  private
{    FInterfaceData: IInterface; }
    function GetButtonGroup: TbsSkinCategoryButtons;
    function GetCategory: TbsButtonCategory;
  protected
    function GetNotifyTarget: TComponent; override;
  public
    procedure Assign(Source: TPersistent); override;
{    property InterfaceData: IInterface read FInterfaceData write FInterfaceData; }
    procedure ScrollIntoView; override;
    property Category: TbsButtonCategory read GetCategory;
  published
    property ButtonGroup: TbsSkinCategoryButtons read GetButtonGroup;
  end;

  TbsButtonCollection = class(TCollection)
  private
    FCategory: TbsButtonCategory;
    function GetItem(Index: Integer): TbsButtonItem;
    procedure SetItem(Index: Integer; const Value: TbsButtonItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
{    procedure Notify(Item: TCollectionItem;
      Action: TCollectionNotification); override;}
  public