diff --git a/.gitattributes b/.gitattributes index c50f034910..06e7643da9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 318c6c1798..de3f1aa909 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -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'; diff --git a/ide/main.pp b/ide/main.pp index 729c9fbbbd..8ec4e389ef 100644 --- a/ide/main.pp +++ b/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; diff --git a/ideintf/menuintf.pas b/ideintf/menuintf.pas index 28c0ade053..872926b22d 100644 --- a/ideintf/menuintf.pas +++ b/ideintf/menuintf.pas @@ -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; diff --git a/ideintf/texttools.pas b/ideintf/texttools.pas index 0cf88a0066..54ea0d378f 100644 --- a/ideintf/texttools.pas +++ b/ideintf/texttools.pas @@ -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 diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp index f49e13a29a..bd5f2304c1 100644 --- a/lcl/alllclunits.pp +++ b/lcl/alllclunits.pp @@ -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, diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index bc0ee19c64..bef9810f79 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -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 //============================================================================== diff --git a/lcl/ldockctrl.pas b/lcl/ldockctrl.pas new file mode 100644 index 0000000000..fc9d1b9d8c --- /dev/null +++ b/lcl/ldockctrl.pas @@ -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. + diff --git a/lcl/ldockctrledit.lfm b/lcl/ldockctrledit.lfm new file mode 100644 index 0000000000..d6667ba7de --- /dev/null +++ b/lcl/ldockctrledit.lfm @@ -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 diff --git a/lcl/ldockctrledit.lrs b/lcl/ldockctrledit.lrs new file mode 100644 index 0000000000..4da077e257 --- /dev/null +++ b/lcl/ldockctrledit.lrs @@ -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 +]); diff --git a/lcl/ldockctrledit.pas b/lcl/ldockctrledit.pas new file mode 100644 index 0000000000..c2dcbf6beb --- /dev/null +++ b/lcl/ldockctrledit.pas @@ -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. + diff --git a/lcl/ldocktree.pas b/lcl/ldocktree.pas index 5e46136831..8ff2516bda 100644 --- a/lcl/ldocktree.pas +++ b/lcl/ldocktree.pas @@ -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.