IDE: implemented registering custom component base classes for designer

git-svn-id: trunk@10458 -
2025-10-21 21:31:36 +02:00 · 2007-01-16 18:28:15 +00:00 · 2007-01-16 18:28:15 +00:00 · 52796d556e
commit 52796d556e
parent 4716bded24
16 changed files with 453 additions and 57 deletions
--- 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
--- 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
--- 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))
--- a/examples/designerbaseclass/README.txt
+++ 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
+
--- a/examples/designerbaseclass/customcomponentclass.pas
+++ 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.
+
--- a/examples/designerbaseclass/designbaseclassdemopkg.lpk
+++ b/examples/designerbaseclass/designbaseclassdemopkg.lpk
@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="2">
+    <Name Value="DesignBaseClassDemoPkg"/>
+    <CompilerOptions>
+      <Version Value="5"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <CodeGeneration>
+        <Generate Value="Faster"/>
+      </CodeGeneration>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="2">
+      <Item1>
+        <Filename Value="customcomponentclass.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="CustomComponentClass"/>
+      </Item1>
+      <Item2>
+        <Filename Value="README.txt"/>
+        <Type Value="Text"/>
+      </Item2>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="IDEIntf"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>
--- a/examples/designerbaseclass/designbaseclassdemopkg.pas
+++ 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.
--- a/examples/designerbaseclass/example/demo1.lpi
+++ b/examples/designerbaseclass/example/demo1.lpi
@ -0,0 +1,66 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="DesignBaseClassDemoPkg"/>
+        <MinVersion Valid="True"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="demo1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Demo1"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="MyComponent1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="unit1.lrs"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
--- a/examples/designerbaseclass/example/demo1.lpr
+++ 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.
+
--- a/examples/designerbaseclass/example/unit1.lfm
+++ 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
--- a/examples/designerbaseclass/example/unit1.lrs
+++ 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
+]);
--- a/examples/designerbaseclass/example/unit1.pas
+++ 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.
+
--- 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;
--- 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,
--- 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;
--- 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');