toolmngr.pas

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

end;

procedure TToolContainer.DoPopupChange;
begin
 if Assigned(FOnPopupChange) then FOnPopupChange(Self);
end;

function TToolContainer.GetTool(Index: integer): TCustomForm;
begin
 Result := TCustomForm(FTools[Index]);
end;

function TToolContainer.GetToolCount: integer;
begin
 Result := FTools.Count;
end;

procedure TToolContainer.InitDockSites(ADockSites: TFormDockSites);
begin
 FDockSites := ADockSites;
end;

procedure TToolContainer.InsertTool(ToolForm: TCustomForm);
var Container: TToolContainer;
begin
 if not Assigned(ToolForm) or (FTools.IndexOf(ToolForm) >= 0) then exit;
 Container := FindToolParentContainer(ToolForm);
 if Assigned(Container) and (Container <> Self) then
  Container.RemoveTool(ToolForm);
 FTools.Add(ToolForm);
 ArrangeTools;
 DoPopupChange;
 if Assigned(HostDockSite) and (HostDockSite is TPanel) and
    Assigned(TPanel(HostDockSite).DockManager) then
   TPanel(HostDockSite).DockManager.ResetBounds(True);
end;

procedure TToolContainer.RemoveTool(ToolForm: TCustomForm);
begin
 FTools.Remove(ToolForm);
 ArrangeTools;
 if (FTools.Count = 0) and Assigned(FOnNeedClose) then FOnNeedClose(Self);
 if not (csDestroying in ComponentState) then DoPopupChange;
end;

procedure TToolContainer.RemoveAll;
begin
 FTools.Clear;
 ArrangeTools;
 if (FTools.Count = 0) and Assigned(FOnNeedClose) then FOnNeedClose(Self);
 if not (csDestroying in ComponentState) then DoPopupChange;
end;

function TToolContainer.GetPageForm(PageIndex: integer): TCustomForm;
begin
  Result := TCustomForm(pgTools.Pages[PageIndex].Controls[0]);
end;

function TToolContainer.FindPage(ToolForm: TCustomForm): TTabSheet;
var i: integer;
begin
 Result := Nil;
 for i:=0 to FTools.Count-1 do
  if GetPageForm(i) = ToolForm then begin
   Result := pgTools.Pages[i];
   break;
  end;
end;

procedure TToolContainer.ArrangeTools;
var i, Index: integer;
    Exists: array of boolean;
    ToolForm: TCustomForm;
    Page: TTabSheet;
begin
 FArranging := True;
 try
  SetLength(Exists, FTools.Count);
  FillChar(Exists[0], Length(Exists) * SizeOf(Exists[0]), 0);
  i := pgTools.PageCount-1;
  while i >= 0 do begin
   ToolForm := GetPageForm(i);
   Index := FTools.IndexOf(ToolForm);
   if Index < 0 then begin
    ToolForm.Hide;
    ToolForm.ManualDock(Nil);
   end else
    Exists[Index] := True;
   dec(i);
  end;
  for i:=0 to Length(Exists)-1 do begin
   if Exists[i] then continue;
   ToolForm := TCustomForm(FTools[i]);
   ToolForm.ManualDock(pgTools, nil, alClient);
   Page := pgTools.Pages[pgTools.PageCount-1];
   if Page.ClientWidth < TForm(ToolForm).Width then
     Width := Width + (TForm(ToolForm).Width - Page.ClientWidth);
   if Page.ClientHeight < TForm(ToolForm).Height then
     Height := Height + (TForm(ToolForm).Height - Page.ClientHeight);
   TForm(ToolForm).UndockWidth := Page.ClientWidth;
   TForm(ToolForm).UndockHeight := Page.ClientHeight;
   Page.TabVisible := True;
   ToolForm.Show;
  end;
 finally
  FArranging := False; 
 end;
end;

function TToolContainer.IsToolExists(ToolForm: TCustomForm): boolean;
begin
 Result := FTools.IndexOf(ToolForm) >= 0;
end;

procedure TToolContainer.PopupClosePage(Sender: TObject);
begin
 RemoveTool(ActivePageForm);
end;

procedure TToolContainer.PopupCloseAll(Sender: TObject);
begin
 RemoveAll;
end;

procedure TToolContainer.PopupToolClick(Sender: TObject);
var ToolForm: TCustomForm;
begin
 if not (Sender is TMenuItem) then exit;
 ToolForm := TCustomForm(TMenuItem(Sender).Tag);
 if IsToolExists(ToolForm) then
  RemoveTool(ToolForm)
 else begin
  InsertTool(ToolForm);
  pgTools.ActivePage := FindPage(ToolForm);
 end;
end;

