toolmngr.pas

FlexGraphics是一套创建矢量图形的VCL组件

unit ToolMngr;

interface

{$IFNDEF VER80}                { DELPHI 1.0     }
 {$IFNDEF VER90}               { DELPHI 2.0     }
  {$IFNDEF VER93}              { C++Builder 1.0 }
   {$IFNDEF VER100}            { DELPHI 3.0     }
    {$IFNDEF VER110}           { C++Builder 3.0 }
     {$IFNDEF VER120}          { DELPHI 4.0 }
      {$IFNDEF VER125}         { C++Builder 4.0 }
       {$IFNDEF VER130}        { DELPHI/C++Builder 5.0 }
         {$DEFINE DELPHI6_UP}
       {$ENDIF}
      {$ENDIF}
     {$ENDIF}
    {$ENDIF}
   {$ENDIF}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, Menus;

const
  DefaultDockWidth   = 210;
  DefaultDockHeight  = 120;

type
  {$IFDEF VER120}
  TWMContextMenu = packed record
    Msg: Cardinal;
    hWnd: HWND;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;
  {$ENDIF}

  TToolContainer = class;

  TFormDockSites = class
  private
    FOwner: TCustomForm;
    FOnDockDrop: TNotifyEvent;
  protected
    procedure RightDockPanelDockOver(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
    procedure BottomDockPanelDockOver(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
    procedure DockPanelDockDrop(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer);
    procedure DockPanelUnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure DockPanelGetSiteInfo(Sender: TObject;
      DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
      var CanDock: Boolean);
  public
    BottomDockPanel: TPanel;
    HSplitter: TSplitter;
    RightDockPanel: TPanel;
    VSplitter: TSplitter;
    constructor Create(AOwner: TCustomForm);
    procedure ShowDockPanel(APanel: TPanel; MakeVisible: Boolean;
      Client: TControl);
    property  Owner: TCustomForm read FOwner;
    property  OnDockDrop: TNotifyEvent read FOnDockDrop write FOnDockDrop;
  end;


  TToolContainer = class(TForm)
    pgTools: TPageControl;
    pmTools: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDockOver(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure pgToolsGetSiteInfo(Sender: TObject; DockClient: TControl;
      var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
    procedure pgToolsUnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure pgToolsDockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
  private
    { Private declarations }
    FTools: TList;
    FArranging: boolean;
    FDockSites: TFormDockSites;
    FOnNeedClose: TNotifyEvent;
    FOnPopupChange: TNotifyEvent;
    procedure ArrangeTools;
    function  GetPageForm(PageIndex: integer): TCustomForm;
    function  FindPage(ToolForm: TCustomForm): TTabSheet;
    procedure PopupClosePage(Sender: TObject);
    procedure PopupCloseAll(Sender: TObject);
    procedure PopupToolClick(Sender: TObject);
    procedure DoToolsPopup(Sender: TObject; MousePos: TPoint);
    function  GetActivePageForm: TCustomForm;
    procedure SetActivePageForm(const Value: TCustomForm);
    function  GetTool(Index: integer): TCustomForm;
    function  GetToolCount: integer;
    function  ComputeDockingRect(var DockRect: TRect; MousePos: TPoint): TAlign;
    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  protected
    procedure DoPopupChange; virtual;
  public
    { Public declarations }
    procedure InitDockSites(ADockSites: TFormDockSites);
    procedure InsertTool(ToolForm: TCustomForm);
    procedure RemoveTool(ToolForm: TCustomForm);
    procedure RemoveAll;
    function  IsToolExists(ToolForm: TCustomForm): boolean;
    property  Tools[Index: integer]: TCustomForm read GetTool;
    property  ToolCount: integer read GetToolCount;
    property  DockSites: TFormDockSites read FDockSites;
    property  ActivePageForm: TCustomForm read GetActivePageForm
      write SetActivePageForm;
    property  OnNeedClose: TNotifyEvent read FOnNeedClose write FOnNeedClose;
    property  OnPopupChange: TNotifyEvent read FOnPopupChange
      write FOnPopupChange;
  end;

var
  ToolForms: TList;
  ToolContainer: TToolContainer;

procedure RegisterToolForm(ToolForm: TCustomForm);
procedure UnRegisterToolForm(ToolForm: TCustomForm);

function  FindChildContainer(Control: TWinControl): TToolContainer;
function  FindToolParentContainer(ToolForm: TCustomForm): TToolContainer;
function  FindToolForm(const AName: string): TCustomForm;

implementation

{$R *.DFM}

function FindToolParentContainer(ToolForm: TCustomForm): TToolContainer;
var Control: TControl;
begin
 Result := Nil;
 if not Assigned(ToolForm) then exit;
 Control := ToolForm.Parent;
 while Assigned(Control) do
  if Control is TToolContainer then begin
   Result := TToolContainer(Control);
   break;
  end else
   Control := Control.Parent;
end;

function FindChildContainer(Control: TWinControl): TToolContainer;
var i: integer;
begin
 Result := Nil;
 with Control do
 for i:=0 to ControlCount-1 do
  if Controls[i] is TToolContainer then begin
   Result := TToolContainer(Controls[i]);
   break;
  end;
end;

function FindToolForm(const AName: string): TCustomForm;
var i: integer;
begin
 Result := Nil;
 for i:=0 to ToolForms.Count-1 do
  if TCustomForm(ToolForms[i]).Name = AName then begin
   Result := TCustomForm(ToolForms[i]);
   break;
  end;
end;

procedure RegisterToolForm(ToolForm: TCustomForm);
begin
 if not Assigned(ToolForms) then ToolForms := TList.Create;
 TForm(ToolForm).DragKind := dkDock;
 ToolForms.Add(ToolForm);
end;

procedure UnRegisterToolForm(ToolForm: TCustomForm);
var Container: TToolContainer;
begin
 if Assigned(ToolForms) then begin
  ToolForms.Remove(ToolForm);
  if ToolForms.Count = 0 then
   {$IFDEF VER120}
   begin
    ToolForms.Free;
    ToolForms := Nil;
   end;
   {$ELSE}
   FreeAndNil(ToolForms);
   {$ENDIF}
 end;
 Container := FindToolParentContainer(ToolForm);
 if Assigned(Container) then Container.RemoveTool(ToolForm);
end;

// TFormDockSites /////////////////////////////////////////////////////////////

constructor TFormDockSites.Create(AOwner: TCustomForm);
begin
  FOwner := AOwner;
  RightDockPanel := TPanel.Create(AOwner);
  with RightDockPanel do begin
    Align := alRight;
    Width := 0;
    Caption := '';
    DockSite := True;
    BevelOuter := bvNone;
    Parent := AOwner;
    OnDockDrop := DockPanelDockDrop;
    OnDockOver := RightDockPanelDockOver;
    OnGetSiteInfo := DockPanelGetSiteInfo;
    OnUndock := DockPanelUndock;
  end;
  VSplitter := TSplitter.Create(AOwner);
  with VSplitter do begin
    Align := alRight;
    Width := 4;
    Visible := False;
    {$IFDEF DELPHI6_UP}
    AutoSnap := False;
    {$ENDIF}
    Parent := AOwner;
    Color := clBtnFace;
  end; 
  BottomDockPanel := TPanel.Create(AOwner);
  with BottomDockPanel do begin
    Align := alBottom;
    Height := 0;
    Caption := '';
    Parent := AOwner;
    BevelOuter := bvNone;
    DockSite := True;
    OnDockDrop := DockPanelDockDrop;
    OnDockOver := BottomDockPanelDockOver;
    OnGetSiteInfo := DockPanelGetSiteInfo;
    OnUndock := DockPanelUndock;
  end;
  HSplitter := TSplitter.Create(AOwner);
  with HSplitter do begin
    Align := alBottom;
    Height := 4;
    Visible := False;
    {$IFDEF DELPHI6_UP}
    AutoSnap := False;
    {$ENDIF}
    Parent := AOwner;
  end;
end;

procedure TFormDockSites.DockPanelDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
begin
  //OnDockDrop gets called AFTER the client has actually docked,
  //so we check for DockClientCount = 1 before making the dock panel visible.
  if (Sender as TPanel).DockClientCount = 1 then begin
    ShowDockPanel(Sender as TPanel, True, nil);
  end;
  (Sender as TPanel).DockManager.ResetBounds(True);
  //Make DockManager repaints it's clients.
  if Assigned(FOnDockDrop) then FOnDockDrop(Self);
end;

procedure TFormDockSites.DockPanelGetSiteInfo(Sender: TObject;
  DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  var CanDock: Boolean);
begin
  //if CanDock is true, the panel will not automatically draw the preview rect.
  CanDock := DockClient is TToolContainer;
end;

procedure TFormDockSites.DockPanelUnDock(Sender: TObject; Client: TControl;
  NewTarget: TWinControl; var Allow: Boolean);
begin
  //OnUnDock gets called BEFORE the client is undocked, in order to optionally
  //disallow the undock. DockClientCount is never 0 when called from this event.
  if (Sender as TPanel).DockClientCount = 1 then
    ShowDockPanel(Sender as TPanel, False, nil);
end;

procedure TFormDockSites.RightDockPanelDockOver(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
var
  ARect: TRect;
begin
  Accept := Source.Control is TToolContainer;
  if Accept then
    with RightDockPanel do begin
      // Modify the DockRect to preview dock area.
      ARect.TopLeft := ClientToScreen(Point(-DefaultDockWidth, 0));
      ARect.BottomRight := ClientToScreen(Point(Width, Height));
      Source.DockRect := ARect;
    end;
end;

procedure TFormDockSites.BottomDockPanelDockOver(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
var
  ARect: TRect;
begin
  Accept := Source.Control is TToolContainer;
  if Accept then
    with BottomDockPanel do begin
      // Modify the DockRect to preview dock area.
      ARect.TopLeft := ClientToScreen(Point(0, -DefaultDockHeight));
      ARect.BottomRight := ClientToScreen(Point(Width, Height));
      Source.DockRect := ARect;
    end;
end;

procedure TFormDockSites.ShowDockPanel(APanel: TPanel; MakeVisible: Boolean;
  Client: TControl);

  function GetVisibleDockClientCount: integer;
  {$IFNDEF DELPHI6_UP}
  var i: integer;
  {$ENDIF}
  begin
    {$IFDEF DELPHI6_UP}
    Result := APanel.VisibleDockClientCount;
    {$ELSE}
    Result := APanel.DockClientCount;
    if Result > 0 then
      for i:=Result - 1 downto 0 do
        if not TControl(APanel.DockClients[i]).Visible then Dec(Result);
    {$ENDIF}
  end;

begin
  //Client - the docked client to show if we are re-showing the panel.
  //Client is ignored if hiding the panel.

  //Since docking to a non-visible docksite isn't allowed, instead of setting
  //Visible for the panels we set the width to zero. The default InfluenceRect
  //for a control extends a few pixels beyond it's boundaries, so it is possible
  //to dock to zero width controls.

  //Don't try to hide a panel which has visible dock clients.
  if not MakeVisible and (GetVisibleDockClientCount > 1) then
    Exit;

  if APanel = RightDockPanel then
    VSplitter.Visible := MakeVisible
  else
    HSplitter.Visible := MakeVisible;

    if MakeVisible then
      if APanel = RightDockPanel then
      begin
        APanel.Width := DefaultDockWidth;
        VSplitter.Left := FOwner.ClientWidth - APanel.Width + VSplitter.Width;
      end
      else begin
        APanel.Height := DefaultDockHeight; 
        HSplitter.Top := FOwner.ClientHeight - APanel.Height - HSplitter.Width;
      end
    else
      if APanel = RightDockPanel then
        APanel.Width := 0
      else
        APanel.Height := 0;
  if MakeVisible and (Client <> nil) then Client.Show;
end;

// TToolContainer ///////////////////////////////////////////////////////////

procedure TToolContainer.FormCreate(Sender: TObject);
begin
  FTools := TList.Create;
end;

procedure TToolContainer.FormDestroy(Sender: TObject);
begin
 FTools.Free;
end;

procedure TToolContainer.FormShow(Sender: TObject);
begin
 with pgTools do begin
  Left := -1;
  Top := 0;
  Width := Self.ClientWidth +3;
  Height := Self.ClientHeight +2;
 end;
end;

procedure TToolContainer.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  FTools.Clear;
  ArrangeTools;
  if Assigned(FDockSites) and (HostDockSite is TPanel) then
    FDockSites.ShowDockPanel(HostDockSite as TPanel, False, nil);
  Action := caFree;
end;

procedure TToolContainer.FormResize(Sender: TObject);
var
  i: integer;
begin
  if FArranging then exit;
  for i:=0 to pgTools.PageCount-1 do
    with GetPageForm(i) do begin
      UndockWidth := pgTools.Pages[i].ClientWidth;
      UndockHeight := pgTools.Pages[i].ClientHeight;
    end;