paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-10 06:04:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed ancestor handling (bug ID 11067)

Browse Source 
git-svn-id: trunk@10588 -
This commit is contained in:
michael 2008-03-30 00:03:03 +00:00
parent 9d3d2bba0b
commit d5eec67b53
2 changed files with 106 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
rtl/objpas/classes/classesh.inc
View File

@ -1239,7 +1239,7 @@ type
FDestroyDriver: Boolean;
FRootAncestor: TComponent;
FPropPath: String;
FAncestorList: TList;
FAncestors: TFPList;
FAncestorPos: Integer;
FChildPos: Integer;
FOnFindAncestor: TFindAncestorEvent;
@ -1247,11 +1247,14 @@ type
FOnWriteStringProperty:TReadWriteStringPropertyEvent;
procedure AddToAncestorList(Component: TComponent);
procedure WriteComponentData(Instance: TComponent);
Procedure DetermineAncestor(Component: TComponent);
procedure DoFindAncestor(Component : TComponent);
protected
procedure SetRoot(ARoot: TComponent); override;
procedure WriteBinary(AWriteData: TStreamProc);
procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
procedure WriteProperties(Instance: TPersistent);
procedure WriteChildren(Component: TComponent);
function CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectWriter; virtual;
public
constructor Create(ADriver: TAbstractObjectWriter);

100
rtl/objpas/classes/writer.inc
View File

@ -402,7 +402,7 @@ end;
// Used as argument for calls to TComponent.GetChildren:
procedure TWriter.AddToAncestorList(Component: TComponent);
begin
FAncestorList.Add(Component);
FAncestors.Add(Component);
end;
procedure TWriter.DefineProperty(const Name: String;
@ -495,25 +495,121 @@ begin
WriteListEnd;
end;
procedure TWriter.DetermineAncestor(Component : TComponent);
Var
S : String;
I : Integer;
C : TComponent;
begin
// Should be set only when we write an inherited with children.
if Not Assigned(FAncestors) then
exit;
FAncestor:=nil;
S:=UpperCase(Component.Name);
I:=0;
While (FAncestor=Nil) and (I<FAncestors.Count) do
begin
C:=TComponent(FAncestors[i]);
if (S=UpperCase(C.Name)) then
FAncestor:=C;
Inc(I);
end;
end;
procedure TWriter.DoFindAncestor(Component : TComponent);
Var
C : TComponent;
begin
if Assigned(FOnFindAncestor) then
if (Ancestor=Nil) or (Ancestor is TComponent) then
begin
C:=TComponent(Ancestor);
FOnFindAncestor(Self,Component,Component.Name,C,FRootAncestor);
Ancestor:=C;
end;
end;
procedure TWriter.WriteComponent(Component: TComponent);
var
i : integer;
SA : TPersistent;
SR : TComponent;
begin
SR:=FRoot;
SA:=FAncestor;
Try
Component.FComponentState:=Component.FComponentState+[csWriting];
Try
// Possibly set ancestor.
DetermineAncestor(Component);
DoFindAncestor(Component); // Mainly for IDE when a parent form had an ancestor renamed...
// Will call WriteComponentData.
Component.WriteState(Self);
Component.GetChildren(@WriteComponent,Root);
FDriver.EndList;
Finally
Component.FComponentState:=Component.FComponentState-[csWriting];
end;
Finally
FAncestor:=SA;
FRoot:=SR;
end;
end;
procedure TWriter.WriteChildren(Component : TComponent);
Var
SRoot, SRootA : TComponent;
SList : TFPList;
begin
// Write children list.
// While writing children, the ancestor environment must be saved
// This is recursive...
SRoot:=FRoot;
SRootA:=FRootAncestor;
SList:=FAncestors;
try
FAncestors:=Nil;
if csInline in Component.ComponentState then
FRoot:=Component;
if (FAncestor is TComponent) then
begin
FAncestors:=TFPList.Create;
if csInline in TComponent(FAncestor).ComponentState then
FRootAncestor := TComponent(FAncestor);
TComponent(FAncestor).GetChildren(@AddToAncestorList,FRootAncestor);
end;
try
Component.GetChildren(@WriteComponent, FRoot);
Finally
FreeAndNil(FAncestors);
end;
finally
FAncestors:=Slist;
FRoot:=SRoot;
FRootAncestor:=SRootA;
end;
end;
procedure TWriter.WriteComponentData(Instance: TComponent);
var Dummy: Integer;
Flags: TFilerFlags;
begin
Dummy:=0;
Flags := [];
If Assigned(FAncestor) then
Flags:=[ffInherited];
FDriver.BeginComponent(Instance,Flags, Dummy);
WriteProperties(Instance);
WriteListEnd;
// Needs special handling of ancestor.
If not IgnoreChildren then
WriteChildren(Instance);
end;
procedure TWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);