paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 20:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: designer: implemented loading lists of ancestors

Browse Source 
git-svn-id: trunk@15229 -
This commit is contained in:
mattias 2008-05-25 23:37:39 +00:00
parent 0f56af6dc6
commit da7efa80db
4 changed files with 169 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

213
designer/jitforms.pp
View File

@ -64,9 +64,10 @@ type
TJITPropertyNotFoundEvent = procedure(Sender: TObject; Reader: TReader; TJITPropertyNotFoundEvent = procedure(Sender: TObject; Reader: TReader;
Instance: TPersistent; var PropName: string; IsPath: boolean; Instance: TPersistent; var PropName: string; IsPath: boolean;
var Handled, Skip: Boolean) of object; var Handled, Skip: Boolean) of object;
TJITFindAncestorBinStream = procedure(Sender: TObject; AClass: TClass; TJITFindAncestors = procedure(Sender: TObject; AClass: TClass;
var BinStream: TExtMemoryStream; var Ancestors: TFPList;// list of TComponent
var IsBaseClass, Abort: boolean) of object; var BinStreams: TFPList;// list of TExtMemoryStream;
var Abort: boolean) of object;
TJITFindClass = procedure(Sender: TObject; TJITFindClass = procedure(Sender: TObject;
const ComponentClassName: string; const ComponentClassName: string;
var ComponentClass: TComponentClass) of object; var ComponentClass: TComponentClass) of object;
@ -84,7 +85,7 @@ type
FCurUnknownClass: string; FCurUnknownClass: string;
FCurUnknownProperty: string; FCurUnknownProperty: string;
FErrors: TLRPositionLinks; FErrors: TLRPositionLinks;
FOnFindAncestorBinStream: TJITFindAncestorBinStream; FOnFindAncestors: TJITFindAncestors;
FOnFindClass: TJITFindClass; FOnFindClass: TJITFindClass;
FOnPropertyNotFound: TJITPropertyNotFoundEvent; FOnPropertyNotFound: TJITPropertyNotFoundEvent;
protected protected
@ -98,7 +99,7 @@ type
FJITComponents: TList; FJITComponents: TList;
FFlags: TJITCompListFlags; FFlags: TJITCompListFlags;
// jit procedures // jit procedures
function CreateNewJITClass(ParentClass: TClass; function CreateNewJITClass(AncestorClass: TClass;
const NewClassName, NewUnitName: ShortString): TClass; const NewClassName, NewUnitName: ShortString): TClass;
procedure FreeJITClass(var AClass: TClass); procedure FreeJITClass(var AClass: TClass);
procedure DoAddNewMethod(JITClass: TClass; const AName: ShortString; procedure DoAddNewMethod(JITClass: TClass; const AName: ShortString;
@ -138,7 +139,7 @@ type
procedure CreateReader(BinStream: TStream; var Reader: TReader; procedure CreateReader(BinStream: TStream; var Reader: TReader;
DestroyDriver: Boolean); virtual; DestroyDriver: Boolean); virtual;
function DoCreateJITComponent(const NewComponentName, NewClassName, function DoCreateJITComponent(const NewComponentName, NewClassName,
NewUnitName: shortstring; ParentClass: TClass; NewUnitName: shortstring; AncestorClass: TClass;
Visible: boolean):integer; Visible: boolean):integer;
procedure DoFinishReading; virtual; procedure DoFinishReading; virtual;
public public
@ -147,9 +148,10 @@ type
property Items[Index: integer]: TComponent read GetItem; default; property Items[Index: integer]: TComponent read GetItem; default;
function Count: integer; function Count: integer;
function AddNewJITComponent(const NewUnitName: shortstring; function AddNewJITComponent(const NewUnitName: shortstring;
ParentClass: TClass): integer; AncestorClass: TClass): integer;
function AddJITComponentFromStream(BinStream: TStream; function AddJITComponentFromStream(BinStream: TStream;
ParentClass: TClass; Ancestor: TComponent;// can be nil
AncestorClass: TClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive, Visible: Boolean):integer; Interactive, Visible: Boolean):integer;
procedure DestroyJITComponent(JITComponent: TComponent); procedure DestroyJITComponent(JITComponent: TComponent);
@ -178,8 +180,8 @@ type
read FOnReaderError write FOnReaderError; read FOnReaderError write FOnReaderError;
property OnPropertyNotFound: TJITPropertyNotFoundEvent property OnPropertyNotFound: TJITPropertyNotFoundEvent
read FOnPropertyNotFound write FOnPropertyNotFound; read FOnPropertyNotFound write FOnPropertyNotFound;
property OnFindAncestorBinStream: TJITFindAncestorBinStream property OnFindAncestors: TJITFindAncestors read FOnFindAncestors
read FOnFindAncestorBinStream write FOnFindAncestorBinStream; write FOnFindAncestors;
property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass; property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass;
property CurReadJITComponent: TComponent read FCurReadJITComponent; property CurReadJITComponent: TComponent read FCurReadJITComponent;
property CurReadClass: TClass read FCurReadClass; property CurReadClass: TClass read FCurReadClass;
@ -723,33 +725,35 @@ begin
end; end;
function TJITComponentList.AddNewJITComponent(const NewUnitName: shortstring; function TJITComponentList.AddNewJITComponent(const NewUnitName: shortstring;
ParentClass: TClass): integer; AncestorClass: TClass): integer;
var var
NewComponentName, NewClassName: shortstring; NewComponentName, NewClassName: shortstring;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
debugln('[TJITComponentList] AddNewJITComponent'); debugln('[TJITComponentList] AddNewJITComponent');
{$ENDIF} {$ENDIF}
NewClassName:=ParentClass.ClassName; NewClassName:=AncestorClass.ClassName;
GetUnusedNames(NewComponentName,NewClassName); GetUnusedNames(NewComponentName,NewClassName);
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
debugln('TJITComponentList.AddNewJITComponent NewComponentName=',NewComponentName,' NewClassName=',NewClassName, debugln('TJITComponentList.AddNewJITComponent NewComponentName=',NewComponentName,' NewClassName=',NewClassName,
' NewUnitName=',NewUnitName,' ParentClass=',ParentClass.ClassName); ' NewUnitName=',NewUnitName,' AncestorClass=',AncestorClass.ClassName);
{$ENDIF} {$ENDIF}
Result:=DoCreateJITComponent(NewComponentName,NewClassName,NewUnitName, Result:=DoCreateJITComponent(NewComponentName,NewClassName,NewUnitName,
ParentClass,true); AncestorClass,true);
end; end;
function TJITComponentList.AddJITComponentFromStream(BinStream: TStream; function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
ParentClass: TClass; Ancestor: TComponent;// can be nil
AncestorClass: TClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive, Visible: Boolean): integer; Interactive, Visible: Boolean): integer;
// returns new index // returns new index
// -1 = invalid stream // -1 = invalid stream
procedure ReadStream(AStream: TStream; StreamClass: TClass); procedure ReadStream(AStream: TStream; StreamClass: TClass;
AnAncestor: TComponent);
var var
Reader:TReader; Reader: TReader;
DestroyDriver: Boolean; DestroyDriver: Boolean;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
@ -763,6 +767,8 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
debugln('[TJITComponentList.AddJITComponentFromStream] Read ...'); debugln('[TJITComponentList.AddJITComponentFromStream] Read ...');
{$ENDIF} {$ENDIF}
try try
Reader.Ancestor:=AnAncestor;
DebugLn(['TJITComponentList.AddJITComponentFromStream.ReadStream FCurReadJITComponent=',DbgSName(FCurReadJITComponent),' StreamClass=',DbgSName(StreamClass),' Ancestor=',DbgSName(Ancestor)]);
Reader.ReadRootComponent(FCurReadJITComponent); Reader.ReadRootComponent(FCurReadJITComponent);
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
debugln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...'); debugln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...');
@ -777,40 +783,35 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
end; end;
function ReadAncestorStreams: boolean; function ReadAncestorStreams: boolean;
var
function ReadAncestor(AClass: TClass): boolean; i: Integer;
var Ancestors: TFPList;
Abort: boolean; AncestorStreams: TFPList;
AncestorStream: TExtMemoryStream; Abort: boolean;
IsBaseClass: Boolean;
begin
// stop at base class
if (AClass=nil) or (AClass=TComponent) then exit(true);
// now read the stream
Abort:=false;
AncestorStream:=nil;
IsBaseClass:=false;
try
OnFindAncestorBinStream(Self,AClass,AncestorStream,IsBaseClass,Abort);
if Abort then exit(false);
if not IsBaseClass then begin
// read ancestor streams first
if not ReadAncestor(AClass.ClassParent) then exit(false);
end;
{$IFDEF VerboseJITForms}
DebugLn(['TJITComponentList.AddJITComponentFromStream.ReadAncestor ',DbgSName(AClass),' HasStream=',AncestorStream<>nil]);
{$ENDIF}
if AncestorStream<>nil then
ReadStream(AncestorStream,AClass);
finally
FreeAndNil(AncestorStream);
end;
Result:=true;
end;
begin begin
if not Assigned(OnFindAncestorBinStream) then exit(true); if not Assigned(OnFindAncestors) then exit(true);
Result:=ReadAncestor(ParentClass); Ancestors:=nil;
AncestorStreams:=nil;
try
Abort:=false;
OnFindAncestors(Self,AncestorClass,Ancestors,AncestorStreams,Abort);
if Abort then exit(false);
if Ancestors<>nil then begin
Ancestor:=nil;
for i:=Ancestors.Count-1 downto 0 do begin
ReadStream(TExtMemoryStream(AncestorStreams[i]),
TComponent(Ancestors[i]).ClassType,
Ancestor);
Ancestor:=TComponent(Ancestors[i]);
end;
end;
finally
Ancestors.Free;
if AncestorStreams<>nil then
for i:=0 to AncestorStreams.Count-1 do
TObject(AncestorStreams[i]).Free;
AncestorStreams.Free;
end;
end; end;
var var
@ -830,10 +831,10 @@ begin
debugln('[TJITComponentList.AddJITComponentFromStream] Create ...'); debugln('[TJITComponentList.AddJITComponentFromStream] Create ...');
{$ENDIF} {$ENDIF}
try try
Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass,Visible); Result:=DoCreateJITComponent('',NewClassName,NewUnitName,AncestorClass,Visible);
if Result<0 then exit; if Result<0 then exit;
ReadAncestorStreams; ReadAncestorStreams;
ReadStream(BinStream,FCurReadJITComponent.ClassType); ReadStream(BinStream,FCurReadJITComponent.ClassType,Ancestor);
if FCurReadJITComponent.Name='' then begin if FCurReadJITComponent.Name='' then begin
NewName:=FCurReadJITComponent.ClassName; NewName:=FCurReadJITComponent.ClassName;
@ -914,7 +915,7 @@ end;
function TJITComponentList.DoCreateJITComponent( function TJITComponentList.DoCreateJITComponent(
const NewComponentName, NewClassName, NewUnitName: shortstring; const NewComponentName, NewClassName, NewUnitName: shortstring;
ParentClass: TClass; Visible: boolean):integer; AncestorClass: TClass; Visible: boolean):integer;
var var
Instance:TComponent; Instance:TComponent;
ok: boolean; ok: boolean;
@ -929,9 +930,9 @@ begin
ok:=false; ok:=false;
// create new class and an instance // create new class and an instance
//debugln('[TJITForms.DoCreateJITComponent] Creating new JIT class '''+NewClassName+''' ...'); //debugln('[TJITForms.DoCreateJITComponent] Creating new JIT class '''+NewClassName+''' ...');
Pointer(FCurReadClass):=CreateNewJITClass(ParentClass,NewClassName, Pointer(FCurReadClass):=CreateNewJITClass(AncestorClass,NewClassName,
NewUnitName); NewUnitName);
//debugln('[TJITForms.DoCreateJITComponent] Creating an instance of JIT class "'+NewClassName+'" = class('+ParentClass.ClassName+') ...'); //debugln('[TJITForms.DoCreateJITComponent] Creating an instance of JIT class "'+NewClassName+'" = class('+AncestorClass.ClassName+') ...');
Instance:=TComponent(FCurReadClass.NewInstance); Instance:=TComponent(FCurReadClass.NewInstance);
//debugln('[TJITForms.DoCreateJITComponent] Initializing new instance ... ',DbgS(Instance)); //debugln('[TJITForms.DoCreateJITComponent] Initializing new instance ... ',DbgS(Instance));
TComponent(FCurReadJITComponent):=Instance; TComponent(FCurReadJITComponent):=Instance;
@ -1167,10 +1168,10 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function TJITComponentList.CreateNewJITClass(ParentClass: TClass; function TJITComponentList.CreateNewJITClass(AncestorClass: TClass;
const NewClassName, NewUnitName: ShortString): TClass; const NewClassName, NewUnitName: ShortString): TClass;
// Create a new class (vmt, virtual method table, field table and typeinfo) // Create a new class (vmt, virtual method table, field table and typeinfo)
// that descends from ParentClass. // that descends from AncestorClass.
// The new class will have no new variables, no new methods and no new fields. // The new class will have no new variables, no new methods and no new fields.
var var
NewVMT: Pointer; NewVMT: Pointer;
@ -1184,8 +1185,8 @@ var
vmtSize: Integer; vmtSize: Integer;
vmtTailSize: Integer; vmtTailSize: Integer;
begin begin
if ParentClass=nil then if AncestorClass=nil then
raise Exception.Create('CreateNewClass ParentClass=nil'); raise Exception.Create('CreateNewClass AncestorClass=nil');
if NewClassName='' then if NewClassName='' then
raise Exception.Create('CreateNewClass NewClassName empty'); raise Exception.Create('CreateNewClass NewClassName empty');
if not IsValidIdent(NewClassName) then if not IsValidIdent(NewClassName) then
@ -1197,17 +1198,17 @@ begin
Result:=nil; Result:=nil;
// create vmt // create vmt
vmtSize:=GetVMTSize(ParentClass); vmtSize:=GetVMTSize(AncestorClass);
vmtTailSize:=vmtSize-vmtMethodStart; vmtTailSize:=vmtSize-vmtMethodStart;
GetMem(NewVMT,vmtSize); GetMem(NewVMT,vmtSize);
FillChar(NewVMT^,vmtSize,0); FillChar(NewVMT^,vmtSize,0);
// set vmtInstanceSize // set vmtInstanceSize
PPtrInt(NewVMT+vmtInstanceSize)^:=ParentClass.InstanceSize; PPtrInt(NewVMT+vmtInstanceSize)^:=AncestorClass.InstanceSize;
PPtrInt(NewVMT+vmtInstanceSizeNeg)^:=-ParentClass.InstanceSize; PPtrInt(NewVMT+vmtInstanceSizeNeg)^:=-AncestorClass.InstanceSize;
// set vmtParent // set vmtParent
TClass(Pointer(NewVMT+vmtParent)^):=ParentClass; TClass(Pointer(NewVMT+vmtParent)^):=AncestorClass;
// set vmtClassName: create pointer to classname (PShortString) // set vmtClassName: create pointer to classname (PShortString)
GetMem(ClassNamePShortString,SizeOf(ShortString)); GetMem(ClassNamePShortString,SizeOf(ShortString));
@ -1241,19 +1242,19 @@ begin
// set TypeData (PropCount is the total number of properties, including ancestors) // set TypeData (PropCount is the total number of properties, including ancestors)
NewTypeData^.ClassType:=TClass(NewVMT); NewTypeData^.ClassType:=TClass(NewVMT);
NewTypeData^.ParentInfo:=ParentClass.ClassInfo; NewTypeData^.ParentInfo:=AncestorClass.ClassInfo;
NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount; NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount;
NewTypeData^.UnitName:=NewUnitName; NewTypeData^.UnitName:=NewUnitName;
AddedPropCount:=GetTypeDataPropCountAddr(NewTypeData); AddedPropCount:=GetTypeDataPropCountAddr(NewTypeData);
AddedPropCount^:=0; AddedPropCount^:=0;
// copy the standard methods // copy the standard methods
System.Move(Pointer(Pointer(ParentClass)+vmtMethodStart)^, System.Move(Pointer(Pointer(AncestorClass)+vmtMethodStart)^,
Pointer(NewVMT+vmtMethodStart)^, Pointer(NewVMT+vmtMethodStart)^,
vmtTailSize); vmtTailSize);
// override 'ValidateRename' for TComponent descendants // override 'ValidateRename' for TComponent descendants
if ParentClass.InheritsFrom(TComponent) then begin if AncestorClass.InheritsFrom(TComponent) then begin
Pointer(Pointer(NewVMT+TComponentValidateRenameOffset)^):= Pointer(Pointer(NewVMT+TComponentValidateRenameOffset)^):=
@TComponentWithOverrideValidateRename.ValidateRename; @TComponentWithOverrideValidateRename.ValidateRename;
end; end;
@ -1600,52 +1601,74 @@ var
DestroyDriver: Boolean; DestroyDriver: Boolean;
SubReader: TReader; SubReader: TReader;
BinStream: TExtMemoryStream; BinStream: TExtMemoryStream;
IsBaseClass: boolean; Ancestor: TComponent;
Abort: boolean; Abort: boolean;
Ancestors: TFPList;
AncestorStreams: TFPList;
i: Integer;
{$ENDIF} {$ENDIF}
begin begin
fCurReadChild:=Component; fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass; fCurReadChildClass:=ComponentClass;
{$IFDEF EnableTFrame} {$IFDEF EnableTFrame}
if Assigned(OnFindAncestorBinStream) then begin if Assigned(OnFindAncestors) then begin
BinStream:=nil; Ancestors:=nil;
DestroyDriver:=false; AncestorStreams:=nil;
SubReader:=nil;
try try
Abort:=false; Abort:=false;
OnFindAncestorBinStream(Self, ComponentClass, BinStream, IsBaseClass, Abort); OnFindAncestors(Self,ComponentClass,Ancestors,AncestorStreams,Abort);
if Abort then begin if Abort then begin
DebugLn(['TJITComponentList.ReaderCreateComponent aborted reading ComponentClass=',DbgSName(ComponentClass)]); DebugLn(['TJITComponentList.ReaderCreateComponent aborted reading ComponentClass=',DbgSName(ComponentClass)]);
raise EReadError.Create('TJITComponentList.ReaderCreateComponent aborted reading ComponentClass='+DbgSName(ComponentClass)); raise EReadError.Create('TJITComponentList.ReaderCreateComponent aborted reading ComponentClass='+DbgSName(ComponentClass));
end; end;
if BinStream<>nil then begin if Ancestors<>nil then begin
// read ancestor streams // read ancestor streams
DebugLn(['TJITComponentList.ReaderCreateComponent Has Stream: ',DbgSName(ComponentClass),' IsBaseClass=',IsBaseClass]); Ancestor:=nil;
if Component=nil then begin for i:=Ancestors.Count-1 downto 0 do begin
DebugLn(['TJITComponentList.ReaderCreateComponent creating ',DbgSName(ComponentClass),' Owner=',DbgSName(Reader.Owner),' ...']); BinStream:=TExtMemoryStream(AncestorStreams[i]);
// allocate memory without running the constructor FCurReadStreamClass:=TComponent(Ancestors[i]).ClassType;
Component:=TComponent(ComponentClass.newinstance);
// set csDesigning and csDesignInstance DebugLn(['TJITComponentList.ReaderCreateComponent Has Stream: ',DbgSName(FCurReadStreamClass)]);
// csDesigning is set for all components at designtime // create component
// csDesignInstance is set for Delphi compatibility. It is used by TFrame. if Component=nil then begin
SetComponentDesignMode(Component,true); DebugLn(['TJITComponentList.ReaderCreateComponent creating ',DbgSName(ComponentClass),' Owner=',DbgSName(Reader.Owner),' ...']);
SetComponentDesignInstanceMode(Component,true); // allocate memory without running the constructor
// this is a streamed sub component => set csInline Component:=TComponent(ComponentClass.newinstance);
SetComponentInlineMode(Component,true); // set csDesigning and csDesignInstance
// now run the constructor // csDesigning is set for all components at designtime
Component.Create(Reader.Owner); // csDesignInstance is set for Delphi compatibility. It is used by TFrame.
SetComponentDesignMode(Component,true);
SetComponentDesignInstanceMode(Component,true);
// this is a streamed sub component => set csInline
SetComponentInlineMode(Component,true);
// now run the constructor
Component.Create(Reader.Owner);
end;
// read stream
fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass;
SubReader:=nil;
DestroyDriver:=false;
try
CreateReader(BinStream,SubReader,DestroyDriver);
SubReader.Ancestor:=Ancestor;
SubReader.ReadRootComponent(Component);
finally
if DestroyDriver then SubReader.Driver.Free;
SubReader.Free;
end;
// next
Ancestor:=TComponent(Ancestors[i]);
end; end;
fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass;
DestroyDriver:=false;
CreateReader(BinStream,SubReader,DestroyDriver);
SubReader.ReadRootComponent(Component);
end; end;
finally finally
if DestroyDriver then SubReader.Driver.Free; Ancestors.Free;
SubReader.Free; if AncestorStreams<>nil then
BinStream.Free; for i:=0 to AncestorStreams.Count-1 do
TObject(AncestorStreams[i]).Free;
AncestorStreams.Free;
end; end;
fCurReadChild:=Component; fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass; fCurReadChildClass:=ComponentClass;

