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

IDE: improved ancestor laoding, LCL: fixed TWinControl.InsertControl overhead calling wrong UpdateControlState

Browse Source 
git-svn-id: trunk@10005 -
This commit is contained in:
mattias 2006-09-29 17:03:51 +00:00
parent ab3ba51719
commit 0c307f6bf0
8 changed files with 360 additions and 237 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
designer/jitforms.pp
View File

@ -130,7 +130,8 @@ type
procedure InitReading(BinStream: TStream; var Reader: TReader; procedure InitReading(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):integer; NewUnitName: shortstring; ParentClass: TClass;
Visible: boolean):integer;
procedure DoFinishReading; virtual; procedure DoFinishReading; virtual;
public public
constructor Create; constructor Create;
@ -139,7 +140,8 @@ type
function Count: integer; function Count: integer;
function AddNewJITComponent(const NewUnitName: shortstring; function AddNewJITComponent(const NewUnitName: shortstring;
ParentClass: TClass): integer; ParentClass: TClass): integer;
function AddJITComponentFromStream(BinStream: TStream; ParentClass: TClass; function AddJITComponentFromStream(BinStream: TStream;
ParentClass: TClass; ParentBinStream: TStream;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive, Visible: Boolean):integer; Interactive, Visible: Boolean):integer;
procedure DestroyJITComponent(JITComponent: TComponent); procedure DestroyJITComponent(JITComponent: TComponent);
@ -646,19 +648,48 @@ begin
' NewUnitName=',NewUnitName,' ParentClass=',ParentClass.ClassName); ' NewUnitName=',NewUnitName,' ParentClass=',ParentClass.ClassName);
{$ENDIF} {$ENDIF}
Result:=DoCreateJITComponent(NewComponentName,NewClassName,NewUnitName, Result:=DoCreateJITComponent(NewComponentName,NewClassName,NewUnitName,
ParentClass); ParentClass,true);
end; end;
function TJITComponentList.AddJITComponentFromStream(BinStream: TStream; function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
ParentClass: TClass; const NewUnitName: ShortString; ParentClass: TClass; ParentBinStream: TStream;
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);
var var
Reader:TReader; Reader:TReader;
DestroyDriver: Boolean;
begin
{$IFDEF VerboseJITForms}
debugln('[TJITComponentList.AddJITComponentFromStream] InitReading ...');
{$ENDIF}
DestroyDriver:=false;
InitReading(AStream,Reader,DestroyDriver);
{$IFDEF VerboseJITForms}
debugln('[TJITComponentList.AddJITComponentFromStream] Read ...');
{$ENDIF}
try
Reader.ReadRootComponent(FCurReadJITComponent);
{$IFDEF VerboseJITForms}
debugln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...');
{$ENDIF}
DoFinishReading;
finally
UnregisterFindGlobalComponentProc(@MyFindGlobalComponent);
Application.FindGlobalComponentEnabled:=true;
if DestroyDriver then Reader.Driver.Free;
Reader.Free;
end;
end;
var
NewClassName: shortstring; NewClassName: shortstring;
NewName: string; NewName: string;
DestroyDriver, IsInherited: Boolean; IsInherited: Boolean;
begin begin
Result:=-1; Result:=-1;
NewClassName:=GetClassNameFromLRSStream(BinStream, IsInherited); NewClassName:=GetClassNameFromLRSStream(BinStream, IsInherited);
@ -667,41 +698,23 @@ begin
MessageDlg('No classname in stream found.',mtError,[mbOK],0); MessageDlg('No classname in stream found.',mtError,[mbOK],0);
exit; exit;
end; end;
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITComponentFromStream] Create ...'); debugln('[TJITComponentList.AddJITComponentFromStream] Create ...');
{$ENDIF} {$ENDIF}
try try
Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass); Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass,Visible);
if Result<0 then exit; if Result<0 then exit;
if ParentBinStream<>nil then
ReadStream(ParentBinStream);
ReadStream(BinStream);
{$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITComponentFromStream] InitReading ...');
{$ENDIF}
DestroyDriver:=false;
InitReading(BinStream,Reader,DestroyDriver);
{$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITComponentFromStream] Read ...');
{$ENDIF}
try
Reader.ReadRootComponent(FCurReadJITComponent);
if FCurReadJITComponent.Name='' then begin if FCurReadJITComponent.Name='' then begin
NewName:=FCurReadJITComponent.ClassName; NewName:=FCurReadJITComponent.ClassName;
if NewName[1] in ['T','t'] then if NewName[1] in ['T','t'] then
System.Delete(NewName,1,1); System.Delete(NewName,1,1);
FCurReadJITComponent.Name:=NewName; FCurReadJITComponent.Name:=NewName;
end; end;
{$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...');
{$ENDIF}
DoFinishReading;
finally
UnregisterFindGlobalComponentProc(@MyFindGlobalComponent);
Application.FindGlobalComponentEnabled:=true;
if DestroyDriver then Reader.Driver.Free;
Reader.Free;
end;
except except
on E: Exception do begin on E: Exception do begin
DebugLn('[TJITComponentList.AddJITChildComponentFromStream] ERROR reading form stream' DebugLn('[TJITComponentList.AddJITChildComponentFromStream] ERROR reading form stream'
@ -714,6 +727,7 @@ begin
end; end;
end; end;
end; end;
FCurReadJITComponent:=nil;
end; end;
function TJITComponentList.OnFindGlobalComponent( function TJITComponentList.OnFindGlobalComponent(
@ -734,12 +748,12 @@ begin
Application.FindGlobalComponentEnabled:=false; Application.FindGlobalComponentEnabled:=false;
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.InitReading] A'); debugln('[TJITComponentList.InitReading] A');
{$ENDIF} {$ENDIF}
// connect TReader events // connect TReader events
Reader.OnError:=@ReaderError; Reader.OnError:=@ReaderError;
Reader.OnFindMethod:=@ReaderFindMethod;
Reader.OnPropertyNotFound:=@ReaderPropertyNotFound; Reader.OnPropertyNotFound:=@ReaderPropertyNotFound;
Reader.OnFindMethod:=@ReaderFindMethod;
Reader.OnSetMethodProperty:=@ReaderSetMethodProperty; Reader.OnSetMethodProperty:=@ReaderSetMethodProperty;
Reader.OnSetName:=@ReaderSetName; Reader.OnSetName:=@ReaderSetName;
Reader.OnReferenceName:=@ReaderReferenceName; Reader.OnReferenceName:=@ReaderReferenceName;
@ -748,7 +762,7 @@ begin
Reader.OnFindComponentClass:=@ReaderFindComponentClass; Reader.OnFindComponentClass:=@ReaderFindComponentClass;
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.InitReading] B'); debugln('[TJITComponentList.InitReading] B');
{$ENDIF} {$ENDIF}
FCurReadChildClass:=nil; FCurReadChildClass:=nil;
@ -758,7 +772,7 @@ end;
function TJITComponentList.DoCreateJITComponent( function TJITComponentList.DoCreateJITComponent(
const NewComponentName, NewClassName, NewUnitName: shortstring; const NewComponentName, NewClassName, NewUnitName: shortstring;
ParentClass: TClass):integer; ParentClass: TClass; Visible: boolean):integer;
var var
Instance:TComponent; Instance:TComponent;
ok: boolean; ok: boolean;
@ -777,6 +791,9 @@ begin
try try
// set into design mode // set into design mode
SetComponentDesignMode(Instance,true); SetComponentDesignMode(Instance,true);
if (not Visible) and (Instance is TControl) then
TControl(Instance).ControlStyle:=
TControl(Instance).ControlStyle+[csNoDesignVisible];
// finish 'create' component // finish 'create' component
Instance.Create(nil); Instance.Create(nil);
if NewComponentName<>'' then if NewComponentName<>'' then
@ -823,7 +840,7 @@ procedure TJITComponentList.RemoveMethod(JITComponent:TComponent;
var OldCode:Pointer; var OldCode:Pointer;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('TJITComponentList.RemoveMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName); debugln('TJITComponentList.RemoveMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
{$ENDIF} {$ENDIF}
if JITComponent=nil then if JITComponent=nil then
raise Exception.Create('TJITComponentList.RemoveMethod JITComponent=nil'); raise Exception.Create('TJITComponentList.RemoveMethod JITComponent=nil');
@ -841,7 +858,7 @@ procedure TJITComponentList.RenameMethod(JITComponent:TComponent;
const OldName,NewName:ShortString); const OldName,NewName:ShortString);
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('TJITComponentList.RenameMethod ',JITComponent.Name,':',JITComponent.Name,' Old=',OldName,' NewName=',NewName); debugln('TJITComponentList.RenameMethod ',JITComponent.Name,':',JITComponent.Name,' Old=',OldName,' NewName=',NewName);
{$ENDIF} {$ENDIF}
if JITComponent=nil then if JITComponent=nil then
raise Exception.Create('TJITComponentList.RenameMethod JITComponent=nil'); raise Exception.Create('TJITComponentList.RenameMethod JITComponent=nil');
@ -857,7 +874,7 @@ procedure TJITComponentList.RenameComponentClass(JITComponent:TComponent;
const NewName:ShortString); const NewName:ShortString);
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('TJITComponentList.RenameComponentClass ',JITComponent.Name,':',JITComponent.Name,' New=',NewName); debugln('TJITComponentList.RenameComponentClass ',JITComponent.Name,':',JITComponent.Name,' New=',NewName);
{$ENDIF} {$ENDIF}
if JITComponent=nil then if JITComponent=nil then
raise Exception.Create('TJITComponentList.RenameComponentClass JITComponent=nil'); raise Exception.Create('TJITComponentList.RenameComponentClass JITComponent=nil');
@ -873,7 +890,7 @@ procedure TJITComponentList.RenameComponentUnitname(JITComponent: TComponent;
const NewUnitName: ShortString); const NewUnitName: ShortString);
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('TJITComponentList.RenameComponentUnitname ',JITComponent.Name,':',JITComponent.Name,' New=',NewUnitName); debugln('TJITComponentList.RenameComponentUnitname ',JITComponent.Name,':',JITComponent.Name,' New=',NewUnitName);
{$ENDIF} {$ENDIF}
if JITComponent=nil then if JITComponent=nil then
raise Exception.Create('TJITComponentList.RenameComponentUnitname JITComponent=nil'); raise Exception.Create('TJITComponentList.RenameComponentUnitname JITComponent=nil');
@ -898,13 +915,13 @@ begin
if IndexOf(JITOwnerComponent)<0 then if IndexOf(JITOwnerComponent)<0 then
RaiseException('TJITComponentList.AddJITChildComponentFromStream'); RaiseException('TJITComponentList.AddJITChildComponentFromStream');
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITChildComponentFromStream] A'); debugln('[TJITComponentList.AddJITChildComponentFromStream] A');
{$ENDIF} {$ENDIF}
try try
DestroyDriver:=false; DestroyDriver:=false;
InitReading(BinStream,Reader,DestroyDriver); InitReading(BinStream,Reader,DestroyDriver);
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITChildComponentFromStream] B'); debugln('[TJITComponentList.AddJITChildComponentFromStream] B');
{$ENDIF} {$ENDIF}
try try
FCurReadJITComponent:=JITOwnerComponent; FCurReadJITComponent:=JITOwnerComponent;
@ -912,7 +929,7 @@ begin
FFlags:=FFlags+[jclAutoRenameComponents]; FFlags:=FFlags+[jclAutoRenameComponents];
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITChildComponentFromStream] C1 ',ComponentClass.ClassName); debugln('[TJITComponentList.AddJITChildComponentFromStream] C1 ',ComponentClass.ClassName);
{$ENDIF} {$ENDIF}
Reader.Root := FCurReadJITComponent; Reader.Root := FCurReadJITComponent;
Reader.Owner := FCurReadJITComponent; Reader.Owner := FCurReadJITComponent;
@ -928,7 +945,7 @@ begin
DebugLn('[TJITComponentList.AddJITChildComponentFromStream] C6 '); DebugLn('[TJITComponentList.AddJITChildComponentFromStream] C6 ');
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.AddJITChildComponentFromStream] D'); debugln('[TJITComponentList.AddJITChildComponentFromStream] D');
{$ENDIF} {$ENDIF}
DoFinishReading; DoFinishReading;
finally finally
@ -953,7 +970,7 @@ var CodeTemplate,NewCode:Pointer;
OldCode: Pointer; OldCode: Pointer;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName); debugln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
{$ENDIF} {$ENDIF}
if JITComponent=nil then if JITComponent=nil then
raise Exception.Create('TJITComponentList.CreateNewMethod JITComponent=nil'); raise Exception.Create('TJITComponentList.CreateNewMethod JITComponent=nil');
@ -1131,7 +1148,7 @@ procedure TJITComponentList.DoAddNewMethod(JITClass:TClass;
var OldMethodTable, NewMethodTable: PMethodNameTable; var OldMethodTable, NewMethodTable: PMethodNameTable;
NewMethodTableSize:integer; NewMethodTableSize:integer;
begin begin
//writeln('[TJITComponentList.AddNewMethod] '''+JITClass.ClassName+'.'+AName+''''); //debugln('[TJITComponentList.AddNewMethod] '''+JITClass.ClassName+'.'+AName+'''');
OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^); OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^);
if Assigned(OldMethodTable) then begin if Assigned(OldMethodTable) then begin
NewMethodTableSize:=SizeOf(DWord)+ NewMethodTableSize:=SizeOf(DWord)+
@ -1149,7 +1166,7 @@ begin
end; end;
{$R-} {$R-}
//for a:=0 to NewMethodTable^.Count-2 do //for a:=0 to NewMethodTable^.Count-2 do
// writeln(a,'=',NewMethodTable^.Entries[a].Name^,' $' // debugln(a,'=',NewMethodTable^.Entries[a].Name^,' $'
// ,DbgS(PtrInt(NewMethodTable^.Entries[a].Name),8)); // ,DbgS(PtrInt(NewMethodTable^.Entries[a].Name),8));
with NewMethodTable^.Entries[NewMethodTable^.Count-1] do begin with NewMethodTable^.Entries[NewMethodTable^.Count-1] do begin
GetMem(Name,256); GetMem(Name,256);
@ -1157,7 +1174,7 @@ begin
Addr:=ACode; Addr:=ACode;
end; end;
//for a:=0 to NewMethodTable^.Count-1 do //for a:=0 to NewMethodTable^.Count-1 do
// writeln(a,'=',NewMethodTable^.Entries[a].Name^,' $' // debugln(a,'=',NewMethodTable^.Entries[a].Name^,' $'
// ,DbgS(PtrInt(NewMethodTable^.Entries[a].Name),8)); // ,DbgS(PtrInt(NewMethodTable^.Entries[a].Name),8));
{$IFDEF RangeCheckOn}{$R+}{$ENDIF} {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^):=NewMethodTable; PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^):=NewMethodTable;
@ -1173,7 +1190,7 @@ var OldMethodTable, NewMethodTable: PMethodNameTable;
a:cardinal; a:cardinal;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.DoRemoveMethod] '''+JITClass.ClassName+'.'+AName+''''); debugln('[TJITComponentList.DoRemoveMethod] '''+JITClass.ClassName+'.'+AName+'''');
{$ENDIF} {$ENDIF}
AName:=uppercase(AName); AName:=uppercase(AName);
OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^); OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^);
@ -1213,7 +1230,7 @@ var MethodTable: PMethodNameTable;
a:integer; a:integer;
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.DoRenameMethod] ClassName='''+JITClass.ClassName+'''' debugln('[TJITComponentList.DoRenameMethod] ClassName='''+JITClass.ClassName+''''
+' OldName='''+OldName+''' NewName='''+OldName+''''); +' OldName='''+OldName+''' NewName='''+OldName+'''');
{$ENDIF} {$ENDIF}
OldName:=uppercase(OldName); OldName:=uppercase(OldName);
@ -1230,7 +1247,7 @@ procedure TJITComponentList.DoRenameClass(JITClass:TClass;
const NewName:ShortString); const NewName:ShortString);
begin begin
{$IFDEF VerboseJITForms} {$IFDEF VerboseJITForms}
writeln('[TJITComponentList.DoRenameClass] OldName='''+JITClass.ClassName debugln('[TJITComponentList.DoRenameClass] OldName='''+JITClass.ClassName
+''' NewName='''+NewName+''' '); +''' NewName='''+NewName+''' ');
{$ENDIF} {$ENDIF}
PShortString((Pointer(JITClass)+vmtClassName)^)^:=NewName; PShortString((Pointer(JITClass)+vmtClassName)^)^:=NewName;
@ -1271,7 +1288,7 @@ procedure TJITComponentList.ReaderFindMethod(Reader: TReader;
var NewMethod: TMethod; var NewMethod: TMethod;
begin begin
{$IFDEF IDE_DEBUG} {$IFDEF IDE_DEBUG}
writeln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address)); debugln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
{$ENDIF} {$ENDIF}
if Address=nil then begin if Address=nil then begin
// there is no method in the ancestor class with this name // there is no method in the ancestor class with this name
@ -1295,22 +1312,23 @@ procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string; Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
var Handled: boolean); var Handled: boolean);
begin begin
//writeln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName); //debugln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
end; end;
procedure TJITComponentList.ReaderSetName(Reader: TReader; procedure TJITComponentList.ReaderSetName(Reader: TReader;
Component: TComponent; var NewName: Ansistring); Component: TComponent; var NewName: Ansistring);
begin begin
// writeln('[TJITComponentList.ReaderSetName] OldName="'+Component.Name+'" NewName="'+NewName+'"'); // debugln('[TJITComponentList.ReaderSetName] OldName="'+Component.Name+'" NewName="'+NewName+'"');
if jclAutoRenameComponents in FFlags then begin if jclAutoRenameComponents in FFlags then begin
while FCurReadJITComponent.FindComponent(NewName)<>nil do while FCurReadJITComponent.FindComponent(NewName)<>nil do
NewName:=CreateNextIdentifier(NewName); NewName:=CreateNextIdentifier(NewName);
end; end;
end; end;
procedure TJITComponentList.ReaderReferenceName(Reader: TReader; var RefName: Ansistring); procedure TJITComponentList.ReaderReferenceName(Reader: TReader;
var RefName: Ansistring);
begin begin
// writeln('[TJITComponentList.ReaderReferenceName] Name='''+RefName+''''); // debugln('[TJITComponentList.ReaderReferenceName] Name='''+RefName+'''');
end; end;
procedure TJITComponentList.ReaderAncestorNotFound(Reader: TReader; procedure TJITComponentList.ReaderAncestorNotFound(Reader: TReader;
@ -1318,8 +1336,8 @@ procedure TJITComponentList.ReaderAncestorNotFound(Reader: TReader;
var Component: TComponent); var Component: TComponent);
begin begin
// ToDo: this is for custom form templates // ToDo: this is for custom form templates
// writeln('[TJITComponentList.ReaderAncestorNotFound] ComponentName='''+ComponentName debugln('[TJITComponentList.ReaderAncestorNotFound] ComponentName='''+ComponentName
// +''' Component='''+Component.Name+''''); +''' Component='''+Component.Name+'''');
end; end;
procedure TJITComponentList.ReaderError(Reader: TReader; procedure TJITComponentList.ReaderError(Reader: TReader;
@ -1367,7 +1385,7 @@ begin
if ComponentClass=nil then begin if ComponentClass=nil then begin
RegComp:=IDEComponentPalette.FindComponent(FindClassName); RegComp:=IDEComponentPalette.FindComponent(FindClassName);
if RegComp<>nil then begin if RegComp<>nil then begin
//writeln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName //debugln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
// +''' is registered'); // +''' is registered');
ComponentClass:=RegComp.ComponentClass; ComponentClass:=RegComp.ComponentClass;
end else begin end else begin
@ -1384,7 +1402,7 @@ procedure TJITComponentList.ReaderCreateComponent(Reader: TReader;
begin begin
fCurReadChild:=Component; fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass; fCurReadChildClass:=ComponentClass;
// writeln('[TJITComponentList.ReaderCreateComponent] Class='''+ComponentClass.ClassName+''''); // debugln('[TJITComponentList.ReaderCreateComponent] Class='''+ComponentClass.ClassName+'''');
end; end;
procedure TJITComponentList.ReaderReadComponent(Component: TComponent); procedure TJITComponentList.ReaderReadComponent(Component: TComponent);

74
ide/customformeditor.pp
View File

@ -109,8 +109,6 @@ each control that's dropped onto the form
{ TCustomFormEditor } { TCustomFormEditor }
TControlClass = class of TControl;
TCustomFormEditor = class(TAbstractFormEditor) TCustomFormEditor = class(TAbstractFormEditor)
private private
FComponentInterfaces: TAVLTree; // tree of TComponentInterface sorted for FComponentInterfaces: TAVLTree; // tree of TComponentInterface sorted for
@ -143,11 +141,11 @@ each control that's dropped onto the form
destructor Destroy; override; destructor Destroy; override;
// selection // selection
Function AddSelected(Value: TComponent) : Integer; function AddSelected(Value: TComponent) : Integer;
Procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean); procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
Function FindComponentByName(const Name: ShortString function FindComponentByName(const Name: ShortString
): TIComponentInterface; override; ): TIComponentInterface; override;
Function FindComponent(AComponent: TComponent): TIComponentInterface; override; function FindComponent(AComponent: TComponent): TIComponentInterface; override;
function SaveSelectionToStream(s: TStream): Boolean; override; function SaveSelectionToStream(s: TStream): Boolean; override;
function InsertFromStream(s: TStream; Parent: TWinControl; function InsertFromStream(s: TStream; Parent: TWinControl;
Flags: TComponentPasteSelectionFlags): Boolean; override; Flags: TComponentPasteSelectionFlags): Boolean; override;
@ -193,7 +191,8 @@ each control that's dropped onto the form
function CreateUniqueComponentName(AComponent: TComponent): string; function CreateUniqueComponentName(AComponent: TComponent): string;
function CreateUniqueComponentName(const AClassName: string; function CreateUniqueComponentName(const AClassName: string;
OwnerComponent: TComponent): string; OwnerComponent: TComponent): string;
function CreateComponentInterface(AComponent: TComponent): TIComponentInterface; function CreateComponentInterface(AComponent: TComponent;
WithChilds: Boolean): TIComponentInterface;
procedure CreateChildComponentInterfaces(AComponent: TComponent); procedure CreateChildComponentInterfaces(AComponent: TComponent);
function GetDefaultComponentParent(TypeClass: TComponentClass function GetDefaultComponentParent(TypeClass: TComponentClass
): TIComponentInterface; override; ): TIComponentInterface; override;
@ -205,10 +204,15 @@ each control that's dropped onto the form
const AUnitName: shortstring; const AUnitName: shortstring;
X,Y,W,H: Integer): TIComponentInterface; override; X,Y,W,H: Integer): TIComponentInterface; override;
function CreateComponentFromStream(BinStream: TStream; function CreateComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; AncestorType: TComponentClass; AncestorBinStream: TStream;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Interactive: boolean;
Visible: boolean = true): TIComponentInterface; override; Visible: boolean = true): TIComponentInterface; override;
function CreateRawComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; AncestorBinStream: TStream;
const NewUnitName: ShortString;
Interactive: boolean;
Visible: boolean = true): 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;
@ -285,6 +289,7 @@ function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
Item: TDefinePropertiesCacheItem): integer; Item: TDefinePropertiesCacheItem): integer;
procedure RegisterStandardClasses; procedure RegisterStandardClasses;
implementation implementation
@ -930,7 +935,7 @@ begin
except except
on E: Exception do begin on E: Exception do begin
MessageDlg('Error', MessageDlg('Error',
'Unable to clear form editing selection'#13 'Unable to clear the form editing selection'#13
+E.Message,mtError,[mbCancel],0); +E.Message,mtError,[mbCancel],0);
end; end;
end; end;
@ -1427,12 +1432,25 @@ Begin
end; end;
Function TCustomFormEditor.CreateComponentFromStream( Function TCustomFormEditor.CreateComponentFromStream(
BinStream: TStream; AncestorType: TComponentClass; BinStream: TStream;
const NewUnitName: ShortString; Interactive: boolean; AncestorType: TComponentClass; AncestorBinStream: TStream;
Visible: boolean): TIComponentInterface; const NewUnitName: ShortString;
Interactive: boolean; Visible: boolean
): TIComponentInterface;
var
NewComponent: TComponent;
begin
NewComponent:=CreateRawComponentFromStream(BinStream,
AncestorType,AncestorBinStream,NewUnitName,Interactive,Visible);
Result:=CreateComponentInterface(NewComponent,true);
end;
function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; AncestorBinStream: TStream;
const NewUnitName: ShortString; Interactive: boolean; Visible: boolean
): TComponent;
var var
NewJITIndex: integer; NewJITIndex: integer;
NewComponent: TComponent;
JITList: TJITComponentList; JITList: TJITComponentList;
begin begin
// create JIT Component // create JIT Component
@ -1440,18 +1458,14 @@ begin
if JITList=nil then if JITList=nil then
RaiseException('TCustomFormEditor.CreateComponentFromStream ClassName='+ RaiseException('TCustomFormEditor.CreateComponentFromStream ClassName='+
AncestorType.ClassName); AncestorType.ClassName);
NewJITIndex := JITList.AddJITComponentFromStream(BinStream,AncestorType, NewJITIndex := JITList.AddJITComponentFromStream(BinStream,
AncestorType,AncestorBinStream,
NewUnitName,Interactive,Visible); NewUnitName,Interactive,Visible);
if NewJITIndex < 0 then begin if NewJITIndex < 0 then begin
Result:=nil; Result:=nil;
exit; exit;
end; end;
NewComponent:=JITList[NewJITIndex]; Result:=JITList[NewJITIndex];
// create a component interface
Result:=CreateComponentInterface(NewComponent);
CreateChildComponentInterfaces(NewComponent);
end; end;
function TCustomFormEditor.CreateChildComponentFromStream(BinStream: TStream; function TCustomFormEditor.CreateChildComponentFromStream(BinStream: TStream;
@ -1460,7 +1474,6 @@ function TCustomFormEditor.CreateChildComponentFromStream(BinStream: TStream;
var var
NewComponent: TComponent; NewComponent: TComponent;
JITList: TJITComponentList; JITList: TJITComponentList;
i: Integer;
begin begin
Result:=nil; Result:=nil;
@ -1472,13 +1485,8 @@ begin
NewComponent:=JITList.AddJITChildComponentFromStream( NewComponent:=JITList.AddJITChildComponentFromStream(
Root,BinStream,ComponentClass,ParentControl); Root,BinStream,ComponentClass,ParentControl);
// create a component interface for the new child component // create component interface(s) for the new child component(s)
Result:=CreateComponentInterface(NewComponent); Result:=CreateComponentInterface(NewComponent,true);
// create a component interface for each new child component
for i:=0 to Root.ComponentCount-1 do
if FindComponent(Root.Components[i])=nil then
CreateComponentInterface(Root.Components[i]);
end; end;
Procedure TCustomFormEditor.SetComponentNameAndClass(CI: TIComponentInterface; Procedure TCustomFormEditor.SetComponentNameAndClass(CI: TIComponentInterface;
@ -1832,12 +1840,16 @@ begin
end; end;
Function TCustomFormEditor.CreateComponentInterface( Function TCustomFormEditor.CreateComponentInterface(
AComponent: TComponent): TIComponentInterface; AComponent: TComponent; WithChilds: Boolean): TIComponentInterface;
Begin Begin
if FindComponent(AComponent)<>nil then exit; Result:=FindComponent(AComponent);
if Result=nil then begin
Result := TComponentInterface.Create(AComponent); Result := TComponentInterface.Create(AComponent);
FComponentInterfaces.Add(Result); FComponentInterfaces.Add(Result);
end; end;
if WithChilds then
CreateChildComponentInterfaces(AComponent);
end;
procedure TCustomFormEditor.CreateChildComponentInterfaces( procedure TCustomFormEditor.CreateChildComponentInterfaces(
AComponent: TComponent); AComponent: TComponent);
@ -1846,7 +1858,7 @@ var
begin begin
// create a component interface for each component owned by the new component // create a component interface for each component owned by the new component
for i:=0 to AComponent.ComponentCount-1 do for i:=0 to AComponent.ComponentCount-1 do
CreateComponentInterface(AComponent.Components[i]); CreateComponentInterface(AComponent.Components[i],false);
end; end;
function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass

196
ide/main.pp
View File

@ -552,13 +552,12 @@ type
AncestorType: TPersistentClass; ResourceCode: TCodeBuffer): TModalResult; AncestorType: TPersistentClass; ResourceCode: TCodeBuffer): TModalResult;
// methods for 'save unit' // methods for 'save unit'
function DoLoadResourceFile(AnUnitInfo: TUnitInfo;
var LFMCode, ResourceCode: TCodeBuffer;
IgnoreSourceErrors: boolean): TModalResult;
function DoShowSaveFileAsDialog(AnUnitInfo: TUnitInfo; function DoShowSaveFileAsDialog(AnUnitInfo: TUnitInfo;
var ResourceCode: TCodeBuffer): TModalResult; var ResourceCode: TCodeBuffer): TModalResult;
function DoSaveFileResources(AnUnitInfo: TUnitInfo; function DoSaveFileResources(AnUnitInfo: TUnitInfo;
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult; ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
function DoSaveFileResourceToBinStream(AnUnitInfo: TUnitInfo;
var BinCompStream: TExtMemoryStream): TModalResult;
function DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo; function DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo;
OkOnCodeErrors: boolean): TModalResult; OkOnCodeErrors: boolean): TModalResult;
function DoRenameUnit(AnUnitInfo: TUnitInfo; function DoRenameUnit(AnUnitInfo: TUnitInfo;
@ -573,6 +572,9 @@ type
procedure DoRestoreBookMarks(AnUnitInfo: TUnitInfo; ASrcEdit:TSourceEditor); procedure DoRestoreBookMarks(AnUnitInfo: TUnitInfo; ASrcEdit:TSourceEditor);
function DoOpenFileInSourceEditor(AnUnitInfo: TUnitInfo; function DoOpenFileInSourceEditor(AnUnitInfo: TUnitInfo;
PageIndex: integer; Flags: TOpenFlags): TModalResult; PageIndex: integer; Flags: TOpenFlags): TModalResult;
function DoLoadResourceFile(AnUnitInfo: TUnitInfo;
var LFMCode, ResourceCode: TCodeBuffer;
IgnoreSourceErrors: boolean): TModalResult;
function DoLoadLFM(AnUnitInfo: TUnitInfo; Flags: TOpenFlags): TModalResult; function DoLoadLFM(AnUnitInfo: TUnitInfo; Flags: TOpenFlags): TModalResult;
function DoLoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer; function DoLoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer;
Flags: TOpenFlags; CloseDsgnForm: boolean): TModalResult; Flags: TOpenFlags; CloseDsgnForm: boolean): TModalResult;
@ -852,16 +854,19 @@ const
CodeToolsIncludeLinkFile = 'includelinks.xml'; CodeToolsIncludeLinkFile = 'includelinks.xml';
var var
ShowSplashScreen: boolean; ShowSplashScreen: boolean = false;
implementation implementation
uses uses
Math; Math;
const
LRSStreamChunkSize = 4096; // allocating mem in 4k chunks helps many mem managers
var var
SkipAutoLoadingLastProject: boolean; SkipAutoLoadingLastProject: boolean = false;
StartedByStartLazarus: boolean; StartedByStartLazarus: boolean = false;
//============================================================================== //==============================================================================
@ -4021,8 +4026,6 @@ end;
function TMainIDE.DoSaveFileResources(AnUnitInfo: TUnitInfo; function TMainIDE.DoSaveFileResources(AnUnitInfo: TUnitInfo;
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult; ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
const
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
var var
ComponentSavingOk: boolean; ComponentSavingOk: boolean;
MemStream, BinCompStream, TxtCompStream: TExtMemoryStream; MemStream, BinCompStream, TxtCompStream: TExtMemoryStream;
@ -4062,7 +4065,8 @@ begin
// stream component to binary stream // stream component to binary stream
BinCompStream:=TExtMemoryStream.Create; BinCompStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastBinStreamSize>0 then if AnUnitInfo.ComponentLastBinStreamSize>0 then
BinCompStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize; BinCompStream.Capacity:=
AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize;
Writer:=nil; Writer:=nil;
DestroyDriver:=false; DestroyDriver:=false;
try try
@ -4081,11 +4085,11 @@ begin
{$ENDIF} {$ENDIF}
Writer.WriteDescendent(AnUnitInfo.Component,nil); Writer.WriteDescendent(AnUnitInfo.Component,nil);
if DestroyDriver then Writer.Driver.Free; if DestroyDriver then Writer.Driver.Free;
Writer.Free; FreeAndNil(Writer);
Writer:=nil;
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size; AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
except except
on E: Exception do begin on E: Exception do begin
DumpExceptionBackTrace;
ACaption:=lisStreamingError; ACaption:=lisStreamingError;
AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName, AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
AnUnitInfo.ComponentName])+#13 AnUnitInfo.ComponentName])+#13
@ -4115,7 +4119,7 @@ begin
// changed too // changed too
MemStream:=TExtMemoryStream.Create; MemStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastLRSStreamSize>0 then if AnUnitInfo.ComponentLastLRSStreamSize>0 then
MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+BufSize; MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+LRSStreamChunkSize;
try try
BinCompStream.Position:=0; BinCompStream.Position:=0;
BinaryToLazarusResourceCode(BinCompStream,MemStream BinaryToLazarusResourceCode(BinCompStream,MemStream
@ -4195,7 +4199,7 @@ begin
TxtCompStream:=TExtMemoryStream.Create; TxtCompStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastLFMStreamSize>0 then if AnUnitInfo.ComponentLastLFMStreamSize>0 then
TxtCompStream.Capacity:=AnUnitInfo.ComponentLastLFMStreamSize TxtCompStream.Capacity:=AnUnitInfo.ComponentLastLFMStreamSize
+BufSize; +LRSStreamChunkSize;
try try
BinCompStream.Position:=0; BinCompStream.Position:=0;
LRSObjectBinaryToText(BinCompStream,TxtCompStream); LRSObjectBinaryToText(BinCompStream,TxtCompStream);
@ -4287,6 +4291,56 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function TMainIDE.DoSaveFileResourceToBinStream(AnUnitInfo: TUnitInfo;
var BinCompStream: TExtMemoryStream): TModalResult;
var
Writer: TWriter;
DestroyDriver: Boolean;
begin
// save designer form properties to the component
FormEditor1.SaveHiddenDesignerFormProperties(AnUnitInfo.Component);
// stream component to binary stream
if BinCompStream=nil then
BinCompStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastBinStreamSize>0 then
BinCompStream.Capacity:=Max(BinCompStream.Capacity,BinCompStream.Position+
AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize);
Writer:=nil;
DestroyDriver:=false;
try
Result:=mrOk;
try
BinCompStream.Position:=0;
Writer:=CreateLRSWriter(BinCompStream,DestroyDriver);
Writer.WriteDescendent(AnUnitInfo.Component,nil);
if DestroyDriver then Writer.Driver.Free;
FreeAndNil(Writer);
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
except
on E: Exception do begin
DumpExceptionBackTrace;
Result:=MessageDlg(lisStreamingError,
Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
AnUnitInfo.ComponentName])+#13
+E.Message,
mtError,[mbAbort, mbRetry, mbIgnore], 0);
if Result=mrAbort then exit;
if Result=mrIgnore then Result:=mrOk;
end;
end;
finally
try
if DestroyDriver and (Writer<>nil) then Writer.Driver.Free;
Writer.Free;
except
on E: Exception do begin
debugln('TMainIDE.DoSaveFileResourceToBinStream Error cleaning up: ',E.Message);
end;
end;
end;
end;
function TMainIDE.DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo; function TMainIDE.DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo;
OkOnCodeErrors: boolean): TModalResult; OkOnCodeErrors: boolean): TModalResult;
var var
@ -4725,15 +4779,13 @@ const
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
var var
ComponentLoadingOk: boolean; ComponentLoadingOk: boolean;
TxtLFMStream, BinLFMStream: TExtMemoryStream; TxtLFMStream, BinStream, AncestorBinStream: TExtMemoryStream;
CInterface: TComponentInterface;
NewComponent: TComponent; NewComponent: TComponent;
AncestorType: TComponentClass; AncestorType: TComponentClass;
DesignerForm: TCustomForm; DesignerForm: TCustomForm;
NewClassName: String; NewClassName: String;
LFMType: String; LFMType: String;
NewAncestorName: String; AncestorClassName: String;
APersistentClass: TPersistentClass;
ACaption, AText: String; ACaption, AText: String;
NewUnitName: String; NewUnitName: String;
AncestorUnitInfo: TUnitInfo; AncestorUnitInfo: TUnitInfo;
@ -4775,46 +4827,51 @@ begin
exit; exit;
end; end;
BinStream:=nil;
AncestorBinStream:=nil;
try
// find the ancestor type in the source // find the ancestor type in the source
NewAncestorName:=''; AncestorClassName:='';
AncestorType:=nil; AncestorType:=nil;
AncestorUnitInfo:=nil;
if not CodeToolBoss.FindFormAncestor(AnUnitInfo.Source,NewClassName, if not CodeToolBoss.FindFormAncestor(AnUnitInfo.Source,NewClassName,
NewAncestorName,true) AncestorClassName,true)
then begin then begin
DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" NewClassName=',NewClassName,'. Unable to find ancestor class: ',CodeToolBoss.ErrorMessage); DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" NewClassName=',NewClassName,'. Unable to find ancestor class: ',CodeToolBoss.ErrorMessage);
end; end;
if NewAncestorName<>'' then begin if AncestorClassName<>'' then begin
if CompareText(NewAncestorName,'TForm')=0 then begin if CompareText(AncestorClassName,'TForm')=0 then begin
AncestorType:=TForm; AncestorType:=TForm;
end else if CompareText(NewAncestorName,'TDataModule')=0 then begin end else if CompareText(AncestorClassName,'TDataModule')=0 then begin
// use our TDataModule // use our TDataModule
// (some fpc versions have non designable TDataModule) // (some fpc versions have non designable TDataModule)
AncestorType:=TDataModule; AncestorType:=TDataModule;
end else if CompareText(AncestorClassName,'TCustomForm')=0 then begin
MessageDlg('Error','The resource class "'+NewClassName+'" descends from'
+' "'+AncestorClassName+'". Probably this is a typo for TForm.',
mtError,[mbCancel],0);
Result:=mrCancel;
end;
end else begin end else begin
APersistentClass:=Classes.GetClass(NewAncestorName); AncestorType:=TForm;
if (APersistentClass<>nil)
and (APersistentClass.InheritsFrom(TComponent)) then begin
// ancestor type is a registered component class
AncestorType:=TComponentClass(APersistentClass);
end;
end;
end; end;
// try loading the ancestor first (unit, lfm and component instance)
if (AncestorType=nil) then begin if (AncestorType=nil) then begin
// try loading the ancestor first Result:=DoLoadHiddenResourceComponent(AnUnitInfo,AncestorClassName,Flags,
AncestorUnitInfo:=nil;
Result:=DoLoadHiddenResourceComponent(AnUnitInfo,NewAncestorName,Flags,
AncestorType,AncestorUnitInfo); AncestorType,AncestorUnitInfo);
if Result<>mrOk then exit; if Result<>mrOk then exit;
Result:=DoSaveFileResourceToBinStream(AncestorUnitInfo,AncestorBinStream);
if Result<>mrOk then exit;
AncestorBinStream.Position:=0;
end; end;
// use TForm as default ancestor // use TForm as default ancestor
if AncestorType=nil then if AncestorType=nil then
AncestorType:=TForm; AncestorType:=TForm;
//DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" AncestorClassName=',NewAncestorName,' AncestorType=',AncestorType.ClassName); //DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" AncestorClassName=',AncestorClassName,' AncestorType=',AncestorType.ClassName);
BinLFMStream:=TExtMemoryStream.Create; BinStream:=TExtMemoryStream.Create;
try
TxtLFMStream:=TExtMemoryStream.Create; TxtLFMStream:=TExtMemoryStream.Create;
try try
LFMBuf.SaveToStream(TxtLFMStream); LFMBuf.SaveToStream(TxtLFMStream);
@ -4824,10 +4881,10 @@ begin
// convert text to binary format // convert text to binary format
try try
if AnUnitInfo.ComponentLastBinStreamSize>0 then if AnUnitInfo.ComponentLastBinStreamSize>0 then
BinLFMStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize; BinStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
LRSObjectTextToBinary(TxtLFMStream,BinLFMStream); LRSObjectTextToBinary(TxtLFMStream,BinStream);
AnUnitInfo.ComponentLastBinStreamSize:=BinLFMStream.Size; AnUnitInfo.ComponentLastBinStreamSize:=BinStream.Size;
BinLFMStream.Position:=0; BinStream.Position:=0;
Result:=mrOk; Result:=mrOk;
except except
on E: Exception do begin on E: Exception do begin
@ -4852,14 +4909,12 @@ begin
NewUnitName:=AnUnitInfo.UnitName; NewUnitName:=AnUnitInfo.UnitName;
if NewUnitName='' then if NewUnitName='' then
NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename); NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename);
CInterface := TComponentInterface( NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream,
FormEditor1.CreateComponentFromStream(BinLFMStream, AncestorType,AncestorBinStream,copy(NewUnitName,1,255),true);
AncestorType,copy(NewUnitName,1,255),true)); AnUnitInfo.Component:=NewComponent;
if CInterface=nil then begin if NewComponent=nil then begin
// error streaming component -> examine lfm file // error streaming component -> examine lfm file
DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"'); DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
NewComponent:=nil;
AnUnitInfo.Component:=NewComponent;
// open lfm file in editor // open lfm file in editor
Result:=DoOpenEditorFile(LFMBuf.Filename,AnUnitInfo.EditorIndex+1, Result:=DoOpenEditorFile(LFMBuf.Filename,AnUnitInfo.EditorIndex+1,
Flags+[ofOnlyIfExists,ofQuiet,ofRegularFile]); Flags+[ofOnlyIfExists,ofQuiet,ofRegularFile]);
@ -4867,17 +4922,15 @@ begin
Result:=DoCheckLFMInEditor; Result:=DoCheckLFMInEditor;
if Result=mrOk then Result:=mrCancel; if Result=mrOk then Result:=mrCancel;
exit; exit;
end else begin end;
NewComponent:=CInterface.Component; FormEditor1.CreateComponentInterface(NewComponent,true);
DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"'); DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
AnUnitInfo.Component:=NewComponent;
AnUnitInfo.ComponentName:=NewComponent.Name; AnUnitInfo.ComponentName:=NewComponent.Name;
AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName; AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
DesignerForm:=nil;
if not (ofLoadHiddenResource in Flags) then begin if not (ofLoadHiddenResource in Flags) then begin
CreateDesignerForComponent(NewComponent); CreateDesignerForComponent(NewComponent);
DesignerForm:=FormEditor1.GetDesignerForm(AnUnitInfo.Component); DesignerForm:=FormEditor1.GetDesignerForm(AnUnitInfo.Component);
end else begin
DesignerForm:=nil;
end; end;
// select the new form (object inspector, formeditor, control selection) // select the new form (object inspector, formeditor, control selection)
@ -4893,12 +4946,12 @@ begin
FLastFormActivated:=DesignerForm; FLastFormActivated:=DesignerForm;
end; end;
end; end;
end;
{$IFDEF IDE_DEBUG} {$IFDEF IDE_DEBUG}
debugln('[TMainIDE.DoLoadLFM] LFM end'); debugln('[TMainIDE.DoLoadLFM] LFM end');
{$ENDIF} {$ENDIF}
finally finally
BinLFMStream.Free; BinStream.Free;
AncestorBinStream.Free;
end; end;
Result:=mrOk; Result:=mrOk;
end; end;
@ -4984,6 +5037,24 @@ function TMainIDE.DoLoadHiddenResourceComponent(AnUnitInfo: TUnitInfo;
end; end;
end; end;
function TryRegisteredClasses(out TheModalResult: TModalResult): boolean;
var
APersistentClass: TPersistentClass;
begin
Result:=false;
APersistentClass:=Classes.GetClass(AComponentClassName);
if APersistentClass=nil then exit;
if not APersistentClass.InheritsFrom(TComponent) then exit;
AComponentClass:=TComponentClass(APersistentClass);
if AComponentClass.InheritsFrom(TForm)
or AComponentClass.InheritsFrom(TDataModule) then begin
// at the moment the designer only supports descendants
// of TForm and TDataModule
TheModalResult:=mrOk;
Result:=true;
end;
end;
var var
UsedUnitFilenames: TStrings; UsedUnitFilenames: TStrings;
i: Integer; i: Integer;
@ -5029,7 +5100,13 @@ begin
UsedUnitFilenames.Free; UsedUnitFilenames.Free;
end; end;
Result:=mrCancel; // finally try registered classes
if TryRegisteredClasses(Result) then exit;
Result:=QuestionDlg('Error','Unable to find the lfm file for component class '
+'"'+AComponentClassName+'".',
mtError,[mrCancel,'Cancel loading this component',
mrAbort,'Abort whole loading'],0);
finally finally
AnUnitInfo.LoadingComponent:=false; AnUnitInfo.LoadingComponent:=false;
end; end;
@ -5054,8 +5131,12 @@ begin
LookupRoot:=AnUnitInfo.Component; LookupRoot:=AnUnitInfo.Component;
if LookupRoot=nil then exit; if LookupRoot=nil then exit;
AForm:=FormEditor1.GetDesignerForm(LookupRoot); AForm:=FormEditor1.GetDesignerForm(LookupRoot);
if AForm=nil then OldDesigner:=nil;
RaiseException('TMainIDE.CloseDesignerForm '+AnUnitInfo.Filename); if AForm<>nil then
OldDesigner:=TDesigner(AForm.Designer);
if (OldDesigner=nil) then begin
DebugLn(['TMainIDE.CloseDesignerForm TODO: free hidden component without designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
end else begin
if (AForm=nil) then exit; if (AForm=nil) then exit;
if FLastFormActivated=AForm then if FLastFormActivated=AForm then
FLastFormActivated:=nil; FLastFormActivated:=nil;
@ -5066,10 +5147,9 @@ begin
TheControlSelection.Remove(LookupRoot.Components[i]); TheControlSelection.Remove(LookupRoot.Components[i]);
TheControlSelection.Remove(LookupRoot); TheControlSelection.Remove(LookupRoot);
// free designer and design form // free designer and design form
OldDesigner:=TDesigner(AForm.Designer);
OldDesigner.DeleteFormAndFree; OldDesigner.DeleteFormAndFree;
end;
AnUnitInfo.Component:=nil; AnUnitInfo.Component:=nil;
Result:=mrOk; Result:=mrOk;
end; end;
@ -11974,7 +12054,7 @@ begin
//writeln('TMainIDE.OnPropHookPersistentAdded B ',AComponent.Name,':',AComponent.ClassName); //writeln('TMainIDE.OnPropHookPersistentAdded B ',AComponent.Name,':',AComponent.ClassName);
// create component interface // create component interface
if FormEditor1.FindComponent(AComponent)=nil then if FormEditor1.FindComponent(AComponent)=nil then
FormEditor1.CreateComponentInterface(AComponent); FormEditor1.CreateComponentInterface(AComponent,false);
// set component into design mode // set component into design mode
SetDesigning(AComponent,true); SetDesigning(AComponent,true);
//writeln('TMainIDE.OnPropHookPersistentAdded C ',AComponent.Name,':',AComponent.ClassName); //writeln('TMainIDE.OnPropHookPersistentAdded C ',AComponent.Name,':',AComponent.ClassName);

11
ide/project.pp
View File

@ -578,6 +578,7 @@ type
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo; function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
function UnitWithEditorIndex(Index:integer): TUnitInfo; function UnitWithEditorIndex(Index:integer): TUnitInfo;
function UnitWithComponent(AComponent: TComponent): TUnitInfo; function UnitWithComponent(AComponent: TComponent): TUnitInfo;
function UnitComponentInheritingFrom(AClass: TComponentClass): TUnitInfo;
function UnitInfoWithFilename(const AFilename: string): TUnitInfo; function UnitInfoWithFilename(const AFilename: string): TUnitInfo;
function UnitInfoWithFilename(const AFilename: string; function UnitInfoWithFilename(const AFilename: string;
SearchFlags: TProjectFileSearchFlags): TUnitInfo; SearchFlags: TProjectFileSearchFlags): TUnitInfo;
@ -617,7 +618,7 @@ type
procedure SetBookmark(AnUnitInfo: TUnitInfo; X,Y,ID: integer); procedure SetBookmark(AnUnitInfo: TUnitInfo; X,Y,ID: integer);
procedure MergeBookmarks(AnUnitInfo: TUnitInfo); procedure MergeBookmarks(AnUnitInfo: TUnitInfo);
// dependencies // package dependencies
function FindDependencyByName(const PackageName: string): TPkgDependency; function FindDependencyByName(const PackageName: string): TPkgDependency;
function RequiredDepByIndex(Index: integer): TPkgDependency; function RequiredDepByIndex(Index: integer): TPkgDependency;
function RemovedDepByIndex(Index: integer): TPkgDependency; function RemovedDepByIndex(Index: integer): TPkgDependency;
@ -3372,6 +3373,14 @@ begin
Result:=Result.fNext[uilWithComponent]; Result:=Result.fNext[uilWithComponent];
end; end;
function TProject.UnitComponentInheritingFrom(AClass: TComponentClass
): TUnitInfo;
begin
Result:=fFirst[uilWithComponent];
while (Result<>nil) and (Result.Component.InheritsFrom(AClass)) do
Result:=Result.fNext[uilWithComponent];
end;
function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo; function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo;
var var
i: Integer; i: Integer;

2
ideintf/formeditingintf.pas
View File

@ -105,7 +105,7 @@ type
const AUnitName: shortstring; const AUnitName: shortstring;
X,Y,W,H: Integer): TIComponentInterface; virtual; abstract; X,Y,W,H: Integer): TIComponentInterface; virtual; abstract;
function CreateComponentFromStream(BinStream: TStream; function CreateComponentFromStream(BinStream: TStream;
AncestorType: TComponentClass; AncestorType: TComponentClass; AncestorBinStream: TStream;
const NewUnitName: ShortString; const NewUnitName: ShortString;
Interactive: boolean; Interactive: boolean;
Visible: boolean = true): TIComponentInterface; virtual; abstract; Visible: boolean = true): TIComponentInterface; virtual; abstract;

3
lcl/include/control.inc
View File

@ -3517,7 +3517,8 @@ begin
// no csOpaque: delphi compatible, win32 themes notebook depend on it // no csOpaque: delphi compatible, win32 themes notebook depend on it
// csOpaque means entire client area will be drawn // csOpaque means entire client area will be drawn
// (most controls are semi-transparent) // (most controls are semi-transparent)
FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks]; FControlStyle := FControlStyle
+[csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
FConstraints:= TSizeConstraints.Create(Self); FConstraints:= TSizeConstraints.Create(Self);
FBorderSpacing:=TControlBorderSpacing.Create(Self); FBorderSpacing:=TControlBorderSpacing.Create(Self);
for Side:=Low(FAnchorSides) to High(FAnchorSides) do for Side:=Low(FAnchorSides) to High(FAnchorSides) do

5
lcl/include/customform.inc
View File

@ -1691,6 +1691,8 @@ end;
procedure TCustomForm.CreateWnd; procedure TCustomForm.CreateWnd;
begin begin
//DebugLn('TCustomForm.CreateWnd START ',ClassName); //DebugLn('TCustomForm.CreateWnd START ',ClassName);
if CompareText(ClassName,'TGrandMaForm')=0 then
RaiseGDBException('');
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged]; FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd; inherited CreateWnd;
@ -1778,8 +1780,9 @@ procedure TCustomForm.UpdateShowing;
var var
X, Y : integer; X, Y : integer;
begin begin
if csLoading in ComponentState then exit;
{$IFDEF CHECK_POSITION} {$IFDEF CHECK_POSITION}
DebugLn('[TCustomForm.UpdateShowing] A Class=',Name,':',Classname,' Pos=',DbgS(Left),',',DbgS(Top),' Visible=',DbgS(Visible)); DebugLn('[TCustomForm.UpdateShowing] A ',DbgSName(Self),' Pos=',DbgS(Left),',',DbgS(Top),' Visible=',DbgS(Visible));
{$ENDIF} {$ENDIF}
{ If the the form is about to show, calculate its metrics } { If the the form is about to show, calculate its metrics }
if Visible then begin if Visible then begin

24
lcl/include/wincontrol.inc
View File

@ -2611,11 +2611,11 @@ begin
if HandleAllocated then UpdateWindow(Handle); if HandleAllocated then UpdateWindow(Handle);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TWinControl Focused } TWinControl Focused
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function TWinControl.Focused: Boolean; function TWinControl.Focused: Boolean;
Begin begin
Result := CanTab and (HandleAllocated and (FindOwnerControl(GetFocus)=Self)); Result := CanTab and (HandleAllocated and (FindOwnerControl(GetFocus)=Self));
end; end;
@ -4251,13 +4251,13 @@ begin
UpdateShowing; UpdateShowing;
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TWinControl InsertControl } TWinControl InsertControl
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Procedure TWinControl.InsertControl(AControl: TControl); procedure TWinControl.InsertControl(AControl: TControl);
Begin begin
InsertControl(AControl,ControlCount); InsertControl(AControl,ControlCount);
End; end;
procedure TWinControl.InsertControl(AControl: TControl; Index: integer); procedure TWinControl.InsertControl(AControl: TControl; Index: integer);
begin begin
@ -4273,7 +4273,7 @@ begin
if AControl is TWinControl then if AControl is TWinControl then
begin begin
AControl.Perform(CM_PARENTCTL3DCHANGED, 0, 0); AControl.Perform(CM_PARENTCTL3DCHANGED, 0, 0);
UpdateControlState; TWinControl(AControl).UpdateControlState;
end else end else
if HandleAllocated then AControl.Invalidate; if HandleAllocated then AControl.Invalidate;
//DebugLn('TWinControl.InsertControl ',Name,':',ClassName); //DebugLn('TWinControl.InsertControl ',Name,':',ClassName);