mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 15:49:26 +02:00
358 lines
11 KiB
ObjectPascal
358 lines
11 KiB
ObjectPascal
{ $Id: ldocktree.pas 8153 2005-11-14 21:53:06Z mattias $ }
|
|
{
|
|
/***************************************************************************
|
|
LDockCtrl.pas
|
|
-----------------
|
|
|
|
***************************************************************************/
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.LCL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
This unit contains visual components for docking.
|
|
}
|
|
unit LDockCtrl;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, Controls, Forms, Menus, LCLStrConsts,
|
|
LDockCtrlEdit, LDockTree;
|
|
|
|
type
|
|
TCustomLazControlDocker = class;
|
|
|
|
{ TCustomLazDockingManager }
|
|
|
|
TCustomLazDockingManager = class(TComponent)
|
|
private
|
|
FDockerCount: Integer;
|
|
FDockers: TFPList;
|
|
FManager: TAnchoredDockManager;
|
|
function GetDockers(Index: Integer): TCustomLazControlDocker;
|
|
protected
|
|
procedure Remove(Docker: TCustomLazControlDocker);
|
|
function Add(Docker: TCustomLazControlDocker): Integer;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function FindDockerByName(const ADockerName: string;
|
|
Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
|
|
function CreateUniqueName(const AName: string;
|
|
Ignore: TCustomLazControlDocker): string;
|
|
property Manager: TAnchoredDockManager read FManager;
|
|
property DockerCount: Integer read FDockerCount;
|
|
property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers; default;
|
|
end;
|
|
|
|
{ TLazDockingManager }
|
|
|
|
TLazDockingManager = class(TCustomLazDockingManager)
|
|
published
|
|
end;
|
|
|
|
{ TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
|
|
|
|
TCustomLazControlDocker = class(TComponent)
|
|
private
|
|
FControl: TControl;
|
|
FDockerName: string;
|
|
FExtendPopupMenu: boolean;
|
|
FLocalizedName: string;
|
|
FManager: TCustomLazDockingManager;
|
|
FPopupMenuItem: TMenuItem;
|
|
procedure SetControl(const AValue: TControl);
|
|
procedure SetDockerName(const AValue: string);
|
|
procedure SetExtendPopupMenu(const AValue: boolean);
|
|
procedure SetLocalizedName(const AValue: string);
|
|
procedure SetManager(const AValue: TCustomLazDockingManager);
|
|
procedure PopupMenuItemClick(Sender: TObject);
|
|
protected
|
|
procedure UpdatePopupMenu; virtual;
|
|
procedure Loaded; override;
|
|
procedure ShowDockingEditor; virtual;
|
|
function GetLocalizedName: string;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
property Control: TControl read FControl write SetControl;
|
|
property Manager: TCustomLazDockingManager read FManager write SetManager;
|
|
property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu;
|
|
property PopupMenuItem: TMenuItem read FPopupMenuItem;
|
|
property LocalizedName: string read FLocalizedName write SetLocalizedName;
|
|
property DockerName: string read FDockerName write SetDockerName;
|
|
end;
|
|
|
|
{ TLazControlDocker }
|
|
|
|
TLazControlDocker = class(TCustomLazControlDocker)
|
|
published
|
|
property Control;
|
|
property Manager;
|
|
property ExtendPopupMenu;
|
|
property DockerName;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Misc',[TLazDockingManager,TLazControlDocker]);
|
|
end;
|
|
|
|
{ TCustomLazControlDocker }
|
|
|
|
procedure TCustomLazControlDocker.SetManager(
|
|
const AValue: TCustomLazDockingManager);
|
|
begin
|
|
if FManager=AValue then exit;
|
|
if FManager<>nil then FManager.Remove(Self);
|
|
FManager:=AValue;
|
|
if FManager<>nil then FManager.Add(Self);
|
|
UpdatePopupMenu;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.UpdatePopupMenu;
|
|
// creates or deletes the PopupMenuItem to the PopupMenu of Control
|
|
begin
|
|
if [csDestroying,csDesigning]*ComponentState<>[] then exit;
|
|
if csLoading in ComponentState then exit;
|
|
|
|
if ExtendPopupMenu and (Control<>nil) and (Control.PopupMenu<>nil)
|
|
and (Manager<>nil) then begin
|
|
if (PopupMenuItem<>nil) and (PopupMenuItem.Parent<>Control.PopupMenu.Items)
|
|
then begin
|
|
// PopupMenuItem is in the old PopupMenu -> delete it
|
|
FreeAndNil(FPopupMenuItem);
|
|
end;
|
|
if (PopupMenuItem=nil) then begin
|
|
// create a new PopupMenuItem
|
|
FPopupMenuItem:=TMenuItem.Create(Self);
|
|
PopupMenuItem.Caption:=rsDocking;
|
|
PopupMenuItem.OnClick:=@PopupMenuItemClick;
|
|
end;
|
|
if PopupMenuItem.Parent=nil then begin
|
|
// add PopupMenuItem to Control.PopupMenu
|
|
Control.PopupMenu.Items.Add(PopupMenuItem);
|
|
end;
|
|
end else begin
|
|
// delete PopupMenuItem
|
|
FreeAndNil(FPopupMenuItem);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdatePopupMenu;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.ShowDockingEditor;
|
|
var
|
|
Dlg: TLazDockControlEditorDlg;
|
|
i: Integer;
|
|
TargetDocker: TCustomLazControlDocker;
|
|
Side: TAlign;
|
|
CurDocker: TCustomLazControlDocker;
|
|
begin
|
|
Dlg:=TLazDockControlEditorDlg.Create(nil);
|
|
try
|
|
// fill the list of controls this control can dock to
|
|
Dlg.DockControlComboBox.Text:='';
|
|
Dlg.DockControlComboBox.Items.BeginUpdate;
|
|
try
|
|
Dlg.DockControlComboBox.Items.Clear;
|
|
for i:=0 to Manager.DockerCount-1 do begin
|
|
CurDocker:=Manager.Dockers[i];
|
|
if CurDocker=Self then continue;
|
|
if CurDocker.Control=nil then continue;
|
|
Dlg.DockControlComboBox.Items.Add(CurDocker.GetLocalizedName);
|
|
end;
|
|
Dlg.DockControlComboBox.Enabled:=Dlg.DockControlComboBox.Items.Count>0;
|
|
finally
|
|
Dlg.DockControlComboBox.Items.EndUpdate;
|
|
end;
|
|
|
|
// enable Undock button, if Control is docked
|
|
Dlg.UndockGroupBox.Enabled:=(Control.Parent<>nil)
|
|
and (Control.Parent<>Control.HostDockSite);
|
|
|
|
if Dlg.ShowModal=mrOk then begin
|
|
// dock or undock
|
|
case Dlg.DlgResult of
|
|
ldcedrUndock:
|
|
// undock
|
|
Manager.Manager.UndockControl(Control,true);
|
|
ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop,
|
|
ldcedrDockBottom,ldcedrDockPage:
|
|
// dock
|
|
begin
|
|
TargetDocker:=nil;
|
|
for i:=0 to Manager.DockerCount-1 do begin
|
|
CurDocker:=Manager.Dockers[i];
|
|
if CurDocker=Self then continue;
|
|
if Dlg.DockControlComboBox.Text=CurDocker.GetLocalizedName then
|
|
TargetDocker:=CurDocker;
|
|
end;
|
|
if TargetDocker=nil then begin
|
|
RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor TargetDocker=nil');
|
|
end;
|
|
case Dlg.DlgResult of
|
|
ldcedrDockLeft: Side:=alLeft;
|
|
ldcedrDockRight: Side:=alRight;
|
|
ldcedrDockTop: Side:=alTop;
|
|
ldcedrDockBottom: Side:=alBottom;
|
|
ldcedrDockPage: Side:=alClient;
|
|
else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?');
|
|
end;
|
|
Manager.Manager.DockControl(Control,Side,TargetDocker.Control);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Dlg.Free;
|
|
end;
|
|
end;
|
|
|
|
function TCustomLazControlDocker.GetLocalizedName: string;
|
|
begin
|
|
Result:=LocalizedName;
|
|
if LocalizedName='' then begin
|
|
Result:=DockerName;
|
|
if (Result='') and (Control<>nil) then
|
|
Result:=Control.Name;
|
|
if Result='' then
|
|
Result:=Name;
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
if (not (csLoading in ComponentState))
|
|
and (TheOwner is TControl) then
|
|
// use as default
|
|
Control:=TControl(TheOwner);
|
|
ExtendPopupMenu:=true;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject);
|
|
begin
|
|
ShowDockingEditor;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
|
|
begin
|
|
if FControl=AValue then exit;
|
|
FControl:=AValue;
|
|
if DockerName='' then
|
|
DockerName:=AValue.Name;
|
|
UpdatePopupMenu;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.SetDockerName(const AValue: string);
|
|
var
|
|
NewDockerName: String;
|
|
begin
|
|
if FDockerName=AValue then exit;
|
|
NewDockerName:=AValue;
|
|
if Manager<>nil then
|
|
NewDockerName:=Manager.CreateUniqueName(NewDockerName,Self);
|
|
FDockerName:=NewDockerName;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
|
|
begin
|
|
if FExtendPopupMenu=AValue then exit;
|
|
FExtendPopupMenu:=AValue;
|
|
UpdatePopupMenu;
|
|
end;
|
|
|
|
procedure TCustomLazControlDocker.SetLocalizedName(const AValue: string);
|
|
begin
|
|
if FLocalizedName=AValue then exit;
|
|
FLocalizedName:=AValue;
|
|
end;
|
|
|
|
{ TCustomLazDockingManager }
|
|
|
|
procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
|
|
begin
|
|
FDockers.Remove(Docker);
|
|
end;
|
|
|
|
function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
|
|
begin
|
|
Docker.DockerName:=CreateUniqueName(Docker.DockerName,nil);
|
|
Result:=FDockers.Add(Docker);
|
|
end;
|
|
|
|
function TCustomLazDockingManager.GetDockers(Index: Integer
|
|
): TCustomLazControlDocker;
|
|
begin
|
|
Result:=TCustomLazControlDocker(FDockers[Index]);
|
|
end;
|
|
|
|
constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
FDockers:=TFPList.Create;
|
|
FManager:=TAnchoredDockManager.Create;
|
|
end;
|
|
|
|
destructor TCustomLazDockingManager.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=FDockers.Count-1 downto 0 do
|
|
Dockers[i].Manager:=nil;
|
|
FreeAndNil(FDockers);
|
|
FreeAndNil(FManager);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomLazDockingManager.FindDockerByName(const ADockerName: string;
|
|
Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=DockerCount-1;
|
|
while (i>=0) do begin
|
|
Result:=Dockers[i];
|
|
if (CompareText(Result.DockerName,ADockerName)=0) and (Ignore<>Result) then
|
|
exit;
|
|
dec(i);
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCustomLazDockingManager.CreateUniqueName(const AName: string;
|
|
Ignore: TCustomLazControlDocker): string;
|
|
begin
|
|
Result:=AName;
|
|
if FindDockerByName(Result,Ignore)=nil then exit;
|
|
Result:=CreateFirstIdentifier(Result);
|
|
while FindDockerByName(Result,Ignore)<>nil do
|
|
Result:=CreateNextIdentifier(Result);
|
|
end;
|
|
|
|
end.
|
|
|