mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 11:49:28 +02:00
IDE now extends/clean up project unit path on renaming a project unit
git-svn-id: trunk@8168 -
This commit is contained in:
mattias
parent
cb2563fb4f
commit
ed60dffb71
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -1931,6 +1931,10 @@ lcl/lclproc.pas svneol=native#text/pascal
|
||||
lcl/lclrescache.pas svneol=native#text/pascal
|
||||
lcl/lclstrconsts.pas svneol=native#text/pascal
|
||||
lcl/lcltype.pp svneol=native#text/pascal
|
||||
lcl/ldockctrl.pas svneol=native#text/plain
|
||||
lcl/ldockctrledit.lfm svneol=native#text/plain
|
||||
lcl/ldockctrledit.lrs svneol=native#text/plain
|
||||
lcl/ldockctrledit.pas svneol=native#text/plain
|
||||
lcl/ldocktree.pas svneol=native#text/pascal
|
||||
lcl/lmessages.pp svneol=native#text/pascal
|
||||
lcl/lresources.pp svneol=native#text/pascal
|
||||
|
||||
@ -1977,6 +1977,9 @@ resourcestring
|
||||
// file checks
|
||||
lisUnableToCreateFile = 'Unable to create file';
|
||||
lisCanNotCreateFile = 'Can not create file %s%s%s';
|
||||
lisExtendUnitPath = 'Extend unit path?';
|
||||
lisTheDirectoryIsNotYetInTheUnitPathAddIt = 'The directory %s%s%s is not '
|
||||
+'yet in the unit path.%sAdd it?';
|
||||
lisUnableToCreateFilename = 'Unable to create file %s%s%s.';
|
||||
lisUnableToWriteFile = 'Unable to write file';
|
||||
lisUnableToWriteFile2 = 'Unable to write file %s%s%s';
|
||||
@ -2055,6 +2058,9 @@ resourcestring
|
||||
lisExecutionPausedAdress = 'Execution paused%s Adress: $%s%s Procedure: %'
|
||||
+'s%s File: %s%s(Some day an assembler window might popup here :)%s';
|
||||
lisFileNotFound = 'File not found';
|
||||
lisCleanUpUnitPath = 'Clean up unit path?';
|
||||
lisTheDirectoryIsNoLongerNeededInTheUnitPathRemoveIt = 'The directory %s%s%'
|
||||
+'s is no longer needed in the unit path.%sRemove it?';
|
||||
lisTheFileWasNotFoundDoYouWantToLocateItYourself = 'The file %s%s%s%swas '
|
||||
+'not found.%sDo you want to locate it yourself ?%s';
|
||||
lisRunToFailed = 'Run-to failed';
|
||||
|
||||
46
ide/main.pp
46
ide/main.pp
@ -3661,7 +3661,6 @@ begin
|
||||
FileWithoutPath:=ExtractFileName(NewFilename);
|
||||
// check if file should be auto renamed
|
||||
|
||||
|
||||
if EnvironmentOptions.CharcaseFileAction = ccfaAsk then begin
|
||||
if lowercase(FileWithoutPath)<>FileWithoutPath
|
||||
then begin
|
||||
@ -4041,6 +4040,7 @@ var
|
||||
AmbiguousText: string;
|
||||
i: Integer;
|
||||
AmbiguousFilename: String;
|
||||
OldUnitPath: String;
|
||||
begin
|
||||
OldFilename:=AnUnitInfo.Filename;
|
||||
OldFilePath:=ExtractFilePath(OldFilename);
|
||||
@ -4095,6 +4095,25 @@ begin
|
||||
NewFilePath:=ExtractFilePath(NewFilename);
|
||||
EnvironmentOptions.AddToRecentOpenFiles(NewFilename);
|
||||
SetRecentFilesMenu;
|
||||
|
||||
// add new path to unit path
|
||||
if AnUnitInfo.IsPartOfProject
|
||||
and (FilenameIsPascalUnit(NewFilename))
|
||||
and (CompareFilenames(NewFilePath,Project1.ProjectDirectory)<>0) then begin
|
||||
OldUnitPath:=Project1.CompilerOptions.GetUnitPath(false);
|
||||
|
||||
if SearchDirectoryInSearchPath(OldUnitPath,NewFilePath,1)<1 then begin
|
||||
//DebugLn('TMainIDE.DoRenameUnit NewFilePath="',NewFilePath,'" OldUnitPath="',OldUnitPath,'"');
|
||||
if MessageDlg(lisExtendUnitPath,
|
||||
Format(lisTheDirectoryIsNotYetInTheUnitPathAddIt, ['"', NewFilePath,
|
||||
'"', #13]),
|
||||
mtConfirmation,[mbYes,mbNo],0)=mrYes then
|
||||
begin
|
||||
Project1.CompilerOptions.OtherUnitFiles:=
|
||||
Project1.CompilerOptions.OtherUnitFiles+';'+NewFilePath;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// rename Resource file
|
||||
if (ResourceCode<>nil) then begin
|
||||
@ -4213,6 +4232,31 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// remove old path from unit path
|
||||
if AnUnitInfo.IsPartOfProject
|
||||
and (FilenameIsPascalUnit(OldFilename))
|
||||
and (OldFilePath<>'') then begin
|
||||
//DebugLn('TMainIDE.DoRenameUnit OldFilePath="',OldFilePath,'" SourceDirs="',Project1.SourceDirectories.CreateSearchPathFromAllFiles,'"');
|
||||
if (SearchDirectoryInSearchPath(
|
||||
Project1.SourceDirectories.CreateSearchPathFromAllFiles,OldFilePath,1)<1)
|
||||
then begin
|
||||
//DebugLn('TMainIDE.DoRenameUnit OldFilePath="',OldFilePath,'" UnitPath="',Project1.CompilerOptions.GetUnitPath(false),'"');
|
||||
if (SearchDirectoryInSearchPath(
|
||||
Project1.CompilerOptions.GetUnitPath(false),OldFilePath,1)<1)
|
||||
then begin
|
||||
if MessageDlg(lisCleanUpUnitPath,
|
||||
Format(lisTheDirectoryIsNoLongerNeededInTheUnitPathRemoveIt, ['"',
|
||||
OldFilePath, '"', #13]),
|
||||
mtConfirmation,[mbYes,mbNo],0)=mrYes then
|
||||
begin
|
||||
Project1.CompilerOptions.OtherUnitFiles:=
|
||||
RemoveSearchPaths(Project1.CompilerOptions.OtherUnitFiles,
|
||||
OldUnitPath);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
|
||||
@ -29,8 +29,7 @@ unit MenuIntf;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, Menus, ImgList, Graphics, TextTools, HelpIntf,
|
||||
IDECommands;
|
||||
Classes, SysUtils, LCLProc, Menus, ImgList, Graphics, HelpIntf, IDECommands;
|
||||
|
||||
type
|
||||
TIDEMenuItem = class;
|
||||
|
||||
@ -82,10 +82,6 @@ function RESplit(const TheText, SeparatorRegExpr: string;
|
||||
procedure RESplit(const TheText, SeparatorRegExpr: string; Pieces: TStrings;
|
||||
const ModifierStr: string = '');
|
||||
|
||||
// identifier
|
||||
function CreateFirstIdentifier(const Identifier: string): string;
|
||||
function CreateNextIdentifier(const Identifier: string): string;
|
||||
|
||||
// xml paths
|
||||
function GetPathElement(const Path: string; StartPos: integer;
|
||||
Stopper: char): string;
|
||||
@ -157,27 +153,6 @@ begin
|
||||
RESplit(TheText,SeparatorRegExpr,Result,ModifierStr);
|
||||
end;
|
||||
|
||||
function CreateFirstIdentifier(const Identifier: string): string;
|
||||
// example: Ident59 becomes Ident1
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
p:=length(Identifier);
|
||||
while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
|
||||
Result:=copy(Identifier,1,p)+'1';
|
||||
end;
|
||||
|
||||
function CreateNextIdentifier(const Identifier: string): string;
|
||||
// example: Ident59 becomes Ident60
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
p:=length(Identifier);
|
||||
while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
|
||||
Result:=copy(Identifier,1,p)
|
||||
+IntToStr(1+StrToIntDef(copy(Identifier,p+1,length(Identifier)-p),0));
|
||||
end;
|
||||
|
||||
function GetPathElement(const Path: string; StartPos: integer;
|
||||
Stopper: char): string;
|
||||
var
|
||||
|
||||
@ -48,7 +48,7 @@ uses
|
||||
Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
|
||||
Printers, PostScriptPrinter, PostScriptCanvas, CheckLst, PairSplitter,
|
||||
ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics, ColorBox,
|
||||
PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree,
|
||||
PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree, LDockCtrl,
|
||||
// widgetset skeleton
|
||||
WSActnList, WSArrow, WSButtons, WSCalendar,
|
||||
WSCheckLst, WSCListBox, WSComCtrls, WSControls,
|
||||
|
||||
@ -196,6 +196,10 @@ function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar;
|
||||
procedure UTF8FixBroken(P: PChar);
|
||||
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string;
|
||||
|
||||
// identifier
|
||||
function CreateFirstIdentifier(const Identifier: string): string;
|
||||
function CreateNextIdentifier(const Identifier: string): string;
|
||||
|
||||
|
||||
// ======================================================================
|
||||
// Endian utility functions
|
||||
@ -1740,6 +1744,28 @@ begin
|
||||
SetLength(Result, Dest - PChar(Result));
|
||||
end;
|
||||
|
||||
function CreateFirstIdentifier(const Identifier: string): string;
|
||||
// example: Ident59 becomes Ident1
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
p:=length(Identifier);
|
||||
while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
|
||||
Result:=copy(Identifier,1,p)+'1';
|
||||
end;
|
||||
|
||||
function CreateNextIdentifier(const Identifier: string): string;
|
||||
// example: Ident59 becomes Ident60
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
p:=length(Identifier);
|
||||
while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
|
||||
Result:=copy(Identifier,1,p)
|
||||
+IntToStr(1+StrToIntDef(copy(Identifier,p+1,length(Identifier)-p),0));
|
||||
end;
|
||||
|
||||
|
||||
//==============================================================================
|
||||
// Endian utils
|
||||
//==============================================================================
|
||||
|
||||
357
lcl/ldockctrl.pas
Normal file
357
lcl/ldockctrl.pas
Normal file
@ -0,0 +1,357 @@
|
||||
{ $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.
|
||||
|
||||
162
lcl/ldockctrledit.lfm
Normal file
162
lcl/ldockctrledit.lfm
Normal file
@ -0,0 +1,162 @@
|
||||
object LazDockControlEditorDlg: TLazDockControlEditorDlg
|
||||
ActiveControl = UndockButton
|
||||
Caption = 'LazDockControlEditorDlg'
|
||||
ClientHeight = 315
|
||||
ClientWidth = 310
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 112
|
||||
HorzScrollBar.Page = 309
|
||||
VertScrollBar.Page = 314
|
||||
Left = 286
|
||||
Height = 315
|
||||
Top = 202
|
||||
Width = 310
|
||||
object UndockGroupBox: TGroupBox
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoSize = True
|
||||
Caption = 'UndockGroupBox'
|
||||
ChildSizing.HorizontalSpacing = 5
|
||||
ChildSizing.VerticalSpacing = 5
|
||||
ClientHeight = 9
|
||||
ClientWidth = 291
|
||||
TabOrder = 0
|
||||
Left = 8
|
||||
Height = 26
|
||||
Top = 8
|
||||
Width = 295
|
||||
object UndockButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'UndockButton'
|
||||
OnClick = UndockButtonClick
|
||||
TabOrder = 0
|
||||
Left = 6
|
||||
Height = 26
|
||||
Width = 87
|
||||
end
|
||||
end
|
||||
object DockGroupBox: TGroupBox
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoSize = True
|
||||
Caption = 'DockGroupBox'
|
||||
ChildSizing.HorizontalSpacing = 5
|
||||
ChildSizing.VerticalSpacing = 5
|
||||
ClientHeight = 180
|
||||
ClientWidth = 291
|
||||
TabOrder = 1
|
||||
Left = 8
|
||||
Height = 197
|
||||
Top = 56
|
||||
Width = 295
|
||||
object DockControlLabel: TLabel
|
||||
BorderSpacing.Around = 2
|
||||
Caption = 'DockControlLabel'
|
||||
Color = clNone
|
||||
ParentColor = False
|
||||
AnchorSideTop.Control = DockControlComboBox
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 10
|
||||
Height = 13
|
||||
Top = 6
|
||||
Width = 101
|
||||
end
|
||||
object DockLeftButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'DockLeftButton'
|
||||
OnClick = DockLeftButtonClick
|
||||
TabOrder = 0
|
||||
AnchorSideTop.Control = DockControlComboBox
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 30
|
||||
Width = 94
|
||||
end
|
||||
object DockRightButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'DockRightButton'
|
||||
OnClick = DockRightButtonClick
|
||||
TabOrder = 1
|
||||
AnchorSideLeft.Control = DockLeftButton
|
||||
AnchorSideLeft.Side = asrTop
|
||||
AnchorSideTop.Control = DockLeftButton
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 61
|
||||
Width = 102
|
||||
end
|
||||
object DockTopButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'DockTopButton'
|
||||
OnClick = DockTopButtonClick
|
||||
TabOrder = 2
|
||||
AnchorSideLeft.Control = DockLeftButton
|
||||
AnchorSideLeft.Side = asrTop
|
||||
AnchorSideTop.Control = DockRightButton
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 92
|
||||
Width = 95
|
||||
end
|
||||
object DockBottomButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'DockBottomButton'
|
||||
OnClick = DockBottomButtonClick
|
||||
TabOrder = 3
|
||||
AnchorSideLeft.Control = DockLeftButton
|
||||
AnchorSideLeft.Side = asrTop
|
||||
AnchorSideTop.Control = DockTopButton
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 123
|
||||
Width = 111
|
||||
end
|
||||
object DockPageButton: TButton
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'DockPageButton'
|
||||
OnClick = DockPageButtonClick
|
||||
TabOrder = 4
|
||||
AnchorSideLeft.Control = DockLeftButton
|
||||
AnchorSideLeft.Side = asrTop
|
||||
AnchorSideTop.Control = DockBottomButton
|
||||
Left = 6
|
||||
Height = 26
|
||||
Top = 154
|
||||
Width = 103
|
||||
end
|
||||
object DockControlComboBox: TComboBox
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 4
|
||||
MaxLength = 0
|
||||
OnEditingDone = DockControlComboBoxEditingDone
|
||||
TabOrder = 5
|
||||
Text = 'DockControlComboBox'
|
||||
AnchorSideLeft.Control = DockControlLabel
|
||||
Left = 115
|
||||
Height = 25
|
||||
Width = 171
|
||||
end
|
||||
end
|
||||
object CancelButton: TButton
|
||||
Anchors = [akTop]
|
||||
AutoSize = True
|
||||
BorderSpacing.Top = 10
|
||||
BorderSpacing.InnerBorder = 2
|
||||
Caption = 'CancelButton'
|
||||
TabOrder = 2
|
||||
AnchorSideTop.Control = DockGroupBox
|
||||
Left = 112
|
||||
Height = 26
|
||||
Top = 263
|
||||
Width = 85
|
||||
end
|
||||
end
|
||||
56
lcl/ldockctrledit.lrs
Normal file
56
lcl/ldockctrledit.lrs
Normal file
@ -0,0 +1,56 @@
|
||||
{ Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei }
|
||||
|
||||
LazarusResources.Add('TLazDockControlEditorDlg','FORMDATA',[
|
||||
'TPF0'#24'TLazDockControlEditorDlg'#23'LazDockControlEditorDlg'#13'ActiveCont'
|
||||
+'rol'#7#12'UndockButton'#7'Caption'#6#23'LazDockControlEditorDlg'#12'ClientH'
|
||||
+'eight'#3';'#1#11'ClientWidth'#3'6'#1#8'OnCreate'#7#10'FormCreate'#13'Pixels'
|
||||
+'PerInch'#2'p'#18'HorzScrollBar.Page'#3'5'#1#18'VertScrollBar.Page'#3':'#1#4
|
||||
+'Left'#3#30#1#6'Height'#3';'#1#3'Top'#3#202#0#5'Width'#3'6'#1#0#9'TGroupBox'
|
||||
+#14'UndockGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'
|
||||
+#9#7'Caption'#6#14'UndockGroupBox'#29'ChildSizing.HorizontalSpacing'#2#5#27
|
||||
+'ChildSizing.VerticalSpacing'#2#5#12'ClientHeight'#2#9#11'ClientWidth'#3'#'#1
|
||||
+#8'TabOrder'#2#0#4'Left'#2#8#6'Height'#2#26#3'Top'#2#8#5'Width'#3''''#1#0#7
|
||||
+'TButton'#12'UndockButton'#8'AutoSize'#9#25'BorderSpacing.InnerBorder'#2#2#7
|
||||
+'Caption'#6#12'UndockButton'#7'OnClick'#7#17'UndockButtonClick'#8'TabOrder'#2
|
||||
+#0#4'Left'#2#6#6'Height'#2#26#5'Width'#2'W'#0#0#0#9'TGroupBox'#12'DockGroupB'
|
||||
+'ox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'#9#7'Caption'#6
|
||||
+#12'DockGroupBox'#29'ChildSizing.HorizontalSpacing'#2#5#27'ChildSizing.Verti'
|
||||
+'calSpacing'#2#5#12'ClientHeight'#3#180#0#11'ClientWidth'#3'#'#1#8'TabOrder'
|
||||
+#2#1#4'Left'#2#8#6'Height'#3#197#0#3'Top'#2'8'#5'Width'#3''''#1#0#6'TLabel'
|
||||
+#16'DockControlLabel'#20'BorderSpacing.Around'#2#2#7'Caption'#6#16'DockContr'
|
||||
+'olLabel'#5'Color'#7#6'clNone'#11'ParentColor'#8#21'AnchorSideTop.Control'#7
|
||||
+#19'DockControlComboBox'#18'AnchorSideTop.Side'#7#9'asrCenter'#4'Left'#2#10#6
|
||||
+'Height'#2#13#3'Top'#2#6#5'Width'#2'e'#0#0#7'TButton'#14'DockLeftButton'#8'A'
|
||||
+'utoSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Ca'
|
||||
+'ption'#6#14'DockLeftButton'#7'OnClick'#7#19'DockLeftButtonClick'#8'TabOrder'
|
||||
+#2#0#21'AnchorSideTop.Control'#7#19'DockControlComboBox'#4'Left'#2#6#6'Heigh'
|
||||
+'t'#2#26#3'Top'#2#30#5'Width'#2'^'#0#0#7'TButton'#15'DockRightButton'#8'Auto'
|
||||
+'Size'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capti'
|
||||
+'on'#6#15'DockRightButton'#7'OnClick'#7#20'DockRightButtonClick'#8'TabOrder'
|
||||
+#2#1#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Side'
|
||||
+#7#6'asrTop'#21'AnchorSideTop.Control'#7#14'DockLeftButton'#4'Left'#2#6#6'He'
|
||||
+'ight'#2#26#3'Top'#2'='#5'Width'#2'f'#0#0#7'TButton'#13'DockTopButton'#8'Aut'
|
||||
+'oSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capt'
|
||||
+'ion'#6#13'DockTopButton'#7'OnClick'#7#18'DockTopButtonClick'#8'TabOrder'#2#2
|
||||
+#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Side'#7#6
|
||||
+'asrTop'#21'AnchorSideTop.Control'#7#15'DockRightButton'#4'Left'#2#6#6'Heigh'
|
||||
+'t'#2#26#3'Top'#2'\'#5'Width'#2'_'#0#0#7'TButton'#16'DockBottomButton'#8'Aut'
|
||||
+'oSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capt'
|
||||
+'ion'#6#16'DockBottomButton'#7'OnClick'#7#21'DockBottomButtonClick'#8'TabOrd'
|
||||
+'er'#2#3#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.S'
|
||||
+'ide'#7#6'asrTop'#21'AnchorSideTop.Control'#7#13'DockTopButton'#4'Left'#2#6#6
|
||||
+'Height'#2#26#3'Top'#2'{'#5'Width'#2'o'#0#0#7'TButton'#14'DockPageButton'#8
|
||||
+'AutoSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'C'
|
||||
+'aption'#6#14'DockPageButton'#7'OnClick'#7#19'DockPageButtonClick'#8'TabOrde'
|
||||
+'r'#2#4#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Si'
|
||||
+'de'#7#6'asrTop'#21'AnchorSideTop.Control'#7#16'DockBottomButton'#4'Left'#2#6
|
||||
+#6'Height'#2#26#3'Top'#3#154#0#5'Width'#2'g'#0#0#9'TComboBox'#19'DockControl'
|
||||
+'ComboBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#18'BorderSpacing.Le'
|
||||
+'ft'#2#4#9'MaxLength'#2#0#13'OnEditingDone'#7#30'DockControlComboBoxEditingD'
|
||||
+'one'#8'TabOrder'#2#5#4'Text'#6#19'DockControlComboBox'#22'AnchorSideLeft.Co'
|
||||
+'ntrol'#7#16'DockControlLabel'#4'Left'#2's'#6'Height'#2#25#5'Width'#3#171#0#0
|
||||
+#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11#5'akTop'#0#8'AutoSize'#9#17'B'
|
||||
+'orderSpacing.Top'#2#10#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#12'Ca'
|
||||
+'ncelButton'#8'TabOrder'#2#2#21'AnchorSideTop.Control'#7#12'DockGroupBox'#4
|
||||
+'Left'#2'p'#6'Height'#2#26#3'Top'#3#7#1#5'Width'#2'U'#0#0#0
|
||||
]);
|
||||
179
lcl/ldockctrledit.pas
Normal file
179
lcl/ldockctrledit.pas
Normal file
@ -0,0 +1,179 @@
|
||||
{ $Id: ldocktree.pas 8153 2005-11-14 21:53:06Z mattias $ }
|
||||
{
|
||||
/***************************************************************************
|
||||
LDockCtrlEdit.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 a dialog to dock or undock a control to another.
|
||||
}
|
||||
unit LDockCtrlEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
|
||||
StdCtrls;
|
||||
|
||||
type
|
||||
TLazDockControlEditorDlgResult = (
|
||||
ldcedrNone,
|
||||
ldcedrUndock,
|
||||
ldcedrDockLeft,
|
||||
ldcedrDockRight,
|
||||
ldcedrDockTop,
|
||||
ldcedrDockBottom,
|
||||
ldcedrDockPage
|
||||
);
|
||||
|
||||
{ TLazDockControlEditorDlg }
|
||||
|
||||
TLazDockControlEditorDlg = class(TForm)
|
||||
CancelButton: TButton;
|
||||
DockControlComboBox: TComboBox;
|
||||
DockPageButton: TButton;
|
||||
DockBottomButton: TButton;
|
||||
DockTopButton: TButton;
|
||||
DockRightButton: TButton;
|
||||
DockLeftButton: TButton;
|
||||
DockGroupBox: TGroupBox;
|
||||
DockControlLabel: TLabel;
|
||||
UndockButton: TButton;
|
||||
UndockGroupBox: TGroupBox;
|
||||
procedure DockBottomButtonClick(Sender: TObject);
|
||||
procedure DockControlComboBoxEditingDone(Sender: TObject);
|
||||
procedure DockLeftButtonClick(Sender: TObject);
|
||||
procedure DockPageButtonClick(Sender: TObject);
|
||||
procedure DockRightButtonClick(Sender: TObject);
|
||||
procedure DockTopButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure UndockButtonClick(Sender: TObject);
|
||||
private
|
||||
FCurrentControlName: string;
|
||||
FDlgResult: TLazDockControlEditorDlgResult;
|
||||
procedure CheckSetDlgResult(NewDlgResult: TLazDockControlEditorDlgResult);
|
||||
procedure SetCurrentControlName(const AValue: string);
|
||||
procedure UpdateButtonEnabled;
|
||||
public
|
||||
property DlgResult: TLazDockControlEditorDlgResult read FDlgResult write FDlgResult;
|
||||
property CurrentControlName: string read FCurrentControlName write SetCurrentControlName;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TLazDockControlEditorDlg }
|
||||
|
||||
procedure TLazDockControlEditorDlg.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:='Docking';
|
||||
|
||||
UndockGroupBox.Caption:='Undock';
|
||||
UndockButton.Caption:='Undock (make it a single, normal window)';
|
||||
|
||||
DockPageButton.Caption:='Dock as page';
|
||||
DockBottomButton.Caption:='Dock to bottom';
|
||||
DockTopButton.Caption:='Dock to top';
|
||||
DockRightButton.Caption:='Dock to right';
|
||||
DockLeftButton.Caption:='Dock to left';
|
||||
DockGroupBox.Caption:='Dock to control';
|
||||
DockControlLabel.Caption:='To control';
|
||||
|
||||
UpdateButtonEnabled;
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockLeftButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrDockLeft);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockPageButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrDockPage);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockBottomButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrDockBottom);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockControlComboBoxEditingDone(
|
||||
Sender: TObject);
|
||||
begin
|
||||
UpdateButtonEnabled;
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockRightButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrDockRight);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.DockTopButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrDockTop);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.UndockButtonClick(Sender: TObject);
|
||||
begin
|
||||
CheckSetDlgResult(ldcedrUndock);
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.CheckSetDlgResult(
|
||||
NewDlgResult: TLazDockControlEditorDlgResult);
|
||||
begin
|
||||
if NewDlgResult in [ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop,
|
||||
ldcedrDockBottom,ldcedrDockPage] then
|
||||
begin
|
||||
if DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)<0 then
|
||||
begin
|
||||
MessageDlg('Incomplete','Please select first a control,'
|
||||
+' to which '+CurrentControlName+' should be docked.',mtError,
|
||||
[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
DlgResult:=NewDlgResult;
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.SetCurrentControlName(const AValue: string);
|
||||
begin
|
||||
if FCurrentControlName=AValue then exit;
|
||||
FCurrentControlName:=AValue;
|
||||
end;
|
||||
|
||||
procedure TLazDockControlEditorDlg.UpdateButtonEnabled;
|
||||
var
|
||||
SelectionValid: Boolean;
|
||||
begin
|
||||
SelectionValid:=DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)>=0;
|
||||
DockPageButton.Enabled:=SelectionValid;
|
||||
DockBottomButton.Enabled:=SelectionValid;
|
||||
DockTopButton.Enabled:=SelectionValid;
|
||||
DockRightButton.Enabled:=SelectionValid;
|
||||
DockLeftButton.Enabled:=SelectionValid;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I ldockctrledit.lrs}
|
||||
|
||||
end.
|
||||
|
||||
@ -171,65 +171,6 @@ type
|
||||
end;
|
||||
|
||||
|
||||
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;
|
||||
property Manager: TAnchoredDockManager read FManager;
|
||||
property DockerCount: Integer read FDockerCount;
|
||||
property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers;
|
||||
end;
|
||||
|
||||
{ TLazDockingManager }
|
||||
|
||||
TLazDockingManager = class(TCustomLazDockingManager)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
|
||||
|
||||
TCustomLazControlDocker = class(TComponent)
|
||||
procedure PopupMenuItemClick(Sender: TObject);
|
||||
private
|
||||
FControl: TControl;
|
||||
FExtendPopupMenu: boolean;
|
||||
FManager: TCustomLazDockingManager;
|
||||
FPopupMenuItem: TMenuItem;
|
||||
procedure SetControl(const AValue: TControl);
|
||||
procedure SetExtendPopupMenu(const AValue: boolean);
|
||||
procedure SetManager(const AValue: TCustomLazDockingManager);
|
||||
protected
|
||||
procedure UpdatePopupMenu;
|
||||
procedure Loaded; override;
|
||||
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;
|
||||
end;
|
||||
|
||||
{ TLazControlDocker }
|
||||
|
||||
TLazControlDocker = class(TCustomLazControlDocker)
|
||||
published
|
||||
property Control;
|
||||
property Manager;
|
||||
property ExtendPopupMenu;
|
||||
end;
|
||||
|
||||
const
|
||||
DockAlignOrientations: array[TAlign] of TDockOrientation = (
|
||||
doPages, //alNone,
|
||||
@ -1419,114 +1360,6 @@ begin
|
||||
Result:=Parent as TLazDockPages;
|
||||
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);
|
||||
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.PopupMenu<>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;
|
||||
|
||||
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
|
||||
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
|
||||
begin
|
||||
if FControl=AValue then exit;
|
||||
FControl:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
|
||||
begin
|
||||
if FExtendPopupMenu=AValue then exit;
|
||||
FExtendPopupMenu:=AValue;
|
||||
UpdatePopupMenu;
|
||||
end;
|
||||
|
||||
{ TCustomLazDockingManager }
|
||||
|
||||
procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
|
||||
begin
|
||||
FDockers.Remove(Docker);
|
||||
end;
|
||||
|
||||
function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
|
||||
begin
|
||||
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;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user