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

unit bsButtonGroup;

interface

uses
  Windows, SysUtils, Classes, Controls, ImgList, Forms, Messages,
  Graphics, StdCtrls, bsCategoryButtons, bsSkinCtrls, bsSkinData, ExtCtrls,
  bsUtils;

type
  TbsGrpButtonItem = class;
  TbsGrpButtonItemClass = class of TbsGrpButtonItem;
  TbsGrpButtonItems = class;
  TbsGrpButtonItemsClass = class of TbsGrpButtonItems;

  TbsGrpButtonOptions = set of (bsgboAllowReorder, bsgboFullSize, bsgboGroupStyle,
    gboShowCaptions);

  TbsGrpButtonEvent = procedure(Sender: TObject; Index: Integer) of object;
  TbsGrpButtonDrawEvent = procedure(Sender: TObject; Index: Integer;
    Canvas: TCanvas; Rect: TRect; State: TbsButtonDrawState) of object;
  TbsGrpButtonDrawIconEvent = procedure(Sender: TObject; Index: Integer;
    Canvas: TCanvas; Rect: TRect; State: TbsButtonDrawState; var TextOffset: Integer) of object;
  TbsGrpButtonReorderEvent = procedure(Sender: TObject; OldIndex, NewIndex: Integer) of object;

  TbsSkinButtonGroup = class(TbsSkinControl)
  private
    FIs9XOS: Boolean;
    FMouseTimer: TTimer;
    FButtonsSkinDataName: String;
    FUseSkinFont: Boolean;
    FShowFocus: Boolean;
    FSkinScrollBar: TbsSkinScrollBar;
    FShowBorder: Boolean;
    FDownIndex: Integer;
    FDragIndex: Integer;
    FDragStartPos: TPoint;
    FDragStarted: Boolean;
    FDragImageList: TDragImageList;
    FHiddenItems: Integer; { Hidden rows or Hidden columns, depending on the flow }
    FHotIndex: Integer;
    FInsertLeft, FInsertTop, FInsertRight, FInsertBottom: Integer;
    FIgnoreUpdate: Boolean;
    FScrollBarMax: Integer;
    FPageAmount: Integer;
    FButtonItems: TbsGrpButtonItems;
    FButtonOptions: TbsGrpButtonOptions;
    FButtonWidth, FButtonHeight: Integer;
    FFocusIndex: Integer;
    FItemIndex: Integer;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FMouseInControl: Boolean;
    FOnButtonClicked: TbsGrpButtonEvent;
    FOnClick: TNotifyEvent;
    FOnHotButton: TbsGrpButtonEvent;
    FOnDrawIcon: TbsGrpButtonDrawIconEvent;
    FOnDrawButton: TbsGrpButtonDrawEvent;
    FOnBeforeDrawButton: TbsGrpButtonDrawEvent;
    FOnAfterDrawButton: TbsGrpButtonDrawEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnReorderButton: TbsGrpButtonReorderEvent;
    //
    procedure OnMouseTimerEvent(Sender: TObject);
    procedure ShowSkinScrollBar(const Visible: Boolean);
    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 CalcRowsSeen: Integer;
    procedure DoFillRect(const Rect: TRect);
    procedure ScrollPosChanged(ScrollCode: TScrollCode;
      ScrollPos: Integer);
    procedure SetOnDrawButton(const Value: TbsGrpButtonDrawEvent);
    procedure SetOnDrawIcon(const Value: TbsGrpButtonDrawIconEvent);
    procedure SeTbsGrpButtonItems(const Value: TbsGrpButtonItems);
    procedure SetButtonHeight(const Value: Integer);
    procedure SetGrpButtonOptions(const Value: TbsGrpButtonOptions);
    procedure SetButtonWidth(const Value: Integer);
    procedure SetItemIndex(const Value: Integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CNKeydown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE;
    procedure SetDragIndex(const Value: Integer);
    procedure SetShowBorder(Value: Boolean);
  protected
    procedure PaintBorder(ADC: HDC; AUseExternalDC: Boolean);
    procedure PaintSkinBorder(ADC: HDC; AUseExternalDC: Boolean);
    procedure PaintDefaultBorder(ADC: HDC; AUseExternalDC: Boolean);
    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 WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

    procedure CMBENCPaint(var Message: TMessage); message CM_BENCPAINT;
    procedure CMSENCPaint(var Message: TMessage); message CM_SENCPAINT;    
    
    function CreateButton: TbsGrpButtonItem; virtual;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoEndDrag(Target: TObject; X: Integer; Y: Integer); override;
    procedure DoHotButton; dynamic;
    procedure DoMouseLeave; dynamic;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure DoReorderButton(const OldIndex, NewIndex: Integer);
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DragOver(Source: TObject; X: Integer; Y: Integer;
      State: TDragState; var Accept: Boolean); override;
    procedure DrawButton(Index: Integer; Canvas: TCanvas;
      Rect: TRect; State: TbsButtonDrawState); virtual;
    procedure DrawSkinButton(Index: Integer; Canvas: TCanvas;
      Rct: TRect; State: TbsButtonDrawState); virtual;
    procedure DrawStretchSkinButton(Index: Integer; Canvas: TCanvas;
      Rct: TRect; State: TbsButtonDrawState); virtual;
    procedure DoItemClicked(const Index: Integer); virtual;
    function GetButtonClass: TbsGrpButtonItemClass; virtual;
    function GetButtonsClass: TbsGrpButtonItemsClass; virtual;
    function GetDragImages: TDragImageList; override;
    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 UpdateButton(const Index: Integer);
    procedure UpdateAllButtons;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Assign(Source: TPersistent); override;
    procedure ChangeSkinData; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    { DragIndex: If a drag operation is coming from this control, it is
      because they are dragging the item at DragIndex. Set DragIndex to
      control which item is being dragged before manually calling
      BeginDrag. }
    property DragIndex: Integer read FDragIndex write SetDragIndex;
    property DragImageList: TDragImageList read FDragImageList;
    procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override;
    function GetButtonRect(const Index: Integer): TRect;
    function IndexOfButtonAt(const X, Y: Integer): Integer;
    { RemoveInsertionPoints: Removes the insertion points added by
      SetInsertionPoints }
    procedure RemoveInsertionPoints;
    procedure ScrollIntoView(const Index: Integer);
    { SetInsertionPoints: Draws an insert line for inserting at
      InsertionIndex. Shows/Hides  }
    procedure SetInsertionPoints(const InsertionIndex: Integer);
    { TargetIndexAt: Gives you the target insertion index given a
      coordinate. If it is above half of a current button, it inserts
      above it. If it is below the half, it inserts after it. }
    function TargetIndexAt(const X, Y: Integer): Integer;
    property Canvas;
  published
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property Align;
    property Anchors;
    property ButtonsSkinDataName: String read FButtonsSkinDataName write FButtonsSkinDataName;
    property ShowBoder: Boolean read FShowBorder write SetShowBorder;
    property ShowFocus: Boolean read FShowFocus write FShowFocus;
    property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 24;
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 24;
    property ButtonOptions: TbsGrpButtonOptions read FButtonOptions write SetGrpButtonOptions default [gboShowCaptions];
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height default 100;
    property Images: TCustomImageList read FImages write SetImages;
    property Items: TbsGrpButtonItems read FButtonItems write SeTbsGrpButtonItems;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Width default 100;
    property Visible;
//    property OnAlignInsertBefore;
//    property OnAlignPosition;
    property OnButtonClicked: TbsGrpButtonEvent read FOnButtonClicked write FOnButtonClicked;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnHotButton: TbsGrpButtonEvent read FOnHotButton write FOnHotButton;
    property OnAfterDrawButton: TbsGrpButtonDrawEvent read FOnAfterDrawButton write FOnAfterDrawButton;
    property OnBeforeDrawButton: TbsGrpButtonDrawEvent read FOnBeforeDrawButton write FOnBeforeDrawButton;
    property OnDrawButton: TbsGrpButtonDrawEvent read FOnDrawButton write SetOnDrawButton;
    property OnDrawIcon: TbsGrpButtonDrawIconEvent read FOnDrawIcon write SetOnDrawIcon;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnReorderButton: TbsGrpButtonReorderEvent read FOnReorderButton write FOnReorderButton;
//    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  TbsGrpButtonItem = class(TbsBaseButtonItem)
  private
    function GetButtonGroup: TbsSkinButtonGroup;
    function GetCollection: TbsGrpButtonItems;
    procedure SetCollection(const Value: TbsGrpButtonItems); reintroduce;
  protected
    function GetNotifyTarget: TComponent; override;
  public
    procedure ScrollIntoView; override;
    property Collection: TbsGrpButtonItems read GetCollection write SetCollection;
  published
    property ButtonGroup: TbsSkinButtonGroup read GetButtonGroup;
  end;

  TbsGrpButtonItems = class(TCollection)
  private
    FButtonGroup: TbsSkinButtonGroup;
    FOriginalID: Integer;
    function GetItem(Index: Integer): TbsGrpButtonItem;
    procedure SetItem(Index: Integer; const Value: TbsGrpButtonItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(const ButtonGroup: TbsSkinButtonGroup);
    function Add: TbsGrpButtonItem;
    function AddItem(Item: TbsGrpButtonItem; Index: Integer): TbsGrpButtonItem;
    procedure BeginUpdate; override;
    function Insert(Index: Integer): TbsGrpButtonItem;
    property Items[Index: Integer]: TbsGrpButtonItem read GetItem write SetItem; default;
    property ButtonGroup: TbsSkinButtonGroup read FButtonGroup;
  end;

implementation


{ TbsSkinButtonGroup }

constructor TbsSkinButtonGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIs9XOS := Is9XOs;
  if FIs9XOS
  then
    begin
      FMouseTimer := TTimer.Create(Self);
      FMouseTimer.Enabled := False;
      FMouseTimer.Interval := 100;
      FMouseTimer.OnTimer := OnMouseTimerEvent;
    end;
  FButtonsSkinDataName := 'resizebutton';
  FUseSkinFont := True;
  FShowFocus := False;
  FSkinScrollBar := nil;
  FShowBorder := False;
  Width := 100;
  Height := 100;
  ControlStyle := [csDoubleClicks, csCaptureMouse, csDisplayDragImage, csAcceptsControls];
  FButtonItems := GetButtonsClass.Create(Self);
  FButtonOptions := [gboShowCaptions];
  FButtonWidth := 24;
  FButtonHeight := 24;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FDoubleBuffered := True;
  FHotIndex := -1;
  FDownIndex := -1;
  FItemIndex := -1;
  FDragIndex := -1;
  FInsertBottom := -1;
  FInsertTop := -1;
  FInsertLeft := -1;
  FInsertRight := -1;
  FDragImageList := TDragImageList.Create(nil);
  FFocusIndex := -1;
  TabStop := True;
end;

procedure TbsSkinButtonGroup.ChangeSkinData;
begin
  FSkinDataName := '';

  inherited;

  if FSkinScrollBar <> nil
  then
    begin
      FSkinScrollBar.SkinData := Self.Skindata;
    end;

  if FShowBorder then RecreateWnd;

  Resize;
  AdjustScrollBar;
  Invalidate;
end;

procedure TbsSkinButtonGroup.OnMouseTimerEvent(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  if WindowFromPoint(P) <> Self.Handle
  then
    begin
      FMouseTimer.Enabled := False;
      SendMessage(Handle, WM_MOUSELEAVE, 0, 0);
    end;
end;

procedure TbsSkinButtonGroup.SetBounds;
begin
  inherited;
  if HandleAllocated then 
  if ((FButtonWidth > 0) or (bsgboFullSize in FButtonOptions)) and (FButtonHeight > 0)
  then
    begin
      Resize;
      AdjustScrollBar;
    end;
end;

procedure TbsSkinButtonGroup.SBChange(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPosition;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinButtonGroup.SBUpClick(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scLineDown;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinButtonGroup.SBDownClick(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scLineUp;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinButtonGroup.SBPageUp(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPageUp;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

procedure TbsSkinButtonGroup.SBPageDown(Sender: TObject);
var
  ScrollCode: TScrollCode;
begin
  ScrollCode := scPageDown;
  ScrollPosChanged(TScrollCode(ScrollCode), FSkinScrollBar.Position);
end;

function TbsSkinButtonGroup.GetScrollSize: Integer;
begin
  if FSkinScrollBar = nil
  then
    Result := 0
  else
    Result := FSkinScrollBar.Width;
end;

procedure TbsSkinButtonGroup.AdjustScrollBar;
begin
  if FSkinScrollBar = nil then Exit;
  FSkinScrollBar.SetBounds(ClientWidth - FSkinScrollBar.Width, 0,
  FSkinScrollBar.Width, ClientHeight);
  if not FSkinScrollBar.Visible then FSkinScrollBar.Visible := True;
end;

procedure TbsSkinButtonGroup.ShowSkinScrollBar(const Visible: Boolean);
begin
  if Visible
  then
    begin
     FSkinScrollBar := TbsSkinScrollBar.Create(Self);
     FSkinScrollBar.Visible := False;
     FSkinScrollBar.Parent := Self;
     FSkinScrollBar.DefaultHeight := 0;
     FSkinScrollBar.DefaultWidth := 19;
     //
     FSkinScrollBar.OnChange := SBChange;
     FSkinScrollBar.OnUpButtonClick := SBUpClick;
     FSkinScrollBar.OnDownButtonClick := SBDownClick;