69
ide/customformeditor.pp
View File

@ -138,9 +138,10 @@ each control that's dropped onto the form
procedure JITListPropertyNotFound(Sender: TObject; Reader: TReader; procedure JITListPropertyNotFound(Sender: TObject; Reader: TReader;
Instance: TPersistent; var PropName: string; IsPath: boolean; Instance: TPersistent; var PropName: string; IsPath: boolean;
var Handled, Skip: Boolean); var Handled, Skip: Boolean);
procedure JITListFindAncestorBinStream(Sender: TObject; AClass: TClass; procedure JITListFindAncestors(Sender: TObject; AClass: TClass;
var BinStream: TExtMemoryStream; var Ancestors: TFPList;// list of TComponent
var IsBaseClass, Abort: boolean); var BinStreams: TFPList;// list of TExtMemoryStream;
var Abort: boolean);
procedure JITListFindClass(Sender: TObject; procedure JITListFindClass(Sender: TObject;
const ComponentClassName: string; const ComponentClassName: string;
var ComponentClass: TComponentClass); var ComponentClass: TComponentClass);
@ -234,12 +235,14 @@ each control that's dropped onto the form
AncestorType: TComponentClass; AncestorType: TComponentClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Interactive: boolean;
Visible: boolean = true): TIComponentInterface; override; Visible: boolean = true;
Ancestor: TComponent = nil): TIComponentInterface; override;
function CreateRawComponentFromStream(BinStream: TStream; function CreateRawComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; AncestorType: TComponentClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Interactive: boolean;
Visible: boolean = true): TComponent; Visible: boolean = true;
Ancestor: TComponent = nil): TComponent;
function CreateChildComponentFromStream(BinStream: TStream; function CreateChildComponentFromStream(BinStream: TStream;
ComponentClass: TComponentClass; Root: TComponent; ComponentClass: TComponentClass; Root: TComponent;
ParentControl: TWinControl): TIComponentInterface; override; ParentControl: TWinControl): TIComponentInterface; override;
@ -827,7 +830,7 @@ constructor TCustomFormEditor.Create;
begin begin
List.OnReaderError:=@JITListReaderError; List.OnReaderError:=@JITListReaderError;
List.OnPropertyNotFound:=@JITListPropertyNotFound; List.OnPropertyNotFound:=@JITListPropertyNotFound;
List.OnFindAncestorBinStream:=@JITListFindAncestorBinStream; List.OnFindAncestors:=@JITListFindAncestors;
List.OnFindClass:=@JITListFindClass; List.OnFindClass:=@JITListFindClass;
end; end;
@ -1663,19 +1666,22 @@ function TCustomFormEditor.CreateComponentFromStream(
BinStream: TStream; BinStream: TStream;
AncestorType: TComponentClass; AncestorType: TComponentClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Visible: boolean Interactive: boolean; Visible: boolean;
Ancestor: TComponent
): TIComponentInterface; ): TIComponentInterface;
var var
NewComponent: TComponent; NewComponent: TComponent;
begin begin
NewComponent:=CreateRawComponentFromStream(BinStream, NewComponent:=CreateRawComponentFromStream(BinStream,
AncestorType,NewUnitName,Interactive,Visible); AncestorType,NewUnitName,Interactive,Visible,Ancestor);
Result:=CreateComponentInterface(NewComponent,true); Result:=CreateComponentInterface(NewComponent,true);
end; end;
function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream; function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; const NewUnitName: ShortString; AncestorType: TComponentClass;
Interactive: boolean; Visible: boolean const NewUnitName: ShortString;
Interactive: boolean; Visible: boolean;
Ancestor: TComponent
): TComponent; ): TComponent;
var var
NewJITIndex: integer; NewJITIndex: integer;
@ -1687,7 +1693,7 @@ begin
RaiseException('TCustomFormEditor.CreateComponentFromStream ClassName='+ RaiseException('TCustomFormEditor.CreateComponentFromStream ClassName='+
AncestorType.ClassName); AncestorType.ClassName);
NewJITIndex := JITList.AddJITComponentFromStream(BinStream, NewJITIndex := JITList.AddJITComponentFromStream(BinStream,
AncestorType,NewUnitName,Interactive,Visible); Ancestor,AncestorType,NewUnitName,Interactive,Visible);
if NewJITIndex < 0 then begin if NewJITIndex < 0 then begin
Result:=nil; Result:=nil;
exit; exit;
@ -2121,33 +2127,44 @@ begin
'" IsPath=',IsPath]); '" IsPath=',IsPath]);
end; end;
procedure TCustomFormEditor.JITListFindAncestorBinStream(Sender: TObject; procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject;
AClass: TClass; var BinStream: TExtMemoryStream; AClass: TClass;
var IsBaseClass, Abort: boolean); var Ancestors: TFPList;// list of TComponent
var BinStreams: TFPList;// list of TExtMemoryStream;
var Abort: boolean);
var var
AnUnitInfo: TUnitInfo; AnUnitInfo: TUnitInfo;
Ancestor: TComponent;
BinStream: TExtMemoryStream;
begin begin
Ancestors:=nil;
BinStreams:=nil;
if Project1=nil then exit; if Project1=nil then exit;
if (AClass=nil) or (AClass=TComponent) if (AClass=nil) or (AClass=TComponent)
or (AClass=TForm) or (AClass=TCustomForm) or (AClass=TForm) or (AClass=TCustomForm)
or (AClass=TDataModule) or (AClass=TDataModule)
or (not AClass.InheritsFrom(TComponent)) or (not AClass.InheritsFrom(TComponent))
or (IndexOfDesignerBaseClass(TComponentClass(AClass))>=0) then begin or (IndexOfDesignerBaseClass(TComponentClass(AClass))>=0) then begin
IsBaseClass:=true;
exit; exit;
end; end;
//DebugLn(['TCustomFormEditor.JITListFindAncestorBinStream Class=',DbgSName(AClass)]); //DebugLn(['TCustomFormEditor.JITListFindAncestors Class=',DbgSName(AClass)]);
AnUnitInfo:=Project1.FirstUnitWithComponent; AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(AClass));
while AnUnitInfo<>nil do begin while AnUnitInfo<>nil do begin
if (AnUnitInfo.Component<>nil) DebugLn(['TCustomFormEditor.JITListFindAncestors FOUND ancestor ',DbgSName(AnUnitInfo.Component),', streaming ...']);
and (AnUnitInfo.Component.ClassType=AClass) then begin Ancestor:=AnUnitInfo.Component;
//DebugLn(['TCustomFormEditor.JITListFindAncestorBinStream FOUND class, streaming ...']); BinStream:=nil;
if SaveUnitComponentToBinStream(AnUnitInfo,BinStream)<>mrOk then if SaveUnitComponentToBinStream(AnUnitInfo,BinStream)<>mrOk then begin
Abort:=true; Abort:=true;
BinStream.Position:=0;
exit; exit;
end; end;
AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; BinStream.Position:=0;
if Ancestors=nil then begin
Ancestors:=TFPList.Create;
BinStreams:=TFPList.Create;
end;
Ancestors.Add(Ancestor);
BinStreams.Add(BinStream);
AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
end; end;
end; end;
@ -2158,7 +2175,7 @@ var
Component: TComponent; Component: TComponent;
RegComp: TRegisteredComponent; RegComp: TRegisteredComponent;
begin begin
DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]); //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
RegComp:=IDEComponentPalette.FindComponent(ComponentClassName); RegComp:=IDEComponentPalette.FindComponent(ComponentClassName);
if RegComp<>nil then begin if RegComp<>nil then begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]); //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
@ -2177,7 +2194,7 @@ begin
AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
end; end;
end; end;
DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' Class=',DbgSName(ComponentClass)]); DebugLn(['TCustomFormEditor.JITListFindClass Searched=',ComponentClassName,' Found=',DbgSName(ComponentClass)]);
end; end;
function TCustomFormEditor.GetDesignerBaseClasses(Index: integer function TCustomFormEditor.GetDesignerBaseClasses(Index: integer

7
ide/main.pp
View File

@ -5372,6 +5372,7 @@ var
NestedClassName: string; NestedClassName: string;
NestedClass: TComponentClass; NestedClass: TComponentClass;
NestedUnitInfo: TUnitInfo; NestedUnitInfo: TUnitInfo;
Ancestor: TComponent;
begin begin
debugln('TMainIDE.DoLoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' '); debugln('TMainIDE.DoLoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
@ -5435,6 +5436,10 @@ begin
DebugLn(['TMainIDE.DoLoadLFM DoLoadAncestorDependencyHidden failed for ',AnUnitInfo.Filename]); DebugLn(['TMainIDE.DoLoadLFM DoLoadAncestorDependencyHidden failed for ',AnUnitInfo.Filename]);
exit; exit;
end; end;
Ancestor:=nil;
if AncestorUnitInfo<>nil then
Ancestor:=AncestorUnitInfo.Component;
if MissingClasses<>nil then begin if MissingClasses<>nil then begin
for i:=MissingClasses.Count-1 downto 0 do begin for i:=MissingClasses.Count-1 downto 0 do begin
{$IFNDEF EnableTFrame} {$IFNDEF EnableTFrame}
@ -5498,7 +5503,7 @@ begin
NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename); NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename);
// ToDo: create AncestorBinStream(s) via hook, not via parameters // ToDo: create AncestorBinStream(s) via hook, not via parameters
NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream, NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream,
AncestorType,copy(NewUnitName,1,255),true); AncestorType,copy(NewUnitName,1,255),true,true,Ancestor);
Project1.InvalidateUnitComponentDesignerDependencies; Project1.InvalidateUnitComponentDesignerDependencies;
AnUnitInfo.Component:=NewComponent; AnUnitInfo.Component:=NewComponent;
if (AncestorUnitInfo<>nil) then if (AncestorUnitInfo<>nil) then

3
ideintf/formeditingintf.pas
View File

@ -111,7 +111,8 @@ type
AncestorType: TComponentClass; AncestorType: TComponentClass;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Interactive: boolean;
Visible: boolean = true): TIComponentInterface; virtual; abstract; Visible: boolean = true;
Ancestor: TComponent = nil): TIComponentInterface; virtual; abstract;
function CreateChildComponentFromStream(BinStream: TStream; function CreateChildComponentFromStream(BinStream: TStream;
ComponentClass: TComponentClass; ComponentClass: TComponentClass;
Root: TComponent; Root: TComponent;