{*******************************************************}
{                                                       }
{                     TabedMdiChild                     }
{                                                       }
{   Component derived from TPageControl implementing    }
{   "TabedBrowsing" for                                 }
{   MDI-Children.                                       }
{                                                       }
{      Copyright (c) 2006 Christian Rehn aka R2C2       }
{                                                       }
{   Diese Klasse ist für alle gedacht, die meinen       }
{   sie nützlich finden zu müssen ;-)                   }
{   This class is intended for everybody thinking       }
{   it is useful ;-)                                    }
{                                                       }
{*******************************************************}

//TODO: CloseButton
//TODO: Colored

unit TMdiTabs_class;

interface

uses
  Classes, Forms, ComCtrls, Contnrs, Menus, Controls;

type
  TTabedMdiChild = class;
  TNameChangeEvent = procedure (AChild: TTabedMdiChild;
      const AOldName: string; var ANewName: string) of object;
    TMdiChildEvent = procedure (AChild: TTabedMdiChild) of object;
  TTabedMdiChild = class(TForm)
  private
    FTabName:string;
    FOnTabNameChange: TNameChangeEvent;
    FOnHintChange: TNameChangeEvent;
    FOnClose2: TMdiChildEvent;
    FOnActivate2: TMdiChildEvent;
  protected
    procedure SetTabName(Value: string); virtual;
    procedure SetHint(AHint: string); virtual;
  public
    destructor Destroy; override;
    property OnTabNameChange: TNameChangeEvent read FOnTabNameChange
      write FOnTabNameChange;
    property OnHintChange: TNameChangeEvent read FOnHintChange
      write FOnHintChange;
    property OnClose2: TMdiChildEvent read FOnClose2 write FOnClose2;
    property OnActivate2: TMdichildEvent read FOnActivate2 write FOnActivate2;
    procedure Activate; override;
  published
    property TabName:  string read FTabName write SetTabName;
    property Hint write SetHint;
  end;

  TMdiTab = class;

  TMdiTabs = class(TPageControl)
  private
    FUseChildHints: Boolean;
    FTabMoving: Boolean;
    FPopup: TPopupMenu;
    function GetPage(AIndex: Integer): TMdiTab;
    procedure SetActivePage(const Value: TMdiTab);
    function GetActivePage: TMdiTab;
    function GetTabByChild(AChild: TTabedMdiChild): TMdiTab; virtual;
    procedure ChildTabNameChanged(AChild: TTabedMdiChild;
      const AOldName: string; var ANewName: string); virtual;
    procedure ChildClosed(AChild: TTabedMdiChild); virtual;
    procedure ChildActivated(AChild: TTabedMdiChild); virtual;
    procedure ChildHintChanged(AChild: TTabedMdiChild;
      const AOldName: string; var ANewName: string); virtual;
    procedure PopupClose(Sender: TObject); virtual;
    procedure PopupMoveLeft(Sender: TObject); virtual;
    procedure PopupMoveRight(Sender: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    property Pages[AIndex: Integer]: TMdiTab read GetPage;
    property ActivePage: TMdiTab read GetActivePage write SetActivePage;
    procedure Change; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure AddChild(AChild: TTabedMdiChild); virtual;
  published
    property Color;
    property ParentColor;
    property UseChildHints: Boolean read FUseChildHints write FUseChildHints;
    property TabMoving: Boolean read FTabMoving write FTabMoving;
  end;

  TMdiTab = class(TTabsheet)
  private
    FMdiChild:TTabedMdiChild;
  public
    constructor Create(AOwner: TComponent; AMdiChild: TTabedMdiChild); reintroduce;
    property MdiChild :  TTabedMdiChild read FMdiChild;       
  end;

  procedure Register;

implementation

uses
  SysUtils, Math, Graphics;

procedure Register;
begin
  RegisterComponents('R2C2', [TMdiTabs]);
end;

destructor TTabedMdiChild.Destroy;
begin
  if Assigned(FOnClose2) then
    FOnClose2(self);
  inherited;
end;

procedure TTabedMdiChild.SetHint(AHint: string);
begin
  if Assigned(FOnHintChange) then
    FOnHintChange(Self, Hint, AHint);
  inherited Hint := AHint;
end;

procedure TTabedMdiChild.SetTabName(Value: string);
begin
  if Assigned(FOnTabNameChange) then
    FOnTabNameChange(Self, FTabName, Value);
  FTabName := Value;
end;

procedure TTabedMdiChild.activate;
begin
  inherited;
  if Assigned(FOnActivate2) then
    FOnActivate2(Self);
end;

constructor TMdiTabs.Create(AOwner: TComponent);
var
  item: TMenuItem;
begin
  inherited Create(AOwner);
  Align := alTop;
  HotTrack := True;
  Height := 25;
  Constraints.MaxHeight := 25;
  Constraints.MinHeight := 25;
  FUseChildHints := True;
  FTabMoving := True;

  FPopup := TPopupMenu.Create(Self);

  item := TMenuItem.Create(FPopup);
  item.Caption := 'Seite schließen';
  item.OnClick := PopupClose;
  FPopup.Items.Add(item);

  item := TMenuItem.Create(FPopup);
  item.Caption := '-';
  FPopup.Items.Add(item);

  item := TMenuItem.Create(FPopup);
  item.Caption := 'nach links verschieben';
  item.OnClick := PopupMoveLeft;
  FPopup.Items.Add(item);

  item := TMenuItem.Create(FPopup);
  item.Caption := 'nach rechts verschieben';
  item.OnClick := PopupMoveRight;
  FPopup.Items.Add(item);

  PopupMenu := FPopup;
end;

function TMdiTabs.GetTabByChild(AChild: TTabedMdiChild): TMdiTab;
var
  i: Integer;
begin
  Result := nil;
  for i := PageCount -1 downto 0 do
  begin
    if Pages[i].MdiChild = AChild then
    begin
      Result := Pages[i];
    end;    
  end;
end;

procedure TMdiTabs.Change;
begin
  inherited;
  ActivePage.MdiChild.Show;
end;

procedure TMdiTabs.PopupClose(Sender: TObject);
begin
  ActivePage.MdiChild.Close;
end;

procedure TMdiTabs.PopupMoveLeft(Sender: TObject);
begin
  if ActivePage.PageIndex > 0 then
    ActivePage.PageIndex := ActivePage.PageIndex -1;
end;

procedure TMdiTabs.PopupMoveRight(Sender: TObject);
begin
  if ActivePage.PageIndex < (PageCount -1) then
    ActivePage.PageIndex := ActivePage.PageIndex +1;
end;

procedure TMdiTabs.DragDrop(Source: TObject; X, Y: Integer);
begin
  inherited;
  ActivePage.PageIndex := IndexOfTabAt(X, Y);
end;

procedure TMdiTabs.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
begin
  inherited;
  if IndexOfTabAt(X, Y) <> -1 then
    Accept := True;
end;

procedure TMdiTabs.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbRight then
  begin
    // right mouse-button changes tabs(just like the left one)
    ActivePageIndex := IndexOfTabAt(X, Y);
    Change;
  end
  else if (Button = mbLeft) and (FTabMoving) then
  begin
    BeginDrag(False, 10);
  end;  
end;

procedure TMdiTabs.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FUseChildHints then
    Hint := Pages[IndexOfTabAt(X, Y)].MdiChild.Hint;
end;

function TMdiTabs.GetActivePage: TMdiTab;
begin
  Result := TMdiTab(inherited ActivePage);
end;

procedure TMdiTabs.SetActivePage(const Value: TMdiTab);
begin
  inherited ActivePage := Value;
end;

function TMdiTabs.GetPage(AIndex: Integer): TMdiTab;
begin
  Result := TMdiTab(inherited Pages[AIndex]);
end;

procedure TMdiTabs.AddChild(AChild: TTabedMdiChild);
var
  Tab: TMdiTab;
begin
  if GetTabByChild(AChild) = nil then
  begin
    Tab := TMdiTab.Create(Self, AChild);
    Tab.PageControl := Self;
    Tab.Caption := AChild.TabName;
    Tab.Hint := AChild.Hint;
    AChild.OnTabNameChange := ChildTabNameChanged;
    AChild.OnClose2 := ChildClosed;
    AChild.OnHintChange := ChildHintChanged;
    AChild.OnActivate2 := ChildActivated;
    AChild.Activate;
  end
  else
  begin
    raise Exception.Create('Tab already existent.');
  end;
end;

procedure TMdiTabs.ChildActivated(AChild: TTabedMdiChild);
var
  Tab: TMdiTab;
begin
  Tab := GetTabByChild(AChild);
  Tab.PageControl.ActivePage := Tab;
end;

procedure TMdiTabs.ChildClosed(AChild: TTabedMdiChild);
var
  Tab: TMdiTab;
begin
  Tab := GetTabByChild(AChild);
  Tab.Free;
end;

procedure TMdiTabs.ChildTabNameChanged(AChild: TTabedMdiChild;
  const AOldName: string; var ANewName: string);
var
  Tab: TMdiTab;
begin
  Tab := GetTabByChild(AChild);
  if Tab <> nil then
    Tab.Caption := ANewName;
end;

procedure TMdiTabs.ChildHintChanged(AChild: TTabedMdiChild;
  const AOldName: string; var ANewName: string);
var
  Tab: TMdiTab;
begin
  Tab := GetTabByChild(AChild);
  Tab.Hint := ANewName;
end;

constructor TMdiTab.Create(AOwner: TComponent; AMdiChild: TTabedMdiChild);
begin
  inherited Create(AOwner);
  FMdiChild := AMdiChild;
end;

end.