{*******************************************************************}
{                                                                   }
{       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 bsButtonGroup;

interface

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

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
    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 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;
    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 WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;    
    
    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 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 Align;
    property Anchors;
    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

uses ExtCtrls, bsUtils;

{ TbsSkinButtonGroup }

constructor TbsSkinButtonGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  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.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;
     FSkinScrollBar.OnPageUp := SBPageUp;
     FSkinScrollBar.OnPageDown := SBPageDown;
     //
     FSkinScrollBar.SkinDataName := 'vscrollbar';
     FSkinScrollBar.Kind := sbVertical;
     FSkinScrollBar.SkinData := Self.SkinData;
     FSkinScrollBar.Visible := True;
     AdjustScrollBar;
      //
    end
  else
    begin
      FSkinScrollBar.Visible := False;
      FSkinScrollBar.Free;
      FSkinScrollBar := nil;
    end;
  Resize;
  Invalidate;
end;

procedure TbsSkinButtonGroup.WMNCPAINT(var Message: TMessage);
begin
  if FShowBorder
  then
    PaintBorder
  else
    inherited;
end;

procedure TbsSkinButtonGroup.PaintBorder;
begin
  if (SkinData <> nil) and (not SkinData.Empty) and
     (SkinData.GetControlIndex('panel') <> -1)
  then
    PaintSkinBorder
  else
    PaintDefaultBorder;  
end;

procedure TbsSkinButtonGroup.PaintDefaultBorder;
var
  DC: HDC;
  Cnvs: TControlCanvas;
  R: TRect;
begin
  DC := GetWindowDC(Handle);
  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  R := Rect(0, 0, Width, Height);
  InflateRect(R, -2, -2);

  if R.Bottom > R.Top
  then
    ExcludeClipRect(Cnvs.Handle,R.Left, R.Top, R.Right, R.Bottom);

  with Cnvs do
  begin
    Pen.Color := clBtnShadow;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    Pen.Color := clBtnFace;
    Rectangle(1, 1, Width - 1, Height - 1);
  end;
  Cnvs.Handle := 0;
  ReleaseDC(Handle, DC);
  Cnvs.Free;
end;


procedure TbsSkinButtonGroup.PaintSkinBorder;
var
  LeftBitMap, TopBitMap, RightBitMap, BottomBitMap: TBitMap;
  DC: HDC;
  Cnvs: TControlCanvas;
  OX, OY: Integer;
  PanelData: TbsDataSkinPanelControl;
  CIndex: Integer;
  FSkinPicture: TBitMap;
  NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  NewClRect: TRect;
begin
  CIndex := SkinData.GetControlIndex('panel');
  PanelData := TbsDataSkinPanelControl(SkinData.CtrlList[CIndex]);

  DC := GetWindowDC(Handle);
  Cnvs := TControlCanvas.Create;
  Cnvs.Handle := DC;
  LeftBitMap := TBitMap.Create;
  TopBitMap := TBitMap.Create;
  RightBitMap := TBitMap.Create;
  BottomBitMap := TBitMap.Create;
  //
  with PanelData do
  begin
  OX := Width - RectWidth(SkinRect);
  OY := Height - RectHeight(SkinRect);
  NewLTPoint := LTPoint;
  NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
  NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
  NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
  NewClRect := Rect(ClRect.Left, ClRect.Top,
    ClRect.Right + OX, ClRect.Bottom + OY);
  //
  FSkinPicture := TBitMap(FSD.FActivePictures.Items[panelData.PictureIndex]);
  CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, ClRect,