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