function TToolContainer.GetActivePageForm: TCustomForm;
begin
 Result := GetPageForm( pgTools.ActivePage.PageIndex );
end;

procedure TToolContainer.SetActivePageForm(const Value: TCustomForm);
begin
 pgTools.ActivePage := FindPage(Value);
end;

procedure TToolContainer.DoToolsPopup(Sender: TObject;
  MousePos: TPoint);
var i: integer;
    pmItem: TMenuItem;
    ToolForm: TCustomForm;
begin
 if not Assigned(ToolForms) or (ToolForms.Count = 0) then exit;
 with pmTools do begin
  {$IFNDEF VER120}
  Items.Clear;
  {$ELSE}
  while Items.Count > 0 do Items.Delete(Items.Count-1);
  {$ENDIF}
  pmItem := TMenuItem.Create(pmTools);
  pmItem.Caption := '&Close';
  pmItem.OnClick := PopupClosePage;
  Items.Add(pmItem);
  pmItem := TMenuItem.Create(pmTools);
  pmItem.Caption := '-';
  Items.Add(pmItem);
  for i:=0 to ToolForms.Count-1 do begin
   ToolForm := TCustomForm(ToolForms[i]);
   pmItem := TMenuItem.Create(pmTools);
   pmItem.Caption := ToolForm.Caption;
   pmItem.OnClick := PopupToolClick;
   pmItem.Tag := integer(ToolForm);
   if IsToolExists(ToolForm) then pmItem.Checked := true;
   Items.Add(pmItem);
  end;
  pmItem := TMenuItem.Create(pmTools);
  pmItem.Caption := '-';
  Items.Add(pmItem);
  pmItem := TMenuItem.Create(pmTools);
  pmItem.Caption := 'Close &All';
  pmItem.OnClick := PopupCloseAll;
  Items.Add(pmItem);
  MousePos := Self.ClientToScreen(MousePos);
  Popup(MousePos.X, MousePos.Y);
 end;
end;

procedure TToolContainer.WMContextMenu(var Message: TWMContextMenu);
var Pt: TPoint;
    i: integer;
    Found: boolean;
begin
 Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
 if PtInRect(pgTools.BoundsRect, Pt) then begin
  dec(Pt.X, pgTools.Left);
  dec(Pt.Y, pgTools.Top);
  Found := False;
  for i:=0 to pgTools.ControlCount-1 do
   if PtInRect(pgTools.Controls[i].BoundsRect, Pt) then begin
    Found := True;;
    break;
   end;
  if Found then
   inherited
  else begin
   DoToolsPopup(pgTools, Pt);
   Message.Result := 1;
  end;
 end else
  inherited;
end;

procedure TToolContainer.FormDockOver(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  ARect: TRect;
begin
  Accept := Source.Control is TForm;
  //Draw dock preview depending on where the cursor is relative to our client area
  if Accept and
     Assigned(HostDockSite) and
     (ComputeDockingRect(ARect, Point(X, Y)) <> alNone) then
    Source.DockRect := ARect;
end;

function TToolContainer.ComputeDockingRect(var DockRect: TRect;
  MousePos: TPoint): TAlign;
var
  DockTopRect,
  DockLeftRect,
  DockBottomRect,
  DockRightRect,
  DockCenterRect: TRect;
begin
  Result := alNone;
  //divide form up into docking "Zones"
  DockLeftRect.TopLeft := Point(0, 0);
  DockLeftRect.BottomRight := Point(ClientWidth div 5, ClientHeight);

  DockTopRect.TopLeft := Point(ClientWidth div 5, 0);
  DockTopRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight div 5);

  DockRightRect.TopLeft := Point(ClientWidth div 5 * 4, 0);
  DockRightRect.BottomRight := Point(ClientWidth, ClientHeight);

  DockBottomRect.TopLeft := Point(ClientWidth div 5, ClientHeight div 5 * 4);
  DockBottomRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight);

  DockCenterRect.TopLeft := Point(ClientWidth div 5, ClientHeight div 5);
  DockCenterRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight div 5 * 4);

  //Find out where the mouse cursor is, to decide where to draw dock preview.
  if PtInRect(DockLeftRect, MousePos) then
    begin
      Result := alLeft;
      DockRect := DockLeftRect;
      DockRect.Right := ClientWidth div 2;
    end
  else
    if PtInRect(DockTopRect, MousePos) then
      begin
        Result := alTop;
        DockRect := DockTopRect;
        DockRect.Left := 0;
        DockRect.Right := ClientWidth;
        DockRect.Bottom := ClientHeight div 2;
      end
    else
      if PtInRect(DockRightRect, MousePos) then
        begin
          Result := alRight;
          DockRect := DockRightRect;
          DockRect.Left := ClientWidth div 2;
        end
      else
        if PtInRect(DockBottomRect, MousePos) then
          begin
            Result := alBottom;
            DockRect := DockBottomRect;
            DockRect.Left := 0;
            DockRect.Right := ClientWidth;
            DockRect.Top := ClientHeight div 2;
         end
        else
          if PtInRect(DockCenterRect, MousePos) then
          begin
            Result := alClient;
            DockRect := DockCenterRect;
          end;
  if Result = alNone then Exit;

  //DockRect is in screen coordinates.
  DockRect.TopLeft := ClientToScreen(DockRect.TopLeft);
  DockRect.BottomRight := ClientToScreen(DockRect.BottomRight);
