{
 /***************************************************************************
                             CustomFormEditor.pp
                             -------------------

 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code 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.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
}
unit CustomFormEditor;

{$mode objfpc}{$H+}

{$I ide.inc}

interface

{ $DEFINE VerboseFormEditor}

uses
{$IFDEF IDE_MEM_CHECK}
  MemCheck,
{$ENDIF}
  // RTL+FCL
  Classes, SysUtils, TypInfo, Math, AVL_Tree,
  // LCL
  LCLIntf, LCLType, LResources, LCLMemManager, Controls, Graphics,
  Forms, Menus, Dialogs,
  // LazUtils
  FileUtil, LazFileUtils, LazFileCache, CompWriterPas, LazLoggerBase, LazTracer,
  LazUTF8, AvgLvlTree,
  // Codetools
  CodeCache, CodeTree, CodeToolManager, FindDeclarationTool,
  // BuildIntf
  ComponentReg,
  // IDEIntf
  PropEdits, PropEditUtils, ObjectInspector, FormEditingIntf,
  UnitResources, IDEOptEditorIntf, IDEDialogs, ComponentEditors,
  // IdeUtils
  IdeUtilsPkgStrConsts,
  // IdeProject
  IdeProjectStrConsts,
  // IDE
  LazarusIDEStrConsts, EditorOptions, EnvGuiOptions, Project, MainIntf, PackageDefs,
  // Designer
  CustomNonFormDesigner, NonControlDesigner, FrameDesigner, ControlSelection,
  JITForms, DesignerProcs;

const
  OrdinalTypes = [tkInteger,tkChar,tkEnumeration,tkbool];
  LRSStreamChunkSize = 4096; // allocating mem in 4k chunks helps many mem managers

type
  TSelectFrameEvent = procedure(Sender: TObject; var AComponentClass: TComponentClass) of Object;

  { TCustomFormEditor }

  TCustomFormEditor = class(TAbstractFormEditor)
  private
    FOnSelectFrame: TSelectFrameEvent;
    FSelection: TPersistentSelectionList;
    FObj_Inspector: TObjectInspectorDlg;
    FDefineProperties: TAvlTree;// tree of TDefinePropertiesCacheItem
    FStandardDefinePropertiesRegistered: Boolean;
    FDesignerBaseClasses: TFPList; // list of TComponentClass
    FDesignerMediatorClasses: TFPList;// list of TDesignerMediatorClass
    FOnNodeGetImageIndex: TOnOINodeGetImageEvent;
    FDesignerBaseClassesCanCreateForm: TFPList; // list of TComponentClass
    function GetPropertyEditorHook: TPropertyEditorHook;
    function FindDefinePropertyNode(const APersistentClassName: string
                                    ): TAvlTreeNode;
    procedure FrameCompGetCreationClass(Sender: TObject;
      var NewComponentClass: TComponentClass);
    function CompTree_ParentAcceptsChild(aParent, aChild,
      aLookupRoot: TPersistent): boolean;
    procedure CompTree_SetParent(aChild, aParent, aLookupRoot: TPersistent);
    procedure PasWriterFindAncestor(Writer: TCompWriterPas;
      aComponent: TComponent; const aName: string; var anAncestor,
      aRootAncestor: TComponent);
    procedure PasWriterGetMethodName(Writer: TCompWriterPas;
      Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
    procedure PasWriterGetParentProperty(Writer: TCompWriterPas;
      Component: TComponent; var PropName: string);
    function OnPropHookGetAncestorInstProp(const InstProp: TInstProp;
                                      out AncestorInstProp: TInstProp): boolean;
  protected
    FNonFormForms: TAvlTree; // tree of TNonFormProxyDesignerForm sorted for LookupRoot
    procedure SetSelection(const ASelection: TPersistentSelectionList);
    procedure ObjectInspectorModified(Sender: TObject);
    procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
    procedure JITListBeforeCreate(Sender: TObject; Instance: TPersistent);
    procedure JITListException(Sender: TObject; E: Exception;
                               var {%H-}Action: TModalResult);
    procedure JITListPropertyNotFound(Sender: TObject; {%H-}Reader: TReader;
      Instance: TPersistent; var PropName: string; IsPath: boolean;
      var Handled, Skip: Boolean);
    procedure JITListFindAncestors(Sender: TObject; AClass: TClass;
      var Ancestors: TFPList;// list of TComponent
      var BinStreams: TFPList;// list of TExtMemoryStream;
      var Abort: boolean);
    procedure JITListFindClass(Sender: TObject;
                   const VarName, ComponentUnitName, ComponentClassName: string;
                   var ComponentClass: TComponentClass);

    function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
    function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; override;
    procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); override;
    procedure DesignerMenuItemClick(Sender: TObject); virtual;
    function FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;

    //because we only meet ObjInspectore here, not in abstract ancestor
    procedure DoOnNodeGetImageIndex(APersistent: TPersistent; var AImageIndex: integer); virtual;
  public
    JITFormList: TJITForms;// designed forms
    JITNonFormList: TJITNonFormComponents;// designed custom components like data modules

    constructor Create;
    destructor Destroy; override;
    procedure RegisterFrame;

    // selection
    function AddSelected(Value: TComponent) : Integer;
    procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
    function FindComponentByName(const Name: ShortString): TComponent; override;
    function SaveSelectionToStream(s: TStream): Boolean; override;
    function InsertFromStream(s: TStream; Parent: TWinControl;
                              Flags: TComponentPasteSelectionFlags): Boolean; override;
    function ClearSelection: Boolean; override;
    function DeleteSelection: Boolean; override;
    function CopySelectionToClipboard: Boolean; override;
    function CutSelectionToClipboard: Boolean; override;
    function PasteSelectionFromClipboard(Flags: TComponentPasteSelectionFlags
                                         ): Boolean; override;

    function GetCurrentObjectInspector: TObjectInspectorDlg; override;

    // JIT components
    function IsJITComponent(AComponent: TComponent): boolean;
    function GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
    function FindJITList(AComponent: TComponent): TJITComponentList;
    function FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
    function FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
    function GetDesignerForm(APersistent: TPersistent): TCustomForm; override;

    function FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
    function CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;

    procedure RenameJITComponent(AComponent: TComponent; const NewClassName: shortstring);
    procedure RenameJITComponentUnitname(AComponent: TComponent; const NewUnitName: shortstring);
    procedure UpdateDesignerFormName(AComponent: TComponent);
    procedure UpdateComponentName(AComponent: TComponent);
    function CreateNewJITMethod(ALookupRoot: TComponent; const AMethodName: shortstring): TMethod;
    procedure RenameJITMethod(AComponent: TComponent; const OldMethodName, NewMethodName: shortstring);
    procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
    function FindJITComponentByClassName(const AComponentClassName: string): TComponent;
    function FindJITComponentByClass(AComponentClass: TComponentClass): TComponent;
    procedure WriteMethodPropertyEvent(Writer: TWriter; {%H-}Instance: TPersistent;
      PropInfo: PPropInfo; const MethodValue, DefMethodValue: TMethod;
      var Handled: boolean);
    function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
      var BinCompStream: TExtMemoryStream): TModalResult;
    function OnGetDanglingMethodName(const AMethod: TMethod; aRootComponent: TObject): string;
    procedure SaveComponentAsPascal(aDesigner: TIDesigner; Writer: TCompWriterPas); override;

    // 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 DescendFromDesignerBaseClass(AClass: TComponentClass): integer; override;
    function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override; // can be UnitName/ClassName
    function DesignerClassCanAppCreateForm(AClass: TComponentClass;
      CheckInherited: boolean=true): boolean; override;
    procedure SetDesignerBaseClassCanAppCreateForm(AClass: TComponentClass;
      AValue: boolean); override;

    function StandardDesignerBaseClassesCount: Integer; override;
    // designers
    function DesignerCount: integer; override;
    function GetDesigner(Index: integer): TIDesigner; override;
    function GetCurrentDesigner: TIDesigner; override;
    function GetDesignerByComponent(AComponent: TComponent): TIDesigner; override;

    // designer mediators
    function GetDesignerMediators(Index: integer): TDesignerMediatorClass; override;
    procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
    procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
    function DesignerMediatorCount: integer; override;
    function GetDesignerMediatorClass(ComponentClass: TComponentClass): TDesignerMediatorClass;

    // component editors
    function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
    
    // component creation
    function CreateUniqueComponentName(AComponent: TComponent): string; override;
    function CreateUniqueComponentName(const AClassName: string;
                                       OwnerComponent: TComponent): string; override;
    function GetDefaultComponentParent(TypeClass: TComponentClass
                                       ): TComponent; override;
    function GetDefaultComponentPosition(TypeClass: TComponentClass;
                                         ParentComponent: TComponent;
                                         out X,Y: integer): boolean; override;
    function CreateComponent(ParentComponent: TComponent;
                             TypeClass: TComponentClass;
                             const AUnitName: shortstring;
                             NewLeft,NewTop,NewWidth,NewHeight: Integer;
                             DisableAutoSize: boolean): TComponent; override;
    function CreateComponentFromStream(BinStream: TStream;
                      UnitResourcefileFormat: TUnitResourcefileFormatClass;
                      AncestorType: TComponentClass;
                      const NewUnitName: ShortString;
                      Interactive: boolean;
                      Visible: boolean = true;
                      DisableAutoSize: boolean = false;
                      ContextObj: TObject = nil): TComponent; override;
    function CreateRawComponentFromStream(BinStream: TStream;
                      UnitResourcefileFormat: TUnitResourcefileFormatClass;
                      AncestorType: TComponentClass;
                      const NewUnitName: ShortString;
                      Interactive: boolean;
                      Visible: boolean = true;
                      DisableAutoSize: boolean = false;
                      ContextObj: TObject = nil): TComponent;
    procedure CreateChildComponentsFromStream(BinStream: TStream;
                       ComponentClass: TComponentClass; Root: TComponent;
                       ParentControl: TWinControl; NewComponents: TFPList); override;
    function ParentAcceptsChild(Parent, Child, aLookupRoot: TComponent): boolean; override;
    function ParentAcceptsChildClass(Parent: TComponent;
             ChildClass: TComponentClass; aLookupRoot: TComponent): boolean; override;
    function FixupReferences(AComponent: TComponent): TModalResult;
    procedure WriterFindAncestor({%H-}Writer: TWriter; Component: TComponent;
                                 const {%H-}Name: string;
                                 var Ancestor, RootAncestor: TComponent);
    procedure SetComponentNameAndClass(AComponent: TComponent;
                                       const NewName, NewClassName: shortstring);
    function ClassDependsOnComponent(AClass: TComponentClass;
                                     AComponent: TComponent): Boolean;
    function ComponentDependsOnClass(AComponent: TComponent;
                                     AClass: TComponentClass): Boolean;

    // define properties
    procedure FindDefineProperty(const APersistentClassName,
                                 AncestorClassName, Identifier: string;
                                 var IsDefined: boolean);
    procedure RegisterDefineProperty(const APersistentClassName,
                                     Identifier: string); override;
    procedure RegisterStandardDefineProperties;

    // keys
    function TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
  public
    property Selection: TPersistentSelectionList read FSelection
                                                 write SetSelection;
    property Obj_Inspector: TObjectInspectorDlg
                                     read FObj_Inspector write SetObj_Inspector;
    property PropertyEditorHook: TPropertyEditorHook read GetPropertyEditorHook;
    property OnSelectFrame: TSelectFrameEvent read FOnSelectFrame write FOnSelectFrame;
    property OnNodeGetImageIndex : TOnOINodeGetImageEvent read FOnNodeGetImageIndex
                                      write FOnNodeGetImageIndex;
  end;
  
  
  { TDefinePropertiesCacheItem }
  
  TDefinePropertiesCacheItem = class
  public
    PersistentClassname: string;
    RegisteredComponent: TRegisteredComponent;
    DefineProperties: TStrings;
    destructor Destroy; override;
  end;
  
  
  { TDefinePropertiesReader }
  
  TDefinePropertiesReader = class(TFiler)
  private
    FDefinePropertyNames: TStrings;
  protected
    procedure AddPropertyName(const Name: string);
  public
    destructor Destroy; override;
    procedure DefineProperty(const Name: string;
      {%H-}ReadData: TReaderProc; {%H-}WriteData: TWriterProc;
      {%H-}HasData: Boolean); override;
    procedure DefineBinaryProperty(const Name: string;
      {%H-}ReadData, {%H-}WriteData: TStreamProc;
      {%H-}HasData: Boolean); override;
    procedure FlushBuffer; override;
    property DefinePropertyNames: TStrings read FDefinePropertyNames;
  end;
  
  
  { TDefinePropertiesPersistent
    Wrapper/Friend class, to call the protected method 'DefineProperties' }
  
  TDefinePropertiesPersistent = class(TPersistent)
  private
    FTarget: TPersistent;
  public
    constructor Create(TargetPersistent: TPersistent);
    procedure PublicDefineProperties(Filer: TFiler);
    property Target: TPersistent read FTarget;
  end;
  

var
  StandardDesignerBaseClasses: array[0..2] of TComponentClass =
  (
    Forms.TForm,
    TDataModule,
    Forms.TFrame
  );
  
  
function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
                                     Item: TDefinePropertiesCacheItem): integer;

function TryFreeComponent(var AComponent: TComponent): boolean;

function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;

procedure RegisterStandardClasses;

var
  BaseFormEditor1: TCustomFormEditor = nil;

implementation

function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
begin
  Result:=CompareText(Item1.PersistentClassname,Item2.PersistentClassname);
end;

function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
                                     Item: TDefinePropertiesCacheItem): integer;
begin
  Result:=CompareText(AnsiString(Key),Item.PersistentClassname);
end;

function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;
var
  LFMFilename: String;
  LFMType: String;
  LFMClassName: String;
  Code: TCodeBuffer;
  Tool: TCodeTool;
  ClassNode: TCodeTreeNode;
  ListOfPFindContext: TFPList;
  i: Integer;
  Context: PFindContext;
  AClassName: String;
  LFMCode: TCodeBuffer;
begin
  Result:=pfcbcNone;
  if not FilenameHasPascalExt(aFilename) then exit;
  if not FilenameIsAbsolute(aFilename) then exit;
  LFMFilename:=ChangeFileExt(aFilename,'.lfm');
  if not FileExistsCached(LFMFilename) then exit;
  if not FileExistsCached(aFilename) then exit;
  LFMCode:=CodeToolBoss.LoadFile(LFMFilename,true,false);
  if LFMCode=nil then exit;
  ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
  if LFMClassName='' then exit;
  Code:=CodeToolBoss.LoadFile(aFilename,true,false);
  if Code=nil then exit;
  if not CodeToolBoss.Explore(Code,Tool,false,true) then exit;
  ClassNode:=Tool.FindClassNodeInInterface(LFMClassName,true,false,false);
  if ClassNode=nil then exit;
  ListOfPFindContext:=nil;
  try
    try
      Tool.FindClassAndAncestors(ClassNode,ListOfPFindContext,false);
    except
    end;
    if ListOfPFindContext=nil then exit;
    for i:=0 to ListOfPFindContext.Count-1 do begin
      Context:=PFindContext(ListOfPFindContext[i]);
      AClassName:=Context^.Tool.ExtractClassName(Context^.Node,false);
      //debugln(['CheckLFMBaseClass ',AClassName]);
      if CompareText(AClassName,'TFrame')=0 then
        exit(pfcbcFrame)
      else if CompareText(AClassName,'TForm')=0 then
        exit(pfcbcForm)
      else if CompareText(AClassName,'TCustomForm')=0 then
        exit(pfcbcCustomForm)
      else if CompareText(AClassName,'TDataModule')=0 then
        exit(pfcbcDataModule);
    end;
  finally
    FreeListOfPFindContext(ListOfPFindContext);
  end;
end;

procedure RegisterStandardClasses;
begin
  RegisterClasses([TStringList]);
end;

function TryFreeComponent(var AComponent: TComponent): boolean;
var
  OldName, OldClassName: string;
Begin
  Result := False;
  //debugln(['TryFreeComponent ',DbgSName(AComponent)]);
  {$IFNDEF NoCompCatch}
  try
  {$ENDIF}
    OldName := AComponent.Name;
    OldClassName := AComponent.ClassName;
    AComponent.Free;
    //debugln(['TryFreeComponent ',OldName,':',OldClassName,' success']);
    Result := True;
  {$IFNDEF NoCompCatch}
  except
    on E: Exception do begin
      DebugLn('TryFreeComponent ERROR:',
        ' "'+OldName+':'+OldClassName+'" ',E.Message);
      DumpExceptionBackTrace;
      IDEMessageDialog(lisCCOErrorCaption,
        Format(lisCFEAnExceptionOccurredDuringDeletionOf,
               [LineEnding, OldName, OldClassName, LineEnding, E.Message]),
        mtError,[mbOk]);
    end;
  end;
  {$ENDIF}
  if not Result then begin
    // maybe some references can be removed
    try
      if AComponent is TControl then begin
        TControl(AComponent).Parent:=nil;
      end;
    except
      on e: Exception do begin
        DebugLn('TryFreeComponent manual clean up failed also for ',
          ' "'+OldName+':'+OldClassName+'". This is likely, nothing to worry about. ',E.Message);
      end;
    end;
  end;
  AComponent := nil;
end;

{ TCustomFormEditor }

procedure OnPasWriterDefinePropertyTStrings(Writer: TCompWriterPas;
  Instance: TPersistent; const Identifier: string; var Handled: boolean);
var
  List: TStrings;
  HasData: Boolean;
  i: Integer;
begin
  if not (Instance is TStrings) then exit;
  List:=TStrings(Instance);
  if Assigned(Writer.Ancestor) then
    // Only serialize if string list is different from ancestor
    if Writer.Ancestor.InheritsFrom(TStrings) then
      HasData := not List.Equals(TStrings(Writer.Ancestor))
    else
      HasData := True
  else
    HasData := List.Count > 0;
  if not HasData then exit;
  Writer.WriteStatement('with '+Identifier+' do begin');
  Writer.Indent;
  Writer.WriteStatement('Clear;');
  for i:=0 to List.Count-1 do
    Writer.WriteStatement('Add('+Writer.GetStringLiteral(List[i])+');');
  Writer.Unindent;
  Writer.WriteStatement('end;');
  Handled:=true;
end;

constructor TCustomFormEditor.Create;

  procedure InitJITList(List: TJITComponentList);
  begin
    List.OnBeforeCreate:=@JITListBeforeCreate;
    List.OnException:=@JITListException;
    List.OnPropertyNotFound:=@JITListPropertyNotFound;
    List.OnFindAncestors:=@JITListFindAncestors;
    List.OnFindClass:=@JITListFindClass;
  end;

var
  l: Integer;
begin
  inherited Create;
  FNonFormForms := TAvlTree.Create(@CompareNonFormDesignerForms);
  FSelection := TPersistentSelectionList.Create;
  FDesignerBaseClasses:=TFPList.Create;
  FDesignerBaseClassesCanCreateForm:=TFPList.Create;
  FDesignerMediatorClasses:=TFPList.Create;
  for l:=0 to StandardDesignerBaseClassesCount - 1 do
    FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);

  JITFormList := TJITForms.Create(nil);
  InitJITList(JITFormList);

  JITNonFormList := TJITNonFormComponents.Create(nil);
  InitJITList(JITNonFormList);

  OnDesignerMenuItemClick:=@DesignerMenuItemClick;
  OnGetDesignerForm:=@GetDesignerForm;
  FormEditingHook:=Self;

  RegisterDesignerBaseClass(TAbstractIDEOptionsEditor);

  GlobalDesignHook.AddHandlerGetAncestorInstProp(@OnPropHookGetAncestorInstProp);

  RegisterDefinePropertiesPas(TStrings,@OnPasWriterDefinePropertyTStrings);
end;

destructor TCustomFormEditor.Destroy;
begin
  FormEditingHook:=nil;
  OnDesignerMenuItemClick:=nil;
  if FDefineProperties<>nil then begin
    FDefineProperties.FreeAndClear;
    FreeAndNil(FDefineProperties);
  end;
  FreeAndNil(JITFormList);
  FreeAndNil(JITNonFormList);
  FreeAndNil(FDesignerMediatorClasses);
  FreeAndNil(FDesignerBaseClassesCanCreateForm);
  FreeAndNil(FDesignerBaseClasses);
  FreeAndNil(FSelection);
  FreeAndNil(FNonFormForms);
  inherited Destroy;
end;

procedure TCustomFormEditor.RegisterFrame;
var
  FrameComp: TRegisteredComponent;
begin
  FrameComp:=IDEComponentPalette.FindRegComponent('TFrame');
  if FrameComp <> nil then
    FrameComp.OnGetCreationClass:=@FrameCompGetCreationClass;
end;

procedure TCustomFormEditor.SetSelection(const ASelection: TPersistentSelectionList);
begin
  if FSelection.IsEqual(ASelection) then exit;
  FSelection.Assign(ASelection);
  if Obj_Inspector=nil then
  begin
    GlobalDesignHook.SetSelection(FSelection);
  end else begin
    if FSelection.Count>0 then
      Obj_Inspector.PropertyEditorHook.LookupRoot:=GetLookupRootForComponent(FSelection[0]);
    Obj_Inspector.Selection := FSelection;
  end;
end;

function TCustomFormEditor.AddSelected(Value: TComponent): Integer;
Begin
  Result := FSelection.Add(Value) + 1;
  if Obj_Inspector<>nil then
  begin
    if not Obj_Inspector.Selection.IsEqual(FSelection) then
    Obj_Inspector.Selection := FSelection;
  end else
    GlobalDesignHook.SetSelection(FSelection);
end;

procedure TCustomFormEditor.DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
var
  AForm: TCustomForm;
  AWinControl: TWinControl;
  IsJIT: Boolean;
  i: Integer;
  aDesigner: TIDesigner;
Begin
  IsJIT:=IsJITComponent(AComponent);
  {$IFDEF IDE_DEBUG}
  DebugLn(['TCustomFormEditor.DeleteComponent ',DbgSName(AComponent),' IsJITComponent=',IsJIT,' FreeComponent=',FreeComponent]);
  {$ENDIF}
  if TheControlSelection.LookupRoot = AComponent then
  begin
    TheControlSelection.BeginUpdate;
    try
      TheControlSelection.Clear;
    finally
      TheControlSelection.EndUpdate;
    end;
  end;
  if PropertyEditorHook.LookupRoot=AComponent then
    PropertyEditorHook.LookupRoot:=nil;

  if IsJIT then begin
    // AComponent is a top level component
    if FreeComponent then
    begin
      // tell hooks about deleting
      for i := AComponent.ComponentCount - 1 downto 0 do
        PropertyEditorHook.PersistentDeleting(AComponent.Components[i]);
      PropertyEditorHook.PersistentDeleting(AComponent);
    end;
    // disconnect designer
    aDesigner:=GetDesignerByComponent(AComponent);
    if aDesigner is TComponentEditorDesigner then
      TComponentEditorDesigner(aDesigner).DisconnectComponent;

    if JITFormList.IsJITForm(AComponent) then begin
      // free/unbind a form component
      if FreeComponent then
        JITFormList.DestroyJITComponent(AComponent);
    end else if JITNonFormList.IsJITNonForm(AComponent) then begin
      // free/unbind a non form component and its designer form
      aForm:=GetDesignerForm(AComponent);
      if (AForm<>nil) and (not (AForm is TNonFormProxyDesignerForm)) then
        RaiseGDBException(Format(lisCFETCustomFormEditorDeleteComponentWhereIsTheTCustomN,
                                 [AComponent.ClassName]));

      if (AForm <> nil) then
      begin
        AForm.ControlStyle:=AForm.ControlStyle+[csNoDesignVisible];
        LCLIntf.ShowWindow(AForm.Handle,SW_HIDE);
        FNonFormForms.Remove(AForm);
        (AForm as INonFormDesigner).LookupRoot := nil;
        Application.ReleaseComponent(AForm);
      end;

      if FreeComponent then
        JITNonFormList.DestroyJITComponent(AComponent);
    end else
      RaiseGDBException('TCustomFormEditor.DeleteComponent '+AComponent.ClassName);
  end else if FreeComponent then begin
    if (AComponent.Owner=nil) then
      DebugLn(['WARNING: TCustomFormEditor.DeleteComponent freeing orphaned component ',DbgSName(AComponent)]);
    TryFreeComponent(AComponent);
  end;
  // if not free, then hide it
  if (not FreeComponent) and (AComponent is TWinControl) then begin
    AWinControl:=TWinControl(AComponent);
    if AWinControl.HandleAllocated and (AWinControl.Parent=nil) then begin
      AWinControl.ControlStyle:=AWinControl.ControlStyle+[csNoDesignVisible];
      LCLIntf.ShowWindow(AWinControl.Handle,SW_HIDE);
      DebugLn(['TCustomFormEditor.DeleteComponent Hiding: ',dbgsName(AWinControl)]);
    end;
  end;
  //PropertyEditorHook.PersistentDeleted(AComponent); Not needed?
end;

function TCustomFormEditor.FindComponentByName(const Name: ShortString): TComponent;
var
  i: longint;
Begin
  if JITFormList<>nil then begin
    i:=JITFormList.FindComponentByName(Name);
    if i>=0 then begin
      Result:=JITFormList[i];
      exit;
    end;
  end;
  if JITNonFormList<>nil then begin
    i:=JITNonFormList.FindComponentByName(Name);
    if i>=0 then begin
      Result:=JITNonFormList[i];
      exit;
    end;
  end;
  Result:=nil;
end;

function TCustomFormEditor.SaveSelectionToStream(s: TStream): Boolean;
var
  ADesigner: TIDesigner;
begin
  ADesigner:=GetCurrentDesigner;
  if ADesigner is TComponentEditorDesigner then
    Result:=TComponentEditorDesigner(ADesigner).CopySelectionToStream(s)
  else
    Result:=false;
end;

function TCustomFormEditor.InsertFromStream(s: TStream; Parent: TWinControl;
  Flags: TComponentPasteSelectionFlags): Boolean;
var
  ADesigner: TIDesigner;
begin
  ADesigner:=GetCurrentDesigner;
  if ADesigner is TComponentEditorDesigner then
    Result:=TComponentEditorDesigner(ADesigner).InsertFromStream(s,Parent,Flags)
  else
    Result:=false;
end;

function TCustomFormEditor.ClearSelection: Boolean;
var
  ASelection: TPersistentSelectionList;
begin
  if Selection.Count=0 then exit;
  ASelection:=TPersistentSelectionList.Create;
  try
    Selection:=ASelection;
  except
    on E: Exception do begin
      IDEMessageDialog(lisCCOErrorCaption,
        Format(lisCFEUnableToClearTheFormEditingSelection, [LineEnding, E.Message]),
        mtError, [mbCancel]);
    end;
  end;
  ASelection.Free;
  Result:=(Selection=nil) or (Selection.Count=0);
end;

function TCustomFormEditor.DeleteSelection: Boolean;
var
  ADesigner: TIDesigner;
begin
  if (Selection.Count=0) then begin
    Result:=true;
    exit;
  end;
  if Selection[0] is TComponent then begin
    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
    if ADesigner is TComponentEditorDesigner then begin
      TComponentEditorDesigner(ADesigner).DeleteSelection;
    end;
  end;
  Result:=Selection.Count=0;
  if Selection.Count>0 then begin
    IDEMessageDialog(lisCCOErrorCaption,
      lisCFEDoNotKnowHowToDeleteThisFormEditingSelection,
      mtError,[mbCancel]);
  end;
end;

function TCustomFormEditor.CopySelectionToClipboard: Boolean;
var
  ADesigner: TIDesigner;
begin
  if (Selection.Count=0) then begin
    Result:=false;
    exit;
  end;
  if Selection[0] is TComponent then begin
    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
    if ADesigner is TComponentEditorDesigner then begin
      TComponentEditorDesigner(ADesigner).CopySelection;
    end;
  end;
  Result:=Selection.Count=0;
  if Selection.Count>0 then begin
    IDEMessageDialog(lisCCOErrorCaption,
      lisCFEDoNotKnowHowToCopyThisFormEditingSelection,
      mtError,[mbCancel]);
  end;
end;

function TCustomFormEditor.CutSelectionToClipboard: Boolean;
var
  ADesigner: TIDesigner;
begin
  if (Selection.Count=0) then begin
    Result:=false;
    exit;
  end;
  if Selection[0] is TComponent then begin
    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
    if ADesigner is TComponentEditorDesigner then begin
      TComponentEditorDesigner(ADesigner).CutSelection;
    end;
  end;
  Result:=Selection.Count=0;
  if Selection.Count>0 then begin
    IDEMessageDialog(lisCCOErrorCaption,
      lisCFEDoNotKnowHowToCutThisFormEditingSelection,
      mtError,[mbCancel]);
  end;
end;

function TCustomFormEditor.PasteSelectionFromClipboard(
  Flags: TComponentPasteSelectionFlags): Boolean;
var
  ADesigner: TIDesigner;
begin
  ADesigner:=GetCurrentDesigner;
  if ADesigner is TComponentEditorDesigner then begin
    Result:=TComponentEditorDesigner(ADesigner).PasteSelection(Flags);
  end else
    Result:=false;
end;

function TCustomFormEditor.GetCurrentObjectInspector: TObjectInspectorDlg;
begin
  Result:=FObj_Inspector;
end;

function TCustomFormEditor.IsJITComponent(AComponent: TComponent): boolean;
begin
  Result:=JITFormList.IsJITForm(AComponent)
          or JITNonFormList.IsJITNonForm(AComponent);
end;

function TCustomFormEditor.GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
begin
  if AncestorType.InheritsFrom(TCustomForm) then
    Result := JITFormList
  else 
  if AncestorType.InheritsFrom(TComponent) then
    Result := JITNonFormList
  else
    Result := nil;
end;

function TCustomFormEditor.FindJITList(AComponent: TComponent): TJITComponentList;
begin
  if JITFormList.IndexOf(AComponent) >= 0 then
    Result := JITFormList
  else 
  if JITNonFormList.IndexOf(AComponent) >= 0 then
    Result := JITNonFormList
  else
    Result := nil;
end;

function TCustomFormEditor.FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
begin
  if JITFormList.FindComponentByClassName(AComponentClassName) >= 0 then
    Result := JITFormList
  else 
  if JITNonFormList.FindComponentByClassName(AComponentClassName) >= 0 then
    Result := JITNonFormList
  else
    Result := nil;
end;

function TCustomFormEditor.FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
begin
  if JITFormList.FindComponentByClass(AComponentClass) >= 0 then
    Result := JITFormList
  else 
  if JITNonFormList.FindComponentByClass(AComponentClass) >= 0 then
    Result := JITNonFormList
  else
    Result := nil;
end;

function TCustomFormEditor.GetDesignerForm(APersistent: TPersistent): TCustomForm;
var
  TheOwner: TPersistent;
begin
  Result:=nil;
  TheOwner := GetLookupRootForComponent(APersistent);
  if TheOwner = nil then
    exit;
  if TheOwner is TCustomForm then
    Result := TCustomForm(TheOwner)
  else if TheOwner is TComponent then
    Result := FindNonFormForm(TComponent(TheOwner))
  else
    exit;
end;

function TCustomFormEditor.FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
var
  AVLNode: TAvlTreeNode;
begin
  AVLNode := FindNonFormFormNode(LookupRoot);
  if AVLNode <> nil then
    Result := TNonFormProxyDesignerForm(AVLNode.Data)
  else
    Result := nil;
end;

function TCustomFormEditor.CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
var
  MediatorClass: TDesignerMediatorClass;
  LNonFormProxyDesignerClass: TNonFormProxyDesignerFormClass;
begin
  Result := Nil;
  if FindNonFormFormNode(LookupRoot) <> nil then
    RaiseGDBException(lisCFETCustomFormEditorCreateNonFormFormAlreadyExists);
  if LookupRoot is TComponent then
  begin
    if LookupRoot is TCustomFrame then
    begin
      LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[FrameProxyDesignerFormId];
      Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
      Result.Create(nil, TFrameDesignerForm.Create(Result));
    end
    else
    begin
      LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId];
      Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
      Result.Create(nil, TNonControlDesignerForm.Create(Result));
      Result.Color := EnvironmentGuiOpts.NonFormBackgroundColor;
    end;
    Result.Name:='_Designer_'+LookupRoot.Name;
    (Result as INonFormDesigner).LookupRoot := LookupRoot;
    FNonFormForms.Add(Result);

    if Result is INonControlDesigner then begin
      // create the mediator
      MediatorClass:=GetDesignerMediatorClass(TComponentClass(LookupRoot.ClassType));
      if MediatorClass<>nil then
        (Result as INonControlDesigner).Mediator:=MediatorClass.CreateMediator(nil,LookupRoot);
    end;
  end else
    RaiseGDBException(Format(lisCFETCustomFormEditorCreateNonFormFormUnknownType,
                             [LookupRoot.ClassName]));
end;

procedure TCustomFormEditor.RenameJITComponent(AComponent: TComponent;
  const NewClassName: shortstring);
var
  JITComponentList: TJITComponentList;
begin
  JITComponentList:=FindJITList(AComponent);
  if JITComponentList=nil then
    RaiseGDBException('TCustomFormEditor.RenameJITComponent');
  JITComponentList.RenameComponentClass(AComponent,NewClassName);
end;

procedure TCustomFormEditor.RenameJITComponentUnitname(AComponent: TComponent;
  const NewUnitName: shortstring);
var
  JITComponentList: TJITComponentList;
begin
  JITComponentList:=FindJITList(AComponent);
  if JITComponentList=nil then
    RaiseGDBException('TCustomFormEditor.RenameJITComponent');
  JITComponentList.RenameComponentUnitname(AComponent,NewUnitName);
end;

procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
var
  ANonFormForm: TNonFormProxyDesignerForm;
begin
  ANonFormForm := FindNonFormForm(AComponent);
  //DebugLn(['TCustomFormEditor.UpdateDesignerFormName ',ANonFormForm<>nil, ' ',AComponent.Name]);
  if ANonFormForm <> nil then
    ANonFormForm.Caption := AComponent.Name;
end;

procedure TCustomFormEditor.UpdateComponentName(AComponent: TComponent);
var
  DesignerForm: TCustomForm;
begin
  if AComponent.Owner = nil then
    UpdateDesignerFormName(AComponent)
  else
  begin
    DesignerForm := GetDesignerForm(AComponent);
    if (DesignerForm <> nil) and (DesignerForm.Designer <> nil) and
       EnvironmentGuiOpts.ShowComponentCaptions then
      DesignerForm.Invalidate;
  end;
end;

function TCustomFormEditor.CreateNewJITMethod(ALookupRoot: TComponent;
  const AMethodName: shortstring): TMethod;
var
  JITComponentList: TJITComponentList;
begin
  JITComponentList:=FindJITList(ALookupRoot);
  if JITComponentList=nil then
    RaiseGDBException('TCustomFormEditor.CreateNewJITMethod');
  Result:=JITComponentList.CreateNewMethod(ALookupRoot,AMethodName);
end;

procedure TCustomFormEditor.RenameJITMethod(AComponent: TComponent;
  const OldMethodName, NewMethodName: shortstring);
var
  JITComponentList: TJITComponentList;
begin
  JITComponentList:=FindJITList(AComponent);
  if JITComponentList=nil then
    RaiseGDBException('TCustomFormEditor.RenameJITMethod');
  JITComponentList.RenameMethod(AComponent,OldMethodName,NewMethodName);
end;

procedure TCustomFormEditor.SaveHiddenDesignerFormProperties(AComponent: TComponent);
var
  NonFormForm: TNonFormProxyDesignerForm;
begin
  NonFormForm := FindNonFormForm(AComponent);
  if NonFormForm <> nil then
    (NonFormForm as INonFormDesigner).DoSaveBounds;
end;

function TCustomFormEditor.FindJITComponentByClassName(
  const AComponentClassName: string): TComponent;
var
  i: LongInt;
begin
  Result := nil;
  i := JITFormList.FindComponentByClassName(AComponentClassName);
  if i >= 0 then 
  begin
    Result := JITFormList[i];
    exit;
  end;
  i := JITNonFormList.FindComponentByClassName(AComponentClassName);
  if i >= 0 then 
  begin
    Result := JITNonFormList[i];
    exit;
  end;
end;

function TCustomFormEditor.FindJITComponentByClass(
  AComponentClass: TComponentClass): TComponent;
var
  i: LongInt;
begin
  Result := nil;
  i := JITFormList.FindComponentByClass(AComponentClass);
  if i >= 0 then 
  begin
    Result := JITFormList[i];
    exit;
  end;
  i := JITNonFormList.FindComponentByClass(AComponentClass);
  if i >= 0 then 
  begin
    Result := JITNonFormList[i];
    exit;
  end;
end;

procedure TCustomFormEditor.WriteMethodPropertyEvent(Writer: TWriter;
  Instance: TPersistent; PropInfo: PPropInfo;
  const MethodValue, DefMethodValue: TMethod; var Handled: boolean);
var
  CurName: String;
begin
  Handled:=true;

  //DebugLn(['TCustomFormEditor.WriteMethodPropertyEvent ',GlobalDesignHook.GetMethodName(MethodValue,nil)]);

  // find ancestor method value
  if (DefMethodValue.Data=MethodValue.Data)
  and (DefMethodValue.Code=MethodValue.Code) then
    exit;
  if IsJITMethod(MethodValue) then
    CurName:=TJITMethod(MethodValue.Data).TheMethodName
  else if MethodValue.Code<>nil then begin
    CurName:=Writer.LookupRoot.MethodName(MethodValue.Code);
    if CurName='' then begin
      // this event was not set by the IDE
      // for Delphi compatibility, do not write this property
      // see bug 13846
      exit;
    end;
  end else
    CurName:='';
  Writer.Driver.BeginProperty(Writer.PropertyPath + PPropInfo(PropInfo)^.Name);
  Writer.Driver.WriteMethodName(CurName);
  Writer.Driver.EndProperty;
end;

function TCustomFormEditor.SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
  var BinCompStream: TExtMemoryStream): TModalResult;
var
  Writer: TWriter;
  DestroyDriver: Boolean;
  AncestorUnit: TUnitInfo;
  Ancestor: TComponent;
  {$IFDEF VerboseSaveUnitComponent}
  memStream: TMemoryStream;
  s: string;
  {$ENDIF}
begin
  // save designer form properties to the component
  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.OnWriteMethodProperty:=@WriteMethodPropertyEvent;
      Writer.OnFindAncestor:=@WriterFindAncestor;
      AncestorUnit:=AnUnitInfo.FindAncestorUnit;
      Ancestor:=nil;
      if AncestorUnit<>nil then
        Ancestor:=AncestorUnit.Component;
      if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
        TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
      Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
      if DestroyDriver then Writer.Driver.Free;
      FreeAndNil(Writer);
      AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;

      {$IFDEF VerboseSaveUnitComponent}
      BinCompStream.Position:=0;
      memStream:=TMemoryStream.Create;
      LRSObjectBinaryToText(BinCompStream,memStream);
      memStream.Position:=0;
      SetLength(s,memStream.Size);
      memStream.Read(s[1],length(s));
      DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream START ==================']);
      debugln(s);
      DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream END ==================']);
      memStream.Free;
      {$ENDIF}
    except
      on E: Exception do begin
        DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream ',E.Message]);
        DumpExceptionBackTrace;
        Result:=MessageDlg(lisStreamingError,
            Format(lisUnableToStreamT,
                   [AnUnitInfo.ComponentName, AnUnitInfo.ComponentName])+LineEnding
            +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('TCustomFormEditor.SaveUnitComponentToBinStream Error cleaning up: ',E.Message);
      end;
    end;
  end;
end;

function TCustomFormEditor.OnGetDanglingMethodName(const AMethod: TMethod;
  aRootComponent: TObject): string;
// check if event is a JITMethod of aRootComponent
var
  JITMethod: TJITMethod;
begin
  Result:='';
  if IsJITMethod(aMethod) then begin
    JITMethod:=TJITMethod(aMethod.Data);
    if aRootComponent.ClassType=JITMethod.TheClass then
      Result:=JITMethod.TheMethodName;
  end;
end;

procedure TCustomFormEditor.SaveComponentAsPascal(aDesigner: TIDesigner;
  Writer: TCompWriterPas);
begin
  Writer.OnFindAncestor:=@PasWriterFindAncestor;
  Writer.OnGetParentProperty:=@PasWriterGetParentProperty;
  Writer.OnGetMethodName:=@PasWriterGetMethodName;
  Writer.WriteDescendant(aDesigner.LookupRoot);
end;

function TCustomFormEditor.DesignerCount: integer;
begin
  Result:=JITFormList.Count+JITNonFormList.Count;
end;

function TCustomFormEditor.GetDesigner(Index: integer): TIDesigner;
var
  AForm: TCustomForm;
begin
  if Index < JITFormList.Count then
    Result := JITFormList[Index].Designer
  else 
  begin
    AForm := GetDesignerForm(JITNonFormList[Index-JITFormList.Count]);
    Result := AForm.Designer;
  end;
end;

function TCustomFormEditor.GetCurrentDesigner: TIDesigner;
begin
  Result:=nil;
  if (Selection<>nil) and (Selection.Count>0) and (Selection[0] is TComponent)
  then
    Result:=GetDesignerByComponent(TComponent(Selection[0]));
end;

function TCustomFormEditor.GetDesignerByComponent(AComponent: TComponent
  ): TIDesigner;
var
  AForm: TCustomForm;
begin
  AForm:=GetDesignerForm(AComponent);
  if AForm=nil then
    Result:=nil
  else
    Result:=AForm.Designer;
end;

function TCustomFormEditor.GetDesignerMediators(Index: integer
  ): TDesignerMediatorClass;
begin
  Result:=TDesignerMediatorClass(FDesignerMediatorClasses[Index]);
end;

procedure TCustomFormEditor.RegisterDesignerMediator(
  MediatorClass: TDesignerMediatorClass);
begin
  if FDesignerMediatorClasses.IndexOf(MediatorClass)>=0 then
    raise Exception.Create(Format(
      lisCFETCustomFormEditorRegisterDesignerMediatorAlreadyRe, [DbgSName(
      MediatorClass)]));
  FDesignerMediatorClasses.Add(MediatorClass);
  RegisterDesignerBaseClass(MediatorClass.FormClass);
end;

procedure TCustomFormEditor.UnregisterDesignerMediator(
  MediatorClass: TDesignerMediatorClass);
begin
  UnregisterDesignerBaseClass(MediatorClass.FormClass);
  FDesignerMediatorClasses.Remove(MediatorClass);
end;

function TCustomFormEditor.DesignerMediatorCount: integer;
begin
  Result:=FDesignerMediatorClasses.Count;
end;

function TCustomFormEditor.GetDesignerMediatorClass(
  ComponentClass: TComponentClass): TDesignerMediatorClass;
var
  i: Integer;
  Candidate: TDesignerMediatorClass;
begin
  Result:=nil;
  for i:=0 to DesignerMediatorCount-1 do begin
    Candidate:=DesignerMediators[i];
    if not (ComponentClass.InheritsFrom(Candidate.FormClass)) then continue;
    if (Result<>nil) and Result.InheritsFrom(Candidate.FormClass) then continue;
    Result:=Candidate;
  end;
end;

function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
  ): TBaseComponentEditor;
var
  ADesigner: TIDesigner;
begin
  Result:=nil;
  if AComponent=nil then exit;
  ADesigner:=GetDesignerByComponent(AComponent);
  if ADesigner is TComponentEditorDesigner then
    Result:=ComponentEditors.GetComponentEditor(AComponent,
                                           TComponentEditorDesigner(ADesigner));
end;

function TCustomFormEditor.CreateComponent(ParentComponent: TComponent;
  TypeClass: TComponentClass; const AUnitName: shortstring;
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
  DisableAutoSize: boolean): TComponent;
const
  PreferredDistanceMin = 30;
  PreferredDistanceMax = 250;
var
  NewJITIndex: Integer;
  CompLeft, CompTop, CompWidth, CompHeight, NewPPI, OldPPI: integer;
  NewComponent: TComponent;
  OwnerComponent: TComponent;
  JITList: TJITComponentList;
  AControl: TControl;
  AParent: TWinControl;
  NewComponentName: String;
  DesignForm: TCustomForm;
  NewUnitName: String;
  s: String;
  MonitorBounds: TRect;
  Mediator: TDesignerMediator;
  FreeMediator: Boolean;
  MediatorClass: TDesignerMediatorClass;
  ParentDesigner: TCustomDesignControl;

  function ActiveMonitor: TMonitor;
  begin
    if Screen.ActiveCustomForm <> nil then
      Result := Screen.ActiveCustomForm.Monitor
    else
    if Application.MainForm <> nil then
      Result := Application.MainForm.Monitor
    else
      Result := Screen.PrimaryMonitor;
  end;

  procedure CreateMediator;
  var
    NewSize: TPoint;
  begin
    if Mediator=nil then
    begin
      MediatorClass:=GetDesignerMediatorClass(TComponentClass(NewComponent.ClassType));
      if MediatorClass<>nil then
      begin
        Mediator:=MediatorClass.CreateMediator(nil,NewComponent);
        FreeMediator:=true;
      end;
    end;
    if (Mediator<>nil) and (ParentComponent=nil) then
    begin
      NewSize:=Mediator.GetDefaultSize;
      if NewWidth=0 then
        NewWidth:=NewSize.X;
      if NewHeight=0 then
        NewHeight:=NewSize.Y;
    end;
  end;

  procedure MediatorInitComponent;
  begin
    if Mediator<>nil then begin
      //DebugLn(['TCustomFormEditor.CreateComponent ',DbgSName(NewComponent),' ',dbgs(Bounds(CompLeft,CompTop,CompWidth,CompHeight)),' ',Mediator<>nil]);
      Mediator.InitComponent(NewComponent,ParentComponent,
        Bounds(CompLeft,CompTop,CompWidth,CompHeight));
    end;
  end;

begin
  Result:=nil;
  AParent:=nil;
  NewComponent:=nil;
  Mediator:=nil;
  FreeMediator:=false;
  try
    //DebugLn(['[TCustomFormEditor.CreateComponent] Class="'+TypeClass.ClassName+'" ',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight]);
    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent A');{$ENDIF}

    OwnerComponent:=nil;
    if Assigned(ParentComponent) then
    begin
      // add as child component
      Mediator:=GetDesignerMediatorByComponent(ParentComponent);
      OwnerComponent := ParentComponent;
      if OwnerComponent.Owner <> nil then
        OwnerComponent := OwnerComponent.Owner;
      try
        NewComponent := TComponent(TypeClass.newinstance);
        if DisableAutoSize and (NewComponent is TControl) then
          TControl(NewComponent).DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomFormEditor.CreateComponent'){$ENDIF};
        SetComponentDesignMode(NewComponent,true);
        if DescendFromDesignerBaseClass(TypeClass)>=0 then begin
          // this class can have its own lfm streams (e.g. a TFrame)
          //  => set csInline
          DebugLn(['TCustomFormEditor.CreateComponent Inline ',DbgSName(TypeClass)]);
          SetComponentInlineMode(NewComponent,true);
        end;
        try
          NewComponent.Create(OwnerComponent);
        except
          NewComponent:=nil;
          raise;
        end;
      except
        on e: Exception do begin
          DumpExceptionBackTrace;
          IDEMessageDialog(lisCFEErrorCreatingComponent,
            Format(lisCFEErrorCreatingComponent2,
                   [TypeClass.ClassName, LineEnding, E.Message]),
            mtError,[mbCancel]);
          exit;
        end;
      end;
      // check if Owner was properly set
      if NewComponent.Owner <> OwnerComponent then begin
        IDEMessageDialog(lisCFEInvalidComponentOwner,
          Format(lisCFETheComponentOfTypeFailedToSetItsOwnerTo, [NewComponent.
            ClassName, OwnerComponent.Name, OwnerComponent.ClassName]),
          mtError,[mbCancel]);
        exit;
      end;

      // read inline streams
      if csInline in NewComponent.ComponentState then begin
        JITList:=FindJITList(OwnerComponent);
        if JITList=nil then
          RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
        JITList.ReadInlineJITChildComponent(NewComponent);
      end;

      // calc parent
      AParent:=nil;
      if ParentComponent is TControl then begin
        if (ParentComponent is TWinControl) then
          AParent:=TWinControl(ParentComponent)
        else
          AParent:=TControl(ParentComponent).Parent;
        while (AParent<>nil) do begin
          if (AParent is TWinControl)
          and (csAcceptsControls in AParent.ControlStyle) then
            break;
          AParent:=AParent.Parent;
        end;
      end;
      //DebugLn('TCustomFormEditor.CreateComponent: Parent is '''+dbgsName(AParent)+'''');
    end else begin
      // create a toplevel component
      // -> a form or a datamodule or a custom component
      if AUnitName='' then
        NewUnitName:=DefaultJITUnitName
      else
        NewUnitName:=AUnitName;
      JITList:=GetJITListOfType(TypeClass);
      if JITList=nil then
        RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
      NewJITIndex := JITList.AddNewJITComponent(NewUnitName,TypeClass,DisableAutoSize);
      if NewJITIndex < 0 then
        exit;
      // create component interface
      NewComponent:=JITList[NewJITIndex];
    end;
    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent D ');{$ENDIF}
    try
      NewComponentName := CreateUniqueComponentName(NewComponent);
      NewComponent.Name := NewComponentName;
    except
      on e: Exception do begin
        IDEMessageDialog(lisErrorNamingComponent,
          Format(lisErrorSettingTheNameOfAComponentTo, [dbgsName(NewComponent),
            NewComponentName]),
          mtError,[mbCancel]);
        exit;
      end;
    end;

    try
      CreateMediator;

      // set bounds
      CompLeft:=NewLeft;
      CompTop:=NewTop;
      CompWidth:=NewWidth;
      CompHeight:=NewHeight;
      if NewComponent is TControl then
      begin
        AControl := TControl(NewComponent);
        if AControl is TCustomDesignControl then
          OldPPI := TCustomDesignControl(AControl).DesignTimePPI
        else
          OldPPI := 96;
        ParentDesigner := GetParentDesignControl(AParent);
        // calc bounds
        if CompWidth <= 0 then
        begin
          CompWidth := Max(5, AControl.Width);
          if ParentDesigner<>nil then
            CompWidth := MulDiv(CompWidth, ParentDesigner.PixelsPerInch, OldPPI);
        end;
        if CompHeight <= 0 then
        begin
          CompHeight := Max(5, AControl.Height);
          if ParentDesigner<>nil then
            CompHeight := MulDiv(CompHeight, ParentDesigner.PixelsPerInch, OldPPI);
        end;
        MonitorBounds := ActiveMonitor.BoundsRect;
        if (CompLeft < 0) and (AParent <> nil) then
          CompLeft := (AParent.Width - CompWidth) div 2
        else
        if (AControl is TCustomForm) and (CompLeft < MonitorBounds.Left + PreferredDistanceMin) then
          with MonitorBounds do
            CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin))
        else
        if CompLeft < 0 then
          CompLeft := 0;
        if (CompTop < 0) and (AParent <> nil) then
          CompTop := (AParent.Height - CompHeight) div 2
        else
        if (AControl is TCustomForm) and (CompTop < MonitorBounds.Top + PreferredDistanceMin) then
          with MonitorBounds do
            CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin))
        else
        if CompTop < 0 then
          CompTop := 0;

        if ParentDesigner<>nil then
          NewPPI := ParentDesigner.PixelsPerInch
        else
        if (AControl is TCustomForm) then
          NewPPI := TCustomForm(AControl).Monitor.PixelsPerInch
        else
          NewPPI := 0;
        if NewPPI > 0 then
          AControl.AutoAdjustLayout(lapAutoAdjustForDPI, OldPPI, NewPPI, 0, 0);

        if (AParent <> nil) or (AControl is TCustomForm) then
        begin
          // set parent after placing control to prevent display at (0,0)
          AControl.SetBounds(CompLeft,CompTop,CompWidth,CompHeight);
          AControl.Parent := AParent;
        end else
        begin
          // no parent and not a form
          AControl.SetBounds(0,0,CompWidth,CompHeight);
          AControl.DesignInfo := LeftTopToDesignInfo(CompLeft, CompTop);
          //DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(AControl),' ',LazLongRec(AControl.DesignInfo).Lo,',',LazLongRec(AControl.DesignInfo).Hi]);
        end;
      end
      else
      if (NewComponent is TDataModule) then
      begin
        // data module
        with TDataModule(NewComponent) do
        begin
          if CompWidth <= 0 then CompWidth := Max(150, DesignSize.X);
          if CompHeight <= 0 then CompHeight := Max(150, DesignSize.Y);
          MonitorBounds := ActiveMonitor.BoundsRect;
          if CompLeft < MonitorBounds.Left + PreferredDistanceMin then
            with MonitorBounds do
              CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin));
          if CompTop < MonitorBounds.Top + PreferredDistanceMin then
            with MonitorBounds do
              CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin));
          DesignOffset := Point(CompLeft, CompTop);
          DesignSize := Point(CompWidth, CompHeight);
          //debugln('TCustomFormEditor.CreateComponent TDataModule Bounds ',dbgsName(NewComponent),' ',dbgs(DesignOffset.X),',',dbgs(DesignOffset.Y),' ',DbgS(NewComponent),8),' ',DbgS(Cardinal(@DesignOffset));
        end;
      end
      else begin
        // non TControl
        CompLeft := Max(Low(SmallInt), Min(High(SmallInt), CompLeft));
        CompTop := Max(Low(SmallInt), Min(High(SmallInt), CompTop));
        if Mediator=nil then
          SetComponentLeftTopOrDesignInfo(NewComponent,CompLeft,CompTop);

        if ParentComponent <> nil then
        begin
          DesignForm := GetDesignerForm(ParentComponent);
          if DesignForm <> nil then DesignForm.Invalidate;
        end;
      end;
      MediatorInitComponent;
    except
      on e: Exception do begin
        DebugLn(e.Message);
        DumpExceptionBackTrace;
        IDEMessageDialog(lisErrorMovingComponent,
          Format(lisErrorMovingComponent2, [NewComponent.Name,
            NewComponent.ClassName]),
          mtError,[mbCancel]);
        exit;
      end;
    end;

    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent F ');{$ENDIF}
    //DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(NewComponent),' ',FindComponent(NewComponent)<>nil]);

    Result := NewComponent;
  finally
    // clean up carefully
    if FreeMediator and (Mediator<>nil) then begin
      try
        FreeAndNil(Mediator);
      except
        on E: Exception do begin
          s:=Format(lisCFEErrorDestroyingMediatorOfUnit,
                    [Mediator.ClassName, AUnitName, LineEnding, E.Message]);
          DebugLn(['TCustomFormEditor.CreateComponent ',s]);
          DumpExceptionBackTrace;
          IDEMessageDialog(lisCFEErrorDestroyingMediator, s, mtError, [mbCancel]);
        end;
      end;
    end;
    if Result=nil then begin
      if NewComponent<>nil then begin
        try
          NewComponent.Free;
          NewComponent:=nil;
        except
          on E: Exception do begin
            s:=Format(lisCFEErrorDestroyingComponentOfTypeOfUnit,
                      [TypeClass.ClassName, AUnitName, LineEnding, E.Message]);
            DebugLn(['TCustomFormEditor.CreateComponent ',s]);
            DumpExceptionBackTrace;
            IDEMessageDialog(lisCFEErrorDestroyingComponent, s, mtError, [mbCancel]);
          end;
        end;
      end;
    end;
  end;
end;

function TCustomFormEditor.CreateComponentFromStream(
  BinStream: TStream;
  UnitResourcefileFormat: TUnitResourcefileFormatClass;
  AncestorType: TComponentClass;
  const NewUnitName: ShortString;
  Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
  ContextObj: TObject): TComponent;
begin
  Result:=CreateRawComponentFromStream(BinStream, UnitResourcefileFormat,
       AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,ContextObj);
end;

function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream;
  UnitResourcefileFormat: TUnitResourcefileFormatClass;
  AncestorType: TComponentClass;
  const NewUnitName: ShortString;
  Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
  ContextObj: TObject): TComponent;
var
  NewJITIndex: integer;
  JITList: TJITComponentList;
begin
  // create JIT Component
  JITList:=GetJITListOfType(AncestorType);
  if JITList=nil then
    RaiseGDBException('TCustomFormEditor.CreateComponentFromStream ClassName='+
                      AncestorType.ClassName);
  try
    NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
                AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
                ContextObj);
    if NewJITIndex < 0 then
      exit(nil);
  except
    on E: EUnknownProperty do
      exit(nil);
  end;
  Result:=JITList[NewJITIndex];
end;

procedure TCustomFormEditor.CreateChildComponentsFromStream(BinStream: TStream;
  ComponentClass: TComponentClass; Root: TComponent;
  ParentControl: TWinControl; NewComponents: TFPList);
var
  JITList: TJITComponentList;
begin
  JITList:=FindJITList(Root);
  if JITList=nil then
    RaiseGDBException('TCustomFormEditor.CreateChildComponentFromStream ClassName='+
                      Root.ClassName);

  JITList.AddJITChildComponentsFromStream(
                     Root,BinStream,ComponentClass,ParentControl,NewComponents);
end;

function TCustomFormEditor.ParentAcceptsChild(Parent, Child,
  aLookupRoot: TComponent): boolean;
var
  Mediator: TDesignerMediator;
  AControl: TControl;
  aComp: TComponent;
begin
  Result:=false;
  if (Parent=nil) or (Child=nil) or (aLookupRoot=nil) then
    exit;

  // don't allow to move ancestor components
  if csAncestor in Child.ComponentState then
    exit;

  // check if one of the parents of the Parent is the Child itself
  aComp:=Parent;
  repeat
    if aComp=Child then exit;
    aComp:=aComp.GetParentComponent;
  until aComp=nil;

  // check mediator
  Mediator:=GetDesignerMediatorByComponent(aLookupRoot);
  if Mediator<>nil then
  begin
    if not Mediator.ParentAcceptsChildComponent(Parent,Child) then
      exit;
  end;

  // check LCL rules
  if Parent is TWinControl then
  begin
    if (not (csAcceptsControls in TWinControl(Parent).ControlStyle)) then
      exit;
    if not TWinControl(Parent).CheckChildClassAllowed(TComponentClass(Child.ClassType), False) then
      exit;
  end
  else if Parent is TControl then begin
    exit;
  end;

  if Child is TControl then
  begin
    // do not move children of a restricted parent to another parent
    // e.g. TPage of TPageControl
    AControl:=TControl(Child);
    if (AControl.Parent <> nil) and (AControl.Parent <> Parent) and
        (not (csAcceptsControls in AControl.Parent.ControlStyle)) then
      exit;
  end;
  Result:=true;
end;

function TCustomFormEditor.ParentAcceptsChildClass(Parent: TComponent;
  ChildClass: TComponentClass; aLookupRoot: TComponent): boolean;
var
  Mediator: TDesignerMediator;
begin
  Result:=false;
  if (Parent=nil) or (ChildClass=nil) or (aLookupRoot=nil) then
    exit;
  Mediator:=GetDesignerMediatorByComponent(aLookupRoot);
  if Mediator<>nil then
    Result:=Mediator.ParentAcceptsChild(Parent,ChildClass)
  else if Parent is TWinControl then
  begin
    if not TWinControl(Parent).CheckChildClassAllowed(ChildClass, False) then
      exit;
  end else if Parent is TControl then begin
    exit;
  end;
  Result:=true;
end;

function TCustomFormEditor.FixupReferences(AComponent: TComponent): TModalResult;
begin
  Result:=MainIDEInterface.DoFixupComponentReferences(AComponent,[]);
end;

procedure TCustomFormEditor.WriterFindAncestor(Writer: TWriter;
  Component: TComponent; const Name: string; var Ancestor,
  RootAncestor: TComponent);
// Note: TWriter wants the stream ancestor, which is not always the class ancestor
var
  AnUnitInfo: TUnitInfo;
begin
  {$IFDEF VerboseFormEditor}
  DebugLn(['TCustomFormEditor.WriterFindAncestor START Component=',DbgSName(Component)]);
  {$ENDIF}
  AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(Component.ClassType));
  if (AnUnitInfo<>nil) then begin
    if (AnUnitInfo.Component=Component) then begin
      // Component is a root component (e.g. not nested, inline)
      // the stream ancestor is the component of the ClassParent
      AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
    end else begin
      // Component is a nested, inline component
      // the stream ancestor is the component of the class
    end;
    if (AnUnitInfo<>nil) and (AnUnitInfo.Component<>nil) then begin
      Ancestor:=AnUnitInfo.Component;
      RootAncestor:=AnUnitInfo.Component;
    end;
    {$IFDEF VerboseFormEditor}
    DebugLn(['TCustomFormEditor.WriterFindAncestor Component=',DbgSName(Component),' Ancestor=',DbgSName(Ancestor),' RootAncestor=',DbgSName(RootAncestor)]);
    {$ENDIF}
  end;
end;

procedure TCustomFormEditor.SetComponentNameAndClass(
  AComponent: TComponent;
  const NewName, NewClassName: shortstring);
var
  JITList: TJITComponentList;
begin
  JITList:=GetJITListOfType(TComponentClass(AComponent.ClassType));
  JITList.RenameComponentClass(AComponent,NewClassName);
  AComponent.Name:=NewName;
end;

function TCustomFormEditor.ClassDependsOnComponent(AClass: TComponentClass;
  AComponent: TComponent): Boolean;
{ Check if AClass uses AComponent.

  For example:
    Add frame2 to frame1 ( frame1 uses frame2 )
    Add frame3 to frame2 ( frame2 uses frame3 => frame 2 uses frame1)
    Add frame1 to frame3 => circle
}
var
  AnUnitInfo: TUnitInfo;
begin
  if AClass.InheritsFrom(AComponent.ClassType) then exit(true);
  AnUnitInfo := Project1.UnitWithComponentClass(AClass);
  if AnUnitInfo = nil then Exit(false);
  Result := ComponentDependsOnClass(AnUnitInfo.Component,
                                    TComponentClass(AComponent.ClassType));
end;

function TCustomFormEditor.ComponentDependsOnClass(AComponent: TComponent;
  AClass: TComponentClass): Boolean;
var
  i: Integer;
begin
  if AComponent is AClass then exit(true);
  if AComponent<>nil then
    for i:=0 to AComponent.ComponentCount-1 do
      if ComponentDependsOnClass(AComponent.Components[i],AClass) then
        exit(true);
  Result:=false;
end;

function TCustomFormEditor.GetAncestorLookupRoot(AComponent: TComponent
  ): TComponent;
{ returns the ancestor of the Owner, if it owns a component with same name.
}
var
  CurRoot: TComponent;
  AncestorRoot: TComponent;
begin
  Result:=nil;
  if AComponent=nil then exit;
  CurRoot:=AComponent.Owner;
  if CurRoot=nil then exit;
  AncestorRoot:=GetAncestorInstance(CurRoot);
  if AncestorRoot=nil then exit;
  if AncestorRoot.FindComponent(AComponent.Name)=nil then exit;
  Result:=AncestorRoot;
  {$IFDEF VerboseFormEditor}
  DebugLn(['TCustomFormEditor.GetAncestorLookupRoot AComponent=',DbgSName(AComponent),' Result=',DbgSName(Result)]);
  {$ENDIF}
end;

function TCustomFormEditor.GetAncestorInstance(AComponent: TComponent): TComponent;
{ Returns the next ancestor instance.
  For example:
    TFrame3 = class(TFrame2), TFrame2 = class(TFrame1)
    Frame1 is the ancestor instance of Frame2.
    Frame2 is the ancestor instance of Frame3.

    If TFrame1 introduced Button1 then
    TFrame1.Button1 is the ancestor instance of TFrame2.Button1.
    TFrame2.Button1 is the ancestor instance of TFrame3.Button1.
}
var
  aRoot: TComponent;
begin
  Result:=nil;
  if (AComponent=nil) or (AComponent.ClassType=TComponent) then exit;
  if AComponent.Owner=nil then begin
    // root component
    Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassParent));
  end else if csInline in AComponent.ComponentState then begin
    // inline/embedded components (e.g. nested frame)
    Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassType));
  end else begin
    // child component
    aRoot:=GetAncestorInstance(AComponent.Owner);
    if aRoot<>nil then
      Result:=aRoot.FindComponent(AComponent.Name);
  end;
  {$IFDEF VerboseFormEditor}
  debugln(['TCustomFormEditor.GetAncestorInstance ',DbgSName(AComponent),' csAncestor=',csAncestor in AComponent.ComponentState,' Result=',DbgSName(Result)]);
  {$ENDIF}
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 := 0 to StandardDesignerBaseClassesCount-1 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.DescendFromDesignerBaseClass(AClass: TComponentClass): integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to FDesignerBaseClasses.Count-1 do
  begin
    if AClass.InheritsFrom(TClass(FDesignerBaseClasses[i])) then
    begin
      if (Result<0)
          or (TClass(FDesignerBaseClassesCanCreateForm[i]).InheritsFrom(TClass(FDesignerBaseClasses[Result]))) then
        Result:=i;
    end;
  end;
end;

function TCustomFormEditor.FindDesignerBaseClassByName(
  const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
var
  i: Integer;
  HasUnitName: Boolean;

  function Fits(aClass: TComponentClass): boolean;
  begin
    if HasUnitName then
      Result:=SameText(AClass.UnitName+'/'+aClass.ClassName,AClassName)
    else
      Result:=SameText(aClass.ClassName,AClassName);
  end;

  function SearchInParent(AParent: TComponentClass): TComponentClass;
  begin
    Result := nil;
    while AParent <> nil do
    begin
      if Fits(AParent) then
        Exit(AParent);
      AParent:=TComponentClass(AParent.ClassParent);
      if AParent = TComponent then
        exit;
    end;
  end;

begin
  HasUnitName:=Pos('/',AClassName)>0;
  if WithDefaults then
  begin
    for i := 0 to StandardDesignerBaseClassesCount - 1 do
    begin
      Result := SearchInParent(StandardDesignerBaseClasses[i]);
      if Result <> nil then exit;
    end;
  end;
  for i:=FDesignerBaseClasses.Count-1 downto 0 do
  begin
    Result:=DesignerBaseClasses[i];
    if Fits(Result) then exit;
  end;
  Result:=nil;
end;

function TCustomFormEditor.StandardDesignerBaseClassesCount: Integer;
begin
  Result := Succ(High(CustomFormEditor.StandardDesignerBaseClasses) - Low(CustomFormEditor.StandardDesignerBaseClasses));
end;

procedure TCustomFormEditor.FindDefineProperty(
  const APersistentClassName, AncestorClassName, Identifier: string;
  var IsDefined: boolean);
var
  AutoFreePersistent: Boolean;
  APersistent: TPersistent;
  CacheItem: TDefinePropertiesCacheItem;
  DefinePropertiesReader: TDefinePropertiesReader;
  ANode: TAvlTreeNode;
  OldClassName: String;
  DefinePropertiesPersistent: TDefinePropertiesPersistent;

  function CreateTempPersistent(APersistentClass: TPersistentClass): boolean;
  begin
    Result:=false;
    if APersistent<>nil then
      RaiseGDBException('TCustomFormEditor.FindDefineProperty.CreateTempPersistent Inconsistency');
    try
      if APersistentClass.InheritsFrom(TComponent) then
        APersistent:=TComponentClass(APersistentClass).Create(nil)
      else if APersistentClass.InheritsFrom(TGraphic) then
        APersistent:=TGraphicClass(APersistentClass).Create
      else
        APersistent:=APersistentClass.Create;
      Result:=true;
      AutoFreePersistent:=true;
    except
      on E: Exception do begin
        debugln('TCustomFormEditor.FindDefineProperty Error creating ',
                APersistentClass.Classname, ': ', E.Message);
      end;
    end;
  end;
  
  function GetDefinePersistent(const AClassName: string): Boolean;
  var
    APersistentClass: TPersistentClass;
    AncestorClass: TComponentClass;
  begin
    Result:=false;
    Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');

    // try to find the AClassName in the registered components
    if APersistent=nil then begin
      CacheItem.RegisteredComponent:=IDEComponentPalette.FindRegComponent(AClassName);
      if (CacheItem.RegisteredComponent<>nil)
      and (CacheItem.RegisteredComponent.ComponentClass<>nil) then begin
        //debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',AClassName,' is registered');
        if not CreateTempPersistent(CacheItem.RegisteredComponent.ComponentClass)
        then exit;
      end;
    end;
    
    // try to find the AClassName in the registered TPersistent classes
    if APersistent=nil then begin
      APersistentClass:=Classes.GetClass(AClassName);
      if APersistentClass<>nil then begin
        //debugln('TCustomFormEditor.FindDefineProperty PersistentClass ',AClassName,' is registered');
        Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
        if not CreateTempPersistent(APersistentClass) then exit;
      end;
    end;

    if APersistent=nil then begin
      // try to find the AClassName in the open forms/datamodules
      Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
      APersistent:=FindJITComponentByClassName(AClassName);
      if APersistent<>nil then
        debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',
          AClassName,' is a resource,'
          +' but inheriting design properties is not yet implemented');
    end;

    // try default classes
    if (APersistent=nil) then begin
      AncestorClass:=FindDesignerBaseClassByName(AClassName,true);
      if AncestorClass<>nil then begin
        if not CreateTempPersistent(AncestorClass) then exit;
      end;
    end;

    Result:=true;
  end;
  
begin
  //debugln('TCustomFormEditor.GetDefineProperties ',
  //  ' APersistentClassName="',APersistentClassName,'"',
  // ' AncestorClassName="',AncestorClassName,'"',
  //  ' Identifier="',Identifier,'"');
  IsDefined:=false;
  RegisterStandardDefineProperties;
  ANode:=FindDefinePropertyNode(APersistentClassName);
  if ANode=nil then begin
    // cache component class, try to retrieve the define properties
    CacheItem:=TDefinePropertiesCacheItem.Create;
    CacheItem.PersistentClassname:=APersistentClassName;
    FDefineProperties.Add(CacheItem);
    //debugln('TCustomFormEditor.FindDefineProperty APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');

    APersistent:=nil;
    AutoFreePersistent:=false;

    if not GetDefinePersistent(APersistentClassName) then exit;
    if APersistent=nil then
      if not GetDefinePersistent(AncestorClassName) then exit;

    if APersistent<>nil then begin
      debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Getting define properties for ',APersistent.ClassName);

      // try creating a component class and call DefineProperties
      DefinePropertiesReader:=nil;
      DefinePropertiesPersistent:=nil;
      try
        try
          DefinePropertiesReader:=TDefinePropertiesReader.Create;
          DefinePropertiesPersistent:=TDefinePropertiesPersistent.Create(APersistent);
          DefinePropertiesPersistent.PublicDefineProperties(DefinePropertiesReader);
        except
          on E: Exception do begin
            DbgOut('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error calling DefineProperties for ');
            if (CacheItem.RegisteredComponent<>nil) then begin
              DbgOut(CacheItem.RegisteredComponent.ComponentClass.Classname);
            end;
            DebugLn(' : ',E.Message);
          end;
        end;
        // free component
        if AutoFreePersistent then begin
          try
            OldClassName:=APersistent.ClassName;
            APersistent.Free;
          except
            on E: Exception do begin
              debugln('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error freeing ',
                OldClassName,': ',E.Message);
            end;
          end;
        end;
      finally
        // cache defined properties
        if (DefinePropertiesReader<>nil)
        and (DefinePropertiesReader.DefinePropertyNames<>nil) then begin
          CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
          CacheItem.DefineProperties.Assign(DefinePropertiesReader.DefinePropertyNames);
          debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Class=',APersistentClassName,
            ' DefineProps="',CacheItem.DefineProperties.Text,'"');
        end;
        DefinePropertiesReader.Free;
        DefinePropertiesPersistent.Free;
      end;
    end else begin
      debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Persistent is NOT registered');
    end;
    //debugln('TCustomFormEditor.FindDefineProperty END APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');
  end else begin
    CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
  end;
  if CacheItem.DefineProperties<>nil then
    IsDefined:=CacheItem.DefineProperties.IndexOf(Identifier)>=0;
end;

procedure TCustomFormEditor.RegisterDefineProperty(const APersistentClassName,
  Identifier: string);
var
  ANode: TAvlTreeNode;
  CacheItem: TDefinePropertiesCacheItem;
begin
  //DebugLn('TCustomFormEditor.RegisterDefineProperty ',APersistentClassName,' ',Identifier);
  ANode:=FindDefinePropertyNode(APersistentClassName);
  if ANode=nil then begin
    CacheItem:=TDefinePropertiesCacheItem.Create;
    CacheItem.PersistentClassname:=APersistentClassName;
    FDefineProperties.Add(CacheItem);
  end else begin
    CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
  end;
  if (CacheItem.DefineProperties=nil) then
    CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
  if (CacheItem.DefineProperties.IndexOf(Identifier)<0) then
    CacheItem.DefineProperties.Add(Identifier);
end;

procedure TCustomFormEditor.RegisterStandardDefineProperties;
begin
  if FStandardDefinePropertiesRegistered then exit;
  FStandardDefinePropertiesRegistered:=true;
  RegisterDefineProperty('TStrings','Strings');
end;

procedure TCustomFormEditor.JITListBeforeCreate(Sender: TObject;
  Instance: TPersistent);
var
  MediatorClass: TDesignerMediatorClass;
begin
  if Instance is TComponent then begin
    MediatorClass:=GetDesignerMediatorClass(TComponentClass(Instance.ClassType));
    if MediatorClass<>nil then
      MediatorClass.InitFormInstance(TComponent(Instance));
  end;
end;

procedure TCustomFormEditor.JITListException(Sender: TObject; E: Exception;
  var Action: TModalResult);
var
  List: TJITComponentList;
  AnUnitInfo: TUnitInfo;
  LFMFilename: String;
  Msg: String;
begin
  List:=TJITComponentList(Sender);
  LFMFilename:='';
  Msg:='';
  DebugLn(['TCustomFormEditor.JITListException List.CurReadStreamClass=',DbgSName(List.CurReadStreamClass),' ',DbgSName(List.ContextObject)]);
  if (List.CurReadStreamClass<>nil) and (Project1<>nil)
  and (List.CurReadStreamClass.InheritsFrom(TComponent)) then begin
    AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(List.CurReadStreamClass));
    if AnUnitInfo<>nil then begin
      LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
    end;
  end;
  if (LFMFilename='') and (List.ContextObject is TUnitInfo) then begin
    LFMFilename:=ChangeFileExt(TUnitInfo(List.ContextObject).Filename,'.lfm');
  end;
  if LFMFilename<>'' then
    Msg:=Format(lisCFEInFile, [LFMFilename]) + LineEnding;

  if List.CurReadErrorMsg<>'' then
    Msg:=Msg+List.CurReadErrorMsg+LineEnding;
  Msg+=E.Message;
  IDEMessageDialog(lisCodeToolsDefsReadError, Msg, mtError, [mbCancel]);
end;

procedure TCustomFormEditor.DesignerMenuItemClick(Sender: TObject);
var
  CompEditor: TBaseComponentEditor;
  MenuItem: TMenuItem;
  CompClassName: String;
begin
  if (Sender=nil) or (not (Sender is TMenuItem)) then exit;
  MenuItem:=TMenuItem(Sender);
  if (MenuItem.Count>0) or MenuItem.IsInMenuBar then exit;

  CompEditor:=GetComponentEditor(TComponent(Sender));
  if CompEditor=nil then exit;
  CompClassName:=CompEditor.ClassName;
  try
    CompEditor.Edit;
  except
    on E: Exception do begin
      DebugLn('TCustomFormEditor.DesignerMenuItemClick ERROR on CompEditor.Edit: ',E.Message);
      IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
        Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
               [CompClassName, LineEnding, E.Message]),
        mtError,[mbOk]);
    end;
  end;
  try
    CompEditor.Free;
  except
    on E: Exception do begin
      DebugLn('TCustomFormEditor.DesignerMenuItemClick ERROR on CompEditor.Free: ',E.Message);
      IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
        Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
               [CompClassName, LineEnding, E.Message]),
        mtError,[mbOk]);
    end;
  end;
end;

function TCustomFormEditor.DesignerClassCanAppCreateForm(
  AClass: TComponentClass; CheckInherited: boolean): boolean;
var
  i: Integer;
begin
  Result:=false;
  if AClass=nil then exit;
  // check standard classes
  if (AClass=TCustomForm) or (AClass=TDataModule) then
    exit(true);
  if CheckInherited and (AClass.InheritsFrom(TCustomForm) or AClass.InheritsFrom(TDataModule)) then
    exit(true);
  // check addons
  Result:=FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0;
  if CheckInherited then
  begin
    for i:=0 to FDesignerBaseClassesCanCreateForm.Count-1 do
      if AClass.InheritsFrom(TComponentClass(FDesignerBaseClassesCanCreateForm[i])) then
        exit(true);
  end;
end;

procedure TCustomFormEditor.SetDesignerBaseClassCanAppCreateForm(
  AClass: TComponentClass; AValue: boolean);
begin
  if AValue then
  begin
    if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0 then exit;
    FDesignerBaseClassesCanCreateForm.Add(AClass);
  end else begin
    if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)<0 then exit;
    FDesignerBaseClassesCanCreateForm.Remove(AClass);
  end;
end;

function TCustomFormEditor.FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
begin
  Result := FNonFormForms.FindKey(Pointer(LookupRoot),
                                   @CompareLookupRootAndNonFormDesignerForm);
end;

procedure TCustomFormEditor.JITListPropertyNotFound(Sender: TObject;
  Reader: TReader; Instance: TPersistent; var PropName: string;
  IsPath: boolean; var Handled, Skip: Boolean);
var
  Index: Integer;
begin
  Index := PropertiesToSkip.IndexOf(Instance, PropName);
  if Index >= 0 then
  begin
    Skip := True;
    Handled := True;
  end
  else
    DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName,
      ' Instance=',Instance.ClassName,' PropName="',PropName,
      '" IsPath=',IsPath]);
end;

procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject;
  AClass: TClass;
  var Ancestors: TFPList;// list of TComponent
  var BinStreams: TFPList;// list of TExtMemoryStream;
  var Abort: boolean);
var
  AnUnitInfo: TUnitInfo;
  Ancestor: TComponent;
  BinStream: TExtMemoryStream;
begin
  Ancestors:=nil;
  BinStreams:=nil;
  if Project1=nil then exit;
  if (AClass=nil) or (AClass=TComponent)
  or (AClass=TForm) or (AClass=TCustomForm)
  or (AClass=TDataModule)
  or (not AClass.InheritsFrom(TComponent))
  or (IndexOfDesignerBaseClass(TComponentClass(AClass))>=0) then begin
    exit;
  end;
  AnUnitInfo:=Project1.UnitWithComponentClassName(AClass.ClassName);
  //AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(AClass));
  while AnUnitInfo<>nil do begin
    {$IFDEF VerboseFormEditor}
    DebugLn(['TCustomFormEditor.JITListFindAncestors FOUND ancestor ',DbgSName(AnUnitInfo.Component),', streaming ...']);
    {$ENDIF}
    Ancestor:=AnUnitInfo.Component;
    BinStream:=nil;
    if SaveUnitComponentToBinStream(AnUnitInfo,BinStream)<>mrOk then begin
      Abort:=true;
      exit;
    end;
    BinStream.Position:=0;
    if Ancestors=nil then begin
      Ancestors:=TFPList.Create;
      BinStreams:=TFPList.Create;
    end;
    Ancestors.Add(Ancestor);
    BinStreams.Add(BinStream);
    AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
  end;
end;

procedure TCustomFormEditor.JITListFindClass(Sender: TObject; const VarName,
  ComponentUnitName, ComponentClassName: string;
  var ComponentClass: TComponentClass);

  function FindRegisteredComp(const aClassName: string): TRegisteredComponent;
  begin
    Result:=IDEComponentPalette.FindRegComponent(aClassName);
    if Result=nil then exit;
    if Result.ComponentClass.InheritsFrom(TCustomFrame) then
    begin
      debugln(['TCustomFormEditor.JITListFindClass.FindRegisteredComp "',aClassName,'", ignoring registered TFrame descendant "',dbgsname(Result.ComponentClass),'"']);
      exit(nil); // Nested TFrame
    end;
  end;

var
  AnUnitInfo: TUnitInfo;
  Component: TComponent;
  RegComp: TRegisteredComponent;
  JITList: TJITComponentList;
begin
  //DebugLn(['TCustomFormEditor.JITListFindClass Var="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'"']);

  JITList:=Sender as TJITComponentList;
  //DebugLn(['TCustomFormEditor.JITListFindClass JITList.ContextObject=',DbgSName(JITList.ContextObject)]);
  if JITList.ContextObject is TUnitInfo then begin
    AnUnitInfo:=TUnitInfo(JITList.ContextObject);
    {$IFDEF VerboseIDEAmbiguousClasses}
    if AnUnitInfo.ComponentVarsToClasses<>nil then
      debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses.Count=',AnUnitInfo.ComponentVarsToClasses.Count])
    else
      debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses=nil']);
    {$ENDIF}
    if (AnUnitInfo.ComponentVarsToClasses<>nil) and (VarName<>'') then
    begin
      ComponentClass:=TComponentClass(AnUnitInfo.ComponentVarsToClasses[VarName]);
      if ComponentClass<>nil then
      begin
        // use a specific class for this variable
        debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Vars=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
        exit;
      end;
    end;
    {$IFDEF VerboseIDEAmbiguousClasses}
    if AnUnitInfo.ComponentTypesToClasses<>nil then
      debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses.Count=',AnUnitInfo.ComponentTypesToClasses.Count])
    else
      debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses=nil']);
    {$ENDIF}
    if AnUnitInfo.ComponentTypesToClasses<>nil then
    begin
      ComponentClass:=TComponentClass(AnUnitInfo.ComponentTypesToClasses[ComponentClassName]);
      if ComponentClass<>nil then
      begin
        // use a specific class for this classname
        debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Classes=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
        exit;
      end;
    end;
  end;

  // search in the registered components
  RegComp:=nil;
  if ComponentUnitName<>'' then
    RegComp:=FindRegisteredComp(ComponentUnitName+'/'+ComponentClassName);
  if RegComp=nil then
  begin
    // search without unitname in the registered components
    RegComp:=FindRegisteredComp(ComponentClassName);
    if (RegComp<>nil) and RegComp.HasAmbiguousClassName then
    begin
      debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'". Found ambigious registered ComponentClass=',dbgsname(RegComp.ComponentClass)]);
      // ToDo: ask user
    end;
  end;
  if (RegComp<>nil) then
  begin
    //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
    ComponentClass:=RegComp.ComponentClass;
  end else begin
    // search in open and hidden designer forms (e.g. nested frames)
    AnUnitInfo:=Project1.FirstUnitWithComponent;
    while AnUnitInfo<>nil do begin
      Component:=AnUnitInfo.Component;
      if CompareText(Component.ClassName,ComponentClassName)=0 then
      begin
        //DebugLn(['TCustomFormEditor.JITListFindClass found nested class '+DbgSName(Component)+' in unit '+AnUnitInfo.Filename]);
        ComponentClass:=TComponentClass(Component.ClassType);
        break;
      end;
      AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
    end;
  end;
  //if ComponentClass=nil then
  //  DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Not Found'])
  //else
  //  DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Found ',ComponentClass.UnitName,'/',ComponentClass.ClassName])
end;

function TCustomFormEditor.GetDesignerBaseClasses(Index: integer): TComponentClass;
begin
  Result:=TComponentClass(FDesignerBaseClasses[Index]);
end;

function TCustomFormEditor.GetStandardDesignerBaseClasses(Index: integer): TComponentClass;
begin
  Result := CustomFormEditor.StandardDesignerBaseClasses[Index];
end;

procedure TCustomFormEditor.SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass);
begin
  CustomFormEditor.StandardDesignerBaseClasses[Index] := AValue;
end;

procedure TCustomFormEditor.FrameCompGetCreationClass(Sender: TObject;
  var NewComponentClass: TComponentClass);
begin
  if Assigned(OnSelectFrame) then
    OnSelectFrame(Sender,NewComponentClass);
end;

function TCustomFormEditor.CompTree_ParentAcceptsChild(aParent, aChild,
  aLookupRoot: TPersistent): boolean;
begin
  Result:=(aParent is TComponent)
      and (aChild is TComponent)
      and (aLookupRoot is TComponent)
      and ParentAcceptsChild(TComponent(aParent),TComponent(aChild),TComponent(aLookupRoot));
end;

procedure TCustomFormEditor.CompTree_SetParent(aChild, aParent,
  aLookupRoot: TPersistent);
var
  Mediator: TDesignerMediator;
  ChildComp, OldParent: TComponent;
begin
  if not (aChild is TComponent) then exit;
  if not (aParent is TComponent) then exit;
  if not (aLookupRoot is TComponent) then exit;
  Mediator:=GetDesignerMediatorByComponent(TComponent(aLookupRoot));
  if Mediator<>nil then
  begin
    ChildComp:=TComponent(aChild);
    OldParent:=ChildComp.GetParentComponent;
    Mediator.ChangeParent(ChildComp,TComponent(aParent));
    if ChildComp.GetParentComponent<>OldParent then
      ObjectInspectorModified(Self);
  end;
end;

procedure TCustomFormEditor.PasWriterFindAncestor(Writer: TCompWriterPas;
  aComponent: TComponent; const aName: string; var anAncestor,
  aRootAncestor: TComponent);
var
  C: TComponent;
begin
  C:=GetAncestorInstance(aComponent);
  if C=nil then exit;
  anAncestor:=C;
  if C.Owner=nil then
    aRootAncestor:=C;
  if Writer=nil then ;
  if aName='' then ;
end;

procedure TCustomFormEditor.PasWriterGetMethodName(Writer: TCompWriterPas;
  Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
var
  aMethod: TMethod;
  aJITMethod: TJITMethod;
begin
  Name:='';
  if Instance=nil then exit;
  aMethod:=GetMethodProp(Instance,PropInfo);
  if GetJITMethod(aMethod,aJITMethod) then
    Name:=aJITMethod.TheMethodName;
  if Writer=nil then ;
end;

procedure TCustomFormEditor.PasWriterGetParentProperty(
  Writer: TCompWriterPas; Component: TComponent; var PropName: string);
begin
  if Component is TControl then
    PropName:='Parent';
  if Writer=nil then ;
end;

function TCustomFormEditor.OnPropHookGetAncestorInstProp(
  const InstProp: TInstProp; out AncestorInstProp: TInstProp): boolean;
var
  aComponent: TComponent;
begin
  Result:=false;
  if (InstProp.Instance=nil) or (InstProp.PropInfo=nil) then exit;
  if InstProp.Instance is TComponent then begin
    aComponent:=TComponent(InstProp.Instance);
    AncestorInstProp.Instance:=GetAncestorInstance(aComponent);
    if AncestorInstProp.Instance=nil then exit;
    AncestorInstProp.PropInfo:=GetPropInfo(AncestorInstProp.Instance,InstProp.PropInfo^.Name);
    if AncestorInstProp.PropInfo<>InstProp.PropInfo then exit;
    Result:=true;
  end;
end;

function TCustomFormEditor.GetPropertyEditorHook: TPropertyEditorHook;
begin
  Result:=GlobalDesignHook;
  if Obj_Inspector<>nil then
    Result:=Obj_Inspector.PropertyEditorHook;
end;

function TCustomFormEditor.FindDefinePropertyNode(
  const APersistentClassName: string): TAvlTreeNode;
begin
  if FDefineProperties=nil then
    FDefineProperties:=TAvlTree.Create(TListSortCompare(@CompareDefPropCacheItems));
  Result:=FDefineProperties.FindKey(PChar(APersistentClassName),
                    TListSortCompare(@ComparePersClassNameAndDefPropCacheItem));
end;

function TCustomFormEditor.CreateUniqueComponentName(AComponent: TComponent): string;
begin
  Result:='';
  if (AComponent=nil) then exit;
  Result:=AComponent.Name;
  if (AComponent.Owner=nil) or (Result<>'') then exit;
  Result:=CreateUniqueComponentName(AComponent.ClassName,AComponent.Owner);
end;

function TCustomFormEditor.CreateUniqueComponentName(const AClassName: string;
  OwnerComponent: TComponent): string;
var
  i, j: integer;
begin
  Result:=AClassName;
  if (OwnerComponent=nil) or (Result='') then exit;
  i:=1;
  while true do begin
    j:=OwnerComponent.ComponentCount-1;
    Result:=ClassNameToComponentName(AClassName);
    if Result[length(Result)] in ['0'..'9'] then
      Result:=Result+'_';
    Result:=Result+IntToStr(i);
    while (j>=0)
    and (CompareText(Result,OwnerComponent.Components[j].Name)<>0) do
      dec(j);
    if j<0 then exit;
    inc(i);
  end;
end;

function TCustomFormEditor.TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
begin
  //debugln(['TCustomFormEditor.TranslateKeyToDesignerCommand ',DbgSName(TDesignerIDECommandForm),' ',Key,' ',dbgs(Shift)]);
  Result:=EditorOpts.KeyMap.TranslateKey(Key,Shift,TDesignerIDECommandForm);
end;

function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass
  ): TComponent;
var
  NewParent: TComponent;
  Root: TPersistent;
  Mediator: TDesignerMediator;
begin
  Result:=nil;
  // find selected component
  if (FSelection = nil) or (FSelection.Count <= 0) then Exit;
  NewParent:=TComponent(FSelection[0]);
  //Debugln('TCustomFormEditor.GetDefaultComponentParent A:', DbgSName(NewParent));
  if not (NewParent is TComponent) then exit;
  if TypeClass<>nil then begin
    if TypeClass.InheritsFrom(TControl) and (NewParent is TControl) then begin
      // New TypeClass is a TControl and selected component is TControl =>
      // use only a TWinControl as parent
      while (NewParent<>nil) do begin
        if (NewParent is TWinControl)
        and (csAcceptsControls in TWinControl(NewParent).ControlStyle) then
          break;
        NewParent:=TControl(NewParent).Parent;
        //Debugln('TCustomFormEditor.GetDefaultComponentParent B:', DbgSName(NewParent));
      end;
    end else begin
      // New TypeClass or selected component is not a TControl =>
      // use Root component as parent
      Root:=GetLookupRootForComponent(NewParent);
      if Root is TComponent then begin
        Mediator:=GetDesignerMediatorByComponent(TComponent(Root));
        if (Mediator<>nil) then begin
          while (NewParent<>nil) do begin
            if Mediator.ParentAcceptsChild(NewParent,TypeClass) then
              break;
            NewParent:=NewParent.GetParentComponent;
          end;
          if NewParent=nil then
            NewParent:=TComponent(Root);
        end else
          NewParent:=TComponent(Root);
      end;
    end;
  end;
  Result:=NewParent;
end;

function TCustomFormEditor.GetDefaultComponentPosition(
  TypeClass: TComponentClass; ParentComponent: TComponent; out X, Y: integer
  ): boolean;
var
  i: Integer;
  CurComponent: TComponent;
  P: TPoint;
  AForm: TNonFormProxyDesignerForm;
  MinX: Integer;
  MinY: Integer;
  MaxX: Integer;
  MaxY: Integer;
begin
  Result:=true;
  X:=10;
  Y:=10;
  if ParentComponent=nil then
    ParentComponent:=GetDefaultComponentParent(TypeClass);
  if (ParentComponent=nil) or (TypeClass=nil) then exit;
  if (TypeClass.InheritsFrom(TControl)) then exit;
  // a non visual component
  // put it somewhere right or below the other non visual components
  MinX:=-1;
  MinY:=-1;
  if (ParentComponent is TWinControl) then
  begin
    MaxX:=TWinControl(ParentComponent).ClientWidth-ComponentPaletteBtnWidth;
    MaxY:=TWinControl(ParentComponent).ClientHeight-ComponentPaletteBtnHeight;
  end else
  begin
    AForm:=FindNonFormForm(ParentComponent);
    if AForm<>nil then begin
      MaxX:=AForm.ClientWidth-ComponentPaletteBtnWidth;
      MaxY:=AForm.ClientHeight-ComponentPaletteBtnHeight;
    end else begin
      MaxX:=300;
      MaxY:=0;
    end;
  end;
  // find top left most non visual component
  for i:=0 to ParentComponent.ComponentCount-1 do begin
    CurComponent:=ParentComponent.Components[i];
    if ComponentIsNonVisual(CurComponent) then begin
      P:=GetParentFormRelativeTopLeft(CurComponent);
      if (P.X>=0) and (P.Y>=0) then begin
        if (MinX<0) or (P.Y<MinY) or ((P.Y=MinY) and (P.X<MinX)) then begin
          MinX:=P.X;
          MinY:=P.Y;
        end;
      end;
    end;
  end;
  if MinX<0 then begin
    MinX:=10;
    MinY:=10;
  end;
  // find a position without intersection
  X:=MinX;
  Y:=MinY;
  //debugln('TCustomFormEditor.GetDefaultComponentPosition Min=',dbgs(MinX),',',dbgs(MinY));
  i:=0;
  while i<ParentComponent.ComponentCount do begin
    CurComponent:=ParentComponent.Components[i];
    inc(i);
    if ComponentIsNonVisual(CurComponent) then begin
      P:=GetParentFormRelativeTopLeft(CurComponent);
      //debugln('TCustomFormEditor.GetDefaultComponentPosition ',dbgsName(CurComponent),' P=',dbgs(P));
      if (P.X>=0) and (P.Y>=0) then begin
        if (X+ComponentPaletteBtnWidth>=P.X)
        and (X<=P.X+ComponentPaletteBtnWidth)
        and (Y+ComponentPaletteBtnHeight>=P.Y)
        and (Y<=P.Y+ComponentPaletteBtnHeight) then begin
          // intersection found
          // move position
          inc(X,ComponentPaletteBtnWidth+2);
          if X>MaxX then begin
            inc(Y,ComponentPaletteBtnHeight+2);
            X:=MinX;
          end;
          // restart intersection test
          i:=0;
        end;
      end;
    end;
  end;
  // keep it visible
  if X>MaxX then X:=MaxX;
  if Y>MaxY then Y:=MaxY;
end;

procedure TCustomFormEditor.ObjectInspectorModified(Sender: TObject);
var
  CustomForm: TCustomForm;
  Instance: TPersistent;
begin
  if (FSelection = nil)
  or (FSelection.Count <= 0) then Exit;
  
  Instance := FSelection[0];
  CustomForm:=GetDesignerForm(Instance);
  if (CustomForm<>nil) and (CustomForm.Designer<>nil) then
    CustomForm.Designer.Modified;
end;

procedure TCustomFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg);
begin
  if AnObjectInspector=FObj_Inspector then exit;
  if FObj_Inspector<>nil then begin
    FObj_Inspector.OnModified:=nil;
    FObj_inspector.OnNodeGetImageIndex:= nil;
    FObj_inspector.ComponentTree.OnParentAcceptsChild:=nil;
  end;

  FObj_Inspector:=AnObjectInspector;
  
  if FObj_Inspector<>nil then begin
    FObj_Inspector.OnModified:=@ObjectInspectorModified;
    FObj_inspector.OnNodeGetImageIndex:= @DoOnNodeGetImageIndex;
    FObj_inspector.ComponentTree.OnParentAcceptsChild:=@CompTree_ParentAcceptsChild;
    FObj_inspector.ComponentTree.OnSetParent:=@CompTree_SetParent;
  end;
end;

procedure TCustomFormEditor.DoOnNodeGetImageIndex(APersistent: TPersistent;
  var AImageIndex: integer);
var
  DesignerForm : TCustomForm;
  Mediator: TDesignerMediator;
begin
  DesignerForm := GetDesignerForm(APersistent);

  // ask TMediator
  if DesignerForm is BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] then
  begin
    Mediator:=(DesignerForm as INonControlDesigner).Mediator;
    if Mediator<>nil then
      Mediator.GetObjInspNodeImageIndex(APersistent, AImageIndex);
  end;
end;

{ TDefinePropertiesCacheItem }

destructor TDefinePropertiesCacheItem.Destroy;
begin
  DefineProperties.Free;
  inherited Destroy;
end;

{ TDefinePropertiesReader }

procedure TDefinePropertiesReader.AddPropertyName(const Name: string);
begin
  debugln('TDefinePropertiesReader.AddPropertyName Name="',Name,'"');
  if FDefinePropertyNames=nil then
    FDefinePropertyNames:=TStringListUTF8Fast.Create;
  if FDefinePropertyNames.IndexOf(Name)<=0 then
    FDefinePropertyNames.Add(Name);
end;

destructor TDefinePropertiesReader.Destroy;
begin
  FDefinePropertyNames.Free;
  inherited Destroy;
end;

procedure TDefinePropertiesReader.DefineProperty(const Name: string;
  ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
begin
  AddPropertyName(Name);
end;

procedure TDefinePropertiesReader.DefineBinaryProperty(const Name: string;
  ReadData, WriteData: TStreamProc; HasData: Boolean);
begin
  AddPropertyName(Name);
end;

procedure TDefinePropertiesReader.FlushBuffer;
begin

end;

{ TDefinePropertiesPersistent }

constructor TDefinePropertiesPersistent.Create(TargetPersistent: TPersistent);
begin
  FTarget:=TargetPersistent;
end;

procedure TDefinePropertiesPersistent.PublicDefineProperties(Filer: TFiler);
begin
  //debugln('TDefinePropertiesPersistent.PublicDefineProperties START ',ClassName,' ',dbgsName(FTarget));
  {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  {$R-}
  TDefinePropertiesPersistent(Target).DefineProperties(Filer);
  {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  //debugln('TDefinePropertiesPersistent.PublicDefineProperties END ',ClassName,' ',dbgsName(FTarget));
end;

type
  TPersistentAccess = class(TPersistent);

function GetFormEditorLookupRoot(APersistent: TPersistent): TPersistent;
// called when a TPersistent does not have an owner
// Search in all designer forms
var
  Checked: TFPList;

  function GetOwner(Instance: TPersistent): TComponent;
  var
    CurOwner, NextOwner: TPersistent;
  begin
    Result:=nil;
    if Instance=nil then exit;
    CurOwner:=Instance;
    repeat
      if (CurOwner is TComponent) then begin
        NextOwner := TComponent(CurOwner).Owner;
        if NextOwner=nil then
          exit(TComponent(CurOwner));
      end else if CurOwner is TCollection then begin
        NextOwner := TCollection(CurOwner).Owner;
      end else if CurOwner is TCollectionItem then begin
        NextOwner := TCollectionItem(CurOwner).Collection;
      end else
        NextOwner := TPersistentAccess(CurOwner).GetOwner;
      if NextOwner=nil then break;
      CurOwner:=NextOwner;
    until false;
    if CurOwner is TComponent then
      Result:=TComponent(CurOwner);
  end;

  function Check(Root: TComponent; Instance: TPersistent): boolean;
  var
    PropList: PPropList;
    PropInfo: PPropInfo;
    Cnt, i: Integer;
    Obj: TObject;
    CurOwner: TComponent;
  begin
    if Checked.IndexOf(Instance)>=0 then exit(false);
    Checked.Add(Instance);

    CurOwner:=GetOwner(Instance);
    if (CurOwner<>nil) and (CurOwner<>Root) then
    begin
      if BaseFormEditor1.IsJITComponent(CurOwner) then
      begin
        // this component is from another designer form
        Root:=CurOwner;
      end;
    end;

    // check all properties
    Cnt:=GetPropList(Instance,PropList);
    try
      for i:=0 to Cnt-1 do
      begin
        PropInfo:=PropList^[i];
        if PropInfo^.PropType^.Kind<>tkClass then continue;
        Obj:=GetObjectProp(Instance,PropInfo,TPersistent);
        if Obj=nil then continue;
        if Obj=APersistent then
        begin
          // found
          GetFormEditorLookupRoot:=Root;
          exit(true);
        end;
        if Check(Root,TPersistent(Obj)) then
          exit(true);
      end;
    finally
      Freemem(PropList);
    end;

    Result:=false;
  end;

var
  i, j: Integer;
  aDesigner: TIDesigner;
  Root, CurOwner: TComponent;
begin
  Result:=nil;
  if APersistent=nil then exit;
  if BaseFormEditor1=nil then exit;

  // first a quick check for regular components:
  CurOwner:=GetOwner(APersistent);
  if CurOwner<>nil then
  begin
    if BaseFormEditor1.IsJITComponent(CurOwner) then
      if CurOwner=APersistent then
        exit(nil) // this is a LookupRoot
      else
        exit(CurOwner);
  end;

  {$IFNDEF EnableGetFormEditorLookupRoot}
  exit;
  {$ENDIF}

  // then the slow search:
  Checked:=TFPList.Create;
  try
    for i:=0 to BaseFormEditor1.DesignerCount-1 do
    begin
      aDesigner:=BaseFormEditor1.Designer[i];
      if aDesigner=nil then continue;
      Root:=aDesigner.LookupRoot;
      if Check(Root,Root) then
        exit;
      for j:=0 to Root.ComponentCount-1 do
        if Check(Root,Root.Components[j]) then
          exit;
    end;
  finally
    Checked.Free;
  end;
end;

initialization
  RegisterStandardClasses;
  RegisterGetLookupRoot(@GetFormEditorLookupRoot);

end.