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