
{************************************************}
{  This unit is a part of FreeVCL library        }
{  Copyright (c) 1998-2003 Evgeny Kryukov        }
{  See License.txt for licence information       }
{                                                }
{  http://sourceforge.net/projects/ksfreevcl     }
{                                                }
{************************************************}

// 2004.02.19 modified by usj12262

unit OfficeToolBar;

{$I OFFICEVER.INC}
{$P+,S-,W-,R-,H+}

interface

uses
  Windows, Classes, Graphics, Controls;

const

  RollBtnWidth = 10;
  TabHeight = 10;
  TabWidth = 50;

type

  { TksoOfficeDock }

  TksoOfficeToolBar = class;

  TksoOfficeDock = class(TCustomControl)
  private
    { tabs }
    function ShowTabs: Boolean;
    { propery sets }
    function GetToolBar(Index: Integer): TksoOfficeToolBar;
    function GetToolBarCount: Integer;
  protected
    function GetClientRect: TRect; override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Drawing }
    procedure Paint; override;
    { Properies }
    property ToolBarCount: Integer read GetToolBarCount;
    property ToolBars[Index: Integer]: TksoOfficeToolBar read GetToolBar;
  published
    property Align;
    property Color;
    property ParentColor;
  end;

  { TksoOfficeToolBar }

  TksoOfficeToolBar = class(TCustomControl)
  private
    FRolled: Boolean;
    FNormalHeight: Integer;
    FButtonDown: Boolean;
    { drawing }
    function GetButtonRect: TRect;
    procedure DrawRollButton;
    { properties }
    procedure SetRolled(const Value: Boolean);
  protected
    function GetClientRect: TRect; override;
    procedure SetParent(AParent: TWinControl); override;
    { mouse }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Drawing }
    procedure Paint; override;
  published
    property Color;
    property ParentColor;
    property Rolled: Boolean read FRolled write SetRolled;
  end;

implementation {===============================================================}

{$R OfficeToolBar.res}

var
  RollUpBmp: TBitmap;
  RollDownBmp: TBitmap;

  { TksoOfficeDock }

constructor TksoOfficeDock.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  Align := alTop;
  Width := 185;
  Height := 22;
  Color := clWindow;
end;

destructor TksoOfficeDock.Destroy;
begin
  inherited Destroy;
end;

procedure TksoOfficeDock.AlignControls(AControl: TControl; var Rect: TRect);
var
  R: TRect;
  I: Integer;
begin
  DisableAlign;
  try
    if Align in [alTop, alBottom] then
      R := Classes.Rect(0, 0, Width, 0)
    else
      R := Classes.Rect(0, 0, 0, Height);
    { Align not rolled toolbars}
    for I := 0 to ToolBarCount - 1 do
      with ToolBars[I] do
        if not Rolled then
        begin
          EnableAlign;
          try
            case Self.Align of
              alTop, alBottom:
                begin
                  BoundsRect := Classes.Rect(R.Left, R.Top, R.Right, R.Top +
                    Height);
                  Inc(R.Top, Height);
                  R.Bottom := R.Top;
                end;
              alLeft, alRight:
                begin
                  BoundsRect := Classes.Rect(R.Left, R.Top, R.Left + Width,
                    R.Bottom);
                  Inc(R.Left, Width);
                  R.Right := R.Left;
                end;
            end;
          finally
            DisableAlign
          end;
        end;
    { Set self bounds}
    if Align in [alTop, alBottom] then
    begin
      if ShowTabs then
        Height := R.Bottom + TabHeight
      else
        Height := R.Bottom;
      R := inherited GetClientRect;
      R.Top := R.Bottom - TabHeight;
    end
    else
    begin
      if ShowTabs then
        Width := R.Right + TabHeight
      else
        Width := R.Right;
      R := inherited GetClientRect;
      R.Left := R.Right - TabHeight;
    end;
    { Align rolled toolbars}
    for I := 0 to ToolBarCount - 1 do
      with ToolBars[I] do
        if Rolled then
        begin
          case Self.Align of
            alTop, alBottom:
              begin
                BoundsRect := Classes.Rect(R.Left, R.Top, R.Left + TabWidth,
                  R.Bottom);
                OffsetRect(R, TabWidth, 0);
              end;
            alLeft, alRight:
              begin
                BoundsRect := Classes.Rect(R.Left, R.Top, R.Right, R.Top +
                  TabWidth);
                OffsetRect(R, 0, TabWidth);
              end;
          end;
        end;
  finally
    EnableAlign;
  end;
end;

function TksoOfficeDock.GetToolBar(Index: Integer): TksoOfficeToolBar;
var
  I: Integer;
begin
  Result := nil;
  I := 0;
  while I < ControlCount do
  begin
    if Controls[I] is TksoOfficeToolBar then
    begin
      if I = Index then
      begin
        Result := Controls[I] as TksoOfficeToolBar;
        Break;
      end;
      Inc(I);
    end;
  end;
end;

function TksoOfficeDock.GetToolBarCount: Integer;
var
  I: Integer;
begin
  I := 0;
  while I < ControlCount do
  begin
    if Controls[I] is TksoOfficeToolBar then
    begin
      Inc(I);
    end;
  end;
  Result := I;
end;

function TksoOfficeDock.GetClientRect: TRect;
begin
  Result := inherited GetClientRect;
  if not ShowTabs then Exit;
  case Align of
    alLeft, alRight: Result := Rect(0, 0, Width - TabHeight, Height);
    alTop, alBottom: Result := Rect(0, 0, Width, Height - TabHeight);
  end;
end;

function TksoOfficeDock.ShowTabs: Boolean;
var
  I: Integer;
begin
  for I := 0 to ToolBarCount - 1 do
    if ToolBars[I].Rolled then
    begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

procedure TksoOfficeDock.Paint;
begin
  with Canvas do
  begin
    Pen.Style := psClear;
    Brush.Style := bsSolid;
    Brush.Color := Color;
    Rectangle(0, 0, Width + 1, Height + 1);
  end;
end;

{ TksoOfficeToolBar }

constructor TksoOfficeToolBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  Width := 185;
  Height := 22;
  ShowHint := False;
  ParentShowHint := False;
end;

destructor TksoOfficeToolBar.Destroy;
begin
  inherited Destroy;
end;

function TksoOfficeToolBar.GetClientRect: TRect;
begin
  if not Rolled then
    if Parent.Align in [alTop, alBottom] then
      Result := Rect(RollBtnWidth + 2, 0, Width, Height)
    else
      Result := Rect(0, RollBtnWidth + 2, Width, Height)
end;

function TksoOfficeToolBar.GetButtonRect: TRect;
begin
  if Parent.Align in [alTop, alBottom] then
    Result := Rect(0, 0, RollBtnWidth, Height)
  else
    Result := Rect(0, 0, Width, RollBtnWidth);
end;

procedure TksoOfficeToolBar.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) then
  begin
    if not Rolled then
    begin
      if PtInRect(GetButtonRect, Point(X, Y)) then
        FButtonDown := True;
    end
    else
    begin
      FButtonDown := True;
    end;
    DrawRollButton;
  end;
end;

procedure TksoOfficeToolBar.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) then
  begin
    if not Rolled then
    begin
      if PtInRect(GetButtonRect, Point(X, Y)) then
        Rolled := True;
    end
    else
    begin
      Rolled := False;
    end;
    FButtonDown := False;
    DrawRollButton;
  end;
end;

procedure TksoOfficeToolBar.DrawRollButton;
var
  R: TRect;
begin
  with Canvas do
  begin
    if not Rolled then
    begin
      { Draw rollbtn }
      Pen.Style := psSolid;
      Brush.Style := bsSolid;
      if not FButtonDown then
      begin
        Brush.Color := Color;
        R := GetButtonRect;
        FillRect(R);
        DrawEdge(Handle, R, BDR_RAISEDINNER, BF_RECT);
        { Draw btm }
        Draw(2, 2, RollUpBmp);
      end
      else
      begin
        Brush.Color := clBtnShadow;
        R := GetButtonRect;
        FillRect(R);
        DrawEdge(Handle, R, BDR_SUNKENINNER, BF_RECT);
        { Draw btm }
        Draw(3, 3, RollUpBmp);
      end;
    end
    else
    begin
      { Draw rollbtn }
      Pen.Style := psSolid;
      R := inherited GetClientRect;
      if not FButtonDown then
      begin
        Brush.Color := Color;
        Rectangle(0, 0, Width + 1, Height + 1);
        DrawEdge(Handle, R, BDR_RAISEDINNER, BF_RECT);
        { Draw btm }
        Draw(3, 2, RollDownBmp);
      end
      else
      begin
        Brush.Color := clBtnShadow;
        Rectangle(0, 0, Width + 1, Height + 1);
        DrawEdge(Handle, R, BDR_SUNKENINNER, BF_RECT);
        { Draw btm }
        Draw(4, 3, RollDownBmp);
      end;
    end;
  end;
end;

procedure TksoOfficeToolBar.Paint;
begin
  with Canvas do
  begin
    if not Rolled then
    begin
      { Draw face }
      Pen.Style := psClear;
      Brush.Style := bsSolid;
      Brush.Color := Color;
      Rectangle(0, 0, Width + 1, Height + 1);
      DrawRollButton;
    end
    else
    begin
      DrawRollButton;
    end;
  end;
end;

procedure TksoOfficeToolBar.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
end;

procedure TksoOfficeToolBar.SetRolled(const Value: Boolean);
var
  R: TRect;
  I: Integer;
begin
  if Value = FRolled then Exit;
  { Save old height }
  if (not FRolled) and Value then
  begin
    if Parent.Align in [alTop, alBottom] then
      FNormalHeight := Height
    else
      FNormalHeight := Width;
    { Hide controls }
    for I := 0 to ControlCount - 1 do
    begin
      Controls[I].Tag := Integer(Controls[I].Visible);
      Controls[I].Visible := False;
    end;
    ShowHint := True;
  end;
  { Restore from height }
  if (FRolled) and (not Value) then
  begin
    FRolled := False;
    if Parent.Align in [alTop, alBottom] then
      Height := FNormalHeight
    else
      Width := FNormalHeight;
    { Show controls }
    for I := 0 to ControlCount - 1 do
      Controls[I].Visible := Boolean(Controls[I].Tag);
    ShowHint := False;
  end
  else
  begin
    { Set value }
    FRolled := Value;
    { Align owner }
    if Parent is TksoOfficeDock then
      (Parent as TksoOfficeDock).AlignControls(nil, R);
  end;
end;

initialization
  RollUpBmp := TBitmap.Create;
  RollUpBmp.Handle := LoadBitmap(HInstance, 'KSO_TBROLLUP');
  RollUpBmp.Transparent := True;
  RollDownBmp := TBitmap.Create;
  RollDownBmp.Handle := LoadBitmap(HInstance, 'KSO_TBROLLDOWN');
  RollDownBmp.Transparent := True;
finalization
  RollDownBmp.Free;
  RollUpBmp.Free;
end.
