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