diff --git a/.gitattributes b/.gitattributes
index d9a67a34a1..b413d8db49 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1044,6 +1044,15 @@ examples/componentstreaming/componentstreaming.lpr svneol=native#text/plain
examples/componentstreaming/mainunit.lfm svneol=native#text/plain
examples/componentstreaming/mainunit.lrs svneol=native#text/plain
examples/componentstreaming/mainunit.pas svneol=native#text/plain
+examples/designerbaseclass/README.txt svneol=native#text/plain
+examples/designerbaseclass/customcomponentclass.pas svneol=native#text/plain
+examples/designerbaseclass/designbaseclassdemopkg.lpk svneol=native#text/plain
+examples/designerbaseclass/designbaseclassdemopkg.pas svneol=native#text/plain
+examples/designerbaseclass/example/demo1.lpi svneol=native#text/plain
+examples/designerbaseclass/example/demo1.lpr svneol=native#text/plain
+examples/designerbaseclass/example/unit1.lfm svneol=native#text/plain
+examples/designerbaseclass/example/unit1.lrs svneol=native#text/plain
+examples/designerbaseclass/example/unit1.pas svneol=native#text/plain
examples/dlgform.pp svneol=native#text/pascal
examples/easter/about.lfm svneol=native#text/plain
examples/easter/about.lrs svneol=native#text/pascal
diff --git a/designer/jitform/jitform.pas b/designer/jitform/jitform.pas
index 17649a6074..0d6468e6a1 100644
--- a/designer/jitform/jitform.pas
+++ b/designer/jitform/jitform.pas
@@ -22,9 +22,13 @@
Abstract:
JITForm - just-in-time form.
+ This unit contains some of the dirtiest hacks in the lazarus IDE.
+ Nevertheless they work for year on all platforms and make many things
+ much easier.
+
Forms are the most common resources/design items in the IDE, hence the name.
- Of course any TComponent descendant can be editid but naming it
- 'JITComponent' would confuse new developers.
+ Why the tricks: Of course any TComponent descendant can be edited
+ but naming it 'JITComponent' would confuse new developers.
Because the IDE does wild things with forms and datamodules, like creating
an own class for each opened form/datamodule and dynamically creating
diff --git a/designer/jitforms.pp b/designer/jitforms.pp
index f7c0d0d606..3f4b5fa3f2 100644
--- a/designer/jitforms.pp
+++ b/designer/jitforms.pp
@@ -77,12 +77,10 @@ type
TJITComponentList = class(TPersistentWithTemplates)
private
- FComponentPrefix: string;
FCurUnknownClass: string;
FCurUnknownProperty: string;
FErrors: TLRPositionLinks;
FOnPropertyNotFound: TJITPropertyNotFoundEvent;
- procedure SetComponentPrefix(const AValue: string);
protected
FCurReadErrorMsg: string;
FCurReadJITComponent:TComponent;
@@ -178,8 +176,6 @@ type
property CurReadErrorMsg: string read FCurReadErrorMsg;
property CurUnknownProperty: string read FCurUnknownProperty;
property CurUnknownClass: string read FCurUnknownClass;
- property ComponentPrefix: string read FComponentPrefix
- write SetComponentPrefix;
property Errors: TLRPositionLinks read FErrors;
end;
@@ -190,7 +186,6 @@ type
private
function GetItem(Index: integer): TForm;
public
- constructor Create;
function IsJITForm(AComponent: TComponent): boolean;
property Items[Index:integer]: TForm read GetItem; default;
end;
@@ -200,7 +195,6 @@ type
TJITNonFormComponents = class(TJITComponentList)
public
- constructor Create;
function IsJITNonForm(AComponent: TComponent): boolean;
end;
@@ -339,7 +333,7 @@ type
end;
var
- TComponentValidateRenameOffset: LongInt;
+ TComponentValidateRenameOffset: LongInt = 0;
procedure TComponentWithOverrideValidateRename.ValidateRename(
AComponent: TComponent; const CurName, NewName: string);
@@ -543,7 +537,6 @@ end;
constructor TJITComponentList.Create;
begin
inherited Create;
- FComponentPrefix:='Form';
FJITComponents:=TList.Create;
FErrors:=TLRPositionLinks.Create;
end;
@@ -633,11 +626,15 @@ end;
procedure TJITComponentList.GetUnusedNames(
var ComponentName,ComponentClassName:shortstring);
var a:integer;
+ ComponentPrefix: String;
begin
a:=1;
+ ComponentPrefix:=ComponentClassName;
+ if ComponentPrefix[1] in ['t','T'] then
+ ComponentPrefix:=copy(ComponentPrefix,2,length(ComponentPrefix));
repeat
ComponentName:=ComponentPrefix+IntToStr(a);
- ComponentClassName:='T'+ComponentPrefix+IntToStr(a);
+ ComponentClassName:='T'+ComponentName;
inc(a);
until (FindComponentByName(ComponentName)<0)
and (FindComponentByClassName(ComponentClassName)<0);
@@ -1003,12 +1000,6 @@ begin
Result.Code:=NewCode;
end;
-procedure TJITComponentList.SetComponentPrefix(const AValue: string);
-begin
- if FComponentPrefix=AValue then exit;
- FComponentPrefix:=AValue;
-end;
-
function TJITComponentList.CreateNewJITClass(ParentClass: TClass;
const NewClassName, NewUnitName: ShortString): TClass;
// Create a new class (vmt, virtual method table, field table and typeinfo)
@@ -1081,7 +1072,7 @@ begin
then
raise Exception.Create('CreateNewClass new aligned TypeData');
- // set TypeData (PropCount is the total number of properties)
+ // set TypeData (PropCount is the total number of properties, including ancestors)
NewTypeData^.ClassType:=TClass(NewVMT);
NewTypeData^.ParentInfo:=ParentClass.ClassInfo;
NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount;
@@ -1094,7 +1085,7 @@ begin
Pointer(NewVMT+vmtMethodStart)^,
vmtTailSize);
- // override 'ValidateRename' for TComponent descendents
+ // override 'ValidateRename' for TComponent descendants
if ParentClass.InheritsFrom(TComponent) then begin
Pointer(Pointer(NewVMT+TComponentValidateRenameOffset)^):=
@TComponentWithOverrideValidateRename.ValidateRename;
@@ -1424,12 +1415,6 @@ end;
{ TJITForms }
-constructor TJITForms.Create;
-begin
- inherited Create;
- FComponentPrefix:='Form';
-end;
-
function TJITForms.IsJITForm(AComponent: TComponent): boolean;
begin
Result:=(AComponent<>nil) and (AComponent is TForm)
@@ -1443,12 +1428,6 @@ end;
{ TJITNonFormComponents }
-constructor TJITNonFormComponents.Create;
-begin
- inherited Create;
- FComponentPrefix:='DataModule';
-end;
-
function TJITNonFormComponents.IsJITNonForm(AComponent: TComponent): boolean;
begin
Result:=(AComponent<>nil) and (not (AComponent is TForm))
diff --git a/examples/designerbaseclass/README.txt b/examples/designerbaseclass/README.txt
new file mode 100644
index 0000000000..d296e2c53b
--- /dev/null
+++ b/examples/designerbaseclass/README.txt
@@ -0,0 +1,11 @@
+This demonstrates how to add a new component base class for the designer.
+
+Normally the IDE knows only TForm and TDataModule as base classes.
+All components that can be designed in the IDE must descend form one of these
+classes.
+
+Quick start:
+Install the package DesignBaseClassDemoPkg in the IDE and restart it.
+
+Then open the project example/demo1.lpi
+
diff --git a/examples/designerbaseclass/customcomponentclass.pas b/examples/designerbaseclass/customcomponentclass.pas
new file mode 100644
index 0000000000..788ea64add
--- /dev/null
+++ b/examples/designerbaseclass/customcomponentclass.pas
@@ -0,0 +1,93 @@
+{
+ *****************************************************************************
+ * *
+ * This file is part of the Lazarus Component Library (LCL) *
+ * *
+ * See the file COPYING.modifiedLGPL, included in this distribution, *
+ * for details about the copyright. *
+ * *
+ * This program is distributed in the hope that it will be useful, *
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of *
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
+ * *
+ *****************************************************************************
+
+ Author: Mattias Gaertner
+
+ Abtract:
+ Registers a new designer base class (like TForm or TDataModul) in the IDE.
+}
+unit CustomComponentClass;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, LCLProc, Forms, FormEditingIntf;
+
+type
+
+ { TMyComponentClass }
+
+ TMyComponentClass = class(TComponent)
+ private
+ FDemoProperty: integer;
+ protected
+ procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+ public
+ constructor Create(TheOwner: TComponent); override;
+ published
+ property DemoProperty: integer read FDemoProperty write FDemoProperty;
+ end;
+
+procedure Register;
+
+
+implementation
+
+
+procedure Register;
+begin
+ FormEditingHook.RegisterDesignerBaseClass(TMyComponentClass);
+end;
+
+{ TMyComponentClass }
+
+procedure TMyComponentClass.GetChildren(Proc: TGetChildProc; Root: TComponent);
+// this method is called by TWriter to retrieve the child components to write
+var
+ I: Integer;
+ OwnedComponent: TComponent;
+begin
+ DebugLn(['TMyComponentClass.GetChildren ComponentCount=',ComponentCount]);
+ inherited GetChildren(Proc, Root);
+ if Root = Self then begin
+ for I := 0 to ComponentCount - 1 do
+ begin
+ OwnedComponent := Components[I];
+ if not OwnedComponent.HasParent then Proc(OwnedComponent);
+ end;
+ end;
+end;
+
+constructor TMyComponentClass.Create(TheOwner: TComponent);
+// init the component with an IDE resource
+begin
+ DebugLn(['TMyComponentClass.Create ',DbgSName(TheOwner)]);
+ GlobalNameSpace.BeginWrite;
+ try
+ inherited Create(TheOwner);
+ if (ClassType <> TMyComponentClass) and not (csDesigning in ComponentState)
+ then begin
+ if not InitResourceComponent(Self, TDataModule) then begin
+ raise EResNotFound.Create('Resource missing for class '+ClassName);
+ end;
+ end;
+ finally
+ GlobalNameSpace.EndWrite;
+ end;
+end;
+
+end.
+
diff --git a/examples/designerbaseclass/designbaseclassdemopkg.lpk b/examples/designerbaseclass/designbaseclassdemopkg.lpk
new file mode 100644
index 0000000000..81c840de8e
--- /dev/null
+++ b/examples/designerbaseclass/designbaseclassdemopkg.lpk
@@ -0,0 +1,46 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/designerbaseclass/designbaseclassdemopkg.pas b/examples/designerbaseclass/designbaseclassdemopkg.pas
new file mode 100644
index 0000000000..914dc0bb12
--- /dev/null
+++ b/examples/designerbaseclass/designbaseclassdemopkg.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+This source is only used to compile and install the package.
+ }
+
+unit DesignBaseClassDemoPkg;
+
+interface
+
+uses
+ CustomComponentClass, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('CustomComponentClass', @CustomComponentClass.Register);
+end;
+
+initialization
+ RegisterPackage('DesignBaseClassDemoPkg', @Register);
+end.
diff --git a/examples/designerbaseclass/example/demo1.lpi b/examples/designerbaseclass/example/demo1.lpi
new file mode 100644
index 0000000000..fe1bb179a4
--- /dev/null
+++ b/examples/designerbaseclass/example/demo1.lpi
@@ -0,0 +1,66 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/designerbaseclass/example/demo1.lpr b/examples/designerbaseclass/example/demo1.lpr
new file mode 100644
index 0000000000..4d5dde3f58
--- /dev/null
+++ b/examples/designerbaseclass/example/demo1.lpr
@@ -0,0 +1,16 @@
+program Demo1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Unit1, DesignBaseClassDemoPkg;
+
+begin
+ Application.Initialize;
+ Application.Run;
+end.
+
diff --git a/examples/designerbaseclass/example/unit1.lfm b/examples/designerbaseclass/example/unit1.lfm
new file mode 100644
index 0000000000..b6ac5a7ce9
--- /dev/null
+++ b/examples/designerbaseclass/example/unit1.lfm
@@ -0,0 +1,10 @@
+object MyComponent1: TMyComponent1
+ left = 302
+ top = 594
+ object OpenDialog1: TOpenDialog
+ Title = 'Open existing file'
+ FilterIndex = 0
+ left = 91
+ top = 87
+ end
+end
diff --git a/examples/designerbaseclass/example/unit1.lrs b/examples/designerbaseclass/example/unit1.lrs
new file mode 100644
index 0000000000..3cea34ab00
--- /dev/null
+++ b/examples/designerbaseclass/example/unit1.lrs
@@ -0,0 +1,7 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TMyComponent1','FORMDATA',[
+ 'TPF0'#13'TMyComponent1'#12'MyComponent1'#4'left'#3'.'#1#3'top'#3'R'#2#0#11'T'
+ +'OpenDialog'#11'OpenDialog1'#5'Title'#6#18'Open existing file'#11'FilterInde'
+ +'x'#2#0#4'left'#2'['#3'top'#2'W'#0#0#0
+]);
diff --git a/examples/designerbaseclass/example/unit1.pas b/examples/designerbaseclass/example/unit1.pas
new file mode 100644
index 0000000000..80dfe2a553
--- /dev/null
+++ b/examples/designerbaseclass/example/unit1.pas
@@ -0,0 +1,57 @@
+{
+ *****************************************************************************
+ * *
+ * This file is part of the Lazarus Component Library (LCL) *
+ * *
+ * See the file COPYING.modifiedLGPL, included in this distribution, *
+ * for details about the copyright. *
+ * *
+ * This program is distributed in the hope that it will be useful, *
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of *
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
+ * *
+ *****************************************************************************
+
+ Author: Mattias Gaertner
+
+ Important:
+ Before you open the designer of this unit, you must install the package
+ DesignBaseClassDemoPkg, because it registers the TMyComponentClass.
+ Read the README.txt.
+
+ Abstract:
+ When you open the designer, you can see the property 'DemoProperty' in the
+ Object Inspector. This property ws inherited from TMyComponentClass.
+}
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+ CustomComponentClass;
+
+type
+
+ { TMyComponent1 }
+
+ TMyComponent1 = class(TMyComponentClass)
+ OpenDialog1: TOpenDialog;
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ MyComponent1: TMyComponent1;
+
+implementation
+
+initialization
+ {$I unit1.lrs}
+
+end.
+
diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp
index 9ddac4f39f..b5eb86ceb2 100644
--- a/ide/customformeditor.pp
+++ b/ide/customformeditor.pp
@@ -117,6 +117,7 @@ each control that's dropped onto the form
FObj_Inspector: TObjectInspector;
FDefineProperties: TAVLTree;// tree of TDefinePropertiesCacheItem
FStandardDefinePropertiesRegistered: Boolean;
+ FDesignerBaseClasses: TFPList; // list of TComponentClass
function GetPropertyEditorHook: TPropertyEditorHook;
function FindDefinePropertyNode(const APersistentClassName: string
): TAVLTreeNode;
@@ -131,11 +132,12 @@ each control that's dropped onto the form
Instance: TPersistent; var PropName: string; IsPath: boolean;
var Handled, Skip: Boolean);
+ function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
procedure OnDesignerMenuItemClick(Sender: TObject); virtual;
function FindNonControlFormNode(LookupRoot: TComponent): TAVLTreeNode;
public
JITFormList: TJITForms;// designed forms
- JITNonFormList: TJITNonFormComponents;// designed data modules
+ JITNonFormList: TJITNonFormComponents;// designed custom components like data modules
constructor Create;
destructor Destroy; override;
@@ -226,6 +228,11 @@ each control that's dropped onto the form
// ancestors
function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override;
function GetAncestorInstance(AComponent: TComponent): TComponent; override;
+ function RegisterDesignerBaseClass(AClass: TComponentClass): integer; override;
+ function DesignerBaseClassCount: Integer; override;
+ procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
+ function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
+ function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; override;
// define properties
procedure FindDefineProperty(const APersistentClassName,
@@ -288,6 +295,12 @@ each control that's dropped onto the form
property Target: TPersistent read FTarget;
end;
+
+const
+ StandardDesignerBaseClasses: array[1..2] of TComponentClass = (
+ Forms.TForm,
+ {$IFNDEF UseFCLDataModule}Forms.{$ENDIF}TDataModule
+ );
function CompareComponentInterfaces(Data1, Data2: Pointer): integer;
@@ -782,12 +795,18 @@ end;
{ TCustomFormEditor }
constructor TCustomFormEditor.Create;
+var
+ l: Integer;
begin
inherited Create;
FComponentInterfaces := TAVLTree.Create(@CompareComponentInterfaces);
FNonControlForms:=TAVLTree.Create(@CompareNonControlDesignerForms);
FSelection := TPersistentSelectionList.Create;
-
+ FDesignerBaseClasses:=TFPList.Create;
+ for l:=Low(StandardDesignerBaseClasses) to High(StandardDesignerBaseClasses)
+ do
+ FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
+
JITFormList := TJITForms.Create;
JITFormList.OnReaderError:=@JITListReaderError;
JITFormList.OnPropertyNotFound:=@JITListPropertyNotFound;
@@ -811,6 +830,7 @@ begin
end;
FreeAndNil(JITFormList);
FreeAndNil(JITNonFormList);
+ FreeAndNil(FDesignerBaseClasses);
FreeAndNil(FComponentInterfaces);
FreeAndNil(FSelection);
FreeAndNil(FNonControlForms);
@@ -1440,6 +1460,12 @@ Begin
end
else begin
// non TControl
+ if CompWidth<=0 then CompWidth:=50;
+ if CompHeight<=0 then CompHeight:=50;
+ if CompLeft<0 then
+ CompLeft:=Max(1,Min(250,Screen.Width-CompWidth-50));
+ if CompTop<0 then
+ CompTop:=Max(1,Min(250,Screen.Height-CompHeight-50));
with LongRec(Temp.Component.DesignInfo) do begin
Lo:=word(Min(32000,CompLeft));
Hi:=word(Min(32000,CompTop));
@@ -1591,6 +1617,51 @@ begin
Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassParent));
end;
+function TCustomFormEditor.RegisterDesignerBaseClass(AClass: TComponentClass
+ ): integer;
+begin
+ if AClass=nil then
+ RaiseGDBException('TCustomFormEditor.RegisterDesignerBaseClass');
+ Result:=FDesignerBaseClasses.IndexOf(AClass);
+ if Result<0 then
+ Result:=FDesignerBaseClasses.Add(AClass)
+end;
+
+function TCustomFormEditor.DesignerBaseClassCount: Integer;
+begin
+ Result:=FDesignerBaseClasses.Count;
+end;
+
+procedure TCustomFormEditor.UnregisterDesignerBaseClass(AClass: TComponentClass
+ );
+var
+ l: Integer;
+begin
+ for l:=Low(StandardDesignerBaseClasses) to High(StandardDesignerBaseClasses)
+ do
+ if StandardDesignerBaseClasses[l]=AClass then
+ RaiseGDBException('TCustomFormEditor.UnregisterDesignerBaseClass');
+ FDesignerBaseClasses.Remove(AClass);
+end;
+
+function TCustomFormEditor.IndexOfDesignerBaseClass(AClass: TComponentClass
+ ): integer;
+begin
+ Result:=FDesignerBaseClasses.IndexOf(AClass);
+end;
+
+function TCustomFormEditor.FindDesignerBaseClassByName(
+ const AClassName: shortstring): TComponentClass;
+var
+ i: Integer;
+begin
+ for i:=FDesignerBaseClasses.Count-1 downto 0 do begin
+ Result:=DesignerBaseClasses[i];
+ if CompareText(Result.ClassName,AClassName)=0 then exit;
+ end;
+ Result:=nil;
+end;
+
procedure TCustomFormEditor.FindDefineProperty(
const APersistentClassName, AncestorClassName, Identifier: string;
var IsDefined: boolean);
@@ -1630,6 +1701,7 @@ var
function GetDefinePersistent(const AClassName: string): Boolean;
var
APersistentClass: TPersistentClass;
+ AncestorClass: TComponentClass;
begin
Result:=false;
@@ -1663,12 +1735,11 @@ var
end;
// try default classes
- if (APersistent=nil) and (CompareText(AClassName,'TDataModule')=0) then
- begin
- if not CreateTempPersistent(TDataModule) then exit;
- end;
- if (APersistent=nil) and (CompareText(AClassName,'TForm')=0) then begin
- if not CreateTempPersistent(TForm) then exit;
+ if (APersistent=nil) then begin
+ AncestorClass:=FindDesignerBaseClassByName(AClassName);
+ if AncestorClass<>nil then begin
+ if not CreateTempPersistent(AncestorClass) then exit;
+ end;
end;
Result:=true;
@@ -1793,14 +1864,14 @@ var
JITComponentList: TJITComponentList;
begin
JITComponentList:=TJITComponentList(Sender);
- aCaption:='Error reading '+JITComponentList.ComponentPrefix;
+ aCaption:='Error reading '+JITComponentList.ClassName;
aMsg:='';
DlgType:=mtError;
Buttons:=[mbCancel];
HelpCtx:=0;
with JITComponentList do begin
- aMsg:=aMsg+ComponentPrefix+': ';
+ aMsg:=aMsg+ClassName+': ';
if CurReadJITComponent<>nil then
aMsg:=aMsg+CurReadJITComponent.Name+':'+CurReadJITComponent.ClassName
else
@@ -1876,6 +1947,12 @@ begin
'" IsPath=',BoolToStr(IsPath));
end;
+function TCustomFormEditor.GetDesignerBaseClasses(Index: integer
+ ): TComponentClass;
+begin
+ Result:=TComponentClass(FDesignerBaseClasses[Index]);
+end;
+
function TCustomFormEditor.GetPropertyEditorHook: TPropertyEditorHook;
begin
Result:=Obj_Inspector.PropertyEditorHook;
diff --git a/ide/main.pp b/ide/main.pp
index 56b4dc6e52..4b07525722 100644
--- a/ide/main.pp
+++ b/ide/main.pp
@@ -4924,7 +4924,7 @@ begin
case Result of
mrAbort: exit;
mrOk:
- begin
+ if AncestorUnitInfo<>nil then begin
Result:=DoSaveUnitComponentToBinStream(AncestorUnitInfo,
AncestorBinStream);
if Result<>mrOk then exit;
@@ -5212,18 +5212,12 @@ var
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
+ AComponentClass:=
+ FormEditor1.FindDesignerBaseClassByName(AComponentClassName);
+ if AComponentClass<>nil then begin
+ DebugLn(['TMainIDE.DoLoadComponentDependencyHidden.TryRegisteredClasses found: ',AComponentClass.ClassName]);
TheModalResult:=mrOk;
Result:=true;
end;
@@ -5259,7 +5253,10 @@ begin
if TryUnit(ComponentUnitInfo.Filename,Result,false) then exit;
end;
- // then search in used units
+ // then try registered classes
+ if TryRegisteredClasses(Result) then exit;
+
+ // finally search in used units
UsedUnitFilenames:=nil;
try
if not CodeToolBoss.FindUsedUnitFiles(AnUnitInfo.Source,UsedUnitFilenames)
@@ -5294,9 +5291,6 @@ begin
UsedUnitFilenames.Free;
end;
- // finally try registered classes
- if TryRegisteredClasses(Result) then exit;
-
Result:=QuestionDlg(lisCodeTemplError, Format(
lisUnableToFindTheUnitOfComponentClass, ['"', AComponentClassName, '"']),
mtError, [mrCancel, lisCancelLoadingThisComponent,
diff --git a/ideintf/formeditingintf.pas b/ideintf/formeditingintf.pas
index 41a03aedf3..38bfb42388 100644
--- a/ideintf/formeditingintf.pas
+++ b/ideintf/formeditingintf.pas
@@ -88,6 +88,7 @@ type
TAbstractFormEditor = class
protected
+ function GetDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
function GetDesigner(Index: integer): TIDesigner; virtual; abstract;
public
// components
@@ -118,6 +119,12 @@ type
// ancestors
function GetAncestorLookupRoot(AComponent: TComponent): TComponent; virtual; abstract;
function GetAncestorInstance(AComponent: TComponent): TComponent; virtual; abstract;
+ function RegisterDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
+ function DesignerBaseClassCount: Integer; virtual; abstract;
+ property DesignerBaseClasses[Index: integer]: TComponentClass read GetDesignerBaseClasses;
+ procedure UnregisterDesignerBaseClass(AClass: TComponentClass); virtual; abstract;
+ function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
+ function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; virtual; abstract;
// designers
function DesignerCount: integer; virtual; abstract;
diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp
index 1fc1cfd559..c15b416eed 100644
--- a/lcl/interfaces/gtk/gtkint.pp
+++ b/lcl/interfaces/gtk/gtkint.pp
@@ -406,7 +406,6 @@ const
procedure InternalInit;
var
c: TClipboardType;
- cr: TCursor;
begin
gtk_handler_quark := g_quark_from_static_string('gtk-signal-handlers');