mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-21 09:59:32 +02:00
IDE: improved ancestor laoding, LCL: fixed TWinControl.InsertControl overhead calling wrong UpdateControlState
git-svn-id: trunk@10005 -
This commit is contained in:
mattias
parent
ab3ba51719
commit
0c307f6bf0
@ -130,7 +130,8 @@ type
|
||||
procedure InitReading(BinStream: TStream; var Reader: TReader;
|
||||
DestroyDriver: Boolean); virtual;
|
||||
function DoCreateJITComponent(const NewComponentName, NewClassName,
|
||||
NewUnitName: shortstring; ParentClass: TClass):integer;
|
||||
NewUnitName: shortstring; ParentClass: TClass;
|
||||
Visible: boolean):integer;
|
||||
procedure DoFinishReading; virtual;
|
||||
public
|
||||
constructor Create;
|
||||
@ -139,9 +140,10 @@ type
|
||||
function Count: integer;
|
||||
function AddNewJITComponent(const NewUnitName: shortstring;
|
||||
ParentClass: TClass): integer;
|
||||
function AddJITComponentFromStream(BinStream: TStream; ParentClass: TClass;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive, Visible: Boolean):integer;
|
||||
function AddJITComponentFromStream(BinStream: TStream;
|
||||
ParentClass: TClass; ParentBinStream: TStream;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive, Visible: Boolean):integer;
|
||||
procedure DestroyJITComponent(JITComponent: TComponent);
|
||||
procedure DestroyJITComponent(Index: integer);
|
||||
function IndexOf(JITComponent: TComponent): integer;
|
||||
@ -646,19 +648,48 @@ begin
|
||||
' NewUnitName=',NewUnitName,' ParentClass=',ParentClass.ClassName);
|
||||
{$ENDIF}
|
||||
Result:=DoCreateJITComponent(NewComponentName,NewClassName,NewUnitName,
|
||||
ParentClass);
|
||||
ParentClass,true);
|
||||
end;
|
||||
|
||||
function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
|
||||
ParentClass: TClass; const NewUnitName: ShortString;
|
||||
Interactive, Visible: Boolean):integer;
|
||||
ParentClass: TClass; ParentBinStream: TStream;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive, Visible: Boolean): integer;
|
||||
// returns new index
|
||||
// -1 = invalid stream
|
||||
|
||||
procedure ReadStream(AStream: TStream);
|
||||
var
|
||||
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
|
||||
Reader:TReader;
|
||||
NewClassName: shortstring;
|
||||
NewName: string;
|
||||
DestroyDriver, IsInherited: Boolean;
|
||||
IsInherited: Boolean;
|
||||
begin
|
||||
Result:=-1;
|
||||
NewClassName:=GetClassNameFromLRSStream(BinStream, IsInherited);
|
||||
@ -667,40 +698,22 @@ begin
|
||||
MessageDlg('No classname in stream found.',mtError,[mbOK],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITComponentFromStream] Create ...');
|
||||
debugln('[TJITComponentList.AddJITComponentFromStream] Create ...');
|
||||
{$ENDIF}
|
||||
try
|
||||
Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass);
|
||||
Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass,Visible);
|
||||
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
|
||||
NewName:=FCurReadJITComponent.ClassName;
|
||||
if NewName[1] in ['T','t'] then
|
||||
System.Delete(NewName,1,1);
|
||||
FCurReadJITComponent.Name:=NewName;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITComponentFromStream] Finish Reading ...');
|
||||
{$ENDIF}
|
||||
DoFinishReading;
|
||||
finally
|
||||
UnregisterFindGlobalComponentProc(@MyFindGlobalComponent);
|
||||
Application.FindGlobalComponentEnabled:=true;
|
||||
if DestroyDriver then Reader.Driver.Free;
|
||||
Reader.Free;
|
||||
if FCurReadJITComponent.Name='' then begin
|
||||
NewName:=FCurReadJITComponent.ClassName;
|
||||
if NewName[1] in ['T','t'] then
|
||||
System.Delete(NewName,1,1);
|
||||
FCurReadJITComponent.Name:=NewName;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
@ -714,6 +727,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FCurReadJITComponent:=nil;
|
||||
end;
|
||||
|
||||
function TJITComponentList.OnFindGlobalComponent(
|
||||
@ -734,12 +748,12 @@ begin
|
||||
Application.FindGlobalComponentEnabled:=false;
|
||||
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.InitReading] A');
|
||||
debugln('[TJITComponentList.InitReading] A');
|
||||
{$ENDIF}
|
||||
// connect TReader events
|
||||
Reader.OnError:=@ReaderError;
|
||||
Reader.OnFindMethod:=@ReaderFindMethod;
|
||||
Reader.OnPropertyNotFound:=@ReaderPropertyNotFound;
|
||||
Reader.OnFindMethod:=@ReaderFindMethod;
|
||||
Reader.OnSetMethodProperty:=@ReaderSetMethodProperty;
|
||||
Reader.OnSetName:=@ReaderSetName;
|
||||
Reader.OnReferenceName:=@ReaderReferenceName;
|
||||
@ -748,7 +762,7 @@ begin
|
||||
Reader.OnFindComponentClass:=@ReaderFindComponentClass;
|
||||
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.InitReading] B');
|
||||
debugln('[TJITComponentList.InitReading] B');
|
||||
{$ENDIF}
|
||||
|
||||
FCurReadChildClass:=nil;
|
||||
@ -758,7 +772,7 @@ end;
|
||||
|
||||
function TJITComponentList.DoCreateJITComponent(
|
||||
const NewComponentName, NewClassName, NewUnitName: shortstring;
|
||||
ParentClass: TClass):integer;
|
||||
ParentClass: TClass; Visible: boolean):integer;
|
||||
var
|
||||
Instance:TComponent;
|
||||
ok: boolean;
|
||||
@ -777,6 +791,9 @@ begin
|
||||
try
|
||||
// set into design mode
|
||||
SetComponentDesignMode(Instance,true);
|
||||
if (not Visible) and (Instance is TControl) then
|
||||
TControl(Instance).ControlStyle:=
|
||||
TControl(Instance).ControlStyle+[csNoDesignVisible];
|
||||
// finish 'create' component
|
||||
Instance.Create(nil);
|
||||
if NewComponentName<>'' then
|
||||
@ -823,7 +840,7 @@ procedure TJITComponentList.RemoveMethod(JITComponent:TComponent;
|
||||
var OldCode:Pointer;
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('TJITComponentList.RemoveMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
||||
debugln('TJITComponentList.RemoveMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
||||
{$ENDIF}
|
||||
if JITComponent=nil then
|
||||
raise Exception.Create('TJITComponentList.RemoveMethod JITComponent=nil');
|
||||
@ -841,7 +858,7 @@ procedure TJITComponentList.RenameMethod(JITComponent:TComponent;
|
||||
const OldName,NewName:ShortString);
|
||||
begin
|
||||
{$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}
|
||||
if JITComponent=nil then
|
||||
raise Exception.Create('TJITComponentList.RenameMethod JITComponent=nil');
|
||||
@ -857,7 +874,7 @@ procedure TJITComponentList.RenameComponentClass(JITComponent:TComponent;
|
||||
const NewName:ShortString);
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('TJITComponentList.RenameComponentClass ',JITComponent.Name,':',JITComponent.Name,' New=',NewName);
|
||||
debugln('TJITComponentList.RenameComponentClass ',JITComponent.Name,':',JITComponent.Name,' New=',NewName);
|
||||
{$ENDIF}
|
||||
if JITComponent=nil then
|
||||
raise Exception.Create('TJITComponentList.RenameComponentClass JITComponent=nil');
|
||||
@ -873,7 +890,7 @@ procedure TJITComponentList.RenameComponentUnitname(JITComponent: TComponent;
|
||||
const NewUnitName: ShortString);
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('TJITComponentList.RenameComponentUnitname ',JITComponent.Name,':',JITComponent.Name,' New=',NewUnitName);
|
||||
debugln('TJITComponentList.RenameComponentUnitname ',JITComponent.Name,':',JITComponent.Name,' New=',NewUnitName);
|
||||
{$ENDIF}
|
||||
if JITComponent=nil then
|
||||
raise Exception.Create('TJITComponentList.RenameComponentUnitname JITComponent=nil');
|
||||
@ -898,13 +915,13 @@ begin
|
||||
if IndexOf(JITOwnerComponent)<0 then
|
||||
RaiseException('TJITComponentList.AddJITChildComponentFromStream');
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITChildComponentFromStream] A');
|
||||
debugln('[TJITComponentList.AddJITChildComponentFromStream] A');
|
||||
{$ENDIF}
|
||||
try
|
||||
DestroyDriver:=false;
|
||||
InitReading(BinStream,Reader,DestroyDriver);
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITChildComponentFromStream] B');
|
||||
debugln('[TJITComponentList.AddJITChildComponentFromStream] B');
|
||||
{$ENDIF}
|
||||
try
|
||||
FCurReadJITComponent:=JITOwnerComponent;
|
||||
@ -912,7 +929,7 @@ begin
|
||||
|
||||
FFlags:=FFlags+[jclAutoRenameComponents];
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITChildComponentFromStream] C1 ',ComponentClass.ClassName);
|
||||
debugln('[TJITComponentList.AddJITChildComponentFromStream] C1 ',ComponentClass.ClassName);
|
||||
{$ENDIF}
|
||||
Reader.Root := FCurReadJITComponent;
|
||||
Reader.Owner := FCurReadJITComponent;
|
||||
@ -928,7 +945,7 @@ begin
|
||||
DebugLn('[TJITComponentList.AddJITChildComponentFromStream] C6 ');
|
||||
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.AddJITChildComponentFromStream] D');
|
||||
debugln('[TJITComponentList.AddJITChildComponentFromStream] D');
|
||||
{$ENDIF}
|
||||
DoFinishReading;
|
||||
finally
|
||||
@ -953,7 +970,7 @@ var CodeTemplate,NewCode:Pointer;
|
||||
OldCode: Pointer;
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
||||
debugln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
||||
{$ENDIF}
|
||||
if JITComponent=nil then
|
||||
raise Exception.Create('TJITComponentList.CreateNewMethod JITComponent=nil');
|
||||
@ -1131,7 +1148,7 @@ procedure TJITComponentList.DoAddNewMethod(JITClass:TClass;
|
||||
var OldMethodTable, NewMethodTable: PMethodNameTable;
|
||||
NewMethodTableSize:integer;
|
||||
begin
|
||||
//writeln('[TJITComponentList.AddNewMethod] '''+JITClass.ClassName+'.'+AName+'''');
|
||||
//debugln('[TJITComponentList.AddNewMethod] '''+JITClass.ClassName+'.'+AName+'''');
|
||||
OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^);
|
||||
if Assigned(OldMethodTable) then begin
|
||||
NewMethodTableSize:=SizeOf(DWord)+
|
||||
@ -1149,7 +1166,7 @@ begin
|
||||
end;
|
||||
{$R-}
|
||||
//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));
|
||||
with NewMethodTable^.Entries[NewMethodTable^.Count-1] do begin
|
||||
GetMem(Name,256);
|
||||
@ -1157,7 +1174,7 @@ begin
|
||||
Addr:=ACode;
|
||||
end;
|
||||
//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));
|
||||
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
||||
PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^):=NewMethodTable;
|
||||
@ -1173,7 +1190,7 @@ var OldMethodTable, NewMethodTable: PMethodNameTable;
|
||||
a:cardinal;
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.DoRemoveMethod] '''+JITClass.ClassName+'.'+AName+'''');
|
||||
debugln('[TJITComponentList.DoRemoveMethod] '''+JITClass.ClassName+'.'+AName+'''');
|
||||
{$ENDIF}
|
||||
AName:=uppercase(AName);
|
||||
OldMethodTable:=PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^);
|
||||
@ -1213,7 +1230,7 @@ var MethodTable: PMethodNameTable;
|
||||
a:integer;
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.DoRenameMethod] ClassName='''+JITClass.ClassName+''''
|
||||
debugln('[TJITComponentList.DoRenameMethod] ClassName='''+JITClass.ClassName+''''
|
||||
+' OldName='''+OldName+''' NewName='''+OldName+'''');
|
||||
{$ENDIF}
|
||||
OldName:=uppercase(OldName);
|
||||
@ -1230,7 +1247,7 @@ procedure TJITComponentList.DoRenameClass(JITClass:TClass;
|
||||
const NewName:ShortString);
|
||||
begin
|
||||
{$IFDEF VerboseJITForms}
|
||||
writeln('[TJITComponentList.DoRenameClass] OldName='''+JITClass.ClassName
|
||||
debugln('[TJITComponentList.DoRenameClass] OldName='''+JITClass.ClassName
|
||||
+''' NewName='''+NewName+''' ');
|
||||
{$ENDIF}
|
||||
PShortString((Pointer(JITClass)+vmtClassName)^)^:=NewName;
|
||||
@ -1271,7 +1288,7 @@ procedure TJITComponentList.ReaderFindMethod(Reader: TReader;
|
||||
var NewMethod: TMethod;
|
||||
begin
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
|
||||
debugln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
|
||||
{$ENDIF}
|
||||
if Address=nil then begin
|
||||
// there is no method in the ancestor class with this name
|
||||
@ -1295,31 +1312,32 @@ procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
|
||||
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
|
||||
var Handled: boolean);
|
||||
begin
|
||||
//writeln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
|
||||
//debugln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
|
||||
end;
|
||||
|
||||
procedure TJITComponentList.ReaderSetName(Reader: TReader;
|
||||
Component: TComponent; var NewName: Ansistring);
|
||||
begin
|
||||
// writeln('[TJITComponentList.ReaderSetName] OldName="'+Component.Name+'" NewName="'+NewName+'"');
|
||||
// debugln('[TJITComponentList.ReaderSetName] OldName="'+Component.Name+'" NewName="'+NewName+'"');
|
||||
if jclAutoRenameComponents in FFlags then begin
|
||||
while FCurReadJITComponent.FindComponent(NewName)<>nil do
|
||||
NewName:=CreateNextIdentifier(NewName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJITComponentList.ReaderReferenceName(Reader: TReader; var RefName: Ansistring);
|
||||
procedure TJITComponentList.ReaderReferenceName(Reader: TReader;
|
||||
var RefName: Ansistring);
|
||||
begin
|
||||
// writeln('[TJITComponentList.ReaderReferenceName] Name='''+RefName+'''');
|
||||
// debugln('[TJITComponentList.ReaderReferenceName] Name='''+RefName+'''');
|
||||
end;
|
||||
|
||||
procedure TJITComponentList.ReaderAncestorNotFound(Reader: TReader;
|
||||
const ComponentName: Ansistring; ComponentClass: TPersistentClass;
|
||||
var Component: TComponent);
|
||||
begin
|
||||
// ToDo: this is for custom form templates
|
||||
// writeln('[TJITComponentList.ReaderAncestorNotFound] ComponentName='''+ComponentName
|
||||
// +''' Component='''+Component.Name+'''');
|
||||
// ToDo: this is for custom form templates
|
||||
debugln('[TJITComponentList.ReaderAncestorNotFound] ComponentName='''+ComponentName
|
||||
+''' Component='''+Component.Name+'''');
|
||||
end;
|
||||
|
||||
procedure TJITComponentList.ReaderError(Reader: TReader;
|
||||
@ -1367,7 +1385,7 @@ begin
|
||||
if ComponentClass=nil then begin
|
||||
RegComp:=IDEComponentPalette.FindComponent(FindClassName);
|
||||
if RegComp<>nil then begin
|
||||
//writeln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
|
||||
//debugln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
|
||||
// +''' is registered');
|
||||
ComponentClass:=RegComp.ComponentClass;
|
||||
end else begin
|
||||
@ -1384,7 +1402,7 @@ procedure TJITComponentList.ReaderCreateComponent(Reader: TReader;
|
||||
begin
|
||||
fCurReadChild:=Component;
|
||||
fCurReadChildClass:=ComponentClass;
|
||||
// writeln('[TJITComponentList.ReaderCreateComponent] Class='''+ComponentClass.ClassName+'''');
|
||||
// debugln('[TJITComponentList.ReaderCreateComponent] Class='''+ComponentClass.ClassName+'''');
|
||||
end;
|
||||
|
||||
procedure TJITComponentList.ReaderReadComponent(Component: TComponent);
|
||||
|
||||
@ -109,8 +109,6 @@ each control that's dropped onto the form
|
||||
|
||||
{ TCustomFormEditor }
|
||||
|
||||
TControlClass = class of TControl;
|
||||
|
||||
TCustomFormEditor = class(TAbstractFormEditor)
|
||||
private
|
||||
FComponentInterfaces: TAVLTree; // tree of TComponentInterface sorted for
|
||||
@ -143,11 +141,11 @@ each control that's dropped onto the form
|
||||
destructor Destroy; override;
|
||||
|
||||
// selection
|
||||
Function AddSelected(Value: TComponent) : Integer;
|
||||
Procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
|
||||
Function FindComponentByName(const Name: ShortString
|
||||
function AddSelected(Value: TComponent) : Integer;
|
||||
procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
|
||||
function FindComponentByName(const Name: ShortString
|
||||
): TIComponentInterface; override;
|
||||
Function FindComponent(AComponent: TComponent): TIComponentInterface; override;
|
||||
function FindComponent(AComponent: TComponent): TIComponentInterface; override;
|
||||
function SaveSelectionToStream(s: TStream): Boolean; override;
|
||||
function InsertFromStream(s: TStream; Parent: TWinControl;
|
||||
Flags: TComponentPasteSelectionFlags): Boolean; override;
|
||||
@ -193,7 +191,8 @@ each control that's dropped onto the form
|
||||
function CreateUniqueComponentName(AComponent: TComponent): string;
|
||||
function CreateUniqueComponentName(const AClassName: string;
|
||||
OwnerComponent: TComponent): string;
|
||||
function CreateComponentInterface(AComponent: TComponent): TIComponentInterface;
|
||||
function CreateComponentInterface(AComponent: TComponent;
|
||||
WithChilds: Boolean): TIComponentInterface;
|
||||
procedure CreateChildComponentInterfaces(AComponent: TComponent);
|
||||
function GetDefaultComponentParent(TypeClass: TComponentClass
|
||||
): TIComponentInterface; override;
|
||||
@ -205,10 +204,15 @@ each control that's dropped onto the form
|
||||
const AUnitName: shortstring;
|
||||
X,Y,W,H: Integer): TIComponentInterface; override;
|
||||
function CreateComponentFromStream(BinStream: TStream;
|
||||
AncestorType: TComponentClass;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive: boolean;
|
||||
Visible: boolean = true): TIComponentInterface; override;
|
||||
AncestorType: TComponentClass; AncestorBinStream: TStream;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive: boolean;
|
||||
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;
|
||||
ComponentClass: TComponentClass; Root: TComponent;
|
||||
ParentControl: TWinControl): TIComponentInterface; override;
|
||||
@ -285,6 +289,7 @@ function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
|
||||
Item: TDefinePropertiesCacheItem): integer;
|
||||
procedure RegisterStandardClasses;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -629,21 +634,21 @@ end;
|
||||
|
||||
Function TComponentInterface.GetPropValue(Index : Integer; var Value) : Boolean;
|
||||
var
|
||||
PP : PPropInfo;
|
||||
PP : PPropInfo;
|
||||
Begin
|
||||
PP := GetPPropInfoByIndex(Index);
|
||||
Result := FGetProp(PP,Value);
|
||||
PP := GetPPropInfoByIndex(Index);
|
||||
Result := FGetProp(PP,Value);
|
||||
end;
|
||||
|
||||
Function TComponentInterface.GetPropValuebyName(Name: ShortString; var Value) : Boolean;
|
||||
var
|
||||
PRI : PPropInfo;
|
||||
PRI : PPropInfo;
|
||||
Begin
|
||||
Result := False;
|
||||
PRI := GetPPropInfoByName(Name);
|
||||
Result := False;
|
||||
PRI := GetPPropInfoByName(Name);
|
||||
|
||||
if PRI <> nil then
|
||||
Result := FGetProp(PRI,Value);
|
||||
if PRI <> nil then
|
||||
Result := FGetProp(PRI,Value);
|
||||
end;
|
||||
|
||||
Function TComponentInterface.SetProp(Index : Integer; const Value) : Boolean;
|
||||
@ -930,7 +935,7 @@ begin
|
||||
except
|
||||
on E: Exception do begin
|
||||
MessageDlg('Error',
|
||||
'Unable to clear form editing selection'#13
|
||||
'Unable to clear the form editing selection'#13
|
||||
+E.Message,mtError,[mbCancel],0);
|
||||
end;
|
||||
end;
|
||||
@ -1427,12 +1432,25 @@ Begin
|
||||
end;
|
||||
|
||||
Function TCustomFormEditor.CreateComponentFromStream(
|
||||
BinStream: TStream; AncestorType: TComponentClass;
|
||||
const NewUnitName: ShortString; Interactive: boolean;
|
||||
Visible: boolean): TIComponentInterface;
|
||||
BinStream: TStream;
|
||||
AncestorType: TComponentClass; AncestorBinStream: TStream;
|
||||
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
|
||||
NewJITIndex: integer;
|
||||
NewComponent: TComponent;
|
||||
JITList: TJITComponentList;
|
||||
begin
|
||||
// create JIT Component
|
||||
@ -1440,18 +1458,14 @@ begin
|
||||
if JITList=nil then
|
||||
RaiseException('TCustomFormEditor.CreateComponentFromStream ClassName='+
|
||||
AncestorType.ClassName);
|
||||
NewJITIndex := JITList.AddJITComponentFromStream(BinStream,AncestorType,
|
||||
NewUnitName,Interactive,Visible);
|
||||
NewJITIndex := JITList.AddJITComponentFromStream(BinStream,
|
||||
AncestorType,AncestorBinStream,
|
||||
NewUnitName,Interactive,Visible);
|
||||
if NewJITIndex < 0 then begin
|
||||
Result:=nil;
|
||||
exit;
|
||||
end;
|
||||
NewComponent:=JITList[NewJITIndex];
|
||||
|
||||
// create a component interface
|
||||
Result:=CreateComponentInterface(NewComponent);
|
||||
|
||||
CreateChildComponentInterfaces(NewComponent);
|
||||
Result:=JITList[NewJITIndex];
|
||||
end;
|
||||
|
||||
function TCustomFormEditor.CreateChildComponentFromStream(BinStream: TStream;
|
||||
@ -1460,7 +1474,6 @@ function TCustomFormEditor.CreateChildComponentFromStream(BinStream: TStream;
|
||||
var
|
||||
NewComponent: TComponent;
|
||||
JITList: TJITComponentList;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=nil;
|
||||
|
||||
@ -1472,13 +1485,8 @@ begin
|
||||
NewComponent:=JITList.AddJITChildComponentFromStream(
|
||||
Root,BinStream,ComponentClass,ParentControl);
|
||||
|
||||
// create a component interface for the new child component
|
||||
Result:=CreateComponentInterface(NewComponent);
|
||||
|
||||
// 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]);
|
||||
// create component interface(s) for the new child component(s)
|
||||
Result:=CreateComponentInterface(NewComponent,true);
|
||||
end;
|
||||
|
||||
Procedure TCustomFormEditor.SetComponentNameAndClass(CI: TIComponentInterface;
|
||||
@ -1832,11 +1840,15 @@ begin
|
||||
end;
|
||||
|
||||
Function TCustomFormEditor.CreateComponentInterface(
|
||||
AComponent: TComponent): TIComponentInterface;
|
||||
AComponent: TComponent; WithChilds: Boolean): TIComponentInterface;
|
||||
Begin
|
||||
if FindComponent(AComponent)<>nil then exit;
|
||||
Result := TComponentInterface.Create(AComponent);
|
||||
FComponentInterfaces.Add(Result);
|
||||
Result:=FindComponent(AComponent);
|
||||
if Result=nil then begin
|
||||
Result := TComponentInterface.Create(AComponent);
|
||||
FComponentInterfaces.Add(Result);
|
||||
end;
|
||||
if WithChilds then
|
||||
CreateChildComponentInterfaces(AComponent);
|
||||
end;
|
||||
|
||||
procedure TCustomFormEditor.CreateChildComponentInterfaces(
|
||||
@ -1846,7 +1858,7 @@ var
|
||||
begin
|
||||
// create a component interface for each component owned by the new component
|
||||
for i:=0 to AComponent.ComponentCount-1 do
|
||||
CreateComponentInterface(AComponent.Components[i]);
|
||||
CreateComponentInterface(AComponent.Components[i],false);
|
||||
end;
|
||||
|
||||
function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass
|
||||
|
||||
292
ide/main.pp
292
ide/main.pp
@ -552,13 +552,12 @@ type
|
||||
AncestorType: TPersistentClass; ResourceCode: TCodeBuffer): TModalResult;
|
||||
|
||||
// methods for 'save unit'
|
||||
function DoLoadResourceFile(AnUnitInfo: TUnitInfo;
|
||||
var LFMCode, ResourceCode: TCodeBuffer;
|
||||
IgnoreSourceErrors: boolean): TModalResult;
|
||||
function DoShowSaveFileAsDialog(AnUnitInfo: TUnitInfo;
|
||||
var ResourceCode: TCodeBuffer): TModalResult;
|
||||
function DoSaveFileResources(AnUnitInfo: TUnitInfo;
|
||||
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
|
||||
function DoSaveFileResourceToBinStream(AnUnitInfo: TUnitInfo;
|
||||
var BinCompStream: TExtMemoryStream): TModalResult;
|
||||
function DoRemoveDanglingEvents(AnUnitInfo: TUnitInfo;
|
||||
OkOnCodeErrors: boolean): TModalResult;
|
||||
function DoRenameUnit(AnUnitInfo: TUnitInfo;
|
||||
@ -573,6 +572,9 @@ type
|
||||
procedure DoRestoreBookMarks(AnUnitInfo: TUnitInfo; ASrcEdit:TSourceEditor);
|
||||
function DoOpenFileInSourceEditor(AnUnitInfo: TUnitInfo;
|
||||
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; LFMBuf: TCodeBuffer;
|
||||
Flags: TOpenFlags; CloseDsgnForm: boolean): TModalResult;
|
||||
@ -852,16 +854,19 @@ const
|
||||
CodeToolsIncludeLinkFile = 'includelinks.xml';
|
||||
|
||||
var
|
||||
ShowSplashScreen: boolean;
|
||||
ShowSplashScreen: boolean = false;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
|
||||
const
|
||||
LRSStreamChunkSize = 4096; // allocating mem in 4k chunks helps many mem managers
|
||||
|
||||
var
|
||||
SkipAutoLoadingLastProject: boolean;
|
||||
StartedByStartLazarus: boolean;
|
||||
SkipAutoLoadingLastProject: boolean = false;
|
||||
StartedByStartLazarus: boolean = false;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
@ -4021,8 +4026,6 @@ end;
|
||||
|
||||
function TMainIDE.DoSaveFileResources(AnUnitInfo: TUnitInfo;
|
||||
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
|
||||
const
|
||||
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
|
||||
var
|
||||
ComponentSavingOk: boolean;
|
||||
MemStream, BinCompStream, TxtCompStream: TExtMemoryStream;
|
||||
@ -4062,7 +4065,8 @@ begin
|
||||
// stream component to binary stream
|
||||
BinCompStream:=TExtMemoryStream.Create;
|
||||
if AnUnitInfo.ComponentLastBinStreamSize>0 then
|
||||
BinCompStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
|
||||
BinCompStream.Capacity:=
|
||||
AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize;
|
||||
Writer:=nil;
|
||||
DestroyDriver:=false;
|
||||
try
|
||||
@ -4081,11 +4085,11 @@ begin
|
||||
{$ENDIF}
|
||||
Writer.WriteDescendent(AnUnitInfo.Component,nil);
|
||||
if DestroyDriver then Writer.Driver.Free;
|
||||
Writer.Free;
|
||||
Writer:=nil;
|
||||
FreeAndNil(Writer);
|
||||
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DumpExceptionBackTrace;
|
||||
ACaption:=lisStreamingError;
|
||||
AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
|
||||
AnUnitInfo.ComponentName])+#13
|
||||
@ -4115,7 +4119,7 @@ begin
|
||||
// changed too
|
||||
MemStream:=TExtMemoryStream.Create;
|
||||
if AnUnitInfo.ComponentLastLRSStreamSize>0 then
|
||||
MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+BufSize;
|
||||
MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+LRSStreamChunkSize;
|
||||
try
|
||||
BinCompStream.Position:=0;
|
||||
BinaryToLazarusResourceCode(BinCompStream,MemStream
|
||||
@ -4195,7 +4199,7 @@ begin
|
||||
TxtCompStream:=TExtMemoryStream.Create;
|
||||
if AnUnitInfo.ComponentLastLFMStreamSize>0 then
|
||||
TxtCompStream.Capacity:=AnUnitInfo.ComponentLastLFMStreamSize
|
||||
+BufSize;
|
||||
+LRSStreamChunkSize;
|
||||
try
|
||||
BinCompStream.Position:=0;
|
||||
LRSObjectBinaryToText(BinCompStream,TxtCompStream);
|
||||
@ -4287,6 +4291,56 @@ begin
|
||||
{$ENDIF}
|
||||
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;
|
||||
OkOnCodeErrors: boolean): TModalResult;
|
||||
var
|
||||
@ -4725,15 +4779,13 @@ const
|
||||
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
|
||||
var
|
||||
ComponentLoadingOk: boolean;
|
||||
TxtLFMStream, BinLFMStream: TExtMemoryStream;
|
||||
CInterface: TComponentInterface;
|
||||
TxtLFMStream, BinStream, AncestorBinStream: TExtMemoryStream;
|
||||
NewComponent: TComponent;
|
||||
AncestorType: TComponentClass;
|
||||
DesignerForm: TCustomForm;
|
||||
NewClassName: String;
|
||||
LFMType: String;
|
||||
NewAncestorName: String;
|
||||
APersistentClass: TPersistentClass;
|
||||
AncestorClassName: String;
|
||||
ACaption, AText: String;
|
||||
NewUnitName: String;
|
||||
AncestorUnitInfo: TUnitInfo;
|
||||
@ -4775,46 +4827,51 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
// find the ancestor type in the source
|
||||
NewAncestorName:='';
|
||||
AncestorType:=nil;
|
||||
if not CodeToolBoss.FindFormAncestor(AnUnitInfo.Source,NewClassName,
|
||||
NewAncestorName,true)
|
||||
then begin
|
||||
DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" NewClassName=',NewClassName,'. Unable to find ancestor class: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
if NewAncestorName<>'' then begin
|
||||
if CompareText(NewAncestorName,'TForm')=0 then begin
|
||||
AncestorType:=TForm;
|
||||
end else if CompareText(NewAncestorName,'TDataModule')=0 then begin
|
||||
// use our TDataModule
|
||||
// (some fpc versions have non designable TDataModule)
|
||||
AncestorType:=TDataModule;
|
||||
end else begin
|
||||
APersistentClass:=Classes.GetClass(NewAncestorName);
|
||||
if (APersistentClass<>nil)
|
||||
and (APersistentClass.InheritsFrom(TComponent)) then begin
|
||||
// ancestor type is a registered component class
|
||||
AncestorType:=TComponentClass(APersistentClass);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (AncestorType=nil) then begin
|
||||
// try loading the ancestor first
|
||||
AncestorUnitInfo:=nil;
|
||||
Result:=DoLoadHiddenResourceComponent(AnUnitInfo,NewAncestorName,Flags,
|
||||
AncestorType,AncestorUnitInfo);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
// use TForm as default ancestor
|
||||
if AncestorType=nil then
|
||||
AncestorType:=TForm;
|
||||
//DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" AncestorClassName=',NewAncestorName,' AncestorType=',AncestorType.ClassName);
|
||||
|
||||
BinLFMStream:=TExtMemoryStream.Create;
|
||||
BinStream:=nil;
|
||||
AncestorBinStream:=nil;
|
||||
try
|
||||
// find the ancestor type in the source
|
||||
AncestorClassName:='';
|
||||
AncestorType:=nil;
|
||||
AncestorUnitInfo:=nil;
|
||||
if not CodeToolBoss.FindFormAncestor(AnUnitInfo.Source,NewClassName,
|
||||
AncestorClassName,true)
|
||||
then begin
|
||||
DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" NewClassName=',NewClassName,'. Unable to find ancestor class: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
if AncestorClassName<>'' then begin
|
||||
if CompareText(AncestorClassName,'TForm')=0 then begin
|
||||
AncestorType:=TForm;
|
||||
end else if CompareText(AncestorClassName,'TDataModule')=0 then begin
|
||||
// use our TDataModule
|
||||
// (some fpc versions have non designable 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
|
||||
AncestorType:=TForm;
|
||||
end;
|
||||
|
||||
// try loading the ancestor first (unit, lfm and component instance)
|
||||
if (AncestorType=nil) then begin
|
||||
Result:=DoLoadHiddenResourceComponent(AnUnitInfo,AncestorClassName,Flags,
|
||||
AncestorType,AncestorUnitInfo);
|
||||
if Result<>mrOk then exit;
|
||||
Result:=DoSaveFileResourceToBinStream(AncestorUnitInfo,AncestorBinStream);
|
||||
if Result<>mrOk then exit;
|
||||
AncestorBinStream.Position:=0;
|
||||
end;
|
||||
|
||||
// use TForm as default ancestor
|
||||
if AncestorType=nil then
|
||||
AncestorType:=TForm;
|
||||
//DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" AncestorClassName=',AncestorClassName,' AncestorType=',AncestorType.ClassName);
|
||||
|
||||
BinStream:=TExtMemoryStream.Create;
|
||||
TxtLFMStream:=TExtMemoryStream.Create;
|
||||
try
|
||||
LFMBuf.SaveToStream(TxtLFMStream);
|
||||
@ -4824,10 +4881,10 @@ begin
|
||||
// convert text to binary format
|
||||
try
|
||||
if AnUnitInfo.ComponentLastBinStreamSize>0 then
|
||||
BinLFMStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
|
||||
LRSObjectTextToBinary(TxtLFMStream,BinLFMStream);
|
||||
AnUnitInfo.ComponentLastBinStreamSize:=BinLFMStream.Size;
|
||||
BinLFMStream.Position:=0;
|
||||
BinStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
|
||||
LRSObjectTextToBinary(TxtLFMStream,BinStream);
|
||||
AnUnitInfo.ComponentLastBinStreamSize:=BinStream.Size;
|
||||
BinStream.Position:=0;
|
||||
Result:=mrOk;
|
||||
except
|
||||
on E: Exception do begin
|
||||
@ -4852,14 +4909,12 @@ begin
|
||||
NewUnitName:=AnUnitInfo.UnitName;
|
||||
if NewUnitName='' then
|
||||
NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename);
|
||||
CInterface := TComponentInterface(
|
||||
FormEditor1.CreateComponentFromStream(BinLFMStream,
|
||||
AncestorType,copy(NewUnitName,1,255),true));
|
||||
if CInterface=nil then begin
|
||||
NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream,
|
||||
AncestorType,AncestorBinStream,copy(NewUnitName,1,255),true);
|
||||
AnUnitInfo.Component:=NewComponent;
|
||||
if NewComponent=nil then begin
|
||||
// error streaming component -> examine lfm file
|
||||
DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
|
||||
NewComponent:=nil;
|
||||
AnUnitInfo.Component:=NewComponent;
|
||||
// open lfm file in editor
|
||||
Result:=DoOpenEditorFile(LFMBuf.Filename,AnUnitInfo.EditorIndex+1,
|
||||
Flags+[ofOnlyIfExists,ofQuiet,ofRegularFile]);
|
||||
@ -4867,38 +4922,36 @@ begin
|
||||
Result:=DoCheckLFMInEditor;
|
||||
if Result=mrOk then Result:=mrCancel;
|
||||
exit;
|
||||
end else begin
|
||||
NewComponent:=CInterface.Component;
|
||||
DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
|
||||
AnUnitInfo.Component:=NewComponent;
|
||||
AnUnitInfo.ComponentName:=NewComponent.Name;
|
||||
AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
|
||||
if not (ofLoadHiddenResource in Flags) then begin
|
||||
CreateDesignerForComponent(NewComponent);
|
||||
DesignerForm:=FormEditor1.GetDesignerForm(AnUnitInfo.Component);
|
||||
end else begin
|
||||
DesignerForm:=nil;
|
||||
end;
|
||||
end;
|
||||
FormEditor1.CreateComponentInterface(NewComponent,true);
|
||||
DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
|
||||
AnUnitInfo.ComponentName:=NewComponent.Name;
|
||||
AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
|
||||
DesignerForm:=nil;
|
||||
if not (ofLoadHiddenResource in Flags) then begin
|
||||
CreateDesignerForComponent(NewComponent);
|
||||
DesignerForm:=FormEditor1.GetDesignerForm(AnUnitInfo.Component);
|
||||
end;
|
||||
|
||||
// select the new form (object inspector, formeditor, control selection)
|
||||
if ([ofProjectLoading,ofLoadHiddenResource]*Flags=[]) then begin
|
||||
FDisplayState:= dsForm;
|
||||
GlobalDesignHook.LookupRoot := NewComponent;
|
||||
TheControlSelection.AssignPersistent(NewComponent);
|
||||
end;
|
||||
// select the new form (object inspector, formeditor, control selection)
|
||||
if ([ofProjectLoading,ofLoadHiddenResource]*Flags=[]) then begin
|
||||
FDisplayState:= dsForm;
|
||||
GlobalDesignHook.LookupRoot := NewComponent;
|
||||
TheControlSelection.AssignPersistent(NewComponent);
|
||||
end;
|
||||
|
||||
// show new form
|
||||
if DesignerForm<>nil then begin
|
||||
LCLIntf.ShowWindow(DesignerForm.Handle,SW_SHOWNORMAL);
|
||||
FLastFormActivated:=DesignerForm;
|
||||
end;
|
||||
// show new form
|
||||
if DesignerForm<>nil then begin
|
||||
LCLIntf.ShowWindow(DesignerForm.Handle,SW_SHOWNORMAL);
|
||||
FLastFormActivated:=DesignerForm;
|
||||
end;
|
||||
end;
|
||||
{$IFDEF IDE_DEBUG}
|
||||
debugln('[TMainIDE.DoLoadLFM] LFM end');
|
||||
{$ENDIF}
|
||||
finally
|
||||
BinLFMStream.Free;
|
||||
BinStream.Free;
|
||||
AncestorBinStream.Free;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
end;
|
||||
@ -4984,6 +5037,24 @@ function TMainIDE.DoLoadHiddenResourceComponent(AnUnitInfo: TUnitInfo;
|
||||
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
|
||||
UsedUnitFilenames: TStrings;
|
||||
i: Integer;
|
||||
@ -5029,7 +5100,13 @@ begin
|
||||
UsedUnitFilenames.Free;
|
||||
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
|
||||
AnUnitInfo.LoadingComponent:=false;
|
||||
end;
|
||||
@ -5054,22 +5131,25 @@ begin
|
||||
LookupRoot:=AnUnitInfo.Component;
|
||||
if LookupRoot=nil then exit;
|
||||
AForm:=FormEditor1.GetDesignerForm(LookupRoot);
|
||||
if AForm=nil then
|
||||
RaiseException('TMainIDE.CloseDesignerForm '+AnUnitInfo.Filename);
|
||||
if (AForm=nil) then exit;
|
||||
if FLastFormActivated=AForm then
|
||||
FLastFormActivated:=nil;
|
||||
//debugln('TMainIDE.CloseDesignerForm A ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot));
|
||||
OldDesigner:=nil;
|
||||
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 FLastFormActivated=AForm then
|
||||
FLastFormActivated:=nil;
|
||||
//debugln('TMainIDE.CloseDesignerForm A ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot));
|
||||
|
||||
// unselect components
|
||||
for i:=LookupRoot.ComponentCount-1 downto 0 do
|
||||
TheControlSelection.Remove(LookupRoot.Components[i]);
|
||||
TheControlSelection.Remove(LookupRoot);
|
||||
// free designer and design form
|
||||
OldDesigner:=TDesigner(AForm.Designer);
|
||||
OldDesigner.DeleteFormAndFree;
|
||||
// unselect components
|
||||
for i:=LookupRoot.ComponentCount-1 downto 0 do
|
||||
TheControlSelection.Remove(LookupRoot.Components[i]);
|
||||
TheControlSelection.Remove(LookupRoot);
|
||||
// free designer and design form
|
||||
OldDesigner.DeleteFormAndFree;
|
||||
end;
|
||||
AnUnitInfo.Component:=nil;
|
||||
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
@ -11974,7 +12054,7 @@ begin
|
||||
//writeln('TMainIDE.OnPropHookPersistentAdded B ',AComponent.Name,':',AComponent.ClassName);
|
||||
// create component interface
|
||||
if FormEditor1.FindComponent(AComponent)=nil then
|
||||
FormEditor1.CreateComponentInterface(AComponent);
|
||||
FormEditor1.CreateComponentInterface(AComponent,false);
|
||||
// set component into design mode
|
||||
SetDesigning(AComponent,true);
|
||||
//writeln('TMainIDE.OnPropHookPersistentAdded C ',AComponent.Name,':',AComponent.ClassName);
|
||||
|
||||
@ -578,6 +578,7 @@ type
|
||||
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
|
||||
function UnitWithEditorIndex(Index:integer): TUnitInfo;
|
||||
function UnitWithComponent(AComponent: TComponent): TUnitInfo;
|
||||
function UnitComponentInheritingFrom(AClass: TComponentClass): TUnitInfo;
|
||||
function UnitInfoWithFilename(const AFilename: string): TUnitInfo;
|
||||
function UnitInfoWithFilename(const AFilename: string;
|
||||
SearchFlags: TProjectFileSearchFlags): TUnitInfo;
|
||||
@ -617,7 +618,7 @@ type
|
||||
procedure SetBookmark(AnUnitInfo: TUnitInfo; X,Y,ID: integer);
|
||||
procedure MergeBookmarks(AnUnitInfo: TUnitInfo);
|
||||
|
||||
// dependencies
|
||||
// package dependencies
|
||||
function FindDependencyByName(const PackageName: string): TPkgDependency;
|
||||
function RequiredDepByIndex(Index: integer): TPkgDependency;
|
||||
function RemovedDepByIndex(Index: integer): TPkgDependency;
|
||||
@ -3372,6 +3373,14 @@ begin
|
||||
Result:=Result.fNext[uilWithComponent];
|
||||
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;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
@ -105,10 +105,10 @@ type
|
||||
const AUnitName: shortstring;
|
||||
X,Y,W,H: Integer): TIComponentInterface; virtual; abstract;
|
||||
function CreateComponentFromStream(BinStream: TStream;
|
||||
AncestorType: TComponentClass;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive: boolean;
|
||||
Visible: boolean = true): TIComponentInterface; virtual; abstract;
|
||||
AncestorType: TComponentClass; AncestorBinStream: TStream;
|
||||
const NewUnitName: ShortString;
|
||||
Interactive: boolean;
|
||||
Visible: boolean = true): TIComponentInterface; virtual; abstract;
|
||||
function CreateChildComponentFromStream(BinStream: TStream;
|
||||
ComponentClass: TComponentClass;
|
||||
Root: TComponent;
|
||||
|
||||
@ -3517,7 +3517,8 @@ begin
|
||||
// no csOpaque: delphi compatible, win32 themes notebook depend on it
|
||||
// csOpaque means entire client area will be drawn
|
||||
// (most controls are semi-transparent)
|
||||
FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
|
||||
FControlStyle := FControlStyle
|
||||
+[csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
|
||||
FConstraints:= TSizeConstraints.Create(Self);
|
||||
FBorderSpacing:=TControlBorderSpacing.Create(Self);
|
||||
for Side:=Low(FAnchorSides) to High(FAnchorSides) do
|
||||
|
||||
@ -1691,6 +1691,8 @@ end;
|
||||
procedure TCustomForm.CreateWnd;
|
||||
begin
|
||||
//DebugLn('TCustomForm.CreateWnd START ',ClassName);
|
||||
if CompareText(ClassName,'TGrandMaForm')=0 then
|
||||
RaiseGDBException('');
|
||||
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
|
||||
inherited CreateWnd;
|
||||
|
||||
@ -1778,8 +1780,9 @@ procedure TCustomForm.UpdateShowing;
|
||||
var
|
||||
X, Y : integer;
|
||||
begin
|
||||
if csLoading in ComponentState then exit;
|
||||
{$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}
|
||||
{ If the the form is about to show, calculate its metrics }
|
||||
if Visible then begin
|
||||
|
||||
@ -2611,11 +2611,11 @@ begin
|
||||
if HandleAllocated then UpdateWindow(Handle);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TWinControl Focused }
|
||||
{------------------------------------------------------------------------------}
|
||||
Function TWinControl.Focused: Boolean;
|
||||
Begin
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl Focused
|
||||
------------------------------------------------------------------------------}
|
||||
function TWinControl.Focused: Boolean;
|
||||
begin
|
||||
Result := CanTab and (HandleAllocated and (FindOwnerControl(GetFocus)=Self));
|
||||
end;
|
||||
|
||||
@ -4251,13 +4251,13 @@ begin
|
||||
UpdateShowing;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TWinControl InsertControl }
|
||||
{------------------------------------------------------------------------------}
|
||||
Procedure TWinControl.InsertControl(AControl: TControl);
|
||||
Begin
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl InsertControl
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.InsertControl(AControl: TControl);
|
||||
begin
|
||||
InsertControl(AControl,ControlCount);
|
||||
End;
|
||||
end;
|
||||
|
||||
procedure TWinControl.InsertControl(AControl: TControl; Index: integer);
|
||||
begin
|
||||
@ -4273,7 +4273,7 @@ begin
|
||||
if AControl is TWinControl then
|
||||
begin
|
||||
AControl.Perform(CM_PARENTCTL3DCHANGED, 0, 0);
|
||||
UpdateControlState;
|
||||
TWinControl(AControl).UpdateControlState;
|
||||
end else
|
||||
if HandleAllocated then AControl.Invalidate;
|
||||
//DebugLn('TWinControl.InsertControl ',Name,':',ClassName);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user