mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 00:18:08 +02:00
2958 lines
101 KiB
ObjectPascal
2958 lines
101 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
CustomFormEditor.pp
|
|
-------------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit CustomFormEditor;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{$I ide.inc}
|
|
|
|
interface
|
|
|
|
{ $DEFINE VerboseFormEditor}
|
|
|
|
uses
|
|
{$IFDEF IDE_MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
// RTL+FCL
|
|
Classes, SysUtils, TypInfo, Math, AVL_Tree,
|
|
// LCL
|
|
LCLIntf, LCLType, LResources, LCLMemManager, Controls, Graphics,
|
|
Forms, Menus, Dialogs,
|
|
// LazUtils
|
|
FileUtil, LazFileUtils, LazFileCache, CompWriterPas, LazLoggerBase, LazTracer,
|
|
LazUTF8, AvgLvlTree,
|
|
// Codetools
|
|
CodeCache, CodeTree, CodeToolManager, FindDeclarationTool,
|
|
// BuildIntf
|
|
ComponentReg, ProjectIntf,
|
|
// IDEIntf
|
|
PropEdits, PropEditUtils, ObjectInspector, FormEditingIntf,
|
|
UnitResources, IDEOptEditorIntf, IDEDialogs, ComponentEditors,
|
|
// IdeUtils
|
|
IdeUtilsPkgStrConsts,
|
|
// IdeProject
|
|
IdeProjectStrConsts,
|
|
// IDE
|
|
LazarusIDEStrConsts, EditorOptions, EnvGuiOptions, Project, MainIntf, PackageDefs,
|
|
// Designer
|
|
CustomNonFormDesigner, NonControlDesigner, FrameDesigner, ControlSelection,
|
|
JITForms, DesignerProcs;
|
|
|
|
const
|
|
OrdinalTypes = [tkInteger,tkChar,tkEnumeration,tkbool];
|
|
LRSStreamChunkSize = 4096; // allocating mem in 4k chunks helps many mem managers
|
|
|
|
type
|
|
TSelectFrameEvent = procedure(Sender: TObject; var AComponentClass: TComponentClass) of Object;
|
|
|
|
{ TCustomFormEditor }
|
|
|
|
TCustomFormEditor = class(TAbstractFormEditor)
|
|
private
|
|
FOnSelectFrame: TSelectFrameEvent;
|
|
FSelection: TPersistentSelectionList;
|
|
FObj_Inspector: TObjectInspectorDlg;
|
|
FDefineProperties: TAvlTree;// tree of TDefinePropertiesCacheItem
|
|
FStandardDefinePropertiesRegistered: Boolean;
|
|
FDesignerBaseClasses: TFPList; // list of TComponentClass
|
|
FDesignerMediatorClasses: TFPList;// list of TDesignerMediatorClass
|
|
FOnNodeGetImageIndex: TOnOINodeGetImageEvent;
|
|
FDesignerBaseClassesCanCreateForm: TFPList; // list of TComponentClass
|
|
function GetPropertyEditorHook: TPropertyEditorHook;
|
|
function FindDefinePropertyNode(const APersistentClassName: string
|
|
): TAvlTreeNode;
|
|
procedure FrameCompGetCreationClass(Sender: TObject;
|
|
var NewComponentClass: TComponentClass);
|
|
function CompTree_ParentAcceptsChild(aParent, aChild,
|
|
aLookupRoot: TPersistent): boolean;
|
|
procedure CompTree_SetParent(aChild, aParent, aLookupRoot: TPersistent);
|
|
procedure PasWriterFindAncestor(Writer: TCompWriterPas;
|
|
aComponent: TComponent; const aName: string; var anAncestor,
|
|
aRootAncestor: TComponent);
|
|
procedure PasWriterGetMethodName(Writer: TCompWriterPas;
|
|
Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
|
|
procedure PasWriterGetParentProperty(Writer: TCompWriterPas;
|
|
Component: TComponent; var PropName: string);
|
|
function OnPropHookGetAncestorInstProp(const InstProp: TInstProp;
|
|
out AncestorInstProp: TInstProp): boolean;
|
|
protected
|
|
FNonFormForms: TAvlTree; // tree of TNonFormProxyDesignerForm sorted for LookupRoot
|
|
procedure SetSelection(const ASelection: TPersistentSelectionList);
|
|
procedure ObjectInspectorModified(Sender: TObject);
|
|
procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
|
|
procedure JITListBeforeCreate(Sender: TObject; Instance: TPersistent);
|
|
procedure JITListException(Sender: TObject; E: Exception;
|
|
var {%H-}Action: TModalResult);
|
|
procedure JITListPropertyNotFound(Sender: TObject; {%H-}Reader: TReader;
|
|
Instance: TPersistent; var PropName: string; IsPath: boolean;
|
|
var Handled, Skip: Boolean);
|
|
procedure JITListFindAncestors(Sender: TObject; AClass: TClass;
|
|
var Ancestors: TFPList;// list of TComponent
|
|
var BinStreams: TFPList;// list of TExtMemoryStream;
|
|
var Abort: boolean);
|
|
procedure JITListFindClass(Sender: TObject;
|
|
const VarName, ComponentUnitName, ComponentClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
|
|
function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
|
|
function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; override;
|
|
procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); override;
|
|
procedure DesignerMenuItemClick(Sender: TObject); virtual;
|
|
function FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
|
|
|
|
//because we only meet ObjInspectore here, not in abstract ancestor
|
|
procedure DoOnNodeGetImageIndex(APersistent: TPersistent; var AImageIndex: integer); virtual;
|
|
public
|
|
JITFormList: TJITForms;// designed forms
|
|
JITNonFormList: TJITNonFormComponents;// designed custom components like data modules
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure RegisterFrame;
|
|
|
|
// selection
|
|
function AddSelected(Value: TComponent) : Integer;
|
|
procedure DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
|
|
function FindComponentByName(const Name: ShortString): TComponent; override;
|
|
function SaveSelectionToStream(s: TStream): Boolean; override;
|
|
function InsertFromStream(s: TStream; Parent: TWinControl;
|
|
Flags: TComponentPasteSelectionFlags): Boolean; override;
|
|
function ClearSelection: Boolean; override;
|
|
function DeleteSelection: Boolean; override;
|
|
function CopySelectionToClipboard: Boolean; override;
|
|
function CutSelectionToClipboard: Boolean; override;
|
|
function PasteSelectionFromClipboard(Flags: TComponentPasteSelectionFlags
|
|
): Boolean; override;
|
|
|
|
function GetCurrentObjectInspector: TObjectInspectorDlg; override;
|
|
|
|
// JIT components
|
|
function IsJITComponent(AComponent: TComponent): boolean;
|
|
function GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
|
|
function FindJITList(AComponent: TComponent): TJITComponentList;
|
|
function FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
|
|
function FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
|
|
function GetDesignerForm(APersistent: TPersistent): TCustomForm; override;
|
|
|
|
function FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
|
|
function CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
|
|
|
|
procedure RenameJITComponent(AComponent: TComponent; const NewClassName: shortstring);
|
|
procedure RenameJITComponentUnitname(AComponent: TComponent; const NewUnitName: shortstring);
|
|
procedure UpdateDesignerFormName(AComponent: TComponent);
|
|
procedure UpdateComponentName(AComponent: TComponent);
|
|
function CreateNewJITMethod(ALookupRoot: TComponent; const AMethodName: shortstring): TMethod;
|
|
procedure RenameJITMethod(AComponent: TComponent; const OldMethodName, NewMethodName: shortstring);
|
|
procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
|
|
function FindJITComponentByClassName(const AComponentClassName: string): TComponent;
|
|
function FindJITComponentByClass(AComponentClass: TComponentClass): TComponent;
|
|
procedure WriteMethodPropertyEvent(Writer: TWriter; {%H-}Instance: TPersistent;
|
|
PropInfo: PPropInfo; const MethodValue, DefMethodValue: TMethod;
|
|
var Handled: boolean);
|
|
function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
|
|
var BinCompStream: TExtMemoryStream): TModalResult;
|
|
function OnGetDanglingMethodName(const AMethod: TMethod; aRootComponent: TObject): string;
|
|
procedure SaveComponentAsPascal(aDesigner: TIDesigner; Writer: TCompWriterPas); override;
|
|
|
|
// ancestors
|
|
function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override;
|
|
function GetAncestorInstance(AComponent: TComponent): TComponent; override;
|
|
function RegisterDesignerBaseClass(AClass: TComponentClass): integer; override;
|
|
function DesignerBaseClassCount: Integer; override;
|
|
procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
|
|
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
|
|
function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; override;
|
|
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override; // can be UnitName/ClassName
|
|
function DesignerClassCanAppCreateForm(AClass: TComponentClass;
|
|
CheckInherited: boolean=true): boolean; override;
|
|
procedure SetDesignerBaseClassCanAppCreateForm(AClass: TComponentClass;
|
|
AValue: boolean); override;
|
|
|
|
function StandardDesignerBaseClassesCount: Integer; override;
|
|
// designers
|
|
function DesignerCount: integer; override;
|
|
function GetDesigner(Index: integer): TIDesigner; override;
|
|
function GetCurrentDesigner: TIDesigner; override;
|
|
function GetDesignerByComponent(AComponent: TComponent): TIDesigner; override;
|
|
|
|
// designer mediators
|
|
function GetDesignerMediators(Index: integer): TDesignerMediatorClass; override;
|
|
procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
|
|
procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); override;
|
|
function DesignerMediatorCount: integer; override;
|
|
function GetDesignerMediatorClass(ComponentClass: TComponentClass): TDesignerMediatorClass;
|
|
|
|
// component editors
|
|
function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
|
|
|
|
// component creation
|
|
function CreateUniqueComponentName(AComponent: TComponent): string; override;
|
|
function CreateUniqueComponentName(const AClassName: string;
|
|
OwnerComponent: TComponent): string; override;
|
|
function GetDefaultComponentParent(TypeClass: TComponentClass
|
|
): TComponent; override;
|
|
function GetDefaultComponentPosition(TypeClass: TComponentClass;
|
|
ParentComponent: TComponent;
|
|
out X,Y: integer): boolean; override;
|
|
function CreateComponent(ParentComponent: TComponent;
|
|
TypeClass: TComponentClass;
|
|
const AUnitName: shortstring;
|
|
NewLeft,NewTop,NewWidth,NewHeight: Integer;
|
|
DisableAutoSize: boolean): TComponent; override;
|
|
function CreateComponentFromStream(BinStream: TStream;
|
|
UnitResourcefileFormat: TUnitResourcefileFormatClass;
|
|
AncestorType: TComponentClass;
|
|
const NewUnitName: ShortString;
|
|
Interactive: boolean;
|
|
Visible: boolean = true;
|
|
DisableAutoSize: boolean = false;
|
|
ContextObj: TObject = nil): TComponent; override;
|
|
function CreateRawComponentFromStream(BinStream: TStream;
|
|
UnitResourcefileFormat: TUnitResourcefileFormatClass;
|
|
AncestorType: TComponentClass;
|
|
const NewUnitName: ShortString;
|
|
Interactive: boolean;
|
|
Visible: boolean = true;
|
|
DisableAutoSize: boolean = false;
|
|
ContextObj: TObject = nil): TComponent;
|
|
procedure CreateChildComponentsFromStream(BinStream: TStream;
|
|
ComponentClass: TComponentClass; Root: TComponent;
|
|
ParentControl: TWinControl; NewComponents: TFPList); override;
|
|
function ParentAcceptsChild(Parent, Child, aLookupRoot: TComponent): boolean; override;
|
|
function ParentAcceptsChildClass(Parent: TComponent;
|
|
ChildClass: TComponentClass; aLookupRoot: TComponent): boolean; override;
|
|
function FixupReferences(AComponent: TComponent): TModalResult;
|
|
procedure WriterFindAncestor({%H-}Writer: TWriter; Component: TComponent;
|
|
const {%H-}Name: string;
|
|
var Ancestor, RootAncestor: TComponent);
|
|
procedure SetComponentNameAndClass(AComponent: TComponent;
|
|
const NewName, NewClassName: shortstring);
|
|
function ClassDependsOnComponent(AClass: TComponentClass;
|
|
AComponent: TComponent): Boolean;
|
|
function ComponentDependsOnClass(AComponent: TComponent;
|
|
AClass: TComponentClass): Boolean;
|
|
|
|
// define properties
|
|
procedure FindDefineProperty(const APersistentClassName,
|
|
AncestorClassName, Identifier: string;
|
|
var IsDefined: boolean);
|
|
procedure RegisterDefineProperty(const APersistentClassName,
|
|
Identifier: string); override;
|
|
procedure RegisterStandardDefineProperties;
|
|
|
|
// keys
|
|
function TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
|
|
public
|
|
property Selection: TPersistentSelectionList read FSelection
|
|
write SetSelection;
|
|
property Obj_Inspector: TObjectInspectorDlg
|
|
read FObj_Inspector write SetObj_Inspector;
|
|
property PropertyEditorHook: TPropertyEditorHook read GetPropertyEditorHook;
|
|
property OnSelectFrame: TSelectFrameEvent read FOnSelectFrame write FOnSelectFrame;
|
|
property OnNodeGetImageIndex : TOnOINodeGetImageEvent read FOnNodeGetImageIndex
|
|
write FOnNodeGetImageIndex;
|
|
end;
|
|
|
|
|
|
{ TDefinePropertiesCacheItem }
|
|
|
|
TDefinePropertiesCacheItem = class
|
|
public
|
|
PersistentClassname: string;
|
|
RegisteredComponent: TRegisteredComponent;
|
|
DefineProperties: TStrings;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
{ TDefinePropertiesReader }
|
|
|
|
TDefinePropertiesReader = class(TFiler)
|
|
private
|
|
FDefinePropertyNames: TStrings;
|
|
protected
|
|
procedure AddPropertyName(const Name: string);
|
|
public
|
|
destructor Destroy; override;
|
|
procedure DefineProperty(const Name: string;
|
|
{%H-}ReadData: TReaderProc; {%H-}WriteData: TWriterProc;
|
|
{%H-}HasData: Boolean); override;
|
|
procedure DefineBinaryProperty(const Name: string;
|
|
{%H-}ReadData, {%H-}WriteData: TStreamProc;
|
|
{%H-}HasData: Boolean); override;
|
|
procedure FlushBuffer; override;
|
|
property DefinePropertyNames: TStrings read FDefinePropertyNames;
|
|
end;
|
|
|
|
|
|
{ TDefinePropertiesPersistent
|
|
Wrapper/Friend class, to call the protected method 'DefineProperties' }
|
|
|
|
TDefinePropertiesPersistent = class(TPersistent)
|
|
private
|
|
FTarget: TPersistent;
|
|
public
|
|
constructor Create(TargetPersistent: TPersistent);
|
|
procedure PublicDefineProperties(Filer: TFiler);
|
|
property Target: TPersistent read FTarget;
|
|
end;
|
|
|
|
|
|
var
|
|
StandardDesignerBaseClasses: array[0..2] of TComponentClass =
|
|
(
|
|
Forms.TForm,
|
|
TDataModule,
|
|
Forms.TFrame
|
|
);
|
|
|
|
|
|
function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
|
|
function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
|
|
Item: TDefinePropertiesCacheItem): integer;
|
|
|
|
function TryFreeComponent(var AComponent: TComponent): boolean;
|
|
|
|
function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;
|
|
|
|
procedure RegisterStandardClasses;
|
|
|
|
var
|
|
BaseFormEditor1: TCustomFormEditor = nil;
|
|
|
|
implementation
|
|
|
|
function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
|
|
begin
|
|
Result:=CompareText(Item1.PersistentClassname,Item2.PersistentClassname);
|
|
end;
|
|
|
|
function ComparePersClassNameAndDefPropCacheItem(Key: Pointer;
|
|
Item: TDefinePropertiesCacheItem): integer;
|
|
begin
|
|
Result:=CompareText(AnsiString(Key),Item.PersistentClassname);
|
|
end;
|
|
|
|
function FindLFMBaseClass(aFilename: string): TPFComponentBaseClass;
|
|
var
|
|
LFMFilename: String;
|
|
LFMType: String;
|
|
LFMClassName: String;
|
|
Code: TCodeBuffer;
|
|
Tool: TCodeTool;
|
|
ClassNode: TCodeTreeNode;
|
|
ListOfPFindContext: TFPList;
|
|
i: Integer;
|
|
Context: PFindContext;
|
|
AClassName: String;
|
|
LFMCode: TCodeBuffer;
|
|
begin
|
|
Result:=pfcbcNone;
|
|
if not FilenameHasPascalExt(aFilename) then exit;
|
|
if not FilenameIsAbsolute(aFilename) then exit;
|
|
LFMFilename:=ChangeFileExt(aFilename,'.lfm');
|
|
if not FileExistsCached(LFMFilename) then exit;
|
|
if not FileExistsCached(aFilename) then exit;
|
|
LFMCode:=CodeToolBoss.LoadFile(LFMFilename,true,false);
|
|
if LFMCode=nil then exit;
|
|
ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
|
|
if LFMClassName='' then exit;
|
|
Code:=CodeToolBoss.LoadFile(aFilename,true,false);
|
|
if Code=nil then exit;
|
|
if not CodeToolBoss.Explore(Code,Tool,false,true) then exit;
|
|
ClassNode:=Tool.FindClassNodeInInterface(LFMClassName,true,false,false);
|
|
if ClassNode=nil then exit;
|
|
ListOfPFindContext:=nil;
|
|
try
|
|
try
|
|
Tool.FindClassAndAncestors(ClassNode,ListOfPFindContext,false);
|
|
except
|
|
end;
|
|
if ListOfPFindContext=nil then exit;
|
|
for i:=0 to ListOfPFindContext.Count-1 do begin
|
|
Context:=PFindContext(ListOfPFindContext[i]);
|
|
AClassName:=Context^.Tool.ExtractClassName(Context^.Node,false);
|
|
//debugln(['CheckLFMBaseClass ',AClassName]);
|
|
if CompareText(AClassName,'TFrame')=0 then
|
|
exit(pfcbcFrame)
|
|
else if CompareText(AClassName,'TForm')=0 then
|
|
exit(pfcbcForm)
|
|
else if CompareText(AClassName,'TCustomForm')=0 then
|
|
exit(pfcbcCustomForm)
|
|
else if CompareText(AClassName,'TDataModule')=0 then
|
|
exit(pfcbcDataModule);
|
|
end;
|
|
finally
|
|
FreeListOfPFindContext(ListOfPFindContext);
|
|
end;
|
|
end;
|
|
|
|
procedure RegisterStandardClasses;
|
|
begin
|
|
RegisterClasses([TStringList]);
|
|
end;
|
|
|
|
function TryFreeComponent(var AComponent: TComponent): boolean;
|
|
var
|
|
OldName, OldClassName: string;
|
|
Begin
|
|
Result := False;
|
|
//debugln(['TryFreeComponent ',DbgSName(AComponent)]);
|
|
{$IFNDEF NoCompCatch}
|
|
try
|
|
{$ENDIF}
|
|
OldName := AComponent.Name;
|
|
OldClassName := AComponent.ClassName;
|
|
AComponent.Free;
|
|
//debugln(['TryFreeComponent ',OldName,':',OldClassName,' success']);
|
|
Result := True;
|
|
{$IFNDEF NoCompCatch}
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn('TryFreeComponent ERROR:',
|
|
' "'+OldName+':'+OldClassName+'" ',E.Message);
|
|
DumpExceptionBackTrace;
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
Format(lisCFEAnExceptionOccurredDuringDeletionOf,
|
|
[LineEnding, OldName, OldClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
if not Result then begin
|
|
// maybe some references can be removed
|
|
try
|
|
if AComponent is TControl then begin
|
|
TControl(AComponent).Parent:=nil;
|
|
end;
|
|
except
|
|
on e: Exception do begin
|
|
DebugLn('TryFreeComponent manual clean up failed also for ',
|
|
' "'+OldName+':'+OldClassName+'". This is likely, nothing to worry about. ',E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
AComponent := nil;
|
|
end;
|
|
|
|
{ TCustomFormEditor }
|
|
|
|
procedure OnPasWriterDefinePropertyTStrings(Writer: TCompWriterPas;
|
|
Instance: TPersistent; const Identifier: string; var Handled: boolean);
|
|
var
|
|
List: TStrings;
|
|
HasData: Boolean;
|
|
i: Integer;
|
|
begin
|
|
if not (Instance is TStrings) then exit;
|
|
List:=TStrings(Instance);
|
|
if Assigned(Writer.Ancestor) then
|
|
// Only serialize if string list is different from ancestor
|
|
if Writer.Ancestor.InheritsFrom(TStrings) then
|
|
HasData := not List.Equals(TStrings(Writer.Ancestor))
|
|
else
|
|
HasData := True
|
|
else
|
|
HasData := List.Count > 0;
|
|
if not HasData then exit;
|
|
Writer.WriteStatement('with '+Identifier+' do begin');
|
|
Writer.Indent;
|
|
Writer.WriteStatement('Clear;');
|
|
for i:=0 to List.Count-1 do
|
|
Writer.WriteStatement('Add('+Writer.GetStringLiteral(List[i])+');');
|
|
Writer.Unindent;
|
|
Writer.WriteStatement('end;');
|
|
Handled:=true;
|
|
end;
|
|
|
|
constructor TCustomFormEditor.Create;
|
|
|
|
procedure InitJITList(List: TJITComponentList);
|
|
begin
|
|
List.OnBeforeCreate:=@JITListBeforeCreate;
|
|
List.OnException:=@JITListException;
|
|
List.OnPropertyNotFound:=@JITListPropertyNotFound;
|
|
List.OnFindAncestors:=@JITListFindAncestors;
|
|
List.OnFindClass:=@JITListFindClass;
|
|
end;
|
|
|
|
var
|
|
l: Integer;
|
|
begin
|
|
inherited Create;
|
|
FNonFormForms := TAvlTree.Create(@CompareNonFormDesignerForms);
|
|
FSelection := TPersistentSelectionList.Create;
|
|
FDesignerBaseClasses:=TFPList.Create;
|
|
FDesignerBaseClassesCanCreateForm:=TFPList.Create;
|
|
FDesignerMediatorClasses:=TFPList.Create;
|
|
for l:=0 to StandardDesignerBaseClassesCount - 1 do
|
|
FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
|
|
|
|
JITFormList := TJITForms.Create(nil);
|
|
InitJITList(JITFormList);
|
|
|
|
JITNonFormList := TJITNonFormComponents.Create(nil);
|
|
InitJITList(JITNonFormList);
|
|
|
|
OnDesignerMenuItemClick:=@DesignerMenuItemClick;
|
|
OnGetDesignerForm:=@GetDesignerForm;
|
|
FormEditingHook:=Self;
|
|
|
|
RegisterDesignerBaseClass(TAbstractIDEOptionsEditor);
|
|
|
|
GlobalDesignHook.AddHandlerGetAncestorInstProp(@OnPropHookGetAncestorInstProp);
|
|
|
|
RegisterDefinePropertiesPas(TStrings,@OnPasWriterDefinePropertyTStrings);
|
|
end;
|
|
|
|
destructor TCustomFormEditor.Destroy;
|
|
begin
|
|
FormEditingHook:=nil;
|
|
OnDesignerMenuItemClick:=nil;
|
|
if FDefineProperties<>nil then begin
|
|
FDefineProperties.FreeAndClear;
|
|
FreeAndNil(FDefineProperties);
|
|
end;
|
|
FreeAndNil(JITFormList);
|
|
FreeAndNil(JITNonFormList);
|
|
FreeAndNil(FDesignerMediatorClasses);
|
|
FreeAndNil(FDesignerBaseClassesCanCreateForm);
|
|
FreeAndNil(FDesignerBaseClasses);
|
|
FreeAndNil(FSelection);
|
|
FreeAndNil(FNonFormForms);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RegisterFrame;
|
|
var
|
|
FrameComp: TRegisteredComponent;
|
|
begin
|
|
FrameComp:=IDEComponentPalette.FindRegComponent('TFrame');
|
|
if FrameComp <> nil then
|
|
FrameComp.OnGetCreationClass:=@FrameCompGetCreationClass;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SetSelection(const ASelection: TPersistentSelectionList);
|
|
begin
|
|
if FSelection.IsEqual(ASelection) then exit;
|
|
FSelection.Assign(ASelection);
|
|
if Obj_Inspector=nil then
|
|
begin
|
|
GlobalDesignHook.SetSelection(FSelection);
|
|
end else begin
|
|
if FSelection.Count>0 then
|
|
Obj_Inspector.PropertyEditorHook.LookupRoot:=GetLookupRootForComponent(FSelection[0]);
|
|
Obj_Inspector.Selection := FSelection;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.AddSelected(Value: TComponent): Integer;
|
|
Begin
|
|
Result := FSelection.Add(Value) + 1;
|
|
if Obj_Inspector<>nil then
|
|
begin
|
|
if not Obj_Inspector.Selection.IsEqual(FSelection) then
|
|
Obj_Inspector.Selection := FSelection;
|
|
end else
|
|
GlobalDesignHook.SetSelection(FSelection);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.DeleteComponent(AComponent: TComponent; FreeComponent: boolean);
|
|
var
|
|
AForm: TCustomForm;
|
|
AWinControl: TWinControl;
|
|
IsJIT: Boolean;
|
|
i: Integer;
|
|
aDesigner: TIDesigner;
|
|
Begin
|
|
IsJIT:=IsJITComponent(AComponent);
|
|
{$IFDEF IDE_DEBUG}
|
|
DebugLn(['TCustomFormEditor.DeleteComponent ',DbgSName(AComponent),' IsJITComponent=',IsJIT,' FreeComponent=',FreeComponent]);
|
|
{$ENDIF}
|
|
if TheControlSelection.LookupRoot = AComponent then
|
|
begin
|
|
TheControlSelection.BeginUpdate;
|
|
try
|
|
TheControlSelection.Clear;
|
|
finally
|
|
TheControlSelection.EndUpdate;
|
|
end;
|
|
end;
|
|
if PropertyEditorHook.LookupRoot=AComponent then
|
|
PropertyEditorHook.LookupRoot:=nil;
|
|
|
|
if IsJIT then begin
|
|
// AComponent is a top level component
|
|
if FreeComponent then
|
|
begin
|
|
// tell hooks about deleting
|
|
for i := AComponent.ComponentCount - 1 downto 0 do
|
|
PropertyEditorHook.PersistentDeleting(AComponent.Components[i]);
|
|
PropertyEditorHook.PersistentDeleting(AComponent);
|
|
end;
|
|
// disconnect designer
|
|
aDesigner:=GetDesignerByComponent(AComponent);
|
|
if aDesigner is TComponentEditorDesigner then
|
|
TComponentEditorDesigner(aDesigner).DisconnectComponent;
|
|
|
|
if JITFormList.IsJITForm(AComponent) then begin
|
|
// free/unbind a form component
|
|
if FreeComponent then
|
|
JITFormList.DestroyJITComponent(AComponent);
|
|
end else if JITNonFormList.IsJITNonForm(AComponent) then begin
|
|
// free/unbind a non form component and its designer form
|
|
aForm:=GetDesignerForm(AComponent);
|
|
if (AForm<>nil) and (not (AForm is TNonFormProxyDesignerForm)) then
|
|
RaiseGDBException(Format(lisCFETCustomFormEditorDeleteComponentWhereIsTheTCustomN,
|
|
[AComponent.ClassName]));
|
|
|
|
if (AForm <> nil) then
|
|
begin
|
|
AForm.ControlStyle:=AForm.ControlStyle+[csNoDesignVisible];
|
|
LCLIntf.ShowWindow(AForm.Handle,SW_HIDE);
|
|
FNonFormForms.Remove(AForm);
|
|
(AForm as INonFormDesigner).LookupRoot := nil;
|
|
Application.ReleaseComponent(AForm);
|
|
end;
|
|
|
|
if FreeComponent then
|
|
JITNonFormList.DestroyJITComponent(AComponent);
|
|
end else
|
|
RaiseGDBException('TCustomFormEditor.DeleteComponent '+AComponent.ClassName);
|
|
end else if FreeComponent then begin
|
|
if (AComponent.Owner=nil) then
|
|
DebugLn(['WARNING: TCustomFormEditor.DeleteComponent freeing orphaned component ',DbgSName(AComponent)]);
|
|
TryFreeComponent(AComponent);
|
|
end;
|
|
// if not free, then hide it
|
|
if (not FreeComponent) and (AComponent is TWinControl) then begin
|
|
AWinControl:=TWinControl(AComponent);
|
|
if AWinControl.HandleAllocated and (AWinControl.Parent=nil) then begin
|
|
AWinControl.ControlStyle:=AWinControl.ControlStyle+[csNoDesignVisible];
|
|
LCLIntf.ShowWindow(AWinControl.Handle,SW_HIDE);
|
|
DebugLn(['TCustomFormEditor.DeleteComponent Hiding: ',dbgsName(AWinControl)]);
|
|
end;
|
|
end;
|
|
//PropertyEditorHook.PersistentDeleted(AComponent); Not needed?
|
|
end;
|
|
|
|
function TCustomFormEditor.FindComponentByName(const Name: ShortString): TComponent;
|
|
var
|
|
i: longint;
|
|
Begin
|
|
if JITFormList<>nil then begin
|
|
i:=JITFormList.FindComponentByName(Name);
|
|
if i>=0 then begin
|
|
Result:=JITFormList[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
if JITNonFormList<>nil then begin
|
|
i:=JITNonFormList.FindComponentByName(Name);
|
|
if i>=0 then begin
|
|
Result:=JITNonFormList[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.SaveSelectionToStream(s: TStream): Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
ADesigner:=GetCurrentDesigner;
|
|
if ADesigner is TComponentEditorDesigner then
|
|
Result:=TComponentEditorDesigner(ADesigner).CopySelectionToStream(s)
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomFormEditor.InsertFromStream(s: TStream; Parent: TWinControl;
|
|
Flags: TComponentPasteSelectionFlags): Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
ADesigner:=GetCurrentDesigner;
|
|
if ADesigner is TComponentEditorDesigner then
|
|
Result:=TComponentEditorDesigner(ADesigner).InsertFromStream(s,Parent,Flags)
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomFormEditor.ClearSelection: Boolean;
|
|
var
|
|
ASelection: TPersistentSelectionList;
|
|
begin
|
|
if Selection.Count=0 then exit;
|
|
ASelection:=TPersistentSelectionList.Create;
|
|
try
|
|
Selection:=ASelection;
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
Format(lisCFEUnableToClearTheFormEditingSelection, [LineEnding, E.Message]),
|
|
mtError, [mbCancel]);
|
|
end;
|
|
end;
|
|
ASelection.Free;
|
|
Result:=(Selection=nil) or (Selection.Count=0);
|
|
end;
|
|
|
|
function TCustomFormEditor.DeleteSelection: Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
if (Selection.Count=0) then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
if Selection[0] is TComponent then begin
|
|
ADesigner:=FindRootDesigner(TComponent(Selection[0]));
|
|
if ADesigner is TComponentEditorDesigner then begin
|
|
TComponentEditorDesigner(ADesigner).DeleteSelection;
|
|
end;
|
|
end;
|
|
Result:=Selection.Count=0;
|
|
if Selection.Count>0 then begin
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
lisCFEDoNotKnowHowToDeleteThisFormEditingSelection,
|
|
mtError,[mbCancel]);
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.CopySelectionToClipboard: Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
if (Selection.Count=0) then begin
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
if Selection[0] is TComponent then begin
|
|
ADesigner:=FindRootDesigner(TComponent(Selection[0]));
|
|
if ADesigner is TComponentEditorDesigner then begin
|
|
TComponentEditorDesigner(ADesigner).CopySelection;
|
|
end;
|
|
end;
|
|
Result:=Selection.Count=0;
|
|
if Selection.Count>0 then begin
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
lisCFEDoNotKnowHowToCopyThisFormEditingSelection,
|
|
mtError,[mbCancel]);
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.CutSelectionToClipboard: Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
if (Selection.Count=0) then begin
|
|
Result:=false;
|
|
exit;
|
|
end;
|
|
if Selection[0] is TComponent then begin
|
|
ADesigner:=FindRootDesigner(TComponent(Selection[0]));
|
|
if ADesigner is TComponentEditorDesigner then begin
|
|
TComponentEditorDesigner(ADesigner).CutSelection;
|
|
end;
|
|
end;
|
|
Result:=Selection.Count=0;
|
|
if Selection.Count>0 then begin
|
|
IDEMessageDialog(lisCCOErrorCaption,
|
|
lisCFEDoNotKnowHowToCutThisFormEditingSelection,
|
|
mtError,[mbCancel]);
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.PasteSelectionFromClipboard(
|
|
Flags: TComponentPasteSelectionFlags): Boolean;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
ADesigner:=GetCurrentDesigner;
|
|
if ADesigner is TComponentEditorDesigner then begin
|
|
Result:=TComponentEditorDesigner(ADesigner).PasteSelection(Flags);
|
|
end else
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetCurrentObjectInspector: TObjectInspectorDlg;
|
|
begin
|
|
Result:=FObj_Inspector;
|
|
end;
|
|
|
|
function TCustomFormEditor.IsJITComponent(AComponent: TComponent): boolean;
|
|
begin
|
|
Result:=JITFormList.IsJITForm(AComponent)
|
|
or JITNonFormList.IsJITNonForm(AComponent);
|
|
end;
|
|
|
|
function TCustomFormEditor.GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
|
|
begin
|
|
if AncestorType.InheritsFrom(TCustomForm) then
|
|
Result := JITFormList
|
|
else
|
|
if AncestorType.InheritsFrom(TComponent) then
|
|
Result := JITNonFormList
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindJITList(AComponent: TComponent): TJITComponentList;
|
|
begin
|
|
if JITFormList.IndexOf(AComponent) >= 0 then
|
|
Result := JITFormList
|
|
else
|
|
if JITNonFormList.IndexOf(AComponent) >= 0 then
|
|
Result := JITNonFormList
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindJITListByClassName(const AComponentClassName: string): TJITComponentList;
|
|
begin
|
|
if JITFormList.FindComponentByClassName(AComponentClassName) >= 0 then
|
|
Result := JITFormList
|
|
else
|
|
if JITNonFormList.FindComponentByClassName(AComponentClassName) >= 0 then
|
|
Result := JITNonFormList
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindJITListByClass(AComponentClass: TComponentClass): TJITComponentList;
|
|
begin
|
|
if JITFormList.FindComponentByClass(AComponentClass) >= 0 then
|
|
Result := JITFormList
|
|
else
|
|
if JITNonFormList.FindComponentByClass(AComponentClass) >= 0 then
|
|
Result := JITNonFormList
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesignerForm(APersistent: TPersistent): TCustomForm;
|
|
var
|
|
TheOwner: TPersistent;
|
|
begin
|
|
Result:=nil;
|
|
TheOwner := GetLookupRootForComponent(APersistent);
|
|
if TheOwner = nil then
|
|
exit;
|
|
if TheOwner is TCustomForm then
|
|
Result := TCustomForm(TheOwner)
|
|
else if TheOwner is TComponent then
|
|
Result := FindNonFormForm(TComponent(TheOwner))
|
|
else
|
|
exit;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
|
|
var
|
|
AVLNode: TAvlTreeNode;
|
|
begin
|
|
AVLNode := FindNonFormFormNode(LookupRoot);
|
|
if AVLNode <> nil then
|
|
Result := TNonFormProxyDesignerForm(AVLNode.Data)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateNonFormForm(LookupRoot: TComponent): TNonFormProxyDesignerForm;
|
|
var
|
|
MediatorClass: TDesignerMediatorClass;
|
|
LNonFormProxyDesignerClass: TNonFormProxyDesignerFormClass;
|
|
begin
|
|
Result := Nil;
|
|
if FindNonFormFormNode(LookupRoot) <> nil then
|
|
RaiseGDBException(lisCFETCustomFormEditorCreateNonFormFormAlreadyExists);
|
|
if LookupRoot is TComponent then
|
|
begin
|
|
if LookupRoot is TCustomFrame then
|
|
begin
|
|
LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[FrameProxyDesignerFormId];
|
|
Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
|
|
Result.Create(nil, TFrameDesignerForm.Create(Result));
|
|
end
|
|
else
|
|
begin
|
|
LNonFormProxyDesignerClass := BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId];
|
|
Result := TNonFormProxyDesignerForm(LNonFormProxyDesignerClass.NewInstance);
|
|
Result.Create(nil, TNonControlDesignerForm.Create(Result));
|
|
Result.Color := EnvironmentGuiOpts.NonFormBackgroundColor;
|
|
end;
|
|
Result.Name:='_Designer_'+LookupRoot.Name;
|
|
(Result as INonFormDesigner).LookupRoot := LookupRoot;
|
|
FNonFormForms.Add(Result);
|
|
|
|
if Result is INonControlDesigner then begin
|
|
// create the mediator
|
|
MediatorClass:=GetDesignerMediatorClass(TComponentClass(LookupRoot.ClassType));
|
|
if MediatorClass<>nil then
|
|
(Result as INonControlDesigner).Mediator:=MediatorClass.CreateMediator(nil,LookupRoot);
|
|
end;
|
|
end else
|
|
RaiseGDBException(Format(lisCFETCustomFormEditorCreateNonFormFormUnknownType,
|
|
[LookupRoot.ClassName]));
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RenameJITComponent(AComponent: TComponent;
|
|
const NewClassName: shortstring);
|
|
var
|
|
JITComponentList: TJITComponentList;
|
|
begin
|
|
JITComponentList:=FindJITList(AComponent);
|
|
if JITComponentList=nil then
|
|
RaiseGDBException('TCustomFormEditor.RenameJITComponent');
|
|
JITComponentList.RenameComponentClass(AComponent,NewClassName);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RenameJITComponentUnitname(AComponent: TComponent;
|
|
const NewUnitName: shortstring);
|
|
var
|
|
JITComponentList: TJITComponentList;
|
|
begin
|
|
JITComponentList:=FindJITList(AComponent);
|
|
if JITComponentList=nil then
|
|
RaiseGDBException('TCustomFormEditor.RenameJITComponent');
|
|
JITComponentList.RenameComponentUnitname(AComponent,NewUnitName);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
|
|
var
|
|
ANonFormForm: TNonFormProxyDesignerForm;
|
|
begin
|
|
ANonFormForm := FindNonFormForm(AComponent);
|
|
//DebugLn(['TCustomFormEditor.UpdateDesignerFormName ',ANonFormForm<>nil, ' ',AComponent.Name]);
|
|
if ANonFormForm <> nil then
|
|
ANonFormForm.Caption := AComponent.Name;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.UpdateComponentName(AComponent: TComponent);
|
|
var
|
|
DesignerForm: TCustomForm;
|
|
begin
|
|
if AComponent.Owner = nil then
|
|
UpdateDesignerFormName(AComponent)
|
|
else
|
|
begin
|
|
DesignerForm := GetDesignerForm(AComponent);
|
|
if (DesignerForm <> nil) and (DesignerForm.Designer <> nil) and
|
|
EnvironmentGuiOpts.ShowComponentCaptions then
|
|
DesignerForm.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateNewJITMethod(ALookupRoot: TComponent;
|
|
const AMethodName: shortstring): TMethod;
|
|
var
|
|
JITComponentList: TJITComponentList;
|
|
begin
|
|
JITComponentList:=FindJITList(ALookupRoot);
|
|
if JITComponentList=nil then
|
|
RaiseGDBException('TCustomFormEditor.CreateNewJITMethod');
|
|
Result:=JITComponentList.CreateNewMethod(ALookupRoot,AMethodName);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RenameJITMethod(AComponent: TComponent;
|
|
const OldMethodName, NewMethodName: shortstring);
|
|
var
|
|
JITComponentList: TJITComponentList;
|
|
begin
|
|
JITComponentList:=FindJITList(AComponent);
|
|
if JITComponentList=nil then
|
|
RaiseGDBException('TCustomFormEditor.RenameJITMethod');
|
|
JITComponentList.RenameMethod(AComponent,OldMethodName,NewMethodName);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SaveHiddenDesignerFormProperties(AComponent: TComponent);
|
|
var
|
|
NonFormForm: TNonFormProxyDesignerForm;
|
|
begin
|
|
NonFormForm := FindNonFormForm(AComponent);
|
|
if NonFormForm <> nil then
|
|
(NonFormForm as INonFormDesigner).DoSaveBounds;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindJITComponentByClassName(
|
|
const AComponentClassName: string): TComponent;
|
|
var
|
|
i: LongInt;
|
|
begin
|
|
Result := nil;
|
|
i := JITFormList.FindComponentByClassName(AComponentClassName);
|
|
if i >= 0 then
|
|
begin
|
|
Result := JITFormList[i];
|
|
exit;
|
|
end;
|
|
i := JITNonFormList.FindComponentByClassName(AComponentClassName);
|
|
if i >= 0 then
|
|
begin
|
|
Result := JITNonFormList[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindJITComponentByClass(
|
|
AComponentClass: TComponentClass): TComponent;
|
|
var
|
|
i: LongInt;
|
|
begin
|
|
Result := nil;
|
|
i := JITFormList.FindComponentByClass(AComponentClass);
|
|
if i >= 0 then
|
|
begin
|
|
Result := JITFormList[i];
|
|
exit;
|
|
end;
|
|
i := JITNonFormList.FindComponentByClass(AComponentClass);
|
|
if i >= 0 then
|
|
begin
|
|
Result := JITNonFormList[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.WriteMethodPropertyEvent(Writer: TWriter;
|
|
Instance: TPersistent; PropInfo: PPropInfo;
|
|
const MethodValue, DefMethodValue: TMethod; var Handled: boolean);
|
|
var
|
|
CurName: String;
|
|
begin
|
|
Handled:=true;
|
|
|
|
//DebugLn(['TCustomFormEditor.WriteMethodPropertyEvent ',GlobalDesignHook.GetMethodName(MethodValue,nil)]);
|
|
|
|
// find ancestor method value
|
|
if (DefMethodValue.Data=MethodValue.Data)
|
|
and (DefMethodValue.Code=MethodValue.Code) then
|
|
exit;
|
|
if IsJITMethod(MethodValue) then
|
|
CurName:=TJITMethod(MethodValue.Data).TheMethodName
|
|
else if MethodValue.Code<>nil then begin
|
|
CurName:=Writer.LookupRoot.MethodName(MethodValue.Code);
|
|
if CurName='' then begin
|
|
// this event was not set by the IDE
|
|
// for Delphi compatibility, do not write this property
|
|
// see bug 13846
|
|
exit;
|
|
end;
|
|
end else
|
|
CurName:='';
|
|
Writer.Driver.BeginProperty(Writer.PropertyPath + PPropInfo(PropInfo)^.Name);
|
|
Writer.Driver.WriteMethodName(CurName);
|
|
Writer.Driver.EndProperty;
|
|
end;
|
|
|
|
function TCustomFormEditor.SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
|
|
var BinCompStream: TExtMemoryStream): TModalResult;
|
|
var
|
|
Writer: TWriter;
|
|
DestroyDriver: Boolean;
|
|
AncestorUnit: TUnitInfo;
|
|
Ancestor: TComponent;
|
|
{$IFDEF VerboseSaveUnitComponent}
|
|
memStream: TMemoryStream;
|
|
s: string;
|
|
{$ENDIF}
|
|
begin
|
|
// save designer form properties to the component
|
|
SaveHiddenDesignerFormProperties(AnUnitInfo.Component);
|
|
|
|
// stream component to binary stream
|
|
if BinCompStream=nil then
|
|
BinCompStream:=TExtMemoryStream.Create;
|
|
if AnUnitInfo.ComponentLastBinStreamSize>0 then
|
|
BinCompStream.Capacity:=Max(BinCompStream.Capacity,BinCompStream.Position+
|
|
AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize);
|
|
Writer:=nil;
|
|
DestroyDriver:=false;
|
|
try
|
|
Result:=mrOk;
|
|
try
|
|
BinCompStream.Position:=0;
|
|
Writer:=CreateLRSWriter(BinCompStream,DestroyDriver);
|
|
Writer.OnWriteMethodProperty:=@WriteMethodPropertyEvent;
|
|
Writer.OnFindAncestor:=@WriterFindAncestor;
|
|
AncestorUnit:=AnUnitInfo.FindAncestorUnit;
|
|
Ancestor:=nil;
|
|
if AncestorUnit<>nil then
|
|
Ancestor:=AncestorUnit.Component;
|
|
if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
|
|
TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
|
|
Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
|
|
if DestroyDriver then Writer.Driver.Free;
|
|
FreeAndNil(Writer);
|
|
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
|
|
|
|
{$IFDEF VerboseSaveUnitComponent}
|
|
BinCompStream.Position:=0;
|
|
memStream:=TMemoryStream.Create;
|
|
LRSObjectBinaryToText(BinCompStream,memStream);
|
|
memStream.Position:=0;
|
|
SetLength(s,memStream.Size);
|
|
memStream.Read(s[1],length(s));
|
|
DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream START ==================']);
|
|
debugln(s);
|
|
DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream END ==================']);
|
|
memStream.Free;
|
|
{$ENDIF}
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn(['TCustomFormEditor.SaveUnitComponentToBinStream ',E.Message]);
|
|
DumpExceptionBackTrace;
|
|
Result:=MessageDlg(lisStreamingError,
|
|
Format(lisUnableToStreamT,
|
|
[AnUnitInfo.ComponentName, AnUnitInfo.ComponentName])+LineEnding
|
|
+E.Message,
|
|
mtError,[mbAbort, mbRetry, mbIgnore], 0);
|
|
if Result=mrAbort then exit;
|
|
if Result=mrIgnore then Result:=mrOk;
|
|
end;
|
|
end;
|
|
finally
|
|
try
|
|
if DestroyDriver and (Writer<>nil) then Writer.Driver.Free;
|
|
Writer.Free;
|
|
except
|
|
on E: Exception do begin
|
|
debugln('TCustomFormEditor.SaveUnitComponentToBinStream Error cleaning up: ',E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.OnGetDanglingMethodName(const AMethod: TMethod;
|
|
aRootComponent: TObject): string;
|
|
// check if event is a JITMethod of aRootComponent
|
|
var
|
|
JITMethod: TJITMethod;
|
|
begin
|
|
Result:='';
|
|
if IsJITMethod(aMethod) then begin
|
|
JITMethod:=TJITMethod(aMethod.Data);
|
|
if aRootComponent.ClassType=JITMethod.TheClass then
|
|
Result:=JITMethod.TheMethodName;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SaveComponentAsPascal(aDesigner: TIDesigner;
|
|
Writer: TCompWriterPas);
|
|
begin
|
|
Writer.OnFindAncestor:=@PasWriterFindAncestor;
|
|
Writer.OnGetParentProperty:=@PasWriterGetParentProperty;
|
|
Writer.OnGetMethodName:=@PasWriterGetMethodName;
|
|
Writer.WriteDescendant(aDesigner.LookupRoot);
|
|
end;
|
|
|
|
function TCustomFormEditor.DesignerCount: integer;
|
|
begin
|
|
Result:=JITFormList.Count+JITNonFormList.Count;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesigner(Index: integer): TIDesigner;
|
|
var
|
|
AForm: TCustomForm;
|
|
begin
|
|
if Index < JITFormList.Count then
|
|
Result := JITFormList[Index].Designer
|
|
else
|
|
begin
|
|
AForm := GetDesignerForm(JITNonFormList[Index-JITFormList.Count]);
|
|
Result := AForm.Designer;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetCurrentDesigner: TIDesigner;
|
|
begin
|
|
Result:=nil;
|
|
if (Selection<>nil) and (Selection.Count>0) and (Selection[0] is TComponent)
|
|
then
|
|
Result:=GetDesignerByComponent(TComponent(Selection[0]));
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesignerByComponent(AComponent: TComponent
|
|
): TIDesigner;
|
|
var
|
|
AForm: TCustomForm;
|
|
begin
|
|
AForm:=GetDesignerForm(AComponent);
|
|
if AForm=nil then
|
|
Result:=nil
|
|
else
|
|
Result:=AForm.Designer;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesignerMediators(Index: integer
|
|
): TDesignerMediatorClass;
|
|
begin
|
|
Result:=TDesignerMediatorClass(FDesignerMediatorClasses[Index]);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RegisterDesignerMediator(
|
|
MediatorClass: TDesignerMediatorClass);
|
|
begin
|
|
if FDesignerMediatorClasses.IndexOf(MediatorClass)>=0 then
|
|
raise Exception.Create(Format(
|
|
lisCFETCustomFormEditorRegisterDesignerMediatorAlreadyRe, [DbgSName(
|
|
MediatorClass)]));
|
|
FDesignerMediatorClasses.Add(MediatorClass);
|
|
RegisterDesignerBaseClass(MediatorClass.FormClass);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.UnregisterDesignerMediator(
|
|
MediatorClass: TDesignerMediatorClass);
|
|
begin
|
|
UnregisterDesignerBaseClass(MediatorClass.FormClass);
|
|
FDesignerMediatorClasses.Remove(MediatorClass);
|
|
end;
|
|
|
|
function TCustomFormEditor.DesignerMediatorCount: integer;
|
|
begin
|
|
Result:=FDesignerMediatorClasses.Count;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesignerMediatorClass(
|
|
ComponentClass: TComponentClass): TDesignerMediatorClass;
|
|
var
|
|
i: Integer;
|
|
Candidate: TDesignerMediatorClass;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to DesignerMediatorCount-1 do begin
|
|
Candidate:=DesignerMediators[i];
|
|
if not (ComponentClass.InheritsFrom(Candidate.FormClass)) then continue;
|
|
if (Result<>nil) and Result.InheritsFrom(Candidate.FormClass) then continue;
|
|
Result:=Candidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
|
|
): TBaseComponentEditor;
|
|
var
|
|
ADesigner: TIDesigner;
|
|
begin
|
|
Result:=nil;
|
|
if AComponent=nil then exit;
|
|
ADesigner:=GetDesignerByComponent(AComponent);
|
|
if ADesigner is TComponentEditorDesigner then
|
|
Result:=ComponentEditors.GetComponentEditor(AComponent,
|
|
TComponentEditorDesigner(ADesigner));
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateComponent(ParentComponent: TComponent;
|
|
TypeClass: TComponentClass; const AUnitName: shortstring;
|
|
NewLeft, NewTop, NewWidth, NewHeight: Integer;
|
|
DisableAutoSize: boolean): TComponent;
|
|
const
|
|
PreferredDistanceMin = 30;
|
|
PreferredDistanceMax = 250;
|
|
var
|
|
NewJITIndex: Integer;
|
|
CompLeft, CompTop, CompWidth, CompHeight, NewPPI, OldPPI: integer;
|
|
NewComponent: TComponent;
|
|
OwnerComponent: TComponent;
|
|
JITList: TJITComponentList;
|
|
AControl: TControl;
|
|
AParent: TWinControl;
|
|
NewComponentName: String;
|
|
DesignForm: TCustomForm;
|
|
NewUnitName: String;
|
|
s: String;
|
|
MonitorBounds: TRect;
|
|
Mediator: TDesignerMediator;
|
|
FreeMediator: Boolean;
|
|
MediatorClass: TDesignerMediatorClass;
|
|
ParentDesigner: TCustomDesignControl;
|
|
|
|
function ActiveMonitor: TMonitor;
|
|
begin
|
|
if Screen.ActiveCustomForm <> nil then
|
|
Result := Screen.ActiveCustomForm.Monitor
|
|
else
|
|
if Application.MainForm <> nil then
|
|
Result := Application.MainForm.Monitor
|
|
else
|
|
Result := Screen.PrimaryMonitor;
|
|
end;
|
|
|
|
procedure CreateMediator;
|
|
var
|
|
NewSize: TPoint;
|
|
begin
|
|
if Mediator=nil then
|
|
begin
|
|
MediatorClass:=GetDesignerMediatorClass(TComponentClass(NewComponent.ClassType));
|
|
if MediatorClass<>nil then
|
|
begin
|
|
Mediator:=MediatorClass.CreateMediator(nil,NewComponent);
|
|
FreeMediator:=true;
|
|
end;
|
|
end;
|
|
if (Mediator<>nil) and (ParentComponent=nil) then
|
|
begin
|
|
NewSize:=Mediator.GetDefaultSize;
|
|
if NewWidth=0 then
|
|
NewWidth:=NewSize.X;
|
|
if NewHeight=0 then
|
|
NewHeight:=NewSize.Y;
|
|
end;
|
|
end;
|
|
|
|
procedure MediatorInitComponent;
|
|
begin
|
|
if Mediator<>nil then begin
|
|
//DebugLn(['TCustomFormEditor.CreateComponent ',DbgSName(NewComponent),' ',dbgs(Bounds(CompLeft,CompTop,CompWidth,CompHeight)),' ',Mediator<>nil]);
|
|
Mediator.InitComponent(NewComponent,ParentComponent,
|
|
Bounds(CompLeft,CompTop,CompWidth,CompHeight));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result:=nil;
|
|
AParent:=nil;
|
|
NewComponent:=nil;
|
|
Mediator:=nil;
|
|
FreeMediator:=false;
|
|
try
|
|
//DebugLn(['[TCustomFormEditor.CreateComponent] Class="'+TypeClass.ClassName+'" ',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight]);
|
|
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent A');{$ENDIF}
|
|
|
|
OwnerComponent:=nil;
|
|
if Assigned(ParentComponent) then
|
|
begin
|
|
// add as child component
|
|
Mediator:=GetDesignerMediatorByComponent(ParentComponent);
|
|
OwnerComponent := ParentComponent;
|
|
if OwnerComponent.Owner <> nil then
|
|
OwnerComponent := OwnerComponent.Owner;
|
|
try
|
|
NewComponent := TComponent(TypeClass.newinstance);
|
|
if DisableAutoSize and (NewComponent is TControl) then
|
|
TControl(NewComponent).DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomFormEditor.CreateComponent'){$ENDIF};
|
|
SetComponentDesignMode(NewComponent,true);
|
|
if DescendFromDesignerBaseClass(TypeClass)>=0 then begin
|
|
// this class can have its own lfm streams (e.g. a TFrame)
|
|
// => set csInline
|
|
DebugLn(['TCustomFormEditor.CreateComponent Inline ',DbgSName(TypeClass)]);
|
|
SetComponentInlineMode(NewComponent,true);
|
|
end;
|
|
try
|
|
NewComponent.Create(OwnerComponent);
|
|
except
|
|
NewComponent:=nil;
|
|
raise;
|
|
end;
|
|
except
|
|
on e: Exception do begin
|
|
DumpExceptionBackTrace;
|
|
IDEMessageDialog(lisCFEErrorCreatingComponent,
|
|
Format(lisCFEErrorCreatingComponent2,
|
|
[TypeClass.ClassName, LineEnding, E.Message]),
|
|
mtError,[mbCancel]);
|
|
exit;
|
|
end;
|
|
end;
|
|
// check if Owner was properly set
|
|
if NewComponent.Owner <> OwnerComponent then begin
|
|
IDEMessageDialog(lisCFEInvalidComponentOwner,
|
|
Format(lisCFETheComponentOfTypeFailedToSetItsOwnerTo, [NewComponent.
|
|
ClassName, OwnerComponent.Name, OwnerComponent.ClassName]),
|
|
mtError,[mbCancel]);
|
|
exit;
|
|
end;
|
|
|
|
// read inline streams
|
|
if csInline in NewComponent.ComponentState then begin
|
|
JITList:=FindJITList(OwnerComponent);
|
|
if JITList=nil then
|
|
RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
|
|
JITList.ReadInlineJITChildComponent(NewComponent);
|
|
end;
|
|
|
|
// calc parent
|
|
AParent:=nil;
|
|
if ParentComponent is TControl then begin
|
|
if (ParentComponent is TWinControl) then
|
|
AParent:=TWinControl(ParentComponent)
|
|
else
|
|
AParent:=TControl(ParentComponent).Parent;
|
|
while (AParent<>nil) do begin
|
|
if (AParent is TWinControl)
|
|
and (csAcceptsControls in AParent.ControlStyle) then
|
|
break;
|
|
AParent:=AParent.Parent;
|
|
end;
|
|
end;
|
|
//DebugLn('TCustomFormEditor.CreateComponent: Parent is '''+dbgsName(AParent)+'''');
|
|
end else begin
|
|
// create a toplevel component
|
|
// -> a form or a datamodule or a custom component
|
|
if AUnitName='' then
|
|
NewUnitName:=DefaultJITUnitName
|
|
else
|
|
NewUnitName:=AUnitName;
|
|
JITList:=GetJITListOfType(TypeClass);
|
|
if JITList=nil then
|
|
RaiseGDBException('TCustomFormEditor.CreateComponent '+TypeClass.ClassName);
|
|
NewJITIndex := JITList.AddNewJITComponent(NewUnitName,TypeClass,DisableAutoSize);
|
|
if NewJITIndex < 0 then
|
|
exit;
|
|
// create component interface
|
|
NewComponent:=JITList[NewJITIndex];
|
|
end;
|
|
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent D ');{$ENDIF}
|
|
try
|
|
NewComponentName := CreateUniqueComponentName(NewComponent);
|
|
NewComponent.Name := NewComponentName;
|
|
except
|
|
on e: Exception do begin
|
|
IDEMessageDialog(lisErrorNamingComponent,
|
|
Format(lisErrorSettingTheNameOfAComponentTo, [dbgsName(NewComponent),
|
|
NewComponentName]),
|
|
mtError,[mbCancel]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
try
|
|
CreateMediator;
|
|
|
|
// set bounds
|
|
CompLeft:=NewLeft;
|
|
CompTop:=NewTop;
|
|
CompWidth:=NewWidth;
|
|
CompHeight:=NewHeight;
|
|
if NewComponent is TControl then
|
|
begin
|
|
AControl := TControl(NewComponent);
|
|
if AControl is TCustomDesignControl then
|
|
OldPPI := TCustomDesignControl(AControl).DesignTimePPI
|
|
else
|
|
OldPPI := 96;
|
|
ParentDesigner := GetParentDesignControl(AParent);
|
|
// calc bounds
|
|
if CompWidth <= 0 then
|
|
begin
|
|
CompWidth := Max(5, AControl.Width);
|
|
if ParentDesigner<>nil then
|
|
CompWidth := MulDiv(CompWidth, ParentDesigner.PixelsPerInch, OldPPI);
|
|
end;
|
|
if CompHeight <= 0 then
|
|
begin
|
|
CompHeight := Max(5, AControl.Height);
|
|
if ParentDesigner<>nil then
|
|
CompHeight := MulDiv(CompHeight, ParentDesigner.PixelsPerInch, OldPPI);
|
|
end;
|
|
MonitorBounds := ActiveMonitor.BoundsRect;
|
|
if (CompLeft < 0) and (AParent <> nil) then
|
|
CompLeft := (AParent.Width - CompWidth) div 2
|
|
else
|
|
if (AControl is TCustomForm) and (CompLeft < MonitorBounds.Left + PreferredDistanceMin) then
|
|
with MonitorBounds do
|
|
CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin))
|
|
else
|
|
if CompLeft < 0 then
|
|
CompLeft := 0;
|
|
if (CompTop < 0) and (AParent <> nil) then
|
|
CompTop := (AParent.Height - CompHeight) div 2
|
|
else
|
|
if (AControl is TCustomForm) and (CompTop < MonitorBounds.Top + PreferredDistanceMin) then
|
|
with MonitorBounds do
|
|
CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin))
|
|
else
|
|
if CompTop < 0 then
|
|
CompTop := 0;
|
|
|
|
if ParentDesigner<>nil then
|
|
NewPPI := ParentDesigner.PixelsPerInch
|
|
else
|
|
if (AControl is TCustomForm) then
|
|
NewPPI := TCustomForm(AControl).Monitor.PixelsPerInch
|
|
else
|
|
NewPPI := 0;
|
|
if NewPPI > 0 then
|
|
AControl.AutoAdjustLayout(lapAutoAdjustForDPI, OldPPI, NewPPI, 0, 0);
|
|
|
|
if (AParent <> nil) or (AControl is TCustomForm) then
|
|
begin
|
|
// set parent after placing control to prevent display at (0,0)
|
|
AControl.SetBounds(CompLeft,CompTop,CompWidth,CompHeight);
|
|
AControl.Parent := AParent;
|
|
end else
|
|
begin
|
|
// no parent and not a form
|
|
AControl.SetBounds(0,0,CompWidth,CompHeight);
|
|
AControl.DesignInfo := LeftTopToDesignInfo(CompLeft, CompTop);
|
|
//DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(AControl),' ',LazLongRec(AControl.DesignInfo).Lo,',',LazLongRec(AControl.DesignInfo).Hi]);
|
|
end;
|
|
end
|
|
else
|
|
if (NewComponent is TDataModule) then
|
|
begin
|
|
// data module
|
|
with TDataModule(NewComponent) do
|
|
begin
|
|
if CompWidth <= 0 then CompWidth := Max(150, DesignSize.X);
|
|
if CompHeight <= 0 then CompHeight := Max(150, DesignSize.Y);
|
|
MonitorBounds := ActiveMonitor.BoundsRect;
|
|
if CompLeft < MonitorBounds.Left + PreferredDistanceMin then
|
|
with MonitorBounds do
|
|
CompLeft := Max(Left + PreferredDistanceMin, Min(Left + PreferredDistanceMax, Right - CompWidth - PreferredDistanceMin));
|
|
if CompTop < MonitorBounds.Top + PreferredDistanceMin then
|
|
with MonitorBounds do
|
|
CompTop := Max(Top + PreferredDistanceMin, Min(Top + PreferredDistanceMax, Bottom - CompWidth - PreferredDistanceMin));
|
|
DesignOffset := Point(CompLeft, CompTop);
|
|
DesignSize := Point(CompWidth, CompHeight);
|
|
//debugln('TCustomFormEditor.CreateComponent TDataModule Bounds ',dbgsName(NewComponent),' ',dbgs(DesignOffset.X),',',dbgs(DesignOffset.Y),' ',DbgS(NewComponent),8),' ',DbgS(Cardinal(@DesignOffset));
|
|
end;
|
|
end
|
|
else begin
|
|
// non TControl
|
|
CompLeft := Max(Low(SmallInt), Min(High(SmallInt), CompLeft));
|
|
CompTop := Max(Low(SmallInt), Min(High(SmallInt), CompTop));
|
|
if Mediator=nil then
|
|
SetComponentLeftTopOrDesignInfo(NewComponent,CompLeft,CompTop);
|
|
|
|
if ParentComponent <> nil then
|
|
begin
|
|
DesignForm := GetDesignerForm(ParentComponent);
|
|
if DesignForm <> nil then DesignForm.Invalidate;
|
|
end;
|
|
end;
|
|
MediatorInitComponent;
|
|
except
|
|
on e: Exception do begin
|
|
DebugLn(e.Message);
|
|
DumpExceptionBackTrace;
|
|
IDEMessageDialog(lisErrorMovingComponent,
|
|
Format(lisErrorMovingComponent2, [NewComponent.Name,
|
|
NewComponent.ClassName]),
|
|
mtError,[mbCancel]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TCustomFormEditor.CreateComponent F ');{$ENDIF}
|
|
//DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(NewComponent),' ',FindComponent(NewComponent)<>nil]);
|
|
|
|
Result := NewComponent;
|
|
finally
|
|
// clean up carefully
|
|
if FreeMediator and (Mediator<>nil) then begin
|
|
try
|
|
FreeAndNil(Mediator);
|
|
except
|
|
on E: Exception do begin
|
|
s:=Format(lisCFEErrorDestroyingMediatorOfUnit,
|
|
[Mediator.ClassName, AUnitName, LineEnding, E.Message]);
|
|
DebugLn(['TCustomFormEditor.CreateComponent ',s]);
|
|
DumpExceptionBackTrace;
|
|
IDEMessageDialog(lisCFEErrorDestroyingMediator, s, mtError, [mbCancel]);
|
|
end;
|
|
end;
|
|
end;
|
|
if Result=nil then begin
|
|
if NewComponent<>nil then begin
|
|
try
|
|
NewComponent.Free;
|
|
NewComponent:=nil;
|
|
except
|
|
on E: Exception do begin
|
|
s:=Format(lisCFEErrorDestroyingComponentOfTypeOfUnit,
|
|
[TypeClass.ClassName, AUnitName, LineEnding, E.Message]);
|
|
DebugLn(['TCustomFormEditor.CreateComponent ',s]);
|
|
DumpExceptionBackTrace;
|
|
IDEMessageDialog(lisCFEErrorDestroyingComponent, s, mtError, [mbCancel]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateComponentFromStream(
|
|
BinStream: TStream;
|
|
UnitResourcefileFormat: TUnitResourcefileFormatClass;
|
|
AncestorType: TComponentClass;
|
|
const NewUnitName: ShortString;
|
|
Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
|
|
ContextObj: TObject): TComponent;
|
|
begin
|
|
Result:=CreateRawComponentFromStream(BinStream, UnitResourcefileFormat,
|
|
AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,ContextObj);
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateRawComponentFromStream(BinStream: TStream;
|
|
UnitResourcefileFormat: TUnitResourcefileFormatClass;
|
|
AncestorType: TComponentClass;
|
|
const NewUnitName: ShortString;
|
|
Interactive: boolean; Visible: boolean; DisableAutoSize: boolean;
|
|
ContextObj: TObject): TComponent;
|
|
var
|
|
NewJITIndex: integer;
|
|
JITList: TJITComponentList;
|
|
begin
|
|
// create JIT Component
|
|
JITList:=GetJITListOfType(AncestorType);
|
|
if JITList=nil then
|
|
RaiseGDBException('TCustomFormEditor.CreateComponentFromStream ClassName='+
|
|
AncestorType.ClassName);
|
|
try
|
|
NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
|
|
AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
|
|
ContextObj);
|
|
if NewJITIndex < 0 then
|
|
exit(nil);
|
|
except
|
|
on E: EUnknownProperty do
|
|
exit(nil);
|
|
end;
|
|
Result:=JITList[NewJITIndex];
|
|
end;
|
|
|
|
procedure TCustomFormEditor.CreateChildComponentsFromStream(BinStream: TStream;
|
|
ComponentClass: TComponentClass; Root: TComponent;
|
|
ParentControl: TWinControl; NewComponents: TFPList);
|
|
var
|
|
JITList: TJITComponentList;
|
|
begin
|
|
JITList:=FindJITList(Root);
|
|
if JITList=nil then
|
|
RaiseGDBException('TCustomFormEditor.CreateChildComponentFromStream ClassName='+
|
|
Root.ClassName);
|
|
|
|
JITList.AddJITChildComponentsFromStream(
|
|
Root,BinStream,ComponentClass,ParentControl,NewComponents);
|
|
end;
|
|
|
|
function TCustomFormEditor.ParentAcceptsChild(Parent, Child,
|
|
aLookupRoot: TComponent): boolean;
|
|
var
|
|
Mediator: TDesignerMediator;
|
|
AControl: TControl;
|
|
aComp: TComponent;
|
|
begin
|
|
Result:=false;
|
|
if (Parent=nil) or (Child=nil) or (aLookupRoot=nil) then
|
|
exit;
|
|
|
|
// don't allow to move ancestor components
|
|
if csAncestor in Child.ComponentState then
|
|
exit;
|
|
|
|
// check if one of the parents of the Parent is the Child itself
|
|
aComp:=Parent;
|
|
repeat
|
|
if aComp=Child then exit;
|
|
aComp:=aComp.GetParentComponent;
|
|
until aComp=nil;
|
|
|
|
// check mediator
|
|
Mediator:=GetDesignerMediatorByComponent(aLookupRoot);
|
|
if Mediator<>nil then
|
|
begin
|
|
if not Mediator.ParentAcceptsChildComponent(Parent,Child) then
|
|
exit;
|
|
end;
|
|
|
|
// check LCL rules
|
|
if Parent is TWinControl then
|
|
begin
|
|
if (not (csAcceptsControls in TWinControl(Parent).ControlStyle)) then
|
|
exit;
|
|
if not TWinControl(Parent).CheckChildClassAllowed(TComponentClass(Child.ClassType), False) then
|
|
exit;
|
|
end
|
|
else if Parent is TControl then begin
|
|
exit;
|
|
end;
|
|
|
|
if Child is TControl then
|
|
begin
|
|
// do not move children of a restricted parent to another parent
|
|
// e.g. TPage of TPageControl
|
|
AControl:=TControl(Child);
|
|
if (AControl.Parent <> nil) and (AControl.Parent <> Parent) and
|
|
(not (csAcceptsControls in AControl.Parent.ControlStyle)) then
|
|
exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCustomFormEditor.ParentAcceptsChildClass(Parent: TComponent;
|
|
ChildClass: TComponentClass; aLookupRoot: TComponent): boolean;
|
|
var
|
|
Mediator: TDesignerMediator;
|
|
begin
|
|
Result:=false;
|
|
if (Parent=nil) or (ChildClass=nil) or (aLookupRoot=nil) then
|
|
exit;
|
|
Mediator:=GetDesignerMediatorByComponent(aLookupRoot);
|
|
if Mediator<>nil then
|
|
Result:=Mediator.ParentAcceptsChild(Parent,ChildClass)
|
|
else if Parent is TWinControl then
|
|
begin
|
|
if not TWinControl(Parent).CheckChildClassAllowed(ChildClass, False) then
|
|
exit;
|
|
end else if Parent is TControl then begin
|
|
exit;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TCustomFormEditor.FixupReferences(AComponent: TComponent): TModalResult;
|
|
begin
|
|
Result:=MainIDEInterface.DoFixupComponentReferences(AComponent,[]);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.WriterFindAncestor(Writer: TWriter;
|
|
Component: TComponent; const Name: string; var Ancestor,
|
|
RootAncestor: TComponent);
|
|
// Note: TWriter wants the stream ancestor, which is not always the class ancestor
|
|
var
|
|
AnUnitInfo: TUnitInfo;
|
|
begin
|
|
{$IFDEF VerboseFormEditor}
|
|
DebugLn(['TCustomFormEditor.WriterFindAncestor START Component=',DbgSName(Component)]);
|
|
{$ENDIF}
|
|
AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(Component.ClassType));
|
|
if (AnUnitInfo<>nil) then begin
|
|
if (AnUnitInfo.Component=Component) then begin
|
|
// Component is a root component (e.g. not nested, inline)
|
|
// the stream ancestor is the component of the ClassParent
|
|
AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
|
|
end else begin
|
|
// Component is a nested, inline component
|
|
// the stream ancestor is the component of the class
|
|
end;
|
|
if (AnUnitInfo<>nil) and (AnUnitInfo.Component<>nil) then begin
|
|
Ancestor:=AnUnitInfo.Component;
|
|
RootAncestor:=AnUnitInfo.Component;
|
|
end;
|
|
{$IFDEF VerboseFormEditor}
|
|
DebugLn(['TCustomFormEditor.WriterFindAncestor Component=',DbgSName(Component),' Ancestor=',DbgSName(Ancestor),' RootAncestor=',DbgSName(RootAncestor)]);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SetComponentNameAndClass(
|
|
AComponent: TComponent;
|
|
const NewName, NewClassName: shortstring);
|
|
var
|
|
JITList: TJITComponentList;
|
|
begin
|
|
JITList:=GetJITListOfType(TComponentClass(AComponent.ClassType));
|
|
JITList.RenameComponentClass(AComponent,NewClassName);
|
|
AComponent.Name:=NewName;
|
|
end;
|
|
|
|
function TCustomFormEditor.ClassDependsOnComponent(AClass: TComponentClass;
|
|
AComponent: TComponent): Boolean;
|
|
{ Check if AClass uses AComponent.
|
|
|
|
For example:
|
|
Add frame2 to frame1 ( frame1 uses frame2 )
|
|
Add frame3 to frame2 ( frame2 uses frame3 => frame 2 uses frame1)
|
|
Add frame1 to frame3 => circle
|
|
}
|
|
var
|
|
AnUnitInfo: TUnitInfo;
|
|
begin
|
|
if AClass.InheritsFrom(AComponent.ClassType) then exit(true);
|
|
AnUnitInfo := Project1.UnitWithComponentClass(AClass);
|
|
if AnUnitInfo = nil then Exit(false);
|
|
Result := ComponentDependsOnClass(AnUnitInfo.Component,
|
|
TComponentClass(AComponent.ClassType));
|
|
end;
|
|
|
|
function TCustomFormEditor.ComponentDependsOnClass(AComponent: TComponent;
|
|
AClass: TComponentClass): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AComponent is AClass then exit(true);
|
|
if AComponent<>nil then
|
|
for i:=0 to AComponent.ComponentCount-1 do
|
|
if ComponentDependsOnClass(AComponent.Components[i],AClass) then
|
|
exit(true);
|
|
Result:=false;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetAncestorLookupRoot(AComponent: TComponent
|
|
): TComponent;
|
|
{ returns the ancestor of the Owner, if it owns a component with same name.
|
|
}
|
|
var
|
|
CurRoot: TComponent;
|
|
AncestorRoot: TComponent;
|
|
begin
|
|
Result:=nil;
|
|
if AComponent=nil then exit;
|
|
CurRoot:=AComponent.Owner;
|
|
if CurRoot=nil then exit;
|
|
AncestorRoot:=GetAncestorInstance(CurRoot);
|
|
if AncestorRoot=nil then exit;
|
|
if AncestorRoot.FindComponent(AComponent.Name)=nil then exit;
|
|
Result:=AncestorRoot;
|
|
{$IFDEF VerboseFormEditor}
|
|
DebugLn(['TCustomFormEditor.GetAncestorLookupRoot AComponent=',DbgSName(AComponent),' Result=',DbgSName(Result)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomFormEditor.GetAncestorInstance(AComponent: TComponent): TComponent;
|
|
{ Returns the next ancestor instance.
|
|
For example:
|
|
TFrame3 = class(TFrame2), TFrame2 = class(TFrame1)
|
|
Frame1 is the ancestor instance of Frame2.
|
|
Frame2 is the ancestor instance of Frame3.
|
|
|
|
If TFrame1 introduced Button1 then
|
|
TFrame1.Button1 is the ancestor instance of TFrame2.Button1.
|
|
TFrame2.Button1 is the ancestor instance of TFrame3.Button1.
|
|
}
|
|
var
|
|
aRoot: TComponent;
|
|
begin
|
|
Result:=nil;
|
|
if (AComponent=nil) or (AComponent.ClassType=TComponent) then exit;
|
|
if AComponent.Owner=nil then begin
|
|
// root component
|
|
Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassParent));
|
|
end else if csInline in AComponent.ComponentState then begin
|
|
// inline/embedded components (e.g. nested frame)
|
|
Result:=FindJITComponentByClass(TComponentClass(AComponent.ClassType));
|
|
end else begin
|
|
// child component
|
|
aRoot:=GetAncestorInstance(AComponent.Owner);
|
|
if aRoot<>nil then
|
|
Result:=aRoot.FindComponent(AComponent.Name);
|
|
end;
|
|
{$IFDEF VerboseFormEditor}
|
|
debugln(['TCustomFormEditor.GetAncestorInstance ',DbgSName(AComponent),' csAncestor=',csAncestor in AComponent.ComponentState,' Result=',DbgSName(Result)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomFormEditor.RegisterDesignerBaseClass(AClass: TComponentClass): integer;
|
|
begin
|
|
if AClass=nil then
|
|
RaiseGDBException('TCustomFormEditor.RegisterDesignerBaseClass');
|
|
Result:=FDesignerBaseClasses.IndexOf(AClass);
|
|
if Result<0 then
|
|
Result:=FDesignerBaseClasses.Add(AClass)
|
|
end;
|
|
|
|
function TCustomFormEditor.DesignerBaseClassCount: Integer;
|
|
begin
|
|
Result:=FDesignerBaseClasses.Count;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.UnregisterDesignerBaseClass(AClass: TComponentClass);
|
|
var
|
|
l: Integer;
|
|
begin
|
|
for l := 0 to StandardDesignerBaseClassesCount-1 do
|
|
if StandardDesignerBaseClasses[l]=AClass then
|
|
RaiseGDBException('TCustomFormEditor.UnregisterDesignerBaseClass');
|
|
FDesignerBaseClasses.Remove(AClass);
|
|
end;
|
|
|
|
function TCustomFormEditor.IndexOfDesignerBaseClass(AClass: TComponentClass): integer;
|
|
begin
|
|
Result:=FDesignerBaseClasses.IndexOf(AClass);
|
|
end;
|
|
|
|
function TCustomFormEditor.DescendFromDesignerBaseClass(AClass: TComponentClass): integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=-1;
|
|
for i:=0 to FDesignerBaseClasses.Count-1 do
|
|
begin
|
|
if AClass.InheritsFrom(TClass(FDesignerBaseClasses[i])) then
|
|
begin
|
|
if (Result<0)
|
|
or (TClass(FDesignerBaseClassesCanCreateForm[i]).InheritsFrom(TClass(FDesignerBaseClasses[Result]))) then
|
|
Result:=i;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindDesignerBaseClassByName(
|
|
const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
|
|
var
|
|
i: Integer;
|
|
HasUnitName: Boolean;
|
|
|
|
function Fits(aClass: TComponentClass): boolean;
|
|
begin
|
|
if HasUnitName then
|
|
Result:=SameText(AClass.UnitName+'/'+aClass.ClassName,AClassName)
|
|
else
|
|
Result:=SameText(aClass.ClassName,AClassName);
|
|
end;
|
|
|
|
function SearchInParent(AParent: TComponentClass): TComponentClass;
|
|
begin
|
|
Result := nil;
|
|
while AParent <> nil do
|
|
begin
|
|
if Fits(AParent) then
|
|
Exit(AParent);
|
|
AParent:=TComponentClass(AParent.ClassParent);
|
|
if AParent = TComponent then
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
HasUnitName:=Pos('/',AClassName)>0;
|
|
if WithDefaults then
|
|
begin
|
|
for i := 0 to StandardDesignerBaseClassesCount - 1 do
|
|
begin
|
|
Result := SearchInParent(StandardDesignerBaseClasses[i]);
|
|
if Result <> nil then exit;
|
|
end;
|
|
end;
|
|
for i:=FDesignerBaseClasses.Count-1 downto 0 do
|
|
begin
|
|
Result:=DesignerBaseClasses[i];
|
|
if Fits(Result) then exit;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCustomFormEditor.StandardDesignerBaseClassesCount: Integer;
|
|
begin
|
|
Result := Succ(High(CustomFormEditor.StandardDesignerBaseClasses) - Low(CustomFormEditor.StandardDesignerBaseClasses));
|
|
end;
|
|
|
|
procedure TCustomFormEditor.FindDefineProperty(
|
|
const APersistentClassName, AncestorClassName, Identifier: string;
|
|
var IsDefined: boolean);
|
|
var
|
|
AutoFreePersistent: Boolean;
|
|
APersistent: TPersistent;
|
|
CacheItem: TDefinePropertiesCacheItem;
|
|
DefinePropertiesReader: TDefinePropertiesReader;
|
|
ANode: TAvlTreeNode;
|
|
OldClassName: String;
|
|
DefinePropertiesPersistent: TDefinePropertiesPersistent;
|
|
|
|
function CreateTempPersistent(APersistentClass: TPersistentClass): boolean;
|
|
begin
|
|
Result:=false;
|
|
if APersistent<>nil then
|
|
RaiseGDBException('TCustomFormEditor.FindDefineProperty.CreateTempPersistent Inconsistency');
|
|
try
|
|
if APersistentClass.InheritsFrom(TComponent) then
|
|
APersistent:=TComponentClass(APersistentClass).Create(nil)
|
|
else if APersistentClass.InheritsFrom(TGraphic) then
|
|
APersistent:=TGraphicClass(APersistentClass).Create
|
|
else
|
|
APersistent:=APersistentClass.Create;
|
|
Result:=true;
|
|
AutoFreePersistent:=true;
|
|
except
|
|
on E: Exception do begin
|
|
debugln('TCustomFormEditor.FindDefineProperty Error creating ',
|
|
APersistentClass.Classname, ': ', E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetDefinePersistent(const AClassName: string): Boolean;
|
|
var
|
|
APersistentClass: TPersistentClass;
|
|
AncestorClass: TComponentClass;
|
|
begin
|
|
Result:=false;
|
|
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
|
|
|
|
// try to find the AClassName in the registered components
|
|
if APersistent=nil then begin
|
|
CacheItem.RegisteredComponent:=IDEComponentPalette.FindRegComponent(AClassName);
|
|
if (CacheItem.RegisteredComponent<>nil)
|
|
and (CacheItem.RegisteredComponent.ComponentClass<>nil) then begin
|
|
//debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',AClassName,' is registered');
|
|
if not CreateTempPersistent(CacheItem.RegisteredComponent.ComponentClass)
|
|
then exit;
|
|
end;
|
|
end;
|
|
|
|
// try to find the AClassName in the registered TPersistent classes
|
|
if APersistent=nil then begin
|
|
APersistentClass:=Classes.GetClass(AClassName);
|
|
if APersistentClass<>nil then begin
|
|
//debugln('TCustomFormEditor.FindDefineProperty PersistentClass ',AClassName,' is registered');
|
|
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
|
|
if not CreateTempPersistent(APersistentClass) then exit;
|
|
end;
|
|
end;
|
|
|
|
if APersistent=nil then begin
|
|
// try to find the AClassName in the open forms/datamodules
|
|
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
|
|
APersistent:=FindJITComponentByClassName(AClassName);
|
|
if APersistent<>nil then
|
|
debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',
|
|
AClassName,' is a resource,'
|
|
+' but inheriting design properties is not yet implemented');
|
|
end;
|
|
|
|
// try default classes
|
|
if (APersistent=nil) then begin
|
|
AncestorClass:=FindDesignerBaseClassByName(AClassName,true);
|
|
if AncestorClass<>nil then begin
|
|
if not CreateTempPersistent(AncestorClass) then exit;
|
|
end;
|
|
end;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
begin
|
|
//debugln('TCustomFormEditor.GetDefineProperties ',
|
|
// ' APersistentClassName="',APersistentClassName,'"',
|
|
// ' AncestorClassName="',AncestorClassName,'"',
|
|
// ' Identifier="',Identifier,'"');
|
|
IsDefined:=false;
|
|
RegisterStandardDefineProperties;
|
|
ANode:=FindDefinePropertyNode(APersistentClassName);
|
|
if ANode=nil then begin
|
|
// cache component class, try to retrieve the define properties
|
|
CacheItem:=TDefinePropertiesCacheItem.Create;
|
|
CacheItem.PersistentClassname:=APersistentClassName;
|
|
FDefineProperties.Add(CacheItem);
|
|
//debugln('TCustomFormEditor.FindDefineProperty APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');
|
|
|
|
APersistent:=nil;
|
|
AutoFreePersistent:=false;
|
|
|
|
if not GetDefinePersistent(APersistentClassName) then exit;
|
|
if APersistent=nil then
|
|
if not GetDefinePersistent(AncestorClassName) then exit;
|
|
|
|
if APersistent<>nil then begin
|
|
debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Getting define properties for ',APersistent.ClassName);
|
|
|
|
// try creating a component class and call DefineProperties
|
|
DefinePropertiesReader:=nil;
|
|
DefinePropertiesPersistent:=nil;
|
|
try
|
|
try
|
|
DefinePropertiesReader:=TDefinePropertiesReader.Create;
|
|
DefinePropertiesPersistent:=TDefinePropertiesPersistent.Create(APersistent);
|
|
DefinePropertiesPersistent.PublicDefineProperties(DefinePropertiesReader);
|
|
except
|
|
on E: Exception do begin
|
|
DbgOut('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error calling DefineProperties for ');
|
|
if (CacheItem.RegisteredComponent<>nil) then begin
|
|
DbgOut(CacheItem.RegisteredComponent.ComponentClass.Classname);
|
|
end;
|
|
DebugLn(' : ',E.Message);
|
|
end;
|
|
end;
|
|
// free component
|
|
if AutoFreePersistent then begin
|
|
try
|
|
OldClassName:=APersistent.ClassName;
|
|
APersistent.Free;
|
|
except
|
|
on E: Exception do begin
|
|
debugln('Warning: (lazarus) TCustomFormEditor.FindDefineProperty Error freeing ',
|
|
OldClassName,': ',E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
// cache defined properties
|
|
if (DefinePropertiesReader<>nil)
|
|
and (DefinePropertiesReader.DefinePropertyNames<>nil) then begin
|
|
CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
|
|
CacheItem.DefineProperties.Assign(DefinePropertiesReader.DefinePropertyNames);
|
|
debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Class=',APersistentClassName,
|
|
' DefineProps="',CacheItem.DefineProperties.Text,'"');
|
|
end;
|
|
DefinePropertiesReader.Free;
|
|
DefinePropertiesPersistent.Free;
|
|
end;
|
|
end else begin
|
|
debugln('Info: (lazarus) TCustomFormEditor.FindDefineProperty Persistent is NOT registered');
|
|
end;
|
|
//debugln('TCustomFormEditor.FindDefineProperty END APersistentClassName="',APersistentClassName,'" AncestorClassName="',AncestorClassName,'"');
|
|
end else begin
|
|
CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
|
|
end;
|
|
if CacheItem.DefineProperties<>nil then
|
|
IsDefined:=CacheItem.DefineProperties.IndexOf(Identifier)>=0;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RegisterDefineProperty(const APersistentClassName,
|
|
Identifier: string);
|
|
var
|
|
ANode: TAvlTreeNode;
|
|
CacheItem: TDefinePropertiesCacheItem;
|
|
begin
|
|
//DebugLn('TCustomFormEditor.RegisterDefineProperty ',APersistentClassName,' ',Identifier);
|
|
ANode:=FindDefinePropertyNode(APersistentClassName);
|
|
if ANode=nil then begin
|
|
CacheItem:=TDefinePropertiesCacheItem.Create;
|
|
CacheItem.PersistentClassname:=APersistentClassName;
|
|
FDefineProperties.Add(CacheItem);
|
|
end else begin
|
|
CacheItem:=TDefinePropertiesCacheItem(ANode.Data);
|
|
end;
|
|
if (CacheItem.DefineProperties=nil) then
|
|
CacheItem.DefineProperties:=TStringListUTF8Fast.Create;
|
|
if (CacheItem.DefineProperties.IndexOf(Identifier)<0) then
|
|
CacheItem.DefineProperties.Add(Identifier);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.RegisterStandardDefineProperties;
|
|
begin
|
|
if FStandardDefinePropertiesRegistered then exit;
|
|
FStandardDefinePropertiesRegistered:=true;
|
|
RegisterDefineProperty('TStrings','Strings');
|
|
end;
|
|
|
|
procedure TCustomFormEditor.JITListBeforeCreate(Sender: TObject;
|
|
Instance: TPersistent);
|
|
var
|
|
MediatorClass: TDesignerMediatorClass;
|
|
begin
|
|
if Instance is TComponent then begin
|
|
MediatorClass:=GetDesignerMediatorClass(TComponentClass(Instance.ClassType));
|
|
if MediatorClass<>nil then
|
|
MediatorClass.InitFormInstance(TComponent(Instance));
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.JITListException(Sender: TObject; E: Exception;
|
|
var Action: TModalResult);
|
|
var
|
|
List: TJITComponentList;
|
|
AnUnitInfo: TUnitInfo;
|
|
LFMFilename: String;
|
|
Msg: String;
|
|
begin
|
|
List:=TJITComponentList(Sender);
|
|
LFMFilename:='';
|
|
Msg:='';
|
|
DebugLn(['TCustomFormEditor.JITListException List.CurReadStreamClass=',DbgSName(List.CurReadStreamClass),' ',DbgSName(List.ContextObject)]);
|
|
if (List.CurReadStreamClass<>nil) and (Project1<>nil)
|
|
and (List.CurReadStreamClass.InheritsFrom(TComponent)) then begin
|
|
AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(List.CurReadStreamClass));
|
|
if AnUnitInfo<>nil then begin
|
|
LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
|
|
end;
|
|
end;
|
|
if (LFMFilename='') and (List.ContextObject is TUnitInfo) then begin
|
|
LFMFilename:=ChangeFileExt(TUnitInfo(List.ContextObject).Filename,'.lfm');
|
|
end;
|
|
if LFMFilename<>'' then
|
|
Msg:=Format(lisCFEInFile, [LFMFilename]) + LineEnding;
|
|
|
|
if List.CurReadErrorMsg<>'' then
|
|
Msg:=Msg+List.CurReadErrorMsg+LineEnding;
|
|
Msg+=E.Message;
|
|
IDEMessageDialog(lisCodeToolsDefsReadError, Msg, mtError, [mbCancel]);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.DesignerMenuItemClick(Sender: TObject);
|
|
var
|
|
CompEditor: TBaseComponentEditor;
|
|
MenuItem: TMenuItem;
|
|
CompClassName: String;
|
|
begin
|
|
if (Sender=nil) or (not (Sender is TMenuItem)) then exit;
|
|
MenuItem:=TMenuItem(Sender);
|
|
if (MenuItem.Count>0) or MenuItem.IsInMenuBar then exit;
|
|
|
|
CompEditor:=GetComponentEditor(TComponent(Sender));
|
|
if CompEditor=nil then exit;
|
|
CompClassName:=CompEditor.ClassName;
|
|
try
|
|
CompEditor.Edit;
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn('TCustomFormEditor.DesignerMenuItemClick ERROR on CompEditor.Edit: ',E.Message);
|
|
IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
|
|
Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
|
|
[CompClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
try
|
|
CompEditor.Free;
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn('TCustomFormEditor.DesignerMenuItemClick ERROR on CompEditor.Free: ',E.Message);
|
|
IDEMessageDialog(Format(lisErrorIn, [CompClassName]),
|
|
Format(lisCFETheComponentEditorOfClassHasCreatedTheError,
|
|
[CompClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.DesignerClassCanAppCreateForm(
|
|
AClass: TComponentClass; CheckInherited: boolean): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=false;
|
|
if AClass=nil then exit;
|
|
// check standard classes
|
|
if (AClass=TCustomForm) or (AClass=TDataModule) then
|
|
exit(true);
|
|
if CheckInherited and (AClass.InheritsFrom(TCustomForm) or AClass.InheritsFrom(TDataModule)) then
|
|
exit(true);
|
|
// check addons
|
|
Result:=FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0;
|
|
if CheckInherited then
|
|
begin
|
|
for i:=0 to FDesignerBaseClassesCanCreateForm.Count-1 do
|
|
if AClass.InheritsFrom(TComponentClass(FDesignerBaseClassesCanCreateForm[i])) then
|
|
exit(true);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SetDesignerBaseClassCanAppCreateForm(
|
|
AClass: TComponentClass; AValue: boolean);
|
|
begin
|
|
if AValue then
|
|
begin
|
|
if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0 then exit;
|
|
FDesignerBaseClassesCanCreateForm.Add(AClass);
|
|
end else begin
|
|
if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)<0 then exit;
|
|
FDesignerBaseClassesCanCreateForm.Remove(AClass);
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
|
|
begin
|
|
Result := FNonFormForms.FindKey(Pointer(LookupRoot),
|
|
@CompareLookupRootAndNonFormDesignerForm);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.JITListPropertyNotFound(Sender: TObject;
|
|
Reader: TReader; Instance: TPersistent; var PropName: string;
|
|
IsPath: boolean; var Handled, Skip: Boolean);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := PropertiesToSkip.IndexOf(Instance, PropName);
|
|
if Index >= 0 then
|
|
begin
|
|
Skip := True;
|
|
Handled := True;
|
|
end
|
|
else
|
|
DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName,
|
|
' Instance=',Instance.ClassName,' PropName="',PropName,
|
|
'" IsPath=',IsPath]);
|
|
end;
|
|
|
|
procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject;
|
|
AClass: TClass;
|
|
var Ancestors: TFPList;// list of TComponent
|
|
var BinStreams: TFPList;// list of TExtMemoryStream;
|
|
var Abort: boolean);
|
|
var
|
|
AnUnitInfo: TUnitInfo;
|
|
Ancestor: TComponent;
|
|
BinStream: TExtMemoryStream;
|
|
begin
|
|
Ancestors:=nil;
|
|
BinStreams:=nil;
|
|
if Project1=nil then exit;
|
|
if (AClass=nil) or (AClass=TComponent)
|
|
or (AClass=TForm) or (AClass=TCustomForm)
|
|
or (AClass=TDataModule)
|
|
or (not AClass.InheritsFrom(TComponent))
|
|
or (IndexOfDesignerBaseClass(TComponentClass(AClass))>=0) then begin
|
|
exit;
|
|
end;
|
|
AnUnitInfo:=Project1.UnitWithComponentClassName(AClass.ClassName);
|
|
//AnUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(AClass));
|
|
while AnUnitInfo<>nil do begin
|
|
{$IFDEF VerboseFormEditor}
|
|
DebugLn(['TCustomFormEditor.JITListFindAncestors FOUND ancestor ',DbgSName(AnUnitInfo.Component),', streaming ...']);
|
|
{$ENDIF}
|
|
Ancestor:=AnUnitInfo.Component;
|
|
BinStream:=nil;
|
|
if SaveUnitComponentToBinStream(AnUnitInfo,BinStream)<>mrOk then begin
|
|
Abort:=true;
|
|
exit;
|
|
end;
|
|
BinStream.Position:=0;
|
|
if Ancestors=nil then begin
|
|
Ancestors:=TFPList.Create;
|
|
BinStreams:=TFPList.Create;
|
|
end;
|
|
Ancestors.Add(Ancestor);
|
|
BinStreams.Add(BinStream);
|
|
AnUnitInfo:=AnUnitInfo.FindAncestorUnit;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.JITListFindClass(Sender: TObject; const VarName,
|
|
ComponentUnitName, ComponentClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
|
|
function FindRegisteredComp(const aClassName: string): TRegisteredComponent;
|
|
begin
|
|
Result:=IDEComponentPalette.FindRegComponent(aClassName);
|
|
if Result=nil then exit;
|
|
if Result.ComponentClass.InheritsFrom(TCustomFrame) then
|
|
begin
|
|
debugln(['TCustomFormEditor.JITListFindClass.FindRegisteredComp "',aClassName,'", ignoring registered TFrame descendant "',dbgsname(Result.ComponentClass),'"']);
|
|
exit(nil); // Nested TFrame
|
|
end;
|
|
end;
|
|
|
|
var
|
|
AnUnitInfo: TUnitInfo;
|
|
Component: TComponent;
|
|
RegComp: TRegisteredComponent;
|
|
JITList: TJITComponentList;
|
|
begin
|
|
//DebugLn(['TCustomFormEditor.JITListFindClass Var="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'"']);
|
|
|
|
JITList:=Sender as TJITComponentList;
|
|
//DebugLn(['TCustomFormEditor.JITListFindClass JITList.ContextObject=',DbgSName(JITList.ContextObject)]);
|
|
if JITList.ContextObject is TUnitInfo then begin
|
|
AnUnitInfo:=TUnitInfo(JITList.ContextObject);
|
|
{$IFDEF VerboseIDEAmbiguousClasses}
|
|
if AnUnitInfo.ComponentVarsToClasses<>nil then
|
|
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses.Count=',AnUnitInfo.ComponentVarsToClasses.Count])
|
|
else
|
|
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses=nil']);
|
|
{$ENDIF}
|
|
if (AnUnitInfo.ComponentVarsToClasses<>nil) and (VarName<>'') then
|
|
begin
|
|
ComponentClass:=TComponentClass(AnUnitInfo.ComponentVarsToClasses[VarName]);
|
|
if ComponentClass<>nil then
|
|
begin
|
|
// use a specific class for this variable
|
|
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Vars=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
|
|
exit;
|
|
end;
|
|
end;
|
|
{$IFDEF VerboseIDEAmbiguousClasses}
|
|
if AnUnitInfo.ComponentTypesToClasses<>nil then
|
|
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses.Count=',AnUnitInfo.ComponentTypesToClasses.Count])
|
|
else
|
|
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses=nil']);
|
|
{$ENDIF}
|
|
if AnUnitInfo.ComponentTypesToClasses<>nil then
|
|
begin
|
|
ComponentClass:=TComponentClass(AnUnitInfo.ComponentTypesToClasses[ComponentClassName]);
|
|
if ComponentClass<>nil then
|
|
begin
|
|
// use a specific class for this classname
|
|
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Classes=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// search in the registered components
|
|
RegComp:=nil;
|
|
if ComponentUnitName<>'' then
|
|
RegComp:=FindRegisteredComp(ComponentUnitName+'/'+ComponentClassName);
|
|
if RegComp=nil then
|
|
begin
|
|
// search without unitname in the registered components
|
|
RegComp:=FindRegisteredComp(ComponentClassName);
|
|
if (RegComp<>nil) and RegComp.HasAmbiguousClassName then
|
|
begin
|
|
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'". Found ambigious registered ComponentClass=',dbgsname(RegComp.ComponentClass)]);
|
|
// ToDo: ask user
|
|
end;
|
|
end;
|
|
if (RegComp<>nil) then
|
|
begin
|
|
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
|
|
ComponentClass:=RegComp.ComponentClass;
|
|
end else begin
|
|
// search in open and hidden designer forms (e.g. nested frames)
|
|
for TLazProjectFile(AnUnitInfo) in Project1.UnitsWithComponent do begin
|
|
Component:=AnUnitInfo.Component;
|
|
if CompareText(Component.ClassName,ComponentClassName)=0 then
|
|
begin
|
|
//DebugLn(['TCustomFormEditor.JITListFindClass found nested class '+DbgSName(Component)+' in unit '+AnUnitInfo.Filename]);
|
|
ComponentClass:=TComponentClass(Component.ClassType);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
//if ComponentClass=nil then
|
|
// DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Not Found'])
|
|
//else
|
|
// DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Found ',ComponentClass.UnitName,'/',ComponentClass.ClassName])
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDesignerBaseClasses(Index: integer): TComponentClass;
|
|
begin
|
|
Result:=TComponentClass(FDesignerBaseClasses[Index]);
|
|
end;
|
|
|
|
function TCustomFormEditor.GetStandardDesignerBaseClasses(Index: integer): TComponentClass;
|
|
begin
|
|
Result := CustomFormEditor.StandardDesignerBaseClasses[Index];
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass);
|
|
begin
|
|
CustomFormEditor.StandardDesignerBaseClasses[Index] := AValue;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.FrameCompGetCreationClass(Sender: TObject;
|
|
var NewComponentClass: TComponentClass);
|
|
begin
|
|
if Assigned(OnSelectFrame) then
|
|
OnSelectFrame(Sender,NewComponentClass);
|
|
end;
|
|
|
|
function TCustomFormEditor.CompTree_ParentAcceptsChild(aParent, aChild,
|
|
aLookupRoot: TPersistent): boolean;
|
|
begin
|
|
Result:=(aParent is TComponent)
|
|
and (aChild is TComponent)
|
|
and (aLookupRoot is TComponent)
|
|
and ParentAcceptsChild(TComponent(aParent),TComponent(aChild),TComponent(aLookupRoot));
|
|
end;
|
|
|
|
procedure TCustomFormEditor.CompTree_SetParent(aChild, aParent,
|
|
aLookupRoot: TPersistent);
|
|
var
|
|
Mediator: TDesignerMediator;
|
|
ChildComp, OldParent: TComponent;
|
|
begin
|
|
if not (aChild is TComponent) then exit;
|
|
if not (aParent is TComponent) then exit;
|
|
if not (aLookupRoot is TComponent) then exit;
|
|
Mediator:=GetDesignerMediatorByComponent(TComponent(aLookupRoot));
|
|
if Mediator<>nil then
|
|
begin
|
|
ChildComp:=TComponent(aChild);
|
|
OldParent:=ChildComp.GetParentComponent;
|
|
Mediator.ChangeParent(ChildComp,TComponent(aParent));
|
|
if ChildComp.GetParentComponent<>OldParent then
|
|
ObjectInspectorModified(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.PasWriterFindAncestor(Writer: TCompWriterPas;
|
|
aComponent: TComponent; const aName: string; var anAncestor,
|
|
aRootAncestor: TComponent);
|
|
var
|
|
C: TComponent;
|
|
begin
|
|
C:=GetAncestorInstance(aComponent);
|
|
if C=nil then exit;
|
|
anAncestor:=C;
|
|
if C.Owner=nil then
|
|
aRootAncestor:=C;
|
|
if Writer=nil then ;
|
|
if aName='' then ;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.PasWriterGetMethodName(Writer: TCompWriterPas;
|
|
Instance: TPersistent; PropInfo: PPropInfo; out Name: String);
|
|
var
|
|
aMethod: TMethod;
|
|
aJITMethod: TJITMethod;
|
|
begin
|
|
Name:='';
|
|
if Instance=nil then exit;
|
|
aMethod:=GetMethodProp(Instance,PropInfo);
|
|
if GetJITMethod(aMethod,aJITMethod) then
|
|
Name:=aJITMethod.TheMethodName;
|
|
if Writer=nil then ;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.PasWriterGetParentProperty(
|
|
Writer: TCompWriterPas; Component: TComponent; var PropName: string);
|
|
begin
|
|
if Component is TControl then
|
|
PropName:='Parent';
|
|
if Writer=nil then ;
|
|
end;
|
|
|
|
function TCustomFormEditor.OnPropHookGetAncestorInstProp(
|
|
const InstProp: TInstProp; out AncestorInstProp: TInstProp): boolean;
|
|
var
|
|
aComponent: TComponent;
|
|
begin
|
|
Result:=false;
|
|
if (InstProp.Instance=nil) or (InstProp.PropInfo=nil) then exit;
|
|
if InstProp.Instance is TComponent then begin
|
|
aComponent:=TComponent(InstProp.Instance);
|
|
AncestorInstProp.Instance:=GetAncestorInstance(aComponent);
|
|
if AncestorInstProp.Instance=nil then exit;
|
|
AncestorInstProp.PropInfo:=GetPropInfo(AncestorInstProp.Instance,InstProp.PropInfo^.Name);
|
|
if AncestorInstProp.PropInfo<>InstProp.PropInfo then exit;
|
|
Result:=true;
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetPropertyEditorHook: TPropertyEditorHook;
|
|
begin
|
|
Result:=GlobalDesignHook;
|
|
if Obj_Inspector<>nil then
|
|
Result:=Obj_Inspector.PropertyEditorHook;
|
|
end;
|
|
|
|
function TCustomFormEditor.FindDefinePropertyNode(
|
|
const APersistentClassName: string): TAvlTreeNode;
|
|
begin
|
|
if FDefineProperties=nil then
|
|
FDefineProperties:=TAvlTree.Create(TListSortCompare(@CompareDefPropCacheItems));
|
|
Result:=FDefineProperties.FindKey(PChar(APersistentClassName),
|
|
TListSortCompare(@ComparePersClassNameAndDefPropCacheItem));
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateUniqueComponentName(AComponent: TComponent): string;
|
|
begin
|
|
Result:='';
|
|
if (AComponent=nil) then exit;
|
|
Result:=AComponent.Name;
|
|
if (AComponent.Owner=nil) or (Result<>'') then exit;
|
|
Result:=CreateUniqueComponentName(AComponent.ClassName,AComponent.Owner);
|
|
end;
|
|
|
|
function TCustomFormEditor.CreateUniqueComponentName(const AClassName: string;
|
|
OwnerComponent: TComponent): string;
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
Result:=AClassName;
|
|
if (OwnerComponent=nil) or (Result='') then exit;
|
|
i:=1;
|
|
while true do begin
|
|
j:=OwnerComponent.ComponentCount-1;
|
|
Result:=ClassNameToComponentName(AClassName);
|
|
if Result[length(Result)] in ['0'..'9'] then
|
|
Result:=Result+'_';
|
|
Result:=Result+IntToStr(i);
|
|
while (j>=0)
|
|
and (CompareText(Result,OwnerComponent.Components[j].Name)<>0) do
|
|
dec(j);
|
|
if j<0 then exit;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
function TCustomFormEditor.TranslateKeyToDesignerCommand(Key: word; Shift: TShiftState): word;
|
|
begin
|
|
//debugln(['TCustomFormEditor.TranslateKeyToDesignerCommand ',DbgSName(TDesignerIDECommandForm),' ',Key,' ',dbgs(Shift)]);
|
|
Result:=EditorOpts.KeyMap.TranslateKey(Key,Shift,TDesignerIDECommandForm);
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass
|
|
): TComponent;
|
|
var
|
|
NewParent: TComponent;
|
|
Root: TPersistent;
|
|
Mediator: TDesignerMediator;
|
|
begin
|
|
Result:=nil;
|
|
// find selected component
|
|
if (FSelection = nil) or (FSelection.Count <= 0) then Exit;
|
|
NewParent:=TComponent(FSelection[0]);
|
|
//Debugln('TCustomFormEditor.GetDefaultComponentParent A:', DbgSName(NewParent));
|
|
if not (NewParent is TComponent) then exit;
|
|
if TypeClass<>nil then begin
|
|
if TypeClass.InheritsFrom(TControl) and (NewParent is TControl) then begin
|
|
// New TypeClass is a TControl and selected component is TControl =>
|
|
// use only a TWinControl as parent
|
|
while (NewParent<>nil) do begin
|
|
if (NewParent is TWinControl)
|
|
and (csAcceptsControls in TWinControl(NewParent).ControlStyle) then
|
|
break;
|
|
NewParent:=TControl(NewParent).Parent;
|
|
//Debugln('TCustomFormEditor.GetDefaultComponentParent B:', DbgSName(NewParent));
|
|
end;
|
|
end else begin
|
|
// New TypeClass or selected component is not a TControl =>
|
|
// use Root component as parent
|
|
Root:=GetLookupRootForComponent(NewParent);
|
|
if Root is TComponent then begin
|
|
Mediator:=GetDesignerMediatorByComponent(TComponent(Root));
|
|
if (Mediator<>nil) then begin
|
|
while (NewParent<>nil) do begin
|
|
if Mediator.ParentAcceptsChild(NewParent,TypeClass) then
|
|
break;
|
|
NewParent:=NewParent.GetParentComponent;
|
|
end;
|
|
if NewParent=nil then
|
|
NewParent:=TComponent(Root);
|
|
end else
|
|
NewParent:=TComponent(Root);
|
|
end;
|
|
end;
|
|
end;
|
|
Result:=NewParent;
|
|
end;
|
|
|
|
function TCustomFormEditor.GetDefaultComponentPosition(
|
|
TypeClass: TComponentClass; ParentComponent: TComponent; out X, Y: integer
|
|
): boolean;
|
|
var
|
|
i: Integer;
|
|
CurComponent: TComponent;
|
|
P: TPoint;
|
|
AForm: TNonFormProxyDesignerForm;
|
|
MinX: Integer;
|
|
MinY: Integer;
|
|
MaxX: Integer;
|
|
MaxY: Integer;
|
|
begin
|
|
Result:=true;
|
|
X:=10;
|
|
Y:=10;
|
|
if ParentComponent=nil then
|
|
ParentComponent:=GetDefaultComponentParent(TypeClass);
|
|
if (ParentComponent=nil) or (TypeClass=nil) then exit;
|
|
if (TypeClass.InheritsFrom(TControl)) then exit;
|
|
// a non visual component
|
|
// put it somewhere right or below the other non visual components
|
|
MinX:=-1;
|
|
MinY:=-1;
|
|
if (ParentComponent is TWinControl) then
|
|
begin
|
|
MaxX:=TWinControl(ParentComponent).ClientWidth-ComponentPaletteBtnWidth;
|
|
MaxY:=TWinControl(ParentComponent).ClientHeight-ComponentPaletteBtnHeight;
|
|
end else
|
|
begin
|
|
AForm:=FindNonFormForm(ParentComponent);
|
|
if AForm<>nil then begin
|
|
MaxX:=AForm.ClientWidth-ComponentPaletteBtnWidth;
|
|
MaxY:=AForm.ClientHeight-ComponentPaletteBtnHeight;
|
|
end else begin
|
|
MaxX:=300;
|
|
MaxY:=0;
|
|
end;
|
|
end;
|
|
// find top left most non visual component
|
|
for i:=0 to ParentComponent.ComponentCount-1 do begin
|
|
CurComponent:=ParentComponent.Components[i];
|
|
if ComponentIsNonVisual(CurComponent) then begin
|
|
P:=GetParentFormRelativeTopLeft(CurComponent);
|
|
if (P.X>=0) and (P.Y>=0) then begin
|
|
if (MinX<0) or (P.Y<MinY) or ((P.Y=MinY) and (P.X<MinX)) then begin
|
|
MinX:=P.X;
|
|
MinY:=P.Y;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if MinX<0 then begin
|
|
MinX:=10;
|
|
MinY:=10;
|
|
end;
|
|
// find a position without intersection
|
|
X:=MinX;
|
|
Y:=MinY;
|
|
//debugln('TCustomFormEditor.GetDefaultComponentPosition Min=',dbgs(MinX),',',dbgs(MinY));
|
|
i:=0;
|
|
while i<ParentComponent.ComponentCount do begin
|
|
CurComponent:=ParentComponent.Components[i];
|
|
inc(i);
|
|
if ComponentIsNonVisual(CurComponent) then begin
|
|
P:=GetParentFormRelativeTopLeft(CurComponent);
|
|
//debugln('TCustomFormEditor.GetDefaultComponentPosition ',dbgsName(CurComponent),' P=',dbgs(P));
|
|
if (P.X>=0) and (P.Y>=0) then begin
|
|
if (X+ComponentPaletteBtnWidth>=P.X)
|
|
and (X<=P.X+ComponentPaletteBtnWidth)
|
|
and (Y+ComponentPaletteBtnHeight>=P.Y)
|
|
and (Y<=P.Y+ComponentPaletteBtnHeight) then begin
|
|
// intersection found
|
|
// move position
|
|
inc(X,ComponentPaletteBtnWidth+2);
|
|
if X>MaxX then begin
|
|
inc(Y,ComponentPaletteBtnHeight+2);
|
|
X:=MinX;
|
|
end;
|
|
// restart intersection test
|
|
i:=0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
// keep it visible
|
|
if X>MaxX then X:=MaxX;
|
|
if Y>MaxY then Y:=MaxY;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.ObjectInspectorModified(Sender: TObject);
|
|
var
|
|
CustomForm: TCustomForm;
|
|
Instance: TPersistent;
|
|
begin
|
|
if (FSelection = nil)
|
|
or (FSelection.Count <= 0) then Exit;
|
|
|
|
Instance := FSelection[0];
|
|
CustomForm:=GetDesignerForm(Instance);
|
|
if (CustomForm<>nil) and (CustomForm.Designer<>nil) then
|
|
CustomForm.Designer.Modified;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg);
|
|
begin
|
|
if AnObjectInspector=FObj_Inspector then exit;
|
|
if FObj_Inspector<>nil then begin
|
|
FObj_Inspector.OnModified:=nil;
|
|
FObj_inspector.OnNodeGetImageIndex:= nil;
|
|
FObj_inspector.ComponentTree.OnParentAcceptsChild:=nil;
|
|
end;
|
|
|
|
FObj_Inspector:=AnObjectInspector;
|
|
|
|
if FObj_Inspector<>nil then begin
|
|
FObj_Inspector.OnModified:=@ObjectInspectorModified;
|
|
FObj_inspector.OnNodeGetImageIndex:= @DoOnNodeGetImageIndex;
|
|
FObj_inspector.ComponentTree.OnParentAcceptsChild:=@CompTree_ParentAcceptsChild;
|
|
FObj_inspector.ComponentTree.OnSetParent:=@CompTree_SetParent;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomFormEditor.DoOnNodeGetImageIndex(APersistent: TPersistent;
|
|
var AImageIndex: integer);
|
|
var
|
|
DesignerForm : TCustomForm;
|
|
Mediator: TDesignerMediator;
|
|
begin
|
|
DesignerForm := GetDesignerForm(APersistent);
|
|
|
|
// ask TMediator
|
|
if DesignerForm is BaseFormEditor1.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] then
|
|
begin
|
|
Mediator:=(DesignerForm as INonControlDesigner).Mediator;
|
|
if Mediator<>nil then
|
|
Mediator.GetObjInspNodeImageIndex(APersistent, AImageIndex);
|
|
end;
|
|
end;
|
|
|
|
{ TDefinePropertiesCacheItem }
|
|
|
|
destructor TDefinePropertiesCacheItem.Destroy;
|
|
begin
|
|
DefineProperties.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TDefinePropertiesReader }
|
|
|
|
procedure TDefinePropertiesReader.AddPropertyName(const Name: string);
|
|
begin
|
|
debugln('TDefinePropertiesReader.AddPropertyName Name="',Name,'"');
|
|
if FDefinePropertyNames=nil then
|
|
FDefinePropertyNames:=TStringListUTF8Fast.Create;
|
|
if FDefinePropertyNames.IndexOf(Name)<=0 then
|
|
FDefinePropertyNames.Add(Name);
|
|
end;
|
|
|
|
destructor TDefinePropertiesReader.Destroy;
|
|
begin
|
|
FDefinePropertyNames.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDefinePropertiesReader.DefineProperty(const Name: string;
|
|
ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
|
|
begin
|
|
AddPropertyName(Name);
|
|
end;
|
|
|
|
procedure TDefinePropertiesReader.DefineBinaryProperty(const Name: string;
|
|
ReadData, WriteData: TStreamProc; HasData: Boolean);
|
|
begin
|
|
AddPropertyName(Name);
|
|
end;
|
|
|
|
procedure TDefinePropertiesReader.FlushBuffer;
|
|
begin
|
|
|
|
end;
|
|
|
|
{ TDefinePropertiesPersistent }
|
|
|
|
constructor TDefinePropertiesPersistent.Create(TargetPersistent: TPersistent);
|
|
begin
|
|
FTarget:=TargetPersistent;
|
|
end;
|
|
|
|
procedure TDefinePropertiesPersistent.PublicDefineProperties(Filer: TFiler);
|
|
begin
|
|
//debugln('TDefinePropertiesPersistent.PublicDefineProperties START ',ClassName,' ',dbgsName(FTarget));
|
|
{$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
|
|
{$R-}
|
|
TDefinePropertiesPersistent(Target).DefineProperties(Filer);
|
|
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
|
//debugln('TDefinePropertiesPersistent.PublicDefineProperties END ',ClassName,' ',dbgsName(FTarget));
|
|
end;
|
|
|
|
type
|
|
TPersistentAccess = class(TPersistent);
|
|
|
|
function GetFormEditorLookupRoot(APersistent: TPersistent): TPersistent;
|
|
// called when a TPersistent does not have an owner
|
|
// Search in all designer forms
|
|
var
|
|
Checked: TFPList;
|
|
|
|
function GetOwner(Instance: TPersistent): TComponent;
|
|
var
|
|
CurOwner, NextOwner: TPersistent;
|
|
begin
|
|
Result:=nil;
|
|
if Instance=nil then exit;
|
|
CurOwner:=Instance;
|
|
repeat
|
|
if (CurOwner is TComponent) then begin
|
|
NextOwner := TComponent(CurOwner).Owner;
|
|
if NextOwner=nil then
|
|
exit(TComponent(CurOwner));
|
|
end else if CurOwner is TCollection then begin
|
|
NextOwner := TCollection(CurOwner).Owner;
|
|
end else if CurOwner is TCollectionItem then begin
|
|
NextOwner := TCollectionItem(CurOwner).Collection;
|
|
end else
|
|
NextOwner := TPersistentAccess(CurOwner).GetOwner;
|
|
if NextOwner=nil then break;
|
|
CurOwner:=NextOwner;
|
|
until false;
|
|
if CurOwner is TComponent then
|
|
Result:=TComponent(CurOwner);
|
|
end;
|
|
|
|
function Check(Root: TComponent; Instance: TPersistent): boolean;
|
|
var
|
|
PropList: PPropList;
|
|
PropInfo: PPropInfo;
|
|
Cnt, i: Integer;
|
|
Obj: TObject;
|
|
CurOwner: TComponent;
|
|
begin
|
|
if Checked.IndexOf(Instance)>=0 then exit(false);
|
|
Checked.Add(Instance);
|
|
|
|
CurOwner:=GetOwner(Instance);
|
|
if (CurOwner<>nil) and (CurOwner<>Root) then
|
|
begin
|
|
if BaseFormEditor1.IsJITComponent(CurOwner) then
|
|
begin
|
|
// this component is from another designer form
|
|
Root:=CurOwner;
|
|
end;
|
|
end;
|
|
|
|
// check all properties
|
|
Cnt:=GetPropList(Instance,PropList);
|
|
try
|
|
for i:=0 to Cnt-1 do
|
|
begin
|
|
PropInfo:=PropList^[i];
|
|
if PropInfo^.PropType^.Kind<>tkClass then continue;
|
|
Obj:=GetObjectProp(Instance,PropInfo,TPersistent);
|
|
if Obj=nil then continue;
|
|
if Obj=APersistent then
|
|
begin
|
|
// found
|
|
GetFormEditorLookupRoot:=Root;
|
|
exit(true);
|
|
end;
|
|
if Check(Root,TPersistent(Obj)) then
|
|
exit(true);
|
|
end;
|
|
finally
|
|
Freemem(PropList);
|
|
end;
|
|
|
|
Result:=false;
|
|
end;
|
|
|
|
var
|
|
i, j: Integer;
|
|
aDesigner: TIDesigner;
|
|
Root, CurOwner: TComponent;
|
|
begin
|
|
Result:=nil;
|
|
if APersistent=nil then exit;
|
|
if BaseFormEditor1=nil then exit;
|
|
|
|
// first a quick check for regular components:
|
|
CurOwner:=GetOwner(APersistent);
|
|
if CurOwner<>nil then
|
|
begin
|
|
if BaseFormEditor1.IsJITComponent(CurOwner) then
|
|
if CurOwner=APersistent then
|
|
exit(nil) // this is a LookupRoot
|
|
else
|
|
exit(CurOwner);
|
|
end;
|
|
|
|
{$IFNDEF EnableGetFormEditorLookupRoot}
|
|
exit;
|
|
{$ENDIF}
|
|
|
|
// then the slow search:
|
|
Checked:=TFPList.Create;
|
|
try
|
|
for i:=0 to BaseFormEditor1.DesignerCount-1 do
|
|
begin
|
|
aDesigner:=BaseFormEditor1.Designer[i];
|
|
if aDesigner=nil then continue;
|
|
Root:=aDesigner.LookupRoot;
|
|
if Check(Root,Root) then
|
|
exit;
|
|
for j:=0 to Root.ComponentCount-1 do
|
|
if Check(Root,Root.Components[j]) then
|
|
exit;
|
|
end;
|
|
finally
|
|
Checked.Free;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterStandardClasses;
|
|
RegisterGetLookupRoot(@GetFormEditorLookupRoot);
|
|
|
|
end.
|
|
|