end;

procedure TToolContainer.CMDockClient(var Message: TCMDockClient);
var
  ARect: TRect;
  DockType: TAlign;
  Host: TToolContainer;
  Pt: TPoint;
  Container: TToolContainer;
  ToolForm: TForm;
begin
  //Overriding this message allows the dock form to create host forms
  //depending on the mouse position when docking occurs. If we don't override
  //this message, the form will use VCL's default DockManager.

  //NOTE: the only time ManualDock can be safely called during a drag
  //operation is we override processing of CM_DOCKCLIENT.

  //Find out how to dock (Using a TAlign as the result of ComputeDockingRect)
  Pt.x := Message.MousePos.x;
  Pt.y := Message.MousePos.y;
  DockType := ComputeDockingRect(ARect, Pt);

  if Message.DockSource.Control is TToolContainer then begin
    // Container docking //////////////////////////////////////
    Container := TToolContainer(Message.DockSource.Control);
    if DockType <> alClient then begin
      if HostDockSite is TPanel then
        Container.ManualDock(HostDockSite, nil, DockType);
    end else begin
      if HostDockSite is TToolContainer then
        Host := TToolContainer(HostDockSite)
      else
      if (HostDockSite is TPanel) and
         (HostDockSite.ControlCount = 1) and
         (HostDockSite.Controls[0] is TToolContainer) then
        Host := TToolContainer(HostDockSite.Controls[0])
      else
        Host := Nil;
      if Assigned(Host) then begin
        while Container.ToolCount > 0 do
          Host.InsertTool(Container.Tools[0]);
        with Host.pgTools do
          ActivePage := Pages[PageCount-1];
      end;
    end;
  end else
  if Message.DockSource.Control is TForm then begin
    // Form docking //////////////////////////////////////////
    ToolForm := TForm(Message.DockSource.Control);
    if DockType = alClient then begin
      InsertTool(ToolForm);
      pgTools.ActivePage := FindPage(ToolForm);
    end else begin
      // We need create ToolContainer to dock form
      Host := TToolContainer.Create(Application);
      Host.InsertTool(ToolForm);
      Host.Show;
      Host.ManualDock(HostDockSite, nil, DockType);
    end;
  end;
end;

procedure TToolContainer.pgToolsGetSiteInfo(Sender: TObject;
  DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  var CanDock: Boolean);
begin
  CanDock :=
    not Assigned(HostDockSite) and (DockClient is TForm) and
    not (DockClient is TToolContainer);
end;

procedure TToolContainer.pgToolsDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
var
  ToolForm: TForm;
  Page: TTabSheet;
begin
  if FArranging then exit;

  ToolForm := TForm(Source.Control);
  FTools.Add(ToolForm);
  ToolForm.Show;
  Page := FindPage(ToolForm);
  if not Assigned(Page) then exit;
  Page.TabVisible := True;
  pgTools.ActivePage := Page;
  DoPopupChange;
end;

procedure TToolContainer.pgToolsUnDock(Sender: TObject; Client: TControl;
  NewTarget: TWinControl; var Allow: Boolean);
var
  Container: TToolContainer;
  MousePos: TPoint;
begin
  if FArranging then exit;

  if not Assigned(NewTarget) then begin
    // Create new container for tool form
    Container := TToolContainer.Create(Application);
    Container.InsertTool(TForm(Client));
    // Set Container position. We don't really know where the user drops our
    // ToolForm so we just use last mouse position as drop point.
    GetCursorPos(MousePos);
    with Container.ClientToScreen(Point(0, 0)) do begin
      dec(MousePos.X, X - Container.Left);
      dec(MousePos.Y, Y - Container.Top);
    end;
    with TForm(Client) do
      Container.SetBounds(MousePos.X, MousePos.Y, Width, Height);
    Container.Show;
    Allow := False;
  end else
    // Remove undocking tool form from container
    RemoveTool(Client as TForm);

  if (pgTools.DockClientCount = 0) and (NewTarget <> Self) then
    PostMessage(Self.Handle, WM_CLOSE, 0, 0);
end;

initialization

finalization
  ToolForms.Free;

end.