1{
2 /***************************************************************************
3                             CustomFormEditor.pp
4                             -------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 *                                                                         *
10 *   This source is free software; you can redistribute it and/or modify   *
11 *   it under the terms of the GNU General Public License as published by  *
12 *   the Free Software Foundation; either version 2 of the License, or     *
13 *   (at your option) any later version.                                   *
14 *                                                                         *
15 *   This code is distributed in the hope that it will be useful, but      *
16 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
17 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
18 *   General Public License for more details.                              *
19 *                                                                         *
20 *   A copy of the GNU General Public License is available on the World    *
21 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
22 *   obtain it by writing to the Free Software Foundation,                 *
23 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
24 *                                                                         *
25 ***************************************************************************
26}
27unit CustomFormEditor;
28
29{$mode objfpc}{$H+}
30
31{$I ide.inc}
32
33interface
34
35{ $DEFINE VerboseFormEditor}
36
37uses
38{$IFDEF IDE_MEM_CHECK}
39  MemCheck,
40{$ENDIF}
41  // RTL+FCL
42  Classes, SysUtils, TypInfo, Math, Laz_AVL_Tree,
43  // LCL
44  LCLIntf, LCLType, LResources, LCLMemManager, Controls, Graphics,
45  Forms, Menus, Dialogs,
46  // LazUtils
47  FileUtil, LazFileUtils, LazFileCache, CompWriterPas, LazLoggerBase, LazTracer,
48  LazUTF8,
49  // Codetools
50  CodeCache, CodeTree, CodeToolManager, FindDeclarationTool,
51  // IDEIntf
52  PropEdits, PropEditUtils, ObjectInspector, FormEditingIntf, ComponentReg,
53  UnitResources, IDEOptEditorIntf, IDEDialogs, ComponentEditors,
54  // IDE
55  LazarusIDEStrConsts, EditorOptions, EnvironmentOpts, Project, MainIntf, PackageDefs,
56  // Designer
57  CustomNonFormDesigner, NonControlDesigner, FrameDesigner, ControlSelection,
58  JITForms, DesignerProcs;
59
60const
61  OrdinalTypes = [tkInteger,tkChar,tkEnumeration,tkbool];
62
63const
64  LRSStreamChunkSize = 4096; // allocating mem in 4k chunks helps many mem managers
65
66type
67  TSelectFrameEvent = procedure(Sender: TObject; var AComponentClass: TComponentClass) of Object;
68
69  { TCustomFormEditor }
70
71  TCustomFormEditor = class(TAbstractFormEditor)
72  private
73    FOnSelectFrame: TSelectFrameEvent;
74    FSelection: TPersistentSelectionList;
75    FObj_Inspector: TObjectInspectorDlg;
76    FDefineProperties: TAvlTree;// tree of TDefinePropertiesCacheItem
77    FStandardDefinePropertiesRegistered: Boolean;
78    FDesignerBaseClasses: TFPList; // list of TComponentClass
79    FDesignerMediatorClasses: TFPList;// list of TDesignerMediatorClass
80    FOnNodeGetImageIndex: TOnOINodeGetImageEvent;
81    function GetPropertyEditorHook: TPropertyEditorHook;
82    function FindDefinePropertyNode(const APersistentClassName: string
83                                    ): TAvlTreeNode;
84    procedure FrameCompGetCreationClass(Sender: TObject;
85      var NewComponentClass: TComponentClass);
86    procedure OnPasWriterFindAncestor(Writer: TCompWriterPas;
87      aComponent: TComponent; const aName: string; var anAncestor,
88      aRootAncestor: TComponent);
89    procedure OnPasWriterGetMethodName(Writer: TCompWriterPas;
90      Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
91    procedure OnPasWriterGetParentProperty(Writer: TCompWriterPas;
92      Component: TComponent; var PropName: string);
93    function OnPropHookGetAncestorInstProp(const InstProp: TInstProp;
94                                      out AncestorInstProp: TInstProp): boolean;
95  protected
96    FNonFormForms: TAvlTree; // tree of TNonFormProxyDesignerForm sorted for LookupRoot
97    procedure SetSelection(const ASelection: TPersistentSelectionList);
98    procedure OnObjectInspectorModified(Sender: TObject);
99    procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
100    procedure JITListReaderError(Sender: TObject; Reader: TReader;
101          ErrorType: TJITFormError; var Action: TModalResult); virtual;
102    procedure JITListBeforeCreate(Sender: TObject; Instance: TPersistent);
103    procedure JITListException(Sender: TObject; E: Exception;
104                               var {%H-}Action: TModalResult);
105    procedure JITListPropertyNotFound(Sender: TObject; {%H-}Reader: TReader;
106      Instance: TPersistent; var PropName: string; IsPath: boolean;
107      var Handled, Skip: Boolean);
108    procedure JITListFindAncestors(Sender: TObject; AClass: TClass;
109      var Ancestors: TFPList;// list of TComponent
110      var BinStreams: TFPList;// list of TExtMemoryStream;
111      var Abort: boolean);
112    procedure JITListFindClass(Sender: TObject;
113                               const ComponentClassName: string;
114                               var ComponentClass: TComponentClass);
115
116    function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
117    function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; override;
118    procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); override;
119    procedure OnDesignerMenuItemClick(Sender: TObject); virtual;
120    function FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
121
122    //because we only meet ObjInspectore here, not in abstract ancestor
123    procedure DoOnNodeGetImageIndex(APersistent: TPersistent; var AImageIndex: integer); virtual;
124  public
125    JITFormList: TJITForms;// designed forms
126    JITNonFormList: TJITNonFormComponents;// designed custom components like data modules
127
128    constructor Create;
129    destructor Destroy; override;
130    procedure RegisterFrame;
131
132    // selection
133    function AddSelected(Value: TComponent) : Integer;
134    procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
135    function FindComponentByName(const Name: ShortString): TComponent; override;
136    function SaveSelectionToStream(s: TStream): Boolean; override;
137    function InsertFromStream(s: TStream; Parent: TWinControl;
138                              Flags: TComponentPasteSelectionFlags): Boolean; override;
139    function ClearSelection: Boolean; override;
140    function DeleteSelection: Boolean; override;
141    function CopySelectionToClipboard: Boolean; override;
142    function CutSelectionToClipboard: Boolean; override;
143    function PasteSelectionFromClipboard(Flags: TComponentPasteSelectionFlags
144                                         ): Boolean; override;
145
146    function GetCurrentObjectInspector: TObjectInspectorDlg; override;
147
148    // JIT components
149    function IsJITComponent(AComponent: TComponent): boolean;
150    function GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
151    function FindJITList(AComponent: TComponent): TJITComponentList;
152    function FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
153    function FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
154    function GetDesignerForm(APersistent: TPersistent): TCustomForm; override;
155
156    function FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
157    function CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
158
159    procedure RenameJITComponent(AComponent: TComponent; const NewClassName: shortstring);
160    procedure RenameJITComponentUnitname(AComponent: TComponent; const NewUnitName: shortstring);
161    procedure UpdateDesignerFormName(AComponent: TComponent);
162    procedure UpdateComponentName(AComponent: TComponent);
163    function CreateNewJITMethod(ALookupRoot: TComponent; const AMethodName: shortstring): TMethod;
164    procedure RenameJITMethod(AComponent: TComponent; const OldMethodName, NewMethodName: shortstring);
165    procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
166    function FindJITComponentByClassName(const AComponentClassName: string): TComponent;
167    function FindJITComponentByClass(AComponentClass: TComponentClass): TComponent;
168    procedure WriteMethodPropertyEvent(Writer: TWriter; {%H-}Instance: TPersistent;
169      PropInfo: PPropInfo; const MethodValue, DefMethodValue: TMethod;
170      var Handled: boolean);
171    function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
172      var BinCompStream: TExtMemoryStream): TModalResult;
173    function OnGetDanglingMethodName(const AMethod: TMethod; aRootComponent: TObject): string;
174    procedure SaveComponentAsPascal(aDesigner: TIDesigner; Writer: TCompWriterPas); override;
175
176    // ancestors
177    function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override;
178    function GetAncestorInstance(AComponent: TComponent): TComponent; override;
179    function RegisterDesignerBaseClass(AClass: TComponentClass): integer; override;
180    function DesignerBaseClassCount: Integer; override;
181    procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
182    function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
183    function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; override;
184    function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override;
185
186    function StandardDesignerBaseClassesCount: Integer; override;
187    // designers
188    function DesignerCount: integer; override;
189    function GetDesigner(Index: integer): TIDesigner; override;
190    function GetCurrentDesigner: TIDesigner; override;
191    function GetDesignerByComponent(AComponent: TComponent): TIDesigner; override;
192
193    // designer mediators
194    function GetDesignerMediators(Index: integer): TDesignerMediatorClass; override;
195    procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
196    procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
197    function DesignerMediatorCount: integer; override;
198    function GetDesignerMediatorClass(ComponentClass: TComponentClass): TDesignerMediatorClass;
199
200    // component editors
201    function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
202
203    // component creation
204    function CreateUniqueComponentName(AComponent: TComponent): string; override;
205    function CreateUniqueComponentName(const AClassName: string;
206                                       OwnerComponent: TComponent): string; override;
207    function GetDefaultComponentParent(TypeClass: TComponentClass
208                                       ): TComponent; override;
209    function GetDefaultComponentPosition(TypeClass: TComponentClass;
210                                         ParentComponent: TComponent;
211                                         out X,Y: integer): boolean; override;
212    function CreateComponent(ParentComponent: TComponent;
213                             TypeClass: TComponentClass;
214                             const AUnitName: shortstring;
215                             NewLeft,NewTop,NewWidth,NewHeight: Integer;
216                             DisableAutoSize: boolean): TComponent; override;
217    function CreateComponentFromStream(BinStream: TStream;
218                      UnitResourcefileFormat: TUnitResourcefileFormatClass;
219                      AncestorType: TComponentClass;
220                      const NewUnitName: ShortString;
221                      Interactive: boolean;
222                      Visible: boolean = true;
223                      DisableAutoSize: boolean = false;
224                      ContextObj: TObject = nil): TComponent; override;
225    function CreateRawComponentFromStream(BinStream: TStream;
226                      UnitResourcefileFormat: TUnitResourcefileFormatClass;
227                      AncestorType: TComponentClass;
228                      const NewUnitName: ShortString;
229                      Interactive: boolean;
230                      Visible: boolean = true;
231                      DisableAutoSize: boolean = false;
232                      ContextObj: TObject = nil): TComponent;
233    procedure CreateChildComponentsFromStream(BinStream: TStream;
234                       ComponentClass: TComponentClass; Root: TComponent;
235                       ParentControl: TWinControl; NewComponents: TFPList); override;
236    function FixupReferences(AComponent: TComponent): TModalResult;
237    procedure WriterFindAncestor({%H-}Writer: TWriter; Component: TComponent;
238                                 const {%H-}Name: string;
239                                 var Ancestor, RootAncestor: TComponent);
240    procedure SetComponentNameAndClass(AComponent: TComponent;
241                                       const NewName, NewClassName: shortstring);
242    function ClassDependsOnComponent(AClass: TComponentClass;
243                                     AComponent: TComponent): Boolean;
244    function ComponentDependsOnClass(AComponent: TComponent;
245                                     AClass: TComponentClass): Boolean;
246
247    // define properties
248    procedure FindDefineProperty(const APersistentClassName,
249                                 AncestorClassName, Identifier: string;
250                                 var IsDefined: boolean);
251    procedure RegisterDefineProperty(const APersistentClassName,
252                                     Identifier: string); override;
253    procedure RegisterStandardDefineProperties;
254
255    // keys
256    function TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
257  public
258    property Selection: TPersistentSelectionList read FSelection
259                                                 write SetSelection;
260    property Obj_Inspector: TObjectInspectorDlg
261                                     read FObj_Inspector write SetObj_Inspector;
262    property PropertyEditorHook: TPropertyEditorHook read GetPropertyEditorHook;
263    property OnSelectFrame: TSelectFrameEvent read FOnSelectFrame write FOnSelectFrame;
264    property OnNodeGetImageIndex : TOnOINodeGetImageEvent read FOnNodeGetImageIndex
265                                      write FOnNodeGetImageIndex;
266  end;
267
268
269  { TDefinePropertiesCacheItem }
270
271  TDefinePropertiesCacheItem = class
272  public
273    PersistentClassname: string;
274    RegisteredComponent: TRegisteredComponent;
275    DefineProperties: TStrings;
276    destructor Destroy; override;
277  end;
278
279
280  { TDefinePropertiesReader }
281
282  TDefinePropertiesReader = class(TFiler)
283  private
284    FDefinePropertyNames: TStrings;
285  protected
286    procedure AddPropertyName(const Name: string);
287  public
288    destructor Destroy; override;
289    procedure DefineProperty(const Name: string;
290      {%H-}ReadData: TReaderProc; {%H-}WriteData: TWriterProc;
291      {%H-}HasData: Boolean); override;
292    procedure DefineBinaryProperty(const Name: string;
293      {%H-}ReadData, {%H-}WriteData: TStreamProc;
294      {%H-}HasData: Boolean); override;
295    procedure FlushBuffer;  {$IF FPC_FULLVERSION >= 30200}override;{$ENDIF}
296    property DefinePropertyNames: TStrings read FDefinePropertyNames;
297  end;
298
299
300  { TDefinePropertiesPersistent
301    Wrapper/Friend class, to call the protected method 'DefineProperties' }
302
303  TDefinePropertiesPersistent = class(TPersistent)
304  private
305    FTarget: TPersistent;
306  public
307    constructor Create(TargetPersistent: TPersistent);
308    procedure PublicDefineProperties(Filer: TFiler);
309    property Target: TPersistent read FTarget;
310  end;
311
312
313var
314  StandardDesignerBaseClasses: array[0..2] of TComponentClass =
315  (
316    Forms.TForm,
317    TDataModule,
318    Forms.TFrame
319  );
320
321
322function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
323function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
324                                     Item: TDefinePropertiesCacheItem): integer;
325
326function TryFreeComponent(var AComponent: TComponent): boolean;
327
328function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;
329
330procedure RegisterStandardClasses;
331
332var
333  BaseFormEditor1: TCustomFormEditor = nil;
334
335implementation
336
337
338function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem
339  ): integer;
340begin
341  Result:=CompareText(Item1.PersistentClassname,Item2.PersistentClassname);
342end;
343
344function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
345                                     Item: TDefinePropertiesCacheItem): integer;
346begin
347  Result:=CompareText(AnsiString(Key),Item.PersistentClassname);
348end;
349
350function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;
351var
352  LFMFilename: String;
353  LFMType: String;
354  LFMClassName: String;
355  Code: TCodeBuffer;
356  Tool: TCodeTool;
357  ClassNode: TCodeTreeNode;
358  ListOfPFindContext: TFPList;
359  i: Integer;
360  Context: PFindContext;
361  AClassName: String;
362  LFMCode: TCodeBuffer;
363begin
364  Result:=pfcbcNone;
365  if not FilenameHasPascalExt(aFilename) then exit;
366  if not FilenameIsAbsolute(aFilename) then exit;
367  LFMFilename:=ChangeFileExt(aFilename,'.lfm');
368  if not FileExistsCached(LFMFilename) then exit;
369  if not FileExistsCached(aFilename) then exit;
370  LFMCode:=CodeToolBoss.LoadFile(LFMFilename,true,false);
371  if LFMCode=nil then exit;
372  ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
373  if LFMClassName='' then exit;
374  Code:=CodeToolBoss.LoadFile(aFilename,true,false);
375  if Code=nil then exit;
376  if not CodeToolBoss.Explore(Code,Tool,false,true) then exit;
377  ClassNode:=Tool.FindClassNodeInInterface(LFMClassName,true,false,false);
378  if ClassNode=nil then exit;
379  ListOfPFindContext:=nil;
380  try
381    try
382      Tool.FindClassAndAncestors(ClassNode,ListOfPFindContext,false);
383    except
384    end;
385    if ListOfPFindContext=nil then exit;
386    for i:=0 to ListOfPFindContext.Count-1 do begin
387      Context:=PFindContext(ListOfPFindContext[i]);
388      AClassName:=Context^.Tool.ExtractClassName(Context^.Node,false);
389      //debugln(['CheckLFMBaseClass ',AClassName]);
390      if CompareText(AClassName,'TFrame')=0 then
391        exit(pfcbcFrame)
392      else if CompareText(AClassName,'TForm')=0 then
393        exit(pfcbcForm)
394      else if CompareText(AClassName,'TCustomForm')=0 then
395        exit(pfcbcCustomForm)
396      else if CompareText(AClassName,'TDataModule')=0 then
397        exit(pfcbcDataModule);
398    end;
399  finally
400    FreeListOfPFindContext(ListOfPFindContext);
401  end;
402end;
403
404procedure RegisterStandardClasses;
405begin
406  RegisterClasses([TStringList]);
407end;
408
409function TryFreeComponent(var AComponent: TComponent): boolean;
410var
411  OldName, OldClassName: string;
412Begin
413  Result := False;
414  //debugln(['TryFreeComponent ',DbgSName(AComponent)]);
415  {$IFNDEF NoCompCatch}
416  try
417  {$ENDIF}
418    OldName := AComponent.Name;
419    OldClassName := AComponent.ClassName;
420    AComponent.Free;
421    //debugln(['TryFreeComponent ',OldName,':',OldClassName,' success']);
422    Result := True;
423  {$IFNDEF NoCompCatch}
424  except
425    on E: Exception do begin
426      DebugLn('TryFreeComponent ERROR:',
427        ' "'+OldName+':'+OldClassName+'" ',E.Message);
428      DumpExceptionBackTrace;
429      IDEMessageDialog(lisCCOErrorCaption,
430        Format(lisCFEAnExceptionOccurredDuringDeletionOf,
431               [LineEnding, OldName, OldClassName, LineEnding, E.Message]),
432        mtError,[mbOk]);
433    end;
434  end;
435  {$ENDIF}
436  if not Result then begin
437    // maybe some references can be removed
438    try
439      if AComponent is TControl then begin
440        TControl(AComponent).Parent:=nil;
441      end;
442    except
443      on e: Exception do begin
444        DebugLn('TryFreeComponent manual clean up failed also for ',
445          ' "'+OldName+':'+OldClassName+'". This is likely, nothing to worry about. ',E.Message);
446      end;
447    end;
448  end;
449  AComponent := nil;
450end;
451
452{ TCustomFormEditor }
453
454procedure OnPasWriterDefinePropertyTStrings(Writer: TCompWriterPas;
455  Instance: TPersistent; const Identifier: string; var Handled: boolean);
456var
457  List: TStrings;
458  HasData: Boolean;
459  i: Integer;
460begin
461  if not (Instance is TStrings) then exit;
462  List:=TStrings(Instance);
463  if Assigned(Writer.Ancestor) then
464    // Only serialize if string list is different from ancestor
465    if Writer.Ancestor.InheritsFrom(TStrings) then
466      HasData := not List.Equals(TStrings(Writer.Ancestor))
467    else
468      HasData := True
469  else
470    HasData := List.Count > 0;
471  if not HasData then exit;
472  Writer.WriteStatement('with '+Identifier+' do begin');
473  Writer.Indent;
474  Writer.WriteStatement('Clear;');
475  for i:=0 to List.Count-1 do
476    Writer.WriteStatement('Add('+Writer.GetStringLiteral(List[i])+');');
477  Writer.Unindent;
478  Writer.WriteStatement('end;');
479  Handled:=true;
480end;
481
482constructor TCustomFormEditor.Create;
483
484  procedure InitJITList(List: TJITComponentList);
485  begin
486    List.OnReaderError:=@JITListReaderError;
487    List.OnBeforeCreate:=@JITListBeforeCreate;
488    List.OnException:=@JITListException;
489    List.OnPropertyNotFound:=@JITListPropertyNotFound;
490    List.OnFindAncestors:=@JITListFindAncestors;
491    List.OnFindClass:=@JITListFindClass;
492  end;
493
494var
495  l: Integer;
496begin
497  inherited Create;
498  FNonFormForms := TAvlTree.Create(@CompareNonFormDesignerForms);
499  FSelection := TPersistentSelectionList.Create;
500  FDesignerBaseClasses:=TFPList.Create;
501  FDesignerMediatorClasses:=TFPList.Create;
502  for l:=0 to StandardDesignerBaseClassesCount - 1 do
503    FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
504
505  JITFormList := TJITForms.Create(nil);
506  InitJITList(JITFormList);
507
508  JITNonFormList := TJITNonFormComponents.Create(nil);
509  InitJITList(JITNonFormList);
510
511  DesignerMenuItemClick:=@OnDesignerMenuItemClick;
512  OnGetDesignerForm:=@GetDesignerForm;
513  FormEditingHook:=Self;
514
515  RegisterDesignerBaseClass(TAbstractIDEOptionsEditor);
516
517  GlobalDesignHook.AddHandlerGetAncestorInstProp(@OnPropHookGetAncestorInstProp);
518
519  RegisterDefinePropertiesPas(TStrings,@OnPasWriterDefinePropertyTStrings);
520end;
521
522destructor TCustomFormEditor.Destroy;
523begin
524  FormEditingHook:=nil;
525  DesignerMenuItemClick:=nil;
526  if FDefineProperties<>nil then begin
527    FDefineProperties.FreeAndClear;
528    FreeAndNil(FDefineProperties);
529  end;
530  FreeAndNil(JITFormList);
531  FreeAndNil(JITNonFormList);
532  FreeAndNil(FDesignerMediatorClasses);
533  FreeAndNil(FDesignerBaseClasses);
534  FreeAndNil(FSelection);
535  FreeAndNil(FNonFormForms);
536  inherited Destroy;
537end;
538
539procedure TCustomFormEditor.RegisterFrame;
540var
541  FrameComp: TRegisteredComponent;
542begin
543  FrameComp:=IDEComponentPalette.FindRegComponent('TFrame');
544  if FrameComp <> nil then
545    FrameComp.OnGetCreationClass:=@FrameCompGetCreationClass;
546end;
547
548procedure TCustomFormEditor.SetSelection(const ASelection: TPersistentSelectionList);
549begin
550  if FSelection.IsEqual(ASelection) then exit;
551  FSelection.Assign(ASelection);
552  if Obj_Inspector=nil then
553  begin
554    GlobalDesignHook.SetSelection(FSelection);
555  end else begin
556    if FSelection.Count>0 then
557      Obj_Inspector.PropertyEditorHook.LookupRoot:=GetLookupRootForComponent(FSelection[0]);
558    Obj_Inspector.Selection := FSelection;
559  end;
560end;
561
562function TCustomFormEditor.AddSelected(Value: TComponent): Integer;
563Begin
564  Result := FSelection.Add(Value) + 1;
565  if Obj_Inspector<>nil then
566  begin
567    if not Obj_Inspector.Selection.IsEqual(FSelection) then
568    Obj_Inspector.Selection := FSelection;
569  end else
570    GlobalDesignHook.SetSelection(FSelection);
571end;
572
573procedure TCustomFormEditor.DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
574var
575  AForm: TCustomForm;
576  AWinControl: TWinControl;
577  IsJIT: Boolean;
578  i: Integer;
579  aDesigner: TIDesigner;
580Begin
581  IsJIT:=IsJITComponent(AComponent);
582  {$IFDEF IDE_DEBUG}
583  DebugLn(['TCustomFormEditor.DeleteComponent ',DbgSName(AComponent),' IsJITComponent=',IsJIT,' FreeComponent=',FreeComponent]);
584  {$ENDIF}
585  if TheControlSelection.LookupRoot = AComponent then
586  begin
587    TheControlSelection.BeginUpdate;
588    try
589      TheControlSelection.Clear;
590    finally
591      TheControlSelection.EndUpdate;
592    end;
593  end;
594  if PropertyEditorHook.LookupRoot=AComponent then
595    PropertyEditorHook.LookupRoot:=nil;
596
597  if IsJIT then begin
598    // AComponent is a top level component
599    if FreeComponent then
600    begin
601      // tell hooks about deleting
602      for i := AComponent.ComponentCount - 1 downto 0 do
603        PropertyEditorHook.PersistentDeleting(AComponent.Components[i]);
604      PropertyEditorHook.PersistentDeleting(AComponent);
605    end;
606    // disconnect designer
607    aDesigner:=GetDesignerByComponent(AComponent);
608    if aDesigner is TComponentEditorDesigner then
609      TComponentEditorDesigner(aDesigner).DisconnectComponent;
610
611    if JITFormList.IsJITForm(AComponent) then begin
612      // free/unbind a form component
613      if FreeComponent then
614        JITFormList.DestroyJITComponent(AComponent);
615    end else if JITNonFormList.IsJITNonForm(AComponent) then begin
616      // free/unbind a non form component and its designer form
617      aForm:=GetDesignerForm(AComponent);
618      if (AForm<>nil) and (not (AForm is TNonFormProxyDesignerForm)) then
619        RaiseGDBException(Format(lisCFETCustomFormEditorDeleteComponentWhereIsTheTCustomN,
620                                 [AComponent.ClassName]));
621
622      if (AForm <> nil) then
623      begin
624        AForm.ControlStyle:=AForm.ControlStyle+[csNoDesignVisible];
625        LCLIntf.ShowWindow(AForm.Handle,SW_HIDE);
626        FNonFormForms.Remove(AForm);
627        (AForm as INonFormDesigner).LookupRoot := nil;
628        Application.ReleaseComponent(AForm);
629      end;
630
631      if FreeComponent then
632        JITNonFormList.DestroyJITComponent(AComponent);
633    end else
634      RaiseGDBException('TCustomFormEditor.DeleteComponent '+AComponent.ClassName);
635  end else if FreeComponent then begin
636    if (AComponent.Owner=nil) then
637      DebugLn(['WARNING: TCustomFormEditor.DeleteComponent freeing orphaned component ',DbgSName(AComponent)]);
638    TryFreeComponent(AComponent);
639  end;
640  // if not free, then hide it
641  if (not FreeComponent) and (AComponent is TWinControl) then begin
642    AWinControl:=TWinControl(AComponent);
643    if AWinControl.HandleAllocated and (AWinControl.Parent=nil) then begin
644      AWinControl.ControlStyle:=AWinControl.ControlStyle+[csNoDesignVisible];
645      LCLIntf.ShowWindow(AWinControl.Handle,SW_HIDE);
646      DebugLn(['TCustomFormEditor.DeleteComponent Hiding: ',dbgsName(AWinControl)]);
647    end;
648  end;
649  //PropertyEditorHook.PersistentDeleted(AComponent); Not needed?
650end;
651
652function TCustomFormEditor.FindComponentByName(const Name: ShortString): TComponent;
653var
654  i: longint;
655Begin
656  if JITFormList<>nil then begin
657    i:=JITFormList.FindComponentByName(Name);
658    if i>=0 then begin
659      Result:=JITFormList[i];
660      exit;
661    end;
662  end;
663  if JITNonFormList<>nil then begin
664    i:=JITNonFormList.FindComponentByName(Name);
665    if i>=0 then begin
666      Result:=JITNonFormList[i];
667      exit;
668    end;
669  end;
670  Result:=nil;
671end;
672
673function TCustomFormEditor.SaveSelectionToStream(s: TStream): Boolean;
674var
675  ADesigner: TIDesigner;
676begin
677  ADesigner:=GetCurrentDesigner;
678  if ADesigner is TComponentEditorDesigner then
679    Result:=TComponentEditorDesigner(ADesigner).CopySelectionToStream(s)
680  else
681    Result:=false;
682end;
683
684function TCustomFormEditor.InsertFromStream(s: TStream; Parent: TWinControl;
685  Flags: TComponentPasteSelectionFlags): Boolean;
686var
687  ADesigner: TIDesigner;
688begin
689  ADesigner:=GetCurrentDesigner;
690  if ADesigner is TComponentEditorDesigner then
691    Result:=TComponentEditorDesigner(ADesigner).InsertFromStream(s,Parent,Flags)
692  else
693    Result:=false;
694end;
695
696function TCustomFormEditor.ClearSelection: Boolean;
697var
698  ASelection: TPersistentSelectionList;
699begin
700  if Selection.Count=0 then exit;
701  ASelection:=TPersistentSelectionList.Create;
702  try
703    Selection:=ASelection;
704  except
705    on E: Exception do begin
706      IDEMessageDialog(lisCCOErrorCaption,
707        Format(lisCFEUnableToClearTheFormEditingSelection, [LineEnding, E.Message]),
708        mtError, [mbCancel]);
709    end;
710  end;
711  ASelection.Free;
712  Result:=(Selection=nil) or (Selection.Count=0);
713end;
714
715function TCustomFormEditor.DeleteSelection: Boolean;
716var
717  ADesigner: TIDesigner;
718begin
719  if (Selection.Count=0) then begin
720    Result:=true;
721    exit;
722  end;
723  if Selection[0] is TComponent then begin
724    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
725    if ADesigner is TComponentEditorDesigner then begin
726      TComponentEditorDesigner(ADesigner).DeleteSelection;
727    end;
728  end;
729  Result:=Selection.Count=0;
730  if Selection.Count>0 then begin
731    IDEMessageDialog(lisCCOErrorCaption,
732      lisCFEDoNotKnowHowToDeleteThisFormEditingSelection,
733      mtError,[mbCancel]);
734  end;
735end;
736
737function TCustomFormEditor.CopySelectionToClipboard: Boolean;
738var
739  ADesigner: TIDesigner;
740begin
741  if (Selection.Count=0) then begin
742    Result:=false;
743    exit;
744  end;
745  if Selection[0] is TComponent then begin
746    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
747    if ADesigner is TComponentEditorDesigner then begin
748      TComponentEditorDesigner(ADesigner).CopySelection;
749    end;
750  end;
751  Result:=Selection.Count=0;
752  if Selection.Count>0 then begin
753    IDEMessageDialog(lisCCOErrorCaption,
754      lisCFEDoNotKnowHowToCopyThisFormEditingSelection,
755      mtError,[mbCancel]);
756  end;
757end;
758
759function TCustomFormEditor.CutSelectionToClipboard: Boolean;
760var
761  ADesigner: TIDesigner;
762begin
763  if (Selection.Count=0) then begin
764    Result:=false;
765    exit;
766  end;
767  if Selection[0] is TComponent then begin
768    ADesigner:=FindRootDesigner(TComponent(Selection[0]));
769    if ADesigner is TComponentEditorDesigner then begin
770      TComponentEditorDesigner(ADesigner).CutSelection;
771    end;
772  end;
773  Result:=Selection.Count=0;
774  if Selection.Count>0 then begin
775    IDEMessageDialog(lisCCOErrorCaption,
776      lisCFEDoNotKnowHowToCutThisFormEditingSelection,
777      mtError,[mbCancel]);
778  end;
779end;
780
781function TCustomFormEditor.PasteSelectionFromClipboard(
782  Flags: TComponentPasteSelectionFlags): Boolean;
783var
784  ADesigner: TIDesigner;
785begin
786  ADesigner:=GetCurrentDesigner;
787  if ADesigner is TComponentEditorDesigner then begin
788    Result:=TComponentEditorDesigner(ADesigner).PasteSelection(Flags);
789  end else
790    Result:=false;
791end;
792
793function TCustomFormEditor.GetCurrentObjectInspector: TObjectInspectorDlg;
794begin
795  Result:=FObj_Inspector;
796end;
797
798function TCustomFormEditor.IsJITComponent(AComponent: TComponent): boolean;
799begin
800  Result:=JITFormList.IsJITForm(AComponent)
801          or JITNonFormList.IsJITNonForm(AComponent);
802end;
803
804function TCustomFormEditor.GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
805begin
806  if AncestorType.InheritsFrom(TCustomForm) then
807    Result := JITFormList
808  else
809  if AncestorType.InheritsFrom(TComponent) then
810    Result := JITNonFormList
811  else
812    Result := nil;
813end;
814
815function TCustomFormEditor.FindJITList(AComponent: TComponent): TJITComponentList;
816begin
817  if JITFormList.IndexOf(AComponent) >= 0 then
818    Result := JITFormList
819  else
820  if JITNonFormList.IndexOf(AComponent) >= 0 then
821    Result := JITNonFormList
822  else
823    Result := nil;
824end;
825
826function TCustomFormEditor.FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
827begin
828  if JITFormList.FindComponentByClassName(AComponentClassName) >= 0 then
829    Result := JITFormList
830  else
831  if JITNonFormList.FindComponentByClassName(AComponentClassName) >= 0 then
832    Result := JITNonFormList
833  else
834    Result := nil;
835end;
836
837function TCustomFormEditor.FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
838begin
839  if JITFormList.FindComponentByClass(AComponentClass) >= 0 then
840    Result := JITFormList
841  else
842  if JITNonFormList.FindComponentByClass(AComponentClass) >= 0 then
843    Result := JITNonFormList
844  else
845    Result := nil;
846end;
847
848function TCustomFormEditor.GetDesignerForm(APersistent: TPersistent): TCustomForm;
849var
850  TheOwner: TPersistent;
851begin
852  Result:=nil;
853  TheOwner := GetLookupRootForComponent(APersistent);
854  if TheOwner = nil then
855    exit;
856  if TheOwner is TCustomForm then
857    Result := TCustomForm(TheOwner)
858  else if TheOwner is TComponent then
859    Result := FindNonFormForm(TComponent(TheOwner))
860  else
861    exit;
862end;
863
864function TCustomFormEditor.FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
865var
866  AVLNode: TAvlTreeNode;
867begin
868  AVLNode := FindNonFormFormNode(LookupRoot);
869  if AVLNode <> nil then
870    Result := TNonFormProxyDesignerForm(AVLNode.Data)
871  else
872    Result := nil;
873end;
874
875function TCustomFormEditor.CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
876var
877  MediatorClass: TDesignerMediatorClass;
878  LNonFormProxyDesignerClass: TNonFormProxyDesignerFormClass;
879begin
880  Result := Nil;
881  if FindNonFormFormNode(LookupRoot) <> nil then
882    RaiseGDBException(lisCFETCustomFormEditorCreateNonFormFormAlreadyExists);
883  if LookupRoot is TComponent then
884  begin
885    if LookupRoot is TCustomFrame then
886    begin
887      LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[FrameProxyDesignerFormId];
888      Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
889      Result.Create(nil, TFrameDesignerForm.Create(Result));
890    end
891    else
892    begin
893      LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId];
894      Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
895      Result.Create(nil, TNonControlDesignerForm.Create(Result));
896      Result.Color := EnvironmentOptions.NonFormBackgroundColor;
897    end;
898    Result.Name:='_Designer_'+LookupRoot.Name;
899    (Result as INonFormDesigner).LookupRoot := LookupRoot;
900    FNonFormForms.Add(Result);
901
902    if Result is BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId]
903    then begin
904      // create the mediator
905      MediatorClass:=GetDesignerMediatorClass(TComponentClass(LookupRoot.ClassType));
906      if MediatorClass<>nil then
907        (Result as INonControlDesigner).Mediator:=MediatorClass.CreateMediator(nil,LookupRoot);
908    end;
909  end else
910    RaiseGDBException(Format(lisCFETCustomFormEditorCreateNonFormFormUnknownType,
911                             [LookupRoot.ClassName]));
912end;
913
914procedure TCustomFormEditor.RenameJITComponent(AComponent: TComponent;
915  const NewClassName: shortstring);
916var
917  JITComponentList: TJITComponentList;
918begin
919  JITComponentList:=FindJITList(AComponent);
920  if JITComponentList=nil then
921    RaiseGDBException('TCustomFormEditor.RenameJITComponent');
922  JITComponentList.RenameComponentClass(AComponent,NewClassName);
923end;
924
925procedure TCustomFormEditor.RenameJITComponentUnitname(AComponent: TComponent;
926  const NewUnitName: shortstring);
927var
928  JITComponentList: TJITComponentList;
929begin
930  JITComponentList:=FindJITList(AComponent);
931  if JITComponentList=nil then
932    RaiseGDBException('TCustomFormEditor.RenameJITComponent');
933  JITComponentList.RenameComponentUnitname(AComponent,NewUnitName);
934end;
935
936procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
937var
938  ANonFormForm: TNonFormProxyDesignerForm;
939begin
940  ANonFormForm := FindNonFormForm(AComponent);
941  //DebugLn(['TCustomFormEditor.UpdateDesignerFormName ',ANonFormForm<>nil, ' ',AComponent.Name]);
942  if ANonFormForm <> nil then
943    ANonFormForm.Caption := AComponent.Name;
944end;
945
946procedure TCustomFormEditor.UpdateComponentName(AComponent: TComponent);
947var
948  DesignerForm: TCustomForm;
949begin
950  if AComponent.Owner = nil then
951    UpdateDesignerFormName(AComponent)
952  else
953  begin
954    DesignerForm := GetDesignerForm(AComponent);
955    if (DesignerForm <> nil) and (DesignerForm.Designer <> nil) and
956       EnvironmentOptions.ShowComponentCaptions then
957      DesignerForm.Invalidate;
958  end;
959end;
960
961function TCustomFormEditor.CreateNewJITMethod(ALookupRoot: TComponent;
962  const AMethodName: shortstring): TMethod;
963var
964  JITComponentList: TJITComponentList;
965begin
966  JITComponentList:=FindJITList(ALookupRoot);
967  if JITComponentList=nil then
968    RaiseGDBException('TCustomFormEditor.CreateNewJITMethod');
969  Result:=JITComponentList.CreateNewMethod(ALookupRoot,AMethodName);
970end;
971
972procedure TCustomFormEditor.RenameJITMethod(AComponent: TComponent;
973  const OldMethodName, NewMethodName: shortstring);
974var
975  JITComponentList: TJITComponentList;
976begin
977  JITComponentList:=FindJITList(AComponent);
978  if JITComponentList=nil then
979    RaiseGDBException('TCustomFormEditor.RenameJITMethod');
980  JITComponentList.RenameMethod(AComponent,OldMethodName,NewMethodName);
981end;
982
983procedure TCustomFormEditor.SaveHiddenDesignerFormProperties(AComponent: TComponent);
984var
985  NonFormForm: TNonFormProxyDesignerForm;
986begin
987  NonFormForm := FindNonFormForm(AComponent);
988  if NonFormForm <> nil then
989    (NonFormForm as INonFormDesigner).DoSaveBounds;
990end;
991
992function TCustomFormEditor.FindJITComponentByClassName(
993  const AComponentClassName: string): TComponent;
994var
995  i: LongInt;
996begin
997  Result := nil;
998  i := JITFormList.FindComponentByClassName(AComponentClassName);
999  if i >= 0 then
1000  begin
1001    Result := JITFormList[i];
1002    exit;
1003  end;
1004  i := JITNonFormList.FindComponentByClassName(AComponentClassName);
1005  if i >= 0 then
1006  begin
1007    Result := JITNonFormList[i];
1008    exit;
1009  end;
1010end;
1011
1012function TCustomFormEditor.FindJITComponentByClass(
1013  AComponentClass: TComponentClass): TComponent;
1014var
1015  i: LongInt;
1016begin
1017  Result := nil;
1018  i := JITFormList.FindComponentByClass(AComponentClass);
1019  if i >= 0 then
1020  begin
1021    Result := JITFormList[i];
1022    exit;
1023  end;
1024  i := JITNonFormList.FindComponentByClass(AComponentClass);
1025  if i >= 0 then
1026  begin
1027    Result := JITNonFormList[i];
1028    exit;
1029  end;
1030end;
1031
1032procedure TCustomFormEditor.WriteMethodPropertyEvent(Writer: TWriter;
1033  Instance: TPersistent; PropInfo: PPropInfo;
1034  const MethodValue, DefMethodValue: TMethod; var Handled: boolean);
1035var
1036  CurName: String;
1037begin
1038  Handled:=true;
1039
1040  //DebugLn(['TCustomFormEditor.WriteMethodPropertyEvent ',GlobalDesignHook.GetMethodName(MethodValue,nil)]);
1041
1042  // find ancestor method value
1043  if (DefMethodValue.Data=MethodValue.Data)
1044  and (DefMethodValue.Code=MethodValue.Code) then
1045    exit;
1046  if IsJITMethod(MethodValue) then
1047    CurName:=TJITMethod(MethodValue.Data).TheMethodName
1048  else if MethodValue.Code<>nil then begin
1049    CurName:=Writer.LookupRoot.MethodName(MethodValue.Code);
1050    if CurName='' then begin
1051      // this event was not set by the IDE
1052      // for Delphi compatibility, do not write this property
1053      // see bug 13846
1054      exit;
1055    end;
1056  end else
1057    CurName:='';
1058  Writer.Driver.BeginProperty(Writer.PropertyPath + PPropInfo(PropInfo)^.Name);
1059  Writer.Driver.WriteMethodName(CurName);
1060  Writer.Driver.EndProperty;
1061end;
1062
1063function TCustomFormEditor.SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
1064  var BinCompStream: TExtMemoryStream): TModalResult;
1065var
1066  Writer: TWriter;
1067  DestroyDriver: Boolean;
1068  AncestorUnit: TUnitInfo;
1069  Ancestor: TComponent;
1070  {$IFDEF VerboseSaveUnitComponent}
1071  memStream: TMemoryStream;
1072  s: string;
1073  {$ENDIF}
1074begin
1075  // save designer form properties to the component
1076  SaveHiddenDesignerFormProperties(AnUnitInfo.Component);
1077
1078  // stream component to binary stream
1079  if BinCompStream=nil then
1080    BinCompStream:=TExtMemoryStream.Create;
1081  if AnUnitInfo.ComponentLastBinStreamSize>0 then
1082    BinCompStream.Capacity:=Max(BinCompStream.Capacity,BinCompStream.Position+
1083                      AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize);
1084  Writer:=nil;
1085  DestroyDriver:=false;
1086  try
1087    Result:=mrOk;
1088    try
1089      BinCompStream.Position:=0;
1090      Writer:=CreateLRSWriter(BinCompStream,DestroyDriver);
1091      Writer.OnWriteMethodProperty:=@WriteMethodPropertyEvent;
1092      Writer.OnFindAncestor:=@WriterFindAncestor;
1093      AncestorUnit:=AnUnitInfo.FindAncestorUnit;
1094      Ancestor:=nil;
1095      if AncestorUnit<>nil then
1096        Ancestor:=AncestorUnit.Component;
1097      if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
1098        TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
1099      Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
1100      if DestroyDriver then Writer.Driver.Free;
1101      FreeAndNil(Writer);
1102      AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
1103
1104      {$IFDEF VerboseSaveUnitComponent}
1105      BinCompStream.Position:=0;
1106      memStream:=TMemoryStream.Create;
1107      LRSObjectBinaryToText(BinCompStream,memStream);
1108      memStream.Position:=0;
1109      SetLength(s,memStream.Size);
1110      memStream.Read(s[1],length(s));
1111      DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream START ==================']);
1112      debugln(s);
1113      DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream END ==================']);
1114      memStream.Free;
1115      {$ENDIF}
1116    except
1117      on E: Exception do begin
1118        DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream ',E.Message]);
1119        DumpExceptionBackTrace;
1120        Result:=MessageDlg(lisStreamingError,
1121            Format(lisUnableToStreamT,
1122                   [AnUnitInfo.ComponentName, AnUnitInfo.ComponentName])+LineEnding
1123            +E.Message,
1124            mtError,[mbAbort, mbRetry, mbIgnore], 0);
1125        if Result=mrAbort then exit;
1126        if Result=mrIgnore then Result:=mrOk;
1127      end;
1128    end;
1129  finally
1130    try
1131      if DestroyDriver and (Writer<>nil) then Writer.Driver.Free;
1132      Writer.Free;
1133    except
1134      on E: Exception do begin
1135        debugln('TCustomFormEditor.SaveUnitComponentToBinStream Error cleaning up: ',E.Message);
1136      end;
1137    end;
1138  end;
1139end;
1140
1141function TCustomFormEditor.OnGetDanglingMethodName(const AMethod: TMethod;
1142  aRootComponent: TObject): string;
1143// check if event is a JITMethod of aRootComponent
1144var
1145  JITMethod: TJITMethod;
1146begin
1147  Result:='';
1148  if IsJITMethod(aMethod) then begin
1149    JITMethod:=TJITMethod(aMethod.Data);
1150    if aRootComponent.ClassType=JITMethod.TheClass then
1151      Result:=JITMethod.TheMethodName;
1152  end;
1153end;
1154
1155procedure TCustomFormEditor.SaveComponentAsPascal(aDesigner: TIDesigner;
1156  Writer: TCompWriterPas);
1157begin
1158  Writer.OnFindAncestor:=@OnPasWriterFindAncestor;
1159  Writer.OnGetParentProperty:=@OnPasWriterGetParentProperty;
1160  Writer.OnGetMethodName:=@OnPasWriterGetMethodName;
1161  Writer.WriteDescendant(aDesigner.LookupRoot);
1162end;
1163
1164function TCustomFormEditor.DesignerCount: integer;
1165begin
1166  Result:=JITFormList.Count+JITNonFormList.Count;
1167end;
1168
1169function TCustomFormEditor.GetDesigner(Index: integer): TIDesigner;
1170var
1171  AForm: TCustomForm;
1172begin
1173  if Index < JITFormList.Count then
1174    Result := JITFormList[Index].Designer
1175  else
1176  begin
1177    AForm := GetDesignerForm(JITNonFormList[Index-JITFormList.Count]);
1178    Result := AForm.Designer;
1179  end;
1180end;
1181
1182function TCustomFormEditor.GetCurrentDesigner: TIDesigner;
1183begin
1184  Result:=nil;
1185  if (Selection<>nil) and (Selection.Count>0) and (Selection[0] is TComponent)
1186  then
1187    Result:=GetDesignerByComponent(TComponent(Selection[0]));
1188end;
1189
1190function TCustomFormEditor.GetDesignerByComponent(AComponent: TComponent
1191  ): TIDesigner;
1192var
1193  AForm: TCustomForm;
1194begin
1195  AForm:=GetDesignerForm(AComponent);
1196  if AForm=nil then
1197    Result:=nil
1198  else
1199    Result:=AForm.Designer;
1200end;
1201
1202function TCustomFormEditor.GetDesignerMediators(Index: integer
1203  ): TDesignerMediatorClass;
1204begin
1205  Result:=TDesignerMediatorClass(FDesignerMediatorClasses[Index]);
1206end;
1207
1208procedure TCustomFormEditor.RegisterDesignerMediator(
1209  MediatorClass: TDesignerMediatorClass);
1210begin
1211  if FDesignerMediatorClasses.IndexOf(MediatorClass)>=0 then
1212    raise Exception.Create(Format(
1213      lisCFETCustomFormEditorRegisterDesignerMediatorAlreadyRe, [DbgSName(
1214      MediatorClass)]));
1215  FDesignerMediatorClasses.Add(MediatorClass);
1216  RegisterDesignerBaseClass(MediatorClass.FormClass);
1217end;
1218
1219procedure TCustomFormEditor.UnregisterDesignerMediator(
1220  MediatorClass: TDesignerMediatorClass);
1221begin
1222  UnregisterDesignerBaseClass(MediatorClass.FormClass);
1223  FDesignerMediatorClasses.Remove(MediatorClass);
1224end;
1225
1226function TCustomFormEditor.DesignerMediatorCount: integer;
1227begin
1228  Result:=FDesignerMediatorClasses.Count;
1229end;
1230
1231function TCustomFormEditor.GetDesignerMediatorClass(
1232  ComponentClass: TComponentClass): TDesignerMediatorClass;
1233var
1234  i: Integer;
1235  Candidate: TDesignerMediatorClass;
1236begin
1237  Result:=nil;
1238  for i:=0 to DesignerMediatorCount-1 do begin
1239    Candidate:=DesignerMediators[i];
1240    if not (ComponentClass.InheritsFrom(Candidate.FormClass)) then continue;
1241    if (Result<>nil) and Result.InheritsFrom(Candidate.FormClass) then continue;
1242    Result:=Candidate;
1243  end;
1244end;
1245
1246function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
1247  ): TBaseComponentEditor;
1248var
1249  ADesigner: TIDesigner;
1250begin
1251  Result:=nil;
1252  if AComponent=nil then exit;
1253  ADesigner:=GetDesignerByComponent(AComponent);
1254  if ADesigner is TComponentEditorDesigner then
1255    Result:=ComponentEditors.GetComponentEditor(AComponent,
1256                                           TComponentEditorDesigner(ADesigner));
1257end;
1258
1259function TCustomFormEditor.CreateComponent(ParentComponent: TComponent;
1260  TypeClass: TComponentClass; const AUnitName: shortstring;
1261  NewLeft, NewTop, NewWidth, NewHeight: Integer;
1262  DisableAutoSize: boolean): TComponent;
1263const
1264  PreferredDistanceMin = 30;
1265  PreferredDistanceMax = 250;
1266var
1267  NewJITIndex: Integer;
1268  CompLeft, CompTop, CompWidth, CompHeight, NewPPI, OldPPI: integer;
1269  NewComponent: TComponent;
1270  OwnerComponent: TComponent;
1271  JITList: TJITComponentList;
1272  AControl: TControl;
1273  AParent: TWinControl;
1274  NewComponentName: String;
1275  DesignForm: TCustomForm;
1276  NewUnitName: String;
1277  s: String;
1278  MonitorBounds: TRect;
1279  Mediator: TDesignerMediator;
1280  FreeMediator: Boolean;
1281  MediatorClass: TDesignerMediatorClass;
1282  ParentDesigner: TCustomDesignControl;
1283
1284  function ActiveMonitor: TMonitor;
1285  begin
1286    if Screen.ActiveCustomForm <> nil then
1287      Result := Screen.ActiveCustomForm.Monitor
1288    else
1289    if Application.MainForm <> nil then
1290      Result := Application.MainForm.Monitor
1291    else
1292      Result := Screen.PrimaryMonitor;
1293  end;
1294
1295begin
1296  Result:=nil;
1297  AParent:=nil;
1298  NewComponent:=nil;
1299  Mediator:=nil;
1300  FreeMediator:=false;
1301  try
1302    //DebugLn(['[TCustomFormEditor.CreateComponent] Class="'+TypeClass.ClassName+'" ',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight]);
1303    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent A');{$ENDIF}
1304
1305    OwnerComponent:=nil;
1306    if Assigned(ParentComponent) then
1307    begin
1308      // add as child component
1309      Mediator:=GetDesignerMediatorByComponent(ParentComponent);
1310      OwnerComponent := ParentComponent;
1311      if OwnerComponent.Owner <> nil then
1312        OwnerComponent := OwnerComponent.Owner;
1313      try
1314        NewComponent := TComponent(TypeClass.newinstance);
1315        if DisableAutoSize and (NewComponent is TControl) then
1316          TControl(NewComponent).DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomFormEditor.CreateComponent'){$ENDIF};
1317        SetComponentDesignMode(NewComponent,true);
1318        if DescendFromDesignerBaseClass(TypeClass)>=0 then begin
1319          // this class can have its own lfm streams (e.g. a TFrame)
1320          //  => set csInline
1321          DebugLn(['TCustomFormEditor.CreateComponent Inline ',DbgSName(TypeClass)]);
1322          SetComponentInlineMode(NewComponent,true);
1323        end;
1324        try
1325          NewComponent.Create(OwnerComponent);
1326        except
1327          NewComponent:=nil;
1328          raise;
1329        end;
1330      except
1331        on e: Exception do begin
1332          DumpExceptionBackTrace;
1333          IDEMessageDialog(lisCFEErrorCreatingComponent,
1334            Format(lisCFEErrorCreatingComponent2,
1335                   [TypeClass.ClassName, LineEnding, E.Message]),
1336            mtError,[mbCancel]);
1337          exit;
1338        end;
1339      end;
1340      // check if Owner was properly set
1341      if NewComponent.Owner <> OwnerComponent then begin
1342        IDEMessageDialog(lisCFEInvalidComponentOwner,
1343          Format(lisCFETheComponentOfTypeFailedToSetItsOwnerTo, [NewComponent.
1344            ClassName, OwnerComponent.Name, OwnerComponent.ClassName]),
1345          mtError,[mbCancel]);
1346        exit;
1347      end;
1348
1349      // read inline streams
1350      if csInline in NewComponent.ComponentState then begin
1351        JITList:=FindJITList(OwnerComponent);
1352        if JITList=nil then
1353          RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
1354        JITList.ReadInlineJITChildComponent(NewComponent);
1355      end;
1356
1357      // calc parent
1358      AParent:=nil;
1359      if ParentComponent is TControl then begin
1360        if (ParentComponent is TWinControl) then
1361          AParent:=TWinControl(ParentComponent)
1362        else
1363          AParent:=TControl(ParentComponent).Parent;
1364        while (AParent<>nil) do begin
1365          if (AParent is TWinControl)
1366          and (csAcceptsControls in AParent.ControlStyle) then
1367            break;
1368          AParent:=AParent.Parent;
1369        end;
1370      end;
1371      //DebugLn('TCustomFormEditor.CreateComponent: Parent is '''+dbgsName(AParent)+'''');
1372    end else begin
1373      // create a toplevel component
1374      // -> a form or a datamodule or a custom component
1375      if AUnitName='' then
1376        NewUnitName:=DefaultJITUnitName
1377      else
1378        NewUnitName:=AUnitName;
1379      JITList:=GetJITListOfType(TypeClass);
1380      if JITList=nil then
1381        RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
1382      NewJITIndex := JITList.AddNewJITComponent(NewUnitName,TypeClass,DisableAutoSize);
1383      if NewJITIndex < 0 then
1384        exit;
1385      // create component interface
1386      NewComponent:=JITList[NewJITIndex];
1387    end;
1388    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent D ');{$ENDIF}
1389    try
1390      NewComponentName := CreateUniqueComponentName(NewComponent);
1391      NewComponent.Name := NewComponentName;
1392    except
1393      on e: Exception do begin
1394        IDEMessageDialog(lisErrorNamingComponent,
1395          Format(lisErrorSettingTheNameOfAComponentTo, [dbgsName(NewComponent),
1396            NewComponentName]),
1397          mtError,[mbCancel]);
1398        exit;
1399      end;
1400    end;
1401
1402    try
1403      // set bounds
1404      CompLeft:=NewLeft;
1405      CompTop:=NewTop;
1406      CompWidth:=NewWidth;
1407      CompHeight:=NewHeight;
1408      if NewComponent is TControl then
1409      begin
1410        AControl := TControl(NewComponent);
1411        if AControl is TCustomDesignControl then
1412          OldPPI := TCustomDesignControl(AControl).DesignTimePPI
1413        else
1414          OldPPI := 96;
1415        ParentDesigner := GetParentDesignControl(AParent);
1416        // calc bounds
1417        if CompWidth <= 0 then
1418        begin
1419          CompWidth := Max(5, AControl.Width);
1420          if ParentDesigner<>nil then
1421            CompWidth := MulDiv(CompWidth, ParentDesigner.PixelsPerInch, OldPPI);
1422        end;
1423        if CompHeight <= 0 then
1424        begin
1425          CompHeight := Max(5, AControl.Height);
1426          if ParentDesigner<>nil then
1427            CompHeight := MulDiv(CompHeight, ParentDesigner.PixelsPerInch, OldPPI);
1428        end;
1429        MonitorBounds := ActiveMonitor.BoundsRect;
1430        if (CompLeft < 0) and (AParent <> nil) then
1431          CompLeft := (AParent.Width - CompWidth) div 2
1432        else
1433        if (AControl is TCustomForm) and (CompLeft < MonitorBounds.Left + PreferredDistanceMin) then
1434          with MonitorBounds do
1435            CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin))
1436        else
1437        if CompLeft < 0 then
1438          CompLeft := 0;
1439        if (CompTop < 0) and (AParent <> nil) then
1440          CompTop := (AParent.Height - CompHeight) div 2
1441        else
1442        if (AControl is TCustomForm) and (CompTop < MonitorBounds.Top + PreferredDistanceMin) then
1443          with MonitorBounds do
1444            CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin))
1445        else
1446        if CompTop < 0 then
1447          CompTop := 0;
1448
1449        if ParentDesigner<>nil then
1450          NewPPI := ParentDesigner.PixelsPerInch
1451        else
1452        if (AControl is TCustomForm) then
1453          NewPPI := TCustomForm(AControl).Monitor.PixelsPerInch
1454        else
1455          NewPPI := 0;
1456        if NewPPI > 0 then
1457          AControl.AutoAdjustLayout(lapAutoAdjustForDPI, OldPPI, NewPPI, 0, 0);
1458
1459        if (AParent <> nil) or (AControl is TCustomForm) then
1460        begin
1461          // set parent after placing control to prevent display at (0,0)
1462          AControl.SetBounds(CompLeft,CompTop,CompWidth,CompHeight);
1463          AControl.Parent := AParent;
1464        end else
1465        begin
1466          // no parent and not a form
1467          AControl.SetBounds(0,0,CompWidth,CompHeight);
1468          AControl.DesignInfo := LeftTopToDesignInfo(CompLeft, CompTop);
1469          //DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(AControl),' ',LazLongRec(AControl.DesignInfo).Lo,',',LazLongRec(AControl.DesignInfo).Hi]);
1470        end;
1471      end
1472      else
1473      if (NewComponent is TDataModule) then
1474      begin
1475        // data module
1476        with TDataModule(NewComponent) do
1477        begin
1478          if CompWidth <= 0 then CompWidth := Max(150, DesignSize.X);
1479          if CompHeight <= 0 then CompHeight := Max(150, DesignSize.Y);
1480          MonitorBounds := ActiveMonitor.BoundsRect;
1481          if CompLeft < MonitorBounds.Left + PreferredDistanceMin then
1482            with MonitorBounds do
1483              CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin));
1484          if CompTop < MonitorBounds.Top + PreferredDistanceMin then
1485            with MonitorBounds do
1486              CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin));
1487          DesignOffset := Point(CompLeft, CompTop);
1488          DesignSize := Point(CompWidth, CompHeight);
1489          //debugln('TCustomFormEditor.CreateComponent TDataModule Bounds ',dbgsName(NewComponent),' ',dbgs(DesignOffset.X),',',dbgs(DesignOffset.Y),' ',DbgS(NewComponent),8),' ',DbgS(Cardinal(@DesignOffset));
1490        end;
1491      end
1492      else begin
1493        // non TControl
1494        if CompWidth <= 0 then CompWidth := 50;
1495        if CompHeight <= 0 then CompHeight := 50;
1496
1497        CompLeft := Max(Low(SmallInt), Min(High(SmallInt), CompLeft));
1498        CompTop := Max(Low(SmallInt), Min(High(SmallInt), CompTop));
1499
1500        SetComponentLeftTopOrDesignInfo(NewComponent,CompLeft,CompTop);
1501        if ParentComponent <> nil then
1502        begin
1503          DesignForm := GetDesignerForm(ParentComponent);
1504          if DesignForm <> nil then DesignForm.Invalidate;
1505        end;
1506        if Mediator=nil then begin
1507          MediatorClass:=GetDesignerMediatorClass(TComponentClass(NewComponent.ClassType));
1508          if MediatorClass<>nil then begin
1509            Mediator:=MediatorClass.CreateMediator(nil,NewComponent);
1510            FreeMediator:=Mediator<>nil;
1511          end;
1512        end;
1513        //DebugLn(['TCustomFormEditor.CreateComponent ',DbgSName(NewComponent),' ',dbgs(Bounds(CompLeft,CompTop,CompWidth,CompHeight)),' ',Mediator<>nil]);
1514        if Mediator<>nil then begin
1515          Mediator.InitComponent(NewComponent,ParentComponent,
1516            Bounds(CompLeft,CompTop,CompWidth,CompHeight));
1517        end;
1518
1519      end;
1520    except
1521      on e: Exception do begin
1522        DebugLn(e.Message);
1523        DumpExceptionBackTrace;
1524        IDEMessageDialog(lisErrorMovingComponent,
1525          Format(lisErrorMovingComponent2, [NewComponent.Name,
1526            NewComponent.ClassName]),
1527          mtError,[mbCancel]);
1528        exit;
1529      end;
1530    end;
1531
1532    {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent F ');{$ENDIF}
1533    //DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(NewComponent),' ',FindComponent(NewComponent)<>nil]);
1534
1535    Result := NewComponent;
1536  finally
1537    // clean up carefully
1538    if FreeMediator and (Mediator<>nil) then begin
1539      try
1540        FreeAndNil(Mediator);
1541      except
1542        on E: Exception do begin
1543          s:=Format(lisCFEErrorDestroyingMediatorOfUnit,
1544                    [Mediator.ClassName, AUnitName, LineEnding, E.Message]);
1545          DebugLn(['TCustomFormEditor.CreateComponent ',s]);
1546          DumpExceptionBackTrace;
1547          IDEMessageDialog(lisCFEErrorDestroyingMediator, s, mtError, [mbCancel]);
1548        end;
1549      end;
1550    end;
1551    if Result=nil then begin
1552      if NewComponent<>nil then begin
1553        try
1554          NewComponent.Free;
1555          NewComponent:=nil;
1556        except
1557          on E: Exception do begin
1558            s:=Format(lisCFEErrorDestroyingComponentOfTypeOfUnit,
1559                      [TypeClass.ClassName, AUnitName, LineEnding, E.Message]);
1560            DebugLn(['TCustomFormEditor.CreateComponent ',s]);
1561            DumpExceptionBackTrace;
1562            IDEMessageDialog(lisCFEErrorDestroyingComponent, s, mtError, [mbCancel]);
1563          end;
1564        end;
1565      end;
1566    end;
1567  end;
1568end;
1569
1570function TCustomFormEditor.CreateComponentFromStream(
1571  BinStream: TStream;
1572  UnitResourcefileFormat: TUnitResourcefileFormatClass;
1573  AncestorType: TComponentClass;
1574  const NewUnitName: ShortString;
1575  Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
1576  ContextObj: TObject): TComponent;
1577begin
1578  Result:=CreateRawComponentFromStream(BinStream, UnitResourcefileFormat,
1579       AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,ContextObj);
1580end;
1581
1582function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream;
1583  UnitResourcefileFormat: TUnitResourcefileFormatClass;
1584  AncestorType: TComponentClass;
1585  const NewUnitName: ShortString;
1586  Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
1587  ContextObj: TObject): TComponent;
1588var
1589  NewJITIndex: integer;
1590  JITList: TJITComponentList;
1591begin
1592  // create JIT Component
1593  JITList:=GetJITListOfType(AncestorType);
1594  if JITList=nil then
1595    RaiseGDBException('TCustomFormEditor.CreateComponentFromStream ClassName='+
1596                      AncestorType.ClassName);
1597  NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
1598              AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
1599              ContextObj);
1600  if NewJITIndex < 0 then begin
1601    Result:=nil;
1602    exit;
1603  end;
1604  Result:=JITList[NewJITIndex];
1605end;
1606
1607procedure TCustomFormEditor.CreateChildComponentsFromStream(BinStream: TStream;
1608  ComponentClass: TComponentClass; Root: TComponent;
1609  ParentControl: TWinControl; NewComponents: TFPList);
1610var
1611  JITList: TJITComponentList;
1612begin
1613  JITList:=FindJITList(Root);
1614  if JITList=nil then
1615    RaiseGDBException('TCustomFormEditor.CreateChildComponentFromStream ClassName='+
1616                      Root.ClassName);
1617
1618  JITList.AddJITChildComponentsFromStream(
1619                     Root,BinStream,ComponentClass,ParentControl,NewComponents);
1620end;
1621
1622function TCustomFormEditor.FixupReferences(AComponent: TComponent): TModalResult;
1623begin
1624  Result:=MainIDEInterface.DoFixupComponentReferences(AComponent,[]);
1625end;
1626
1627procedure TCustomFormEditor.WriterFindAncestor(Writer: TWriter;
1628  Component: TComponent; const Name: string; var Ancestor,
1629  RootAncestor: TComponent);
1630// Note: TWriter wants the stream ancestor, which is not always the class ancestor
1631var
1632  AnUnitInfo: TUnitInfo;
1633begin
1634  {$IFDEF VerboseFormEditor}
1635  DebugLn(['TCustomFormEditor.WriterFindAncestor START Component=',DbgSName(Component)]);
1636  {$ENDIF}
1637  AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(Component.ClassType));
1638  if (AnUnitInfo<>nil) then begin
1639    if (AnUnitInfo.Component=Component) then begin
1640      // Component is a root component (e.g. not nested, inline)
1641      // the stream ancestor is the component of the ClassParent
1642      AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
1643    end else begin
1644      // Component is a nested, inline component
1645      // the stream ancestor is the component of the class
1646    end;
1647    if (AnUnitInfo<>nil) and (AnUnitInfo.Component<>nil) then begin
1648      Ancestor:=AnUnitInfo.Component;
1649      RootAncestor:=AnUnitInfo.Component;
1650    end;
1651    {$IFDEF VerboseFormEditor}
1652    DebugLn(['TCustomFormEditor.WriterFindAncestor Component=',DbgSName(Component),' Ancestor=',DbgSName(Ancestor),' RootAncestor=',DbgSName(RootAncestor)]);
1653    {$ENDIF}
1654  end;
1655end;
1656
1657procedure TCustomFormEditor.SetComponentNameAndClass(
1658  AComponent: TComponent;
1659  const NewName, NewClassName: shortstring);
1660var
1661  JITList: TJITComponentList;
1662begin
1663  JITList:=GetJITListOfType(TComponentClass(AComponent.ClassType));
1664  JITList.RenameComponentClass(AComponent,NewClassName);
1665  AComponent.Name:=NewName;
1666end;
1667
1668function TCustomFormEditor.ClassDependsOnComponent(AClass: TComponentClass;
1669  AComponent: TComponent): Boolean;
1670{ Check if AClass uses AComponent.
1671
1672  For example:
1673    Add frame2 to frame1 ( frame1 uses frame2 )
1674    Add frame3 to frame2 ( frame2 uses frame3 => frame 2 uses frame1)
1675    Add frame1 to frame3 => circle
1676}
1677var
1678  AnUnitInfo: TUnitInfo;
1679begin
1680  if AClass.InheritsFrom(AComponent.ClassType) then exit(true);
1681  AnUnitInfo := Project1.UnitWithComponentClass(AClass);
1682  if AnUnitInfo = nil then Exit(false);
1683  Result := ComponentDependsOnClass(AnUnitInfo.Component,
1684                                    TComponentClass(AComponent.ClassType));
1685end;
1686
1687function TCustomFormEditor.ComponentDependsOnClass(AComponent: TComponent;
1688  AClass: TComponentClass): Boolean;
1689var
1690  i: Integer;
1691begin
1692  if AComponent is AClass then exit(true);
1693  if AComponent<>nil then
1694    for i:=0 to AComponent.ComponentCount-1 do
1695      if ComponentDependsOnClass(AComponent.Components[i],AClass) then
1696        exit(true);
1697  Result:=false;
1698end;
1699
1700function TCustomFormEditor.GetAncestorLookupRoot(AComponent: TComponent
1701  ): TComponent;
1702{ returns the ancestor of the Owner, if it owns a component with same name.
1703}
1704var
1705  CurRoot: TComponent;
1706  AncestorRoot: TComponent;
1707begin
1708  Result:=nil;
1709  if AComponent=nil then exit;
1710  CurRoot:=AComponent.Owner;
1711  if CurRoot=nil then exit;
1712  AncestorRoot:=GetAncestorInstance(CurRoot);
1713  if AncestorRoot=nil then exit;
1714  if AncestorRoot.FindComponent(AComponent.Name)=nil then exit;
1715  Result:=AncestorRoot;
1716  {$IFDEF VerboseFormEditor}
1717  DebugLn(['TCustomFormEditor.GetAncestorLookupRoot AComponent=',DbgSName(AComponent),' Result=',DbgSName(Result)]);
1718  {$ENDIF}
1719end;
1720
1721function TCustomFormEditor.GetAncestorInstance(AComponent: TComponent): TComponent;
1722{ Returns the next ancestor instance.
1723  For example:
1724    TFrame3 = class(TFrame2), TFrame2 = class(TFrame1)
1725    Frame1 is the ancestor instance of Frame2.
1726    Frame2 is the ancestor instance of Frame3.
1727
1728    If TFrame1 introduced Button1 then
1729    TFrame1.Button1 is the ancestor instance of TFrame2.Button1.
1730    TFrame2.Button1 is the ancestor instance of TFrame3.Button1.
1731}
1732var
1733  aRoot: TComponent;
1734begin
1735  Result:=nil;
1736  if (AComponent=nil) or (AComponent.ClassType=TComponent) then exit;
1737  if AComponent.Owner=nil then begin
1738    // root component
1739    Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassParent));
1740  end else if csInline in AComponent.ComponentState then begin
1741    // inline/embedded components (e.g. nested frame)
1742    Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassType));
1743  end else begin
1744    // child component
1745    aRoot:=GetAncestorInstance(AComponent.Owner);
1746    if aRoot<>nil then
1747      Result:=aRoot.FindComponent(AComponent.Name);
1748  end;
1749  {$IFDEF VerboseFormEditor}
1750  debugln(['TCustomFormEditor.GetAncestorInstance ',DbgSName(AComponent),' csAncestor=',csAncestor in AComponent.ComponentState,' Result=',DbgSName(Result)]);
1751  {$ENDIF}
1752end;
1753
1754function TCustomFormEditor.RegisterDesignerBaseClass(AClass: TComponentClass): integer;
1755begin
1756  if AClass=nil then
1757    RaiseGDBException('TCustomFormEditor.RegisterDesignerBaseClass');
1758  Result:=FDesignerBaseClasses.IndexOf(AClass);
1759  if Result<0 then
1760    Result:=FDesignerBaseClasses.Add(AClass)
1761end;
1762
1763function TCustomFormEditor.DesignerBaseClassCount: Integer;
1764begin
1765  Result:=FDesignerBaseClasses.Count;
1766end;
1767
1768procedure TCustomFormEditor.UnregisterDesignerBaseClass(AClass: TComponentClass);
1769var
1770  l: Integer;
1771begin
1772  for l := 0 to StandardDesignerBaseClassesCount-1 do
1773    if StandardDesignerBaseClasses[l]=AClass then
1774      RaiseGDBException('TCustomFormEditor.UnregisterDesignerBaseClass');
1775  FDesignerBaseClasses.Remove(AClass);
1776end;
1777
1778function TCustomFormEditor.IndexOfDesignerBaseClass(AClass: TComponentClass): integer;
1779begin
1780  Result:=FDesignerBaseClasses.IndexOf(AClass);
1781end;
1782
1783function TCustomFormEditor.DescendFromDesignerBaseClass(AClass: TComponentClass): integer;
1784begin
1785  Result:=FDesignerBaseClasses.Count-1;
1786  while (Result>=0)
1787  and (not AClass.InheritsFrom(TClass(FDesignerBaseClasses[Result]))) do
1788    dec(Result);
1789end;
1790
1791function TCustomFormEditor.FindDesignerBaseClassByName(
1792  const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
1793var
1794  i: Integer;
1795
1796  function SearchInParent(AParent: TComponentClass): TComponentClass;
1797  begin
1798    Result := nil;
1799    while AParent <> nil do
1800    begin
1801      if CompareText(AClassName, AParent.ClassName)=0 then
1802        Exit(AParent);
1803      AParent:=TComponentClass(AParent.ClassParent);
1804      if AParent = TComponent then
1805        Exit;
1806    end;
1807  end;
1808
1809begin
1810  if WithDefaults then
1811  begin
1812    for i := 0 to StandardDesignerBaseClassesCount - 1 do
1813    begin
1814      Result := SearchInParent(StandardDesignerBaseClasses[i]);
1815      if Result <> nil then
1816        Exit(StandardDesignerBaseClasses[i]);
1817    end;
1818  end;
1819  for i:=FDesignerBaseClasses.Count-1 downto 0 do
1820  begin
1821    Result:=DesignerBaseClasses[i];
1822    if CompareText(Result.ClassName,AClassName)=0 then exit;
1823  end;
1824  Result:=nil;
1825end;
1826
1827function TCustomFormEditor.StandardDesignerBaseClassesCount: Integer;
1828begin
1829  Result := Succ(High(CustomFormEditor.StandardDesignerBaseClasses) - Low(CustomFormEditor.StandardDesignerBaseClasses));
1830end;
1831
1832procedure TCustomFormEditor.FindDefineProperty(
1833  const APersistentClassName, AncestorClassName, Identifier: string;
1834  var IsDefined: boolean);
1835var
1836  AutoFreePersistent: Boolean;
1837  APersistent: TPersistent;
1838  CacheItem: TDefinePropertiesCacheItem;
1839  DefinePropertiesReader: TDefinePropertiesReader;
1840  ANode: TAvlTreeNode;
1841  OldClassName: String;
1842  DefinePropertiesPersistent: TDefinePropertiesPersistent;
1843
1844  function CreateTempPersistent(APersistentClass: TPersistentClass): boolean;
1845  begin
1846    Result:=false;
1847    if APersistent<>nil then
1848      RaiseGDBException('TCustomFormEditor.FindDefineProperty.CreateTempPersistent Inconsistency');
1849    try
1850      if APersistentClass.InheritsFrom(TComponent) then
1851        APersistent:=TComponentClass(APersistentClass).Create(nil)
1852      else if APersistentClass.InheritsFrom(TGraphic) then
1853        APersistent:=TGraphicClass(APersistentClass).Create
1854      else
1855        APersistent:=APersistentClass.Create;
1856      Result:=true;
1857      AutoFreePersistent:=true;
1858    except
1859      on E: Exception do begin
1860        debugln('TCustomFormEditor.FindDefineProperty Error creating ',
1861                APersistentClass.Classname, ': ', E.Message);
1862      end;
1863    end;
1864  end;
1865
1866  function GetDefinePersistent(const AClassName: string): Boolean;
1867  var
1868    APersistentClass: TPersistentClass;
1869    AncestorClass: TComponentClass;
1870  begin
1871    Result:=false;
1872    Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
1873
1874    // try to find the AClassName in the registered components
1875    if APersistent=nil then begin
1876      CacheItem.RegisteredComponent:=IDEComponentPalette.FindRegComponent(AClassName);
1877      if (CacheItem.RegisteredComponent<>nil)
1878      and (CacheItem.RegisteredComponent.ComponentClass<>nil) then begin
1879        //debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',AClassName,' is registered');
1880        if not CreateTempPersistent(CacheItem.RegisteredComponent.ComponentClass)
1881        then exit;
1882      end;
1883    end;
1884
1885    // try to find the AClassName in the registered TPersistent classes
1886    if APersistent=nil then begin
1887      APersistentClass:=Classes.GetClass(AClassName);
1888      if APersistentClass<>nil then begin
1889        //debugln('TCustomFormEditor.FindDefineProperty PersistentClass ',AClassName,' is registered');
1890        Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
1891        if not CreateTempPersistent(APersistentClass) then exit;
1892      end;
1893    end;
1894
1895    if APersistent=nil then begin
1896      // try to find the AClassName in the open forms/datamodules
1897      Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
1898      APersistent:=FindJITComponentByClassName(AClassName);
1899      if APersistent<>nil then
1900        debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',
1901          AClassName,' is a resource,'
1902          +' but inheriting design properties is not yet implemented');
1903    end;
1904
1905    // try default classes
1906    if (APersistent=nil) then begin
1907      AncestorClass:=FindDesignerBaseClassByName(AClassName,true);
1908      if AncestorClass<>nil then begin
1909        if not CreateTempPersistent(AncestorClass) then exit;
1910      end;
1911    end;
1912
1913    Result:=true;
1914  end;
1915
1916begin
1917  //debugln('TCustomFormEditor.GetDefineProperties ',
1918  //  ' APersistentClassName="',APersistentClassName,'"',
1919  // ' AncestorClassName="',AncestorClassName,'"',
1920  //  ' Identifier="',Identifier,'"');
1921  IsDefined:=false;
1922  RegisterStandardDefineProperties;
1923  ANode:=FindDefinePropertyNode(APersistentClassName);
1924  if ANode=nil then begin
1925    // cache component class, try to retrieve the define properties
1926    CacheItem:=TDefinePropertiesCacheItem.Create;
1927    CacheItem.PersistentClassname:=APersistentClassName;
1928    FDefineProperties.Add(CacheItem);
1929    //debugln('TCustomFormEditor.FindDefineProperty APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');
1930
1931    APersistent:=nil;
1932    AutoFreePersistent:=false;
1933
1934    if not GetDefinePersistent(APersistentClassName) then exit;
1935    if APersistent=nil then
1936      if not GetDefinePersistent(AncestorClassName) then exit;
1937
1938    if APersistent<>nil then begin
1939      debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Getting define properties for ',APersistent.ClassName);
1940
1941      // try creating a component class and call DefineProperties
1942      DefinePropertiesReader:=nil;
1943      DefinePropertiesPersistent:=nil;
1944      try
1945        try
1946          DefinePropertiesReader:=TDefinePropertiesReader.Create;
1947          DefinePropertiesPersistent:=TDefinePropertiesPersistent.Create(APersistent);
1948          DefinePropertiesPersistent.PublicDefineProperties(DefinePropertiesReader);
1949        except
1950          on E: Exception do begin
1951            DbgOut('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error calling DefineProperties for ');
1952            if (CacheItem.RegisteredComponent<>nil) then begin
1953              DbgOut(CacheItem.RegisteredComponent.ComponentClass.Classname);
1954            end;
1955            DebugLn(' : ',E.Message);
1956          end;
1957        end;
1958        // free component
1959        if AutoFreePersistent then begin
1960          try
1961            OldClassName:=APersistent.ClassName;
1962            APersistent.Free;
1963          except
1964            on E: Exception do begin
1965              debugln('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error freeing ',
1966                OldClassName,': ',E.Message);
1967            end;
1968          end;
1969        end;
1970      finally
1971        // cache defined properties
1972        if (DefinePropertiesReader<>nil)
1973        and (DefinePropertiesReader.DefinePropertyNames<>nil) then begin
1974          CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
1975          CacheItem.DefineProperties.Assign(DefinePropertiesReader.DefinePropertyNames);
1976          debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Class=',APersistentClassName,
1977            ' DefineProps="',CacheItem.DefineProperties.Text,'"');
1978        end;
1979        DefinePropertiesReader.Free;
1980        DefinePropertiesPersistent.Free;
1981      end;
1982    end else begin
1983      debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Persistent is NOT registered');
1984    end;
1985    //debugln('TCustomFormEditor.FindDefineProperty END APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');
1986  end else begin
1987    CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
1988  end;
1989  if CacheItem.DefineProperties<>nil then
1990    IsDefined:=CacheItem.DefineProperties.IndexOf(Identifier)>=0;
1991end;
1992
1993procedure TCustomFormEditor.RegisterDefineProperty(const APersistentClassName,
1994  Identifier: string);
1995var
1996  ANode: TAvlTreeNode;
1997  CacheItem: TDefinePropertiesCacheItem;
1998begin
1999  //DebugLn('TCustomFormEditor.RegisterDefineProperty ',APersistentClassName,' ',Identifier);
2000  ANode:=FindDefinePropertyNode(APersistentClassName);
2001  if ANode=nil then begin
2002    CacheItem:=TDefinePropertiesCacheItem.Create;
2003    CacheItem.PersistentClassname:=APersistentClassName;
2004    FDefineProperties.Add(CacheItem);
2005  end else begin
2006    CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
2007  end;
2008  if (CacheItem.DefineProperties=nil) then
2009    CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
2010  if (CacheItem.DefineProperties.IndexOf(Identifier)<0) then
2011    CacheItem.DefineProperties.Add(Identifier);
2012end;
2013
2014procedure TCustomFormEditor.RegisterStandardDefineProperties;
2015begin
2016  if FStandardDefinePropertiesRegistered then exit;
2017  FStandardDefinePropertiesRegistered:=true;
2018  RegisterDefineProperty('TStrings','Strings');
2019end;
2020
2021procedure TCustomFormEditor.JITListReaderError(Sender: TObject;
2022  Reader: TReader; ErrorType: TJITFormError; var Action: TModalResult);
2023var
2024  aCaption, aMsg: string;
2025  DlgType: TMsgDlgType;
2026  Buttons: TMsgDlgButtons;
2027  JITComponentList: TJITComponentList;
2028  StreamClass: TComponentClass;
2029  AnUnitInfo: TUnitInfo;
2030  LFMFilename: String;
2031  ErrorBinPos: Int64;
2032begin
2033  JITComponentList:=TJITComponentList(Sender);
2034  aCaption:='Read error';
2035  aMsg:='';
2036  DlgType:=mtError;
2037  Buttons:=[mbCancel];
2038
2039  // get current lfm filename
2040  LFMFilename:='';
2041  if (JITComponentList.CurReadStreamClass<>nil)
2042  and (JITComponentList.CurReadStreamClass.InheritsFrom(TComponent)) then begin
2043    StreamClass:=TComponentClass(JITComponentList.CurReadStreamClass);
2044    AnUnitInfo:=Project1.UnitWithComponentClass(StreamClass);
2045    if AnUnitInfo<>nil then begin
2046      LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
2047    end;
2048  end;
2049  if LFMFilename<>'' then
2050    aCaption:=Format(lisCFEErrorReading, [ExtractFilename(LFMFilename)]);
2051
2052  with JITComponentList do begin
2053    if LFMFilename<>'' then
2054      aMsg:=aMsg+LFMFilename
2055    else if CurReadStreamClass<>nil then
2056      aMsg:=Format(lisCFEStream, [aMsg, CurReadStreamClass.ClassName])
2057    else
2058      aMsg:=aMsg+'JITList='+ClassName;
2059    aMsg:=aMsg+': ';
2060    if CurReadJITComponent<>nil then
2061      aMsg:=Format(lisCFERoot, [aMsg, CurReadJITComponent.Name,
2062        CurReadJITComponent.ClassName]);
2063    if CurReadChild<>nil then
2064      aMsg:=Format(lisCFEComponent,
2065                   [aMsg, LineEnding, CurReadChild.Name, CurReadChild.ClassName])
2066    else if CurReadChildClass<>nil then
2067      aMsg:=Format(lisCFEComponentClass,
2068                   [aMsg, LineEnding, CurReadChildClass.ClassName]);
2069    aMsg:=aMsg+LineEnding+CurReadErrorMsg;
2070  end;
2071  if (Reader<>nil) and (Reader.Driver is TLRSObjectReader) then begin
2072    ErrorBinPos:=TLRSObjectReader(Reader.Driver).Stream.Position;
2073    aMsg:=Format(lisCFEStreamPosition, [aMsg, LineEnding, dbgs(ErrorBinPos)]);
2074  end;
2075
2076  case ErrorType of
2077    jfeUnknownProperty, jfeReaderError:
2078      begin
2079        Buttons:=[mbIgnore,mbCancel];
2080      end;
2081    jfeUnknownComponentClass:
2082      begin
2083        aMsg:=Format(lisCFEClassNotFound,
2084                     [aMsg, LineEnding, JITComponentList.CurUnknownClass]);
2085      end;
2086  end;
2087  if Buttons=[mbIgnore,mbCancel] then begin
2088    Action:=IDEQuestionDialog(aCaption,aMsg,DlgType,
2089      [mrIgnore, lisCFEContinueLoading,
2090       mrCancel, lisCFECancelLoadingThisResource,
2091       mrAbort, lisCFEStopAllLoading]);
2092  end else begin
2093    Action:=IDEQuestionDialog(aCaption,aMsg,DlgType,
2094      [mrCancel, lisCFECancelLoadingThisResource,
2095       mrAbort, lisCFEStopAllLoading]);
2096  end;
2097end;
2098
2099procedure TCustomFormEditor.JITListBeforeCreate(Sender: TObject;
2100  Instance: TPersistent);
2101var
2102  MediatorClass: TDesignerMediatorClass;
2103begin
2104  if Instance is TComponent then begin
2105    MediatorClass:=GetDesignerMediatorClass(TComponentClass(Instance.ClassType));
2106    if MediatorClass<>nil then
2107      MediatorClass.InitFormInstance(TComponent(Instance));
2108  end;
2109end;
2110
2111procedure TCustomFormEditor.JITListException(Sender: TObject; E: Exception;
2112  var Action: TModalResult);
2113var
2114  List: TJITComponentList;
2115  AnUnitInfo: TUnitInfo;
2116  LFMFilename: String;
2117  Msg: String;
2118begin
2119  List:=TJITComponentList(Sender);
2120  LFMFilename:='';
2121  Msg:='';
2122  DebugLn(['TCustomFormEditor.JITListException List.CurReadStreamClass=',DbgSName(List.CurReadStreamClass),' ',DbgSName(List.ContextObject)]);
2123  if (List.CurReadStreamClass<>nil) and (Project1<>nil)
2124  and (List.CurReadStreamClass.InheritsFrom(TComponent)) then begin
2125    AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(List.CurReadStreamClass));
2126    if AnUnitInfo<>nil then begin
2127      LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
2128    end;
2129  end;
2130  if (LFMFilename='') and (List.ContextObject is TUnitInfo) then begin
2131    LFMFilename:=ChangeFileExt(TUnitInfo(List.ContextObject).Filename,'.lfm');
2132  end;
2133  if LFMFilename<>'' then
2134    Msg:=Format(lisCFEInFile, [LFMFilename]) + LineEnding;
2135
2136  if List.CurReadErrorMsg<>'' then
2137    Msg:=Msg+List.CurReadErrorMsg+LineEnding;
2138  Msg+=E.Message;
2139  IDEMessageDialog(lisCodeToolsDefsReadError, Msg, mtError, [mbCancel]);
2140end;
2141
2142procedure TCustomFormEditor.OnDesignerMenuItemClick(Sender: TObject);
2143var
2144  CompEditor: TBaseComponentEditor;
2145  MenuItem: TMenuItem;
2146  CompClassName: String;
2147begin
2148  if (Sender=nil) or (not (Sender is TMenuItem)) then exit;
2149  MenuItem:=TMenuItem(Sender);
2150  if (MenuItem.Count>0) or MenuItem.IsInMenuBar then exit;
2151
2152  CompEditor:=GetComponentEditor(TComponent(Sender));
2153  if CompEditor=nil then exit;
2154  CompClassName:=CompEditor.ClassName;
2155  try
2156    CompEditor.Edit;
2157  except
2158    on E: Exception do begin
2159      DebugLn('TCustomFormEditor.OnDesignerMenuItemClick ERROR on CompEditor.Edit: ',E.Message);
2160      IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
2161        Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
2162               [CompClassName, LineEnding, E.Message]),
2163        mtError,[mbOk]);
2164    end;
2165  end;
2166  try
2167    CompEditor.Free;
2168  except
2169    on E: Exception do begin
2170      DebugLn('TCustomFormEditor.OnDesignerMenuItemClick ERROR on CompEditor.Free: ',E.Message);
2171      IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
2172        Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
2173               [CompClassName, LineEnding, E.Message]),
2174        mtError,[mbOk]);
2175    end;
2176  end;
2177end;
2178
2179function TCustomFormEditor.FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
2180begin
2181  Result := FNonFormForms.FindKey(Pointer(LookupRoot),
2182                                   @CompareLookupRootAndNonFormDesignerForm);
2183end;
2184
2185procedure TCustomFormEditor.JITListPropertyNotFound(Sender: TObject;
2186  Reader: TReader; Instance: TPersistent; var PropName: string;
2187  IsPath: boolean; var Handled, Skip: Boolean);
2188var
2189  Index: Integer;
2190begin
2191  Index := PropertiesToSkip.IndexOf(Instance, PropName);
2192  if Index >= 0 then
2193  begin
2194    Skip := True;
2195    Handled := True;
2196  end
2197  else
2198    DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName,
2199      ' Instance=',Instance.ClassName,' PropName="',PropName,
2200      '" IsPath=',IsPath]);
2201end;
2202
2203procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject;
2204  AClass: TClass;
2205  var Ancestors: TFPList;// list of TComponent
2206  var BinStreams: TFPList;// list of TExtMemoryStream;
2207  var Abort: boolean);
2208var
2209  AnUnitInfo: TUnitInfo;
2210  Ancestor: TComponent;
2211  BinStream: TExtMemoryStream;
2212begin
2213  Ancestors:=nil;
2214  BinStreams:=nil;
2215  if Project1=nil then exit;
2216  if (AClass=nil) or (AClass=TComponent)
2217  or (AClass=TForm) or (AClass=TCustomForm)
2218  or (AClass=TDataModule)
2219  or (not AClass.InheritsFrom(TComponent))
2220  or (IndexOfDesignerBaseClass(TComponentClass(AClass))>=0) then begin
2221    exit;
2222  end;
2223  //DebugLn(['TCustomFormEditor.JITListFindAncestors Class=',DbgSName(AClass)]);
2224  AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(AClass));
2225  while AnUnitInfo<>nil do begin
2226    {$IFDEF VerboseFormEditor}
2227    DebugLn(['TCustomFormEditor.JITListFindAncestors FOUND ancestor ',DbgSName(AnUnitInfo.Component),', streaming ...']);
2228    {$ENDIF}
2229    Ancestor:=AnUnitInfo.Component;
2230    BinStream:=nil;
2231    if SaveUnitComponentToBinStream(AnUnitInfo,BinStream)<>mrOk then begin
2232      Abort:=true;
2233      exit;
2234    end;
2235    BinStream.Position:=0;
2236    if Ancestors=nil then begin
2237      Ancestors:=TFPList.Create;
2238      BinStreams:=TFPList.Create;
2239    end;
2240    Ancestors.Add(Ancestor);
2241    BinStreams.Add(BinStream);
2242    AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
2243  end;
2244end;
2245
2246procedure TCustomFormEditor.JITListFindClass(Sender: TObject;
2247  const ComponentClassName: string; var ComponentClass: TComponentClass);
2248var
2249  AnUnitInfo: TUnitInfo;
2250  Component: TComponent;
2251  RegComp: TRegisteredComponent;
2252  JITList: TJITComponentList;
2253  i: Integer;
2254begin
2255  //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
2256  RegComp:=IDEComponentPalette.FindRegComponent(ComponentClassName);
2257  if RegComp<>nil then begin
2258    //DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
2259    ComponentClass:=RegComp.ComponentClass;
2260  end else begin
2261    JITList:=Sender as TJITComponentList;
2262    debugln(['TCustomFormEditor.JITListFindClass JITList.ContextObject=',DbgSName(JITList.ContextObject)]);
2263    if JITList.ContextObject is TUnitInfo then begin
2264      AnUnitInfo:=TUnitInfo(JITList.ContextObject);
2265      if AnUnitInfo.ComponentFallbackClasses<>nil then
2266        for i:=0 to AnUnitInfo.ComponentFallbackClasses.Count-1 do begin
2267          if SysUtils.CompareText(AnUnitInfo.ComponentFallbackClasses[i],ComponentClassName)=0
2268          then begin
2269            {$IFDEF EnableNestedComponentsWithoutLFM}
2270            ComponentClass:=TComponentClass(Pointer(AnUnitInfo.ComponentFallbackClasses.Objects[i]));
2271            if ComponentClass<>nil then begin
2272              // ToDo: create or share a jitclass
2273              debugln(['TCustomFormEditor.JITListFindClass searched "',ComponentClassName,'", found fallback class "',DbgSName(ComponentClass),'" of unitinfo ',AnUnitInfo.Filename]);
2274              exit;
2275            end;
2276            {$ENDIF}
2277          end;
2278        end;
2279    end;
2280
2281    AnUnitInfo:=Project1.FirstUnitWithComponent;
2282    while AnUnitInfo<>nil do begin
2283      Component:=AnUnitInfo.Component;
2284      if SysUtils.CompareText(Component.ClassName,ComponentClassName)=0 then
2285      begin
2286        DebugLn(['TCustomFormEditor.JITListFindClass found nested class '+DbgSName(Component)+' in unit '+AnUnitInfo.Filename]);
2287        ComponentClass:=TComponentClass(Component.ClassType);
2288        break;
2289      end;
2290      AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
2291    end;
2292  end;
2293  //DebugLn(['TCustomFormEditor.JITListFindClass Searched=',ComponentClassName,' Found=',DbgSName(ComponentClass)]);
2294end;
2295
2296function TCustomFormEditor.GetDesignerBaseClasses(Index: integer
2297  ): TComponentClass;
2298begin
2299  Result:=TComponentClass(FDesignerBaseClasses[Index]);
2300end;
2301
2302function TCustomFormEditor.GetStandardDesignerBaseClasses(Index: integer): TComponentClass;
2303begin
2304  Result := CustomFormEditor.StandardDesignerBaseClasses[Index];
2305end;
2306
2307procedure TCustomFormEditor.SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass);
2308begin
2309  CustomFormEditor.StandardDesignerBaseClasses[Index] := AValue;
2310end;
2311
2312procedure TCustomFormEditor.FrameCompGetCreationClass(Sender: TObject;
2313  var NewComponentClass: TComponentClass);
2314begin
2315  if Assigned(OnSelectFrame) then
2316    OnSelectFrame(Sender,NewComponentClass);
2317end;
2318
2319procedure TCustomFormEditor.OnPasWriterFindAncestor(Writer: TCompWriterPas;
2320  aComponent: TComponent; const aName: string; var anAncestor,
2321  aRootAncestor: TComponent);
2322var
2323  C: TComponent;
2324begin
2325  C:=GetAncestorInstance(aComponent);
2326  if C=nil then exit;
2327  anAncestor:=C;
2328  if C.Owner=nil then
2329    aRootAncestor:=C;
2330  if Writer=nil then ;
2331  if aName='' then ;
2332end;
2333
2334procedure TCustomFormEditor.OnPasWriterGetMethodName(Writer: TCompWriterPas;
2335  Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
2336var
2337  aMethod: TMethod;
2338  aJITMethod: TJITMethod;
2339begin
2340  Name:='';
2341  if Instance=nil then exit;
2342  aMethod:=GetMethodProp(Instance,PropInfo);
2343  if GetJITMethod(aMethod,aJITMethod) then
2344    Name:=aJITMethod.TheMethodName;
2345  if Writer=nil then ;
2346end;
2347
2348procedure TCustomFormEditor.OnPasWriterGetParentProperty(
2349  Writer: TCompWriterPas; Component: TComponent; var PropName: string);
2350begin
2351  if Component is TControl then
2352    PropName:='Parent';
2353  if Writer=nil then ;
2354end;
2355
2356function TCustomFormEditor.OnPropHookGetAncestorInstProp(
2357  const InstProp: TInstProp; out AncestorInstProp: TInstProp): boolean;
2358var
2359  aComponent: TComponent;
2360begin
2361  Result:=false;
2362  if (InstProp.Instance=nil) or (InstProp.PropInfo=nil) then exit;
2363  if InstProp.Instance is TComponent then begin
2364    aComponent:=TComponent(InstProp.Instance);
2365    AncestorInstProp.Instance:=GetAncestorInstance(aComponent);
2366    if AncestorInstProp.Instance=nil then exit;
2367    AncestorInstProp.PropInfo:=GetPropInfo(AncestorInstProp.Instance,InstProp.PropInfo^.Name);
2368    if AncestorInstProp.PropInfo<>InstProp.PropInfo then exit;
2369    Result:=true;
2370  end;
2371end;
2372
2373function TCustomFormEditor.GetPropertyEditorHook: TPropertyEditorHook;
2374begin
2375  Result:=GlobalDesignHook;
2376  if Obj_Inspector<>nil then
2377    Result:=Obj_Inspector.PropertyEditorHook;
2378end;
2379
2380function TCustomFormEditor.FindDefinePropertyNode(
2381  const APersistentClassName: string): TAvlTreeNode;
2382begin
2383  if FDefineProperties=nil then
2384    FDefineProperties:=TAvlTree.Create(TListSortCompare(@CompareDefPropCacheItems));
2385  Result:=FDefineProperties.FindKey(PChar(APersistentClassName),
2386                    TListSortCompare(@ComparePersClassNameAndDefPropCacheItem));
2387end;
2388
2389function TCustomFormEditor.CreateUniqueComponentName(AComponent: TComponent): string;
2390begin
2391  Result:='';
2392  if (AComponent=nil) then exit;
2393  Result:=AComponent.Name;
2394  if (AComponent.Owner=nil) or (Result<>'') then exit;
2395  Result:=CreateUniqueComponentName(AComponent.ClassName,AComponent.Owner);
2396end;
2397
2398function TCustomFormEditor.CreateUniqueComponentName(const AClassName: string;
2399  OwnerComponent: TComponent): string;
2400var
2401  i, j: integer;
2402begin
2403  Result:=AClassName;
2404  if (OwnerComponent=nil) or (Result='') then exit;
2405  i:=1;
2406  while true do begin
2407    j:=OwnerComponent.ComponentCount-1;
2408    Result:=ClassNameToComponentName(AClassName);
2409    if Result[length(Result)] in ['0'..'9'] then
2410      Result:=Result+'_';
2411    Result:=Result+IntToStr(i);
2412    while (j>=0)
2413    and (CompareText(Result,OwnerComponent.Components[j].Name)<>0) do
2414      dec(j);
2415    if j<0 then exit;
2416    inc(i);
2417  end;
2418end;
2419
2420function TCustomFormEditor.TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
2421begin
2422  //debugln(['TCustomFormEditor.TranslateKeyToDesignerCommand ',DbgSName(TDesignerIDECommandForm),' ',Key,' ',dbgs(Shift)]);
2423  Result:=EditorOpts.KeyMap.TranslateKey(Key,Shift,TDesignerIDECommandForm);
2424end;
2425
2426function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass
2427  ): TComponent;
2428var
2429  NewParent: TComponent;
2430  Root: TPersistent;
2431  Mediator: TDesignerMediator;
2432begin
2433  Result:=nil;
2434  // find selected component
2435  if (FSelection = nil) or (FSelection.Count <= 0) then Exit;
2436  NewParent:=TComponent(FSelection[0]);
2437  //Debugln('TCustomFormEditor.GetDefaultComponentParent A:', DbgSName(NewParent));
2438  if not (NewParent is TComponent) then exit;
2439  if TypeClass<>nil then begin
2440    if TypeClass.InheritsFrom(TControl) and (NewParent is TControl) then begin
2441      // New TypeClass is a TControl and selected component is TControl =>
2442      // use only a TWinControl as parent
2443      while (NewParent<>nil) do begin
2444        if (NewParent is TWinControl)
2445        and (csAcceptsControls in TWinControl(NewParent).ControlStyle) then
2446          break;
2447        NewParent:=TControl(NewParent).Parent;
2448        //Debugln('TCustomFormEditor.GetDefaultComponentParent B:', DbgSName(NewParent));
2449      end;
2450    end else begin
2451      // New TypeClass or selected component is not a TControl =>
2452      // use Root component as parent
2453      Root:=GetLookupRootForComponent(NewParent);
2454      if Root is TComponent then begin
2455        Mediator:=GetDesignerMediatorByComponent(TComponent(Root));
2456        if (Mediator<>nil) then begin
2457          while (NewParent<>nil) do begin
2458            if Mediator.ParentAcceptsChild(NewParent,TypeClass) then
2459              break;
2460            NewParent:=NewParent.GetParentComponent;
2461          end;
2462          if NewParent=nil then
2463            NewParent:=TComponent(Root);
2464        end else
2465          NewParent:=TComponent(Root);
2466      end;
2467    end;
2468  end;
2469  Result:=NewParent;
2470end;
2471
2472function TCustomFormEditor.GetDefaultComponentPosition(
2473  TypeClass: TComponentClass; ParentComponent: TComponent; out X, Y: integer
2474  ): boolean;
2475var
2476  i: Integer;
2477  CurComponent: TComponent;
2478  P: TPoint;
2479  AForm: TNonFormProxyDesignerForm;
2480  MinX: Integer;
2481  MinY: Integer;
2482  MaxX: Integer;
2483  MaxY: Integer;
2484begin
2485  Result:=true;
2486  X:=10;
2487  Y:=10;
2488  if ParentComponent=nil then
2489    ParentComponent:=GetDefaultComponentParent(TypeClass);
2490  if (ParentComponent=nil) or (TypeClass=nil) then exit;
2491  if (TypeClass.InheritsFrom(TControl)) then exit;
2492  // a non visual component
2493  // put it somewhere right or below the other non visual components
2494  MinX:=-1;
2495  MinY:=-1;
2496  if (ParentComponent is TWinControl) then
2497  begin
2498    MaxX:=TWinControl(ParentComponent).ClientWidth-ComponentPaletteBtnWidth;
2499    MaxY:=TWinControl(ParentComponent).ClientHeight-ComponentPaletteBtnHeight;
2500  end else
2501  begin
2502    AForm:=FindNonFormForm(ParentComponent);
2503    if AForm<>nil then begin
2504      MaxX:=AForm.ClientWidth-ComponentPaletteBtnWidth;
2505      MaxY:=AForm.ClientHeight-ComponentPaletteBtnHeight;
2506    end else begin
2507      MaxX:=300;
2508      MaxY:=0;
2509    end;
2510  end;
2511  // find top left most non visual component
2512  for i:=0 to ParentComponent.ComponentCount-1 do begin
2513    CurComponent:=ParentComponent.Components[i];
2514    if ComponentIsNonVisual(CurComponent) then begin
2515      P:=GetParentFormRelativeTopLeft(CurComponent);
2516      if (P.X>=0) and (P.Y>=0) then begin
2517        if (MinX<0) or (P.Y<MinY) or ((P.Y=MinY) and (P.X<MinX)) then begin
2518          MinX:=P.X;
2519          MinY:=P.Y;
2520        end;
2521      end;
2522    end;
2523  end;
2524  if MinX<0 then begin
2525    MinX:=10;
2526    MinY:=10;
2527  end;
2528  // find a position without intersection
2529  X:=MinX;
2530  Y:=MinY;
2531  //debugln('TCustomFormEditor.GetDefaultComponentPosition Min=',dbgs(MinX),',',dbgs(MinY));
2532  i:=0;
2533  while i<ParentComponent.ComponentCount do begin
2534    CurComponent:=ParentComponent.Components[i];
2535    inc(i);
2536    if ComponentIsNonVisual(CurComponent) then begin
2537      P:=GetParentFormRelativeTopLeft(CurComponent);
2538      //debugln('TCustomFormEditor.GetDefaultComponentPosition ',dbgsName(CurComponent),' P=',dbgs(P));
2539      if (P.X>=0) and (P.Y>=0) then begin
2540        if (X+ComponentPaletteBtnWidth>=P.X)
2541        and (X<=P.X+ComponentPaletteBtnWidth)
2542        and (Y+ComponentPaletteBtnHeight>=P.Y)
2543        and (Y<=P.Y+ComponentPaletteBtnHeight) then begin
2544          // intersection found
2545          // move position
2546          inc(X,ComponentPaletteBtnWidth+2);
2547          if X>MaxX then begin
2548            inc(Y,ComponentPaletteBtnHeight+2);
2549            X:=MinX;
2550          end;
2551          // restart intersection test
2552          i:=0;
2553        end;
2554      end;
2555    end;
2556  end;
2557  // keep it visible
2558  if X>MaxX then X:=MaxX;
2559  if Y>MaxY then Y:=MaxY;
2560end;
2561
2562procedure TCustomFormEditor.OnObjectInspectorModified(Sender: TObject);
2563var
2564  CustomForm: TCustomForm;
2565  Instance: TPersistent;
2566begin
2567  if (FSelection = nil)
2568  or (FSelection.Count <= 0) then Exit;
2569
2570  Instance := FSelection[0];
2571  CustomForm:=GetDesignerForm(Instance);
2572  if (CustomForm<>nil) and (CustomForm.Designer<>nil) then
2573    CustomForm.Designer.Modified;
2574end;
2575
2576procedure TCustomFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg);
2577begin
2578  if AnObjectInspector=FObj_Inspector then exit;
2579  if FObj_Inspector<>nil then begin
2580    FObj_Inspector.OnModified:=nil;
2581    FObj_inspector.OnNodeGetImageIndex:= nil;
2582  end;
2583
2584  FObj_Inspector:=AnObjectInspector;
2585
2586  if FObj_Inspector<>nil then begin
2587    FObj_Inspector.OnModified:=@OnObjectInspectorModified;
2588    FObj_inspector.OnNodeGetImageIndex:= @DoOnNodeGetImageIndex;
2589  end;
2590end;
2591
2592
2593procedure TCustomFormEditor.DoOnNodeGetImageIndex(APersistent: TPersistent;
2594  var AImageIndex: integer);
2595var
2596  DesignerForm : TCustomForm;
2597  Mediator: TDesignerMediator;
2598begin
2599  DesignerForm := GetDesignerForm(APersistent);
2600
2601  // ask TMediator
2602  if DesignerForm is BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] then
2603  begin
2604    Mediator:=(DesignerForm as INonControlDesigner).Mediator;
2605    if Mediator<>nil then
2606      Mediator.GetObjInspNodeImageIndex(APersistent, AImageIndex);
2607  end;
2608end;
2609
2610{ TDefinePropertiesCacheItem }
2611
2612destructor TDefinePropertiesCacheItem.Destroy;
2613begin
2614  DefineProperties.Free;
2615  inherited Destroy;
2616end;
2617
2618{ TDefinePropertiesReader }
2619
2620procedure TDefinePropertiesReader.AddPropertyName(const Name: string);
2621begin
2622  debugln('TDefinePropertiesReader.AddPropertyName Name="',Name,'"');
2623  if FDefinePropertyNames=nil then
2624    FDefinePropertyNames:=TStringListUTF8Fast.Create;
2625  if FDefinePropertyNames.IndexOf(Name)<=0 then
2626    FDefinePropertyNames.Add(Name);
2627end;
2628
2629destructor TDefinePropertiesReader.Destroy;
2630begin
2631  FDefinePropertyNames.Free;
2632  inherited Destroy;
2633end;
2634
2635procedure TDefinePropertiesReader.DefineProperty(const Name: string;
2636  ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
2637begin
2638  AddPropertyName(Name);
2639end;
2640
2641procedure TDefinePropertiesReader.DefineBinaryProperty(const Name: string;
2642  ReadData, WriteData: TStreamProc; HasData: Boolean);
2643begin
2644  AddPropertyName(Name);
2645end;
2646
2647procedure TDefinePropertiesReader.FlushBuffer;
2648begin
2649
2650end;
2651
2652{ TDefinePropertiesPersistent }
2653
2654constructor TDefinePropertiesPersistent.Create(TargetPersistent: TPersistent);
2655begin
2656  FTarget:=TargetPersistent;
2657end;
2658
2659procedure TDefinePropertiesPersistent.PublicDefineProperties(Filer: TFiler);
2660begin
2661  //debugln('TDefinePropertiesPersistent.PublicDefineProperties START ',ClassName,' ',dbgsName(FTarget));
2662  {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
2663  {$R-}
2664  TDefinePropertiesPersistent(Target).DefineProperties(Filer);
2665  {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
2666  //debugln('TDefinePropertiesPersistent.PublicDefineProperties END ',ClassName,' ',dbgsName(FTarget));
2667end;
2668
2669initialization
2670  RegisterStandardClasses;
2671
2672end.
2673
2674