diff --git a/components/custom/README b/components/custom/README
index ee5799009e..78607ed060 100644
--- a/components/custom/README
+++ b/components/custom/README
@@ -1,3 +1,6 @@
+OBSOLETE - OBSOLETE - OBSOLETE - OBSOLETE - OBSOLETE - OBSOLETE - OBSOLETE
+
+
How to add extra components to the lazarus IDE
==============================================
diff --git a/components/custom/customidecomps.pas.template b/components/custom/customidecomps.pas.template
index a09a8516e5..b47feb0e80 100644
--- a/components/custom/customidecomps.pas.template
+++ b/components/custom/customidecomps.pas.template
@@ -20,7 +20,8 @@
Author: Mattias Gaertner
-
+ THIS IS OBSOLETE.
+
Use this unit to add components to the lazarus IDE.
For example:
diff --git a/examples/anchordocking/dockform1unit.lrs b/examples/anchordocking/dockform1unit.lrs
index cd84a2c059..419122318e 100644
--- a/examples/anchordocking/dockform1unit.lrs
+++ b/examples/anchordocking/dockform1unit.lrs
@@ -1,3 +1,5 @@
+{ This is an automatically generated lazarus resource file }
+
LazarusResources.Add('TMainForm','FORMDATA',[
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'$'#1#6'Height'#3','#1#3'Top'#3#209#0
+#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'
diff --git a/examples/anchordocking/dockform1unit.pas b/examples/anchordocking/dockform1unit.pas
index 1125845bb9..7445788118 100644
--- a/examples/anchordocking/dockform1unit.pas
+++ b/examples/anchordocking/dockform1unit.pas
@@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
- XMLCfg, DockForm2Unit, Buttons, Menus, LDockCtrl;
+ DockForm2Unit, Buttons, Menus, LDockCtrl, XMLPropStorage;
type
@@ -42,8 +42,13 @@ begin
end;
procedure TMainForm.SaveLayoutButtonClick(Sender: TObject);
+var
+ Config: TXMLConfigStorage;
begin
- DockingManager.SaveToStream();
+ Config:=TXMLConfigStorage.Create('config.xml',false);
+ DockingManager.SaveToConfig(Config);
+ Config.WriteToDisk;
+ Config.Free;
end;
function TMainForm.CreateNewForm: TCustomForm;
@@ -68,9 +73,17 @@ procedure TMainForm.FormCreate(Sender: TObject);
var
Form2: TCustomForm;
Form3: TCustomForm;
+ Config: TXMLConfigStorage;
begin
if Sender=nil then ;
DockingManager:=TLazDockingManager.Create(Self);
+
+ if FileExists('config.xml') then begin
+ Config:=TXMLConfigStorage.Create('config.xml',true);
+ DockingManager.LoadFromConfig(Config);
+ Config.Free;
+ end;
+
DockerForm1:=TLazControlDocker.Create(Self);
DockerForm1.Name:='DockerForm1';
DockerForm1.Manager:=DockingManager;
@@ -84,7 +97,6 @@ begin
DockingManager.WriteDebugReport;
DockerForm1.GetLayoutFromControl;
- DockerForm1.WriteConfigTreeDebugReport;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
diff --git a/examples/anchordocking/docking1.lpi b/examples/anchordocking/docking1.lpi
index 457bd5c563..bfe9dff701 100644
--- a/examples/anchordocking/docking1.lpi
+++ b/examples/anchordocking/docking1.lpi
@@ -20,10 +20,14 @@
-
+
+
+
+
+
diff --git a/ide/componentpalette.pas b/ide/componentpalette.pas
index ef91802d21..7ba2d08f89 100644
--- a/ide/componentpalette.pas
+++ b/ide/componentpalette.pas
@@ -300,6 +300,8 @@ begin
end;
PopupMenu.Items.Add(OpenUnitMenuItem);
+ PopupMenu.Items.AddSeparator;
+
FindComponentMenuItem:=TMenuItem.Create(PopupMenu);
with FindComponentMenuItem do begin
Name:='FindComponentMenuItem';
diff --git a/lcl/grids.pas b/lcl/grids.pas
index cd570d8dbf..ede9eef881 100644
--- a/lcl/grids.pas
+++ b/lcl/grids.pas
@@ -488,10 +488,10 @@ type
ScrollHeight: Integer; // ClientHeight-FixedHeight
VisibleGrid: TRect; // Visible non fixed rectangle of cellcoordinates
MaxClientXY: Tpoint; // VisibleGrid.BottomRight (pixel) coordinates
- ValidRows: boolean; // true if there are not fixed columns to show
- ValidCols: boolean; // true if there are not fixed rows to show
+ ValidRows: boolean; // true if there are not fixed columns to show
+ ValidCols: boolean; // true if there are not fixed rows to show
ValidGrid: boolean; // true if there are not fixed cells to show
- AccumWidth: TList; // Accumulated width per column
+ AccumWidth: TList; // Accumulated width per column
AccumHeight: TList; // Accumulated Height per row
TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels
MaxTopLeft: TPoint; // Max Top left ( cell coorditates)
@@ -676,7 +676,8 @@ type
procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic;
procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic;
procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); dynamic;
- function ColRowToOffset(IsCol,Fisical:Boolean; index: Integer; var Ini,Fin:Integer): Boolean;
+ function ColRowToOffset(IsCol, Relative: Boolean; Index:Integer;
+ var StartPos, EndPos: Integer): Boolean;
function ColumnIndexFromGridColumn(Column: Integer): Integer;
function ColumnFromGridColumn(Column: Integer): TGridColumn;
procedure ColumnsChanged(aColumn: TGridColumn);
@@ -2417,6 +2418,7 @@ var
RNew: TRect;
OldTopLeft:TPoint;
Xinc,YInc: Integer;
+ i: Integer;
begin
OldTopLeft:=fTopLeft;
@@ -2428,15 +2430,19 @@ begin
RNew:=CellRect(aCol,aRow);
Xinc:=0;
- if Rnew.Left + FGCache.TLColOff < FGCache.FixedWidth then Xinc:=-1
- else if (RNew.Right + FGCache.TLColOff > (FGCache.ClientWidth + GetBorderWidth))
- and (RNew.Left + FGCache.TLColOff - GetColWidths(aCol) >= FGCache.FixedWidth) then XInc:=1;
- // Only scroll left if the left edge of the cell does not become invisible as a result
+ if RNew.Left + FGCache.TLColOff < FGCache.FixedWidth then Xinc:=-1
+ else if (RNew.Right+FGCache.TLColOff > (FGCache.ClientWidth+GetBorderWidth))
+ and (RNew.Left+FGCache.TLColOff-GetColWidths(aCol) >= FGCache.FixedWidth)
+ then XInc:=1;
+ // Only scroll left if the left edge of the cell does not become
+ // invisible as a result
Yinc:=0;
if RNew.Top + FGCache.TLRowOff < FGCache.FixedHeight then Yinc:=-1
- else if (RNew.Bottom + FGCache.TLRowOff > (FGCache.ClientHeight + GetBorderWidth))
- and (RNew.Top + FGCache.TLRowOff - GetRowHeights(aRow) >= FGCache.FixedHeight) then YInc:=1;
- // Only scroll up if the top edge of the cell does not become invisible as a result
+ else if (RNew.Bottom+FGCache.TLRowOff > (FGCache.ClientHeight+GetBorderWidth))
+ and (RNew.Top+FGCache.TLRowOff-GetRowHeights(aRow) >= FGCache.FixedHeight)
+ then YInc:=1;
+ // Only scroll up if the top edge of the cell does not become
+ // invisible as a result
with FTopLeft do
if ((XInc=0)and(YInc=0)) or // the cell is already visible
@@ -3849,35 +3855,37 @@ begin
result := True;
end;
-// ex: IsCol=true, Index:=100, TopLeft.x:=98, FixedCols:=1, all ColWidths:=20
-// Fisical = Relative => Ini := WidthfixedCols+WidthCol98+WidthCol99
-// not Fisical = Absolute => Ini := WidthCols(0..99)
-function TCustomGrid.ColRowToOffset(IsCol,Fisical:Boolean; index:Integer;
- var Ini,Fin:Integer): Boolean;
+{ ------------------------------------------------------------------------------
+ Example:
+ IsCol=true, Index:=100, TopLeft.x:=98, FixedCols:=1, all ColWidths:=20
+ Relative => StartPos := WidthfixedCols+WidthCol98+WidthCol99
+ not Relative = Absolute => StartPos := WidthCols(0..99) }
+function TCustomGrid.ColRowToOffset(IsCol, Relative: Boolean; Index:Integer;
+ var StartPos, EndPos: Integer): Boolean;
var
Dim: Integer;
begin
with FGCache do begin
if IsCol then begin
- Ini:=PtrInt(AccumWidth[index]);
+ StartPos:=PtrInt(AccumWidth[index]);
Dim:=GetColWidths(index);
end else begin
- Ini:=PtrInt(AccumHeight[index]);
+ StartPos:=PtrInt(AccumHeight[index]);
Dim:= GetRowHeights(index);
end;
- Ini := Ini + GetBorderWidth;
- if not Fisical then begin
- Fin:=Ini + Dim;
+ StartPos := StartPos + GetBorderWidth;
+ if not Relative then begin
+ EndPos:=StartPos + Dim;
Exit;
end;
if IsCol then begin
if index>=FFixedCols then
- Ini:=Ini-PtrInt(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff;
+ StartPos:=StartPos-PtrInt(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff;
end else begin
if index>=FFixedRows then
- Ini:=Ini-PtrInt(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff;
+ StartPos:=StartPos-PtrInt(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff;
end;
- Fin:=Ini + Dim;
+ EndPos:=StartPos + Dim;
end;
Result:=true;
end;
@@ -4142,8 +4150,8 @@ begin
R:=CellRect(FSplitter.x, FTopLeft.y);
FSplitter.y:=R.Left;
fGridState:= gsColSizing;
- end else
- if not FixedGrid then begin
+ end
+ else if not FixedGrid then begin
// normal selecting
fGridState:=gsSelecting;
FSplitter:=MouseToCell(Point(X,Y));
diff --git a/lcl/lazconfigstorage.pas b/lcl/lazconfigstorage.pas
index b43174a1e5..58fe518809 100644
--- a/lcl/lazconfigstorage.pas
+++ b/lcl/lazconfigstorage.pas
@@ -49,12 +49,16 @@ type
function GetValue(const APath, ADefault: String): String;
function GetValue(const APath: String; ADefault: Integer): Integer;
function GetValue(const APath: String; ADefault: Boolean): Boolean;
+ procedure GetValue(const APath: String; out ARect: TRect;
+ const ADefault: TRect);
procedure SetValue(const APath, AValue: String);
procedure SetDeleteValue(const APath, AValue, DefValue: String);
procedure SetValue(const APath: String; AValue: Integer);
procedure SetDeleteValue(const APath: String; AValue, DefValue: Integer);
procedure SetValue(const APath: String; AValue: Boolean);
procedure SetDeleteValue(const APath: String; AValue, DefValue: Boolean);
+ procedure SetValue(const APath: String; const AValue: TRect);
+ procedure SetDeleteValue(const APath: String; const AValue, DefValue: TRect);
procedure DeletePath(const APath: string);
procedure DeleteValue(const APath: string);
property CurrentBasePath: string read FCurrentBasePath;
@@ -100,6 +104,15 @@ begin
Result:=GetFullPathValue(ExtendPath(APath),ADefault);
end;
+procedure TConfigStorage.GetValue(const APath: String; out ARect: TRect;
+ const ADefault: TRect);
+begin
+ ARect.Left:=GetValue(APath+'Left',ADefault.Left);
+ ARect.Top:=GetValue(APath+'Top',ADefault.Top);
+ ARect.Right:=GetValue(APath+'Right',ADefault.Right);
+ ARect.Bottom:=GetValue(APath+'Bottom',ADefault.Bottom);
+end;
+
procedure TConfigStorage.SetValue(const APath, AValue: String);
begin
SetFullPathValue(ExtendPath(APath),AValue);
@@ -132,6 +145,23 @@ begin
SetDeleteFullPathValue(ExtendPath(APath),AValue,DefValue);
end;
+procedure TConfigStorage.SetValue(const APath: String; const AValue: TRect);
+begin
+ SetValue(APath+'Left',AValue.Left);
+ SetValue(APath+'Top',AValue.Top);
+ SetValue(APath+'Right',AValue.Right);
+ SetValue(APath+'Bottom',AValue.Bottom);
+end;
+
+procedure TConfigStorage.SetDeleteValue(const APath: String; const AValue,
+ DefValue: TRect);
+begin
+ SetDeleteValue(APath+'Left',AValue.Left,DefValue.Left);
+ SetDeleteValue(APath+'Top',AValue.Top,DefValue.Top);
+ SetDeleteValue(APath+'Right',AValue.Right,DefValue.Right);
+ SetDeleteValue(APath+'Bottom',AValue.Bottom,DefValue.Bottom);
+end;
+
procedure TConfigStorage.DeletePath(const APath: string);
begin
DeleteFullPath(ExtendPath(APath));
diff --git a/lcl/ldockctrl.pas b/lcl/ldockctrl.pas
index 0df1eea409..8514ccd79a 100644
--- a/lcl/ldockctrl.pas
+++ b/lcl/ldockctrl.pas
@@ -60,7 +60,17 @@ type
ldcntPages,
ldcntPage
);
+
+const
+ LDConfigNodeTypeNames: array[TLDConfigNodeType] of string = (
+ 'Control',
+ 'Form',
+ 'Splitter',
+ 'Pages',
+ 'Page'
+ );
+type
{ TLazDockConfigNode }
TLazDockConfigNode = class(TPersistent)
@@ -68,16 +78,16 @@ type
FBounds: TRect;
FName: string;
FParent: TLazDockConfigNode;
- FSides: array[TAnchorKind] of TLazDockConfigNode;
+ FSides: array[TAnchorKind] of string;
FTheType: TLDConfigNodeType;
FChilds: TFPList;
function GetChildCount: Integer;
function GetChilds(Index: integer): TLazDockConfigNode;
- function GetSides(Side: TAnchorKind): TLazDockConfigNode;
+ function GetSides(Side: TAnchorKind): string;
procedure SetBounds(const AValue: TRect);
procedure SetName(const AValue: string);
procedure SetParent(const AValue: TLazDockConfigNode);
- procedure SetSides(Side: TAnchorKind; const AValue: TLazDockConfigNode);
+ procedure SetSides(Side: TAnchorKind; const AValue: string);
procedure SetTheType(const AValue: TLDConfigNodeType);
procedure DoAdd(ChildNode: TLazDockConfigNode);
procedure DoRemove(ChildNode: TLazDockConfigNode);
@@ -86,14 +96,17 @@ type
destructor Destroy; override;
procedure Clear;
function FindByName(const AName: string): TLazDockConfigNode;
+ procedure SaveToConfig(Config: TConfigStorage; const Path: string = '');
+ procedure LoadFromConfig(Config: TConfigStorage; const Path: string = '');
+ procedure WriteDebugReport;
public
property Bounds: TRect read FBounds write SetBounds;
property Parent: TLazDockConfigNode read FParent write SetParent;
- property Sides[Side: TAnchorKind]: TLazDockConfigNode read GetSides write SetSides;
+ property Sides[Side: TAnchorKind]: string read GetSides write SetSides;
property ChildCount: Integer read GetChildCount;
property Childs[Index: integer]: TLazDockConfigNode read GetChilds; default;
published
- property TheType: TLDConfigNodeType read FTheType write SetTheType;
+ property TheType: TLDConfigNodeType read FTheType write SetTheType default ldcntControl;
property Name: string read FName write SetName;
end;
@@ -105,6 +118,9 @@ type
private
FDockers: TFPList;
FManager: TAnchoredDockManager;
+ FConfigs: TFPList;// list of TLazDockConfigNode
+ function GetConfigCount: Integer;
+ function GetConfigs(Index: Integer): TLazDockConfigNode;
function GetDockerCount: Integer;
function GetDockers(Index: Integer): TCustomLazControlDocker;
protected
@@ -119,13 +135,18 @@ type
Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
function CreateUniqueName(const AName: string;
Ignore: TCustomLazControlDocker): string;
- procedure SaveToStream(Stream: TStream);
function GetControlConfigName(AControl: TControl): string;
+ procedure SaveToConfig(Config: TConfigStorage; const Path: string = '');
+ procedure LoadFromConfig(Config: TConfigStorage; const Path: string = '');
+ procedure AddOrReplaceConfig(Config: TLazDockConfigNode);
procedure WriteDebugReport;
+ procedure ClearConfigs;
public
property Manager: TAnchoredDockManager read FManager;
property DockerCount: Integer read GetDockerCount;
property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers; default;
+ property ConfigCount: Integer read GetConfigCount;
+ property Configs[Index: Integer]: TLazDockConfigNode read GetConfigs;
end;
{ TLazDockingManager }
@@ -139,11 +160,8 @@ type
When the control gets visible TCustomLazControlDocker restores the layout.
Before the control gets invisible, TCustomLazControlDocker saves the layout.
}
-
TCustomLazControlDocker = class(TComponent)
private
- FConfigRootNode: TLazDockConfigNode;// the root node of the config tree
- FConfigSelfNode: TLazDockConfigNode;// the node of 'Control'
FControl: TControl;
FDockerName: string;
FExtendPopupMenu: boolean;
@@ -163,20 +181,16 @@ type
procedure ControlVisibleChanging(Sender: TObject);
procedure ControlVisibleChanged(Sender: TObject);
public
- procedure ShowDockingEditor; virtual;
- procedure ClearConfigNodes;
- procedure GetLayoutFromControl;
- function GetControlName(AControl: TControl): string;
- procedure WriteConfigTreeDebugReport;
constructor Create(TheOwner: TComponent); override;
+ procedure ShowDockingEditor; virtual;
+ function GetLayoutFromControl: TLazDockConfigNode;
+ function GetControlName(AControl: TControl): string;
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;
- property ConfigRootNode: TLazDockConfigNode read FConfigRootNode;
- property ConfigSelfNode: TLazDockConfigNode read FConfigSelfNode;
end;
{ TLazControlDocker }
@@ -188,12 +202,22 @@ type
property ExtendPopupMenu;
property DockerName;
end;
+
+
+function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType;
procedure Register;
implementation
+function LDConfigNodeTypeNameToType(const s: string): TLDConfigNodeType;
+begin
+ for Result:=Low(TLDConfigNodeType) to High(TLDConfigNodeType) do
+ if CompareText(LDConfigNodeTypeNames[Result],s)=0 then exit;
+ Result:=ldcntControl;
+end;
+
procedure Register;
begin
RegisterComponents('Misc',[TLazDockingManager,TLazControlDocker]);
@@ -372,7 +396,7 @@ begin
end;
end;
-procedure TCustomLazControlDocker.GetLayoutFromControl;
+function TCustomLazControlDocker.GetLayoutFromControl: TLazDockConfigNode;
procedure CopyChildsLayout(ParentNode: TLazDockConfigNode;
ParentNodeControl: TWinControl);
@@ -417,7 +441,7 @@ procedure TCustomLazControlDocker.GetLayoutFromControl;
RaiseGDBException('inconsistency');
end;
DebugLn('CopyChildsLayout ',DbgSName(CurAnchorControl),' CurAnchorCtrlName="',CurAnchorCtrlName,'"');
- ChildNode.Sides[a]:=CurAnchorNode;
+ ChildNode.Sides[a]:=CurAnchorNode.Name;
end;
end;
finally
@@ -433,9 +457,7 @@ procedure TCustomLazControlDocker.GetLayoutFromControl;
NeedChildNodes: boolean;
begin
Result:=TLazDockConfigNode.Create(ParentNode,GetControlName(AControl));
- if AControl=Control then
- FConfigSelfNode:=Result;
-
+
// The Type
if AControl is TLazDockSplitter then
Result.FTheType:=ldcntSplitter
@@ -481,52 +503,12 @@ procedure TCustomLazControlDocker.GetLayoutFromControl;
var
RootControl: TControl;
begin
- ClearConfigNodes;
- if (Control=nil) or (Manager=nil) then exit;
+ if (Control=nil) or (Manager=nil) then exit(nil);
RootControl:=Control;
while RootControl.Parent<>nil do
RootControl:=RootControl.Parent;
- FConfigRootNode:=AddNode(nil,RootControl);
-end;
-
-procedure TCustomLazControlDocker.ClearConfigNodes;
-begin
- FConfigSelfNode:=nil;
- FConfigRootNode.Free;
- FConfigRootNode:=nil;
-end;
-
-procedure TCustomLazControlDocker.WriteConfigTreeDebugReport;
-
- procedure WriteNode(const Prefix: string; ANode: TLazDockConfigNode);
- var
- a: TAnchorKind;
- i: Integer;
- s: string;
- begin
- if ANode=nil then exit;
- DbgOut(Prefix,'Name="'+ANode.Name+'"');
- DbgOut(' Type=',GetEnumName(TypeInfo(TLDConfigNodeType),ord(ANode.TheType)));
- DbgOut(' Bounds='+dbgs(ANode.Bounds));
- DbgOut(' Childs='+dbgs(ANode.ChildCount));
- for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
- if ANode.Sides[a]=nil then continue;
- s:=ANode.Sides[a].Name;
- if s='' then
- s:='?';
- DbgOut(' '+AnchorNames[a]+'="'+s+'"');
- end;
- debugln;
- for i:=0 to ANode.ChildCount-1 do begin
- WriteNode(Prefix+' ',ANode[i]);
- end;
- end;
-
-begin
- DebugLn('TCustomLazControlDocker.WriteConfigTreeDebugReport '
- ,' Root=',dbgs(ConfigRootNode),' SelfNode=',dbgs(ConfigSelfNode));
- WriteNode(' ',ConfigRootNode);
+ Result:=AddNode(nil,RootControl);
end;
constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
@@ -607,6 +589,20 @@ begin
Result:=FDockers.Count;
end;
+function TCustomLazDockingManager.GetConfigCount: Integer;
+begin
+ if FConfigs<>nil then
+ Result:=FConfigs.Count
+ else
+ Result:=0;
+end;
+
+function TCustomLazDockingManager.GetConfigs(Index: Integer
+ ): TLazDockConfigNode;
+begin
+ Result:=TLazDockConfigNode(FConfigs[Index]);
+end;
+
constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@@ -622,6 +618,8 @@ begin
Dockers[i].Manager:=nil;
FreeAndNil(FDockers);
FreeAndNil(FManager);
+ ClearConfigs;
+ FreeAndNil(FConfigs);
inherited Destroy;
end;
@@ -665,11 +663,6 @@ begin
Result:=CreateNextIdentifier(Result);
end;
-procedure TCustomLazDockingManager.SaveToStream(Stream: TStream);
-begin
- RaiseGDBException('TODO TCustomLazDockingManager.SaveToStream');
-end;
-
function TCustomLazDockingManager.GetControlConfigName(AControl: TControl
): string;
var
@@ -682,6 +675,71 @@ begin
Result:='';
end;
+procedure TCustomLazDockingManager.SaveToConfig(Config: TConfigStorage;
+ const Path: string);
+var
+ i: Integer;
+ ADocker: TCustomLazControlDocker;
+ CurDockConfig: TLazDockConfigNode;
+begin
+ // collect configs
+ for i:=0 to DockerCount-1 do begin
+ ADocker:=Dockers[i];
+ if ((ADocker.Control<>nil) and ADocker.Control.Visible) then begin
+ CurDockConfig:=ADocker.GetLayoutFromControl;
+ AddOrReplaceConfig(CurDockConfig);
+ end;
+ end;
+
+ Config.SetDeleteValue(Path+'Configs/Count',ConfigCount,0);
+ for i:=0 to ConfigCount-1 do begin
+ CurDockConfig:=Configs[i];
+ CurDockConfig.SaveToConfig(Config,Path+'Config'+IntToStr(i)+'/');
+ end;
+end;
+
+procedure TCustomLazDockingManager.LoadFromConfig(Config: TConfigStorage;
+ const Path: string);
+var
+ i: Integer;
+ NewConfigCount: LongInt;
+ NewConfigName: String;
+ SubPath: String;
+ NewConfig: TLazDockConfigNode;
+begin
+ // merge the configs
+ NewConfigCount:=Config.GetValue(Path+'Configs/Count',0);
+ for i:=0 to NewConfigCount-1 do begin
+ SubPath:=Path+'Config'+IntToStr(i)+'/';
+ NewConfigName:=Config.GetValue(SubPath+'Name/Value','');
+ if NewConfigName='' then continue;
+ NewConfig:=TLazDockConfigNode.Create(nil,NewConfigName);
+ NewConfig.LoadFromConfig(Config,SubPath);
+ AddOrReplaceConfig(NewConfig);
+ end;
+
+ // apply the configs
+ // TODO
+end;
+
+procedure TCustomLazDockingManager.AddOrReplaceConfig(
+ Config: TLazDockConfigNode);
+var
+ i: Integer;
+ CurConfig: TLazDockConfigNode;
+begin
+ if FConfigs=nil then
+ FConfigs:=TFPList.Create;
+ for i:=FConfigs.Count-1 downto 0 do begin
+ CurConfig:=Configs[i];
+ if CompareText(CurConfig.Name,Config.Name)=0 then begin
+ CurConfig.Free;
+ FConfigs.Delete(i);
+ end;
+ end;
+ FConfigs.Add(Config);
+end;
+
procedure TCustomLazDockingManager.WriteDebugReport;
var
i: Integer;
@@ -694,9 +752,18 @@ begin
end;
end;
+procedure TCustomLazDockingManager.ClearConfigs;
+var
+ i: Integer;
+begin
+ if FConfigs=nil then exit;
+ for i:=0 to FConfigs.Count-1 do TObject(FConfigs[i]).Free;
+ FConfigs.Clear;
+end;
+
{ TLazDockConfigNode }
-function TLazDockConfigNode.GetSides(Side: TAnchorKind): TLazDockConfigNode;
+function TLazDockConfigNode.GetSides(Side: TAnchorKind): string;
begin
Result:=FSides[Side];
end;
@@ -737,7 +804,7 @@ begin
end;
procedure TLazDockConfigNode.SetSides(Side: TAnchorKind;
- const AValue: TLazDockConfigNode);
+ const AValue: string);
begin
FSides[Side]:=AValue;
end;
@@ -763,6 +830,7 @@ constructor TLazDockConfigNode.Create(ParentNode: TLazDockConfigNode;
const AName: string);
begin
FName:=AName;
+ FTheType:=ldcntControl;
Parent:=ParentNode;
end;
@@ -796,4 +864,86 @@ begin
Result:=nil;
end;
+procedure TLazDockConfigNode.SaveToConfig(Config: TConfigStorage;
+ const Path: string);
+var
+ a: TAnchorKind;
+ i: Integer;
+ Child: TLazDockConfigNode;
+begin
+ Config.SetDeleteValue(Path+'Name/Value',Name,'');
+ Config.SetDeleteValue(Path+'Bounds/',FBounds,Rect(0,0,0,0));
+ Config.SetDeleteValue(Path+'Type/Value',LDConfigNodeTypeNames[TheType],
+ LDConfigNodeTypeNames[ldcntControl]);
+
+ // Sides
+ for a:=Low(TAnchorKind) to High(TAnchorKind) do
+ Config.SetDeleteValue(Path+'Sides/'+AnchorNames[a]+'/Name',Sides[a],'');
+
+ // childs
+ Config.SetDeleteValue(Path+'Childs/Count',ChildCount,0);
+ for i:=0 to ChildCount-1 do begin
+ Child:=Childs[i];
+ Child.SaveToConfig(Config,Path+'Child'+IntToStr(i+1)+'/');
+ end;
+end;
+
+procedure TLazDockConfigNode.LoadFromConfig(Config: TConfigStorage;
+ const Path: string);
+var
+ a: TAnchorKind;
+ i: Integer;
+ NewChildCount: LongInt;
+ NewChildName: String;
+ NewChild: TLazDockConfigNode;
+begin
+ Clear;
+ Config.GetValue(Path+'Bounds/',FBounds,Rect(0,0,0,0));
+ TheType:=LDConfigNodeTypeNameToType(Config.GetValue(Path+'Type/Value',
+ LDConfigNodeTypeNames[ldcntControl]));
+
+ // Sides
+ for a:=Low(TAnchorKind) to High(TAnchorKind) do
+ Sides[a]:=Config.GetValue(Path+'Sides/'+AnchorNames[a]+'/Name','');
+
+ // childs
+ NewChildCount:=Config.GetValue(Path+'Childs/Count',0);
+ for i:=0 to NewChildCount-1 do begin
+ NewChildName:=Config.GetValue(Path+'Name/Value','');
+ NewChild:=TLazDockConfigNode.Create(Self,NewChildName);
+ NewChild.LoadFromConfig(Config,Path+'Child'+IntToStr(i+1)+'/');
+ FChilds.Add(NewChild);
+ end;
+end;
+
+procedure TLazDockConfigNode.WriteDebugReport;
+
+ procedure WriteNode(const Prefix: string; ANode: TLazDockConfigNode);
+ var
+ a: TAnchorKind;
+ i: Integer;
+ s: string;
+ begin
+ if ANode=nil then exit;
+ DbgOut(Prefix,'Name="'+ANode.Name+'"');
+ DbgOut(' Type=',GetEnumName(TypeInfo(TLDConfigNodeType),ord(ANode.TheType)));
+ DbgOut(' Bounds='+dbgs(ANode.Bounds));
+ DbgOut(' Childs='+dbgs(ANode.ChildCount));
+ for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
+ s:=ANode.Sides[a];
+ if s='' then
+ s:='?';
+ DbgOut(' '+AnchorNames[a]+'="'+s+'"');
+ end;
+ debugln;
+ for i:=0 to ANode.ChildCount-1 do begin
+ WriteNode(Prefix+' ',ANode[i]);
+ end;
+ end;
+
+begin
+ DebugLn('TLazDockConfigNode.WriteDebugReport Root=',dbgs(Self));
+ WriteNode(' ',Self);
+end;
+
end.
diff --git a/lcl/xmlpropstorage.pas b/lcl/xmlpropstorage.pas
index 0bd1147795..cb2909d9a9 100644
--- a/lcl/xmlpropstorage.pas
+++ b/lcl/xmlpropstorage.pas
@@ -21,16 +21,19 @@ interface
uses
- Classes, SysUtils, LCLProc, Forms, PropertyStorage, XMLCfg, DOM;
+ Classes, SysUtils, LCLProc, Forms, PropertyStorage, XMLCfg, DOM,
+ LazConfigStorage;
type
- { TXMLPropStorage }
+ { TPropStorageXMLConfig }
TPropStorageXMLConfig = class(TXMLConfig)
Public
Procedure DeleteSubNodes (const ARootNode: String);
end;
+ { TCustomXMLPropStorage }
+
TCustomXMLPropStorage = class(TFormPropertyStorage)
private
FCount: Integer;
@@ -53,6 +56,8 @@ type
property RootNodePath: String Read FRootNodePath Write FRootNodePath;
end;
+ { TXMLPropStorage }
+
TXMLPropStorage = class(TCustomXMLPropStorage)
Published
property StoredValues;
@@ -64,6 +69,35 @@ type
property OnRestoringProperties;
property OnRestoreProperties;
end;
+
+ { TXMLConfigStorage }
+
+ TXMLConfigStorage = class(TConfigStorage)
+ private
+ FFreeXMLConfig: boolean;
+ FXMLConfig: TXMLConfig;
+ protected
+ function GetFullPathValue(const APath, ADefault: String): String; override;
+ function GetFullPathValue(const APath: String; ADefault: Integer): Integer; override;
+ function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; override;
+ procedure SetFullPathValue(const APath, AValue: String); override;
+ procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); override;
+ procedure SetFullPathValue(const APath: String; AValue: Integer); override;
+ procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); override;
+ procedure SetFullPathValue(const APath: String; AValue: Boolean); override;
+ procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); override;
+ procedure DeleteFullPath(const APath: string); override;
+ procedure DeleteFullPathValue(const APath: string); override;
+ public
+ constructor Create(const Filename: string; LoadFromDisk: Boolean); override;
+ constructor Create(TheXMLConfig: TXMLConfig);
+ constructor Create(TheXMLConfig: TXMLConfig; const StartPath: string);
+ destructor Destroy; override;
+ property XMLConfig: TXMLConfig read FXMLConfig;
+ property FreeXMLConfig: boolean read FFreeXMLConfig write FFreeXMLConfig;
+ procedure WriteToDisk; override;
+ function GetFilename: string; override;
+ end;
procedure Register;
@@ -173,4 +207,108 @@ begin
end;
end;
-end.
\ No newline at end of file
+{ TXMLConfigStorage }
+
+function TXMLConfigStorage.GetFullPathValue(const APath, ADefault: String
+ ): String;
+begin
+ Result:=XMLConfig.GetValue(APath, ADefault);
+end;
+
+function TXMLConfigStorage.GetFullPathValue(const APath: String;
+ ADefault: Integer): Integer;
+begin
+ Result:=XMLConfig.GetValue(APath, ADefault);
+end;
+
+function TXMLConfigStorage.GetFullPathValue(const APath: String;
+ ADefault: Boolean): Boolean;
+begin
+ Result:=XMLConfig.GetValue(APath, ADefault);
+end;
+
+procedure TXMLConfigStorage.SetFullPathValue(const APath, AValue: String);
+begin
+ XMLConfig.SetValue(APath, AValue);
+end;
+
+procedure TXMLConfigStorage.SetDeleteFullPathValue(const APath, AValue,
+ DefValue: String);
+begin
+ XMLConfig.SetDeleteValue(APath, AValue, DefValue);
+end;
+
+procedure TXMLConfigStorage.SetFullPathValue(const APath: String;
+ AValue: Integer);
+begin
+ XMLConfig.SetValue(APath, AValue);
+end;
+
+procedure TXMLConfigStorage.SetDeleteFullPathValue(const APath: String;
+ AValue, DefValue: Integer);
+begin
+ XMLConfig.SetDeleteValue(APath, AValue, DefValue);
+end;
+
+procedure TXMLConfigStorage.SetFullPathValue(const APath: String;
+ AValue: Boolean);
+begin
+ XMLConfig.SetValue(APath, AValue);
+end;
+
+procedure TXMLConfigStorage.SetDeleteFullPathValue(const APath: String;
+ AValue, DefValue: Boolean);
+begin
+ XMLConfig.SetDeleteValue(APath, AValue, DefValue);
+end;
+
+procedure TXMLConfigStorage.DeleteFullPath(const APath: string);
+begin
+ XMLConfig.DeletePath(APath);
+end;
+
+procedure TXMLConfigStorage.DeleteFullPathValue(const APath: string);
+begin
+ XMLConfig.DeleteValue(APath);
+end;
+
+constructor TXMLConfigStorage.Create(const Filename: string;
+ LoadFromDisk: Boolean);
+begin
+ FXMLConfig:=TXMLConfig.Create(nil);
+ FXMLConfig.StartEmpty:=not LoadFromDisk;
+ FXMLConfig.Filename:=Filename;
+ FFreeXMLConfig:=true;
+end;
+
+constructor TXMLConfigStorage.Create(TheXMLConfig: TXMLConfig);
+begin
+ FXMLConfig:=TheXMLConfig;
+ if FXMLConfig=nil then
+ raise Exception.Create('');
+end;
+
+constructor TXMLConfigStorage.Create(TheXMLConfig: TXMLConfig;
+ const StartPath: string);
+begin
+ Create(TheXMLConfig);
+ AppendBasePath(StartPath);
+end;
+
+destructor TXMLConfigStorage.Destroy;
+begin
+ if FreeXMLConfig then FreeAndNil(FXMLConfig);
+ inherited Destroy;
+end;
+
+procedure TXMLConfigStorage.WriteToDisk;
+begin
+ FXMLConfig.Flush;
+end;
+
+function TXMLConfigStorage.GetFilename: string;
+begin
+ Result:=FXMLConfig.Filename;
+end;
+
+end.