diff --git a/designer/designer.pp b/designer/designer.pp index bb9164dddd..5f53e47523 100644 --- a/designer/designer.pp +++ b/designer/designer.pp @@ -41,7 +41,7 @@ uses InterfaceBase, Forms, Controls, GraphType, Graphics, Dialogs, ExtCtrls, Menus, ClipBrd, // IDEIntf - IDEDialogs, PropEdits, ComponentEditors, MenuIntf, IDEImagesIntf, + IDEDialogs, PropEdits, ComponentEditors, MenuIntf, IDEImagesIntf, FormEditingIntf, // IDE LazarusIDEStrConsts, EnvironmentOpts, IDECommands, ComponentReg, NonControlDesigner, FrameDesigner, AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, @@ -89,6 +89,7 @@ type FFlags: TDesignerFlags; FGridColor: TColor; FLookupRoot: TComponent; + FMediator: TDesignerMediator; FOnActivated: TNotifyEvent; FOnCloseQuery: TNotifyEvent; FOnPersistentDeleted: TOnPersistentDeleted; @@ -127,6 +128,7 @@ type procedure SetGridSizeX(const AValue: integer); procedure SetGridSizeY(const AValue: integer); procedure SetIsControl(Value: Boolean); + procedure SetMediator(const AValue: TDesignerMediator); procedure SetShowBorderSpacing(const AValue: boolean); procedure SetShowComponentCaptions(const AValue: boolean); procedure SetShowEditorHints(const AValue: boolean); @@ -283,6 +285,7 @@ type property GridColor: TColor read GetGridColor write SetGridColor; property IsControl: Boolean read GetIsControl write SetIsControl; property LookupRoot: TComponent read FLookupRoot; + property Mediator: TDesignerMediator read FMediator write SetMediator; property OnActivated: TNotifyEvent read FOnActivated write FOnActivated; property OnCloseQuery: TNotifyEvent read FOnCloseQuery write FOnCloseQuery; property OnPersistentDeleted: TOnPersistentDeleted @@ -519,6 +522,13 @@ end; destructor TDesigner.Destroy; Begin + try + FreeAndNil(FMediator); + except + on E: Exception do begin + debugln(['TDesigner.Destroy freeing mediator failed: ',E.Message]); + end; + end; FreeAndNil(DesignerPopupMenu); FreeAndNil(FHintWIndow); FreeAndNil(FHintTimer); @@ -2484,6 +2494,12 @@ begin end; +procedure TDesigner.SetMediator(const AValue: TDesignerMediator); +begin + if FMediator=AValue then exit; + FMediator:=AValue; +end; + procedure TDesigner.SetShowEditorHints(const AValue: boolean); begin if AValue=ShowEditorHints then exit; diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 21df85299e..dbd8c8014f 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -212,6 +212,16 @@ each control that's dropped onto the form function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo; var BinCompStream: TExtMemoryStream): TModalResult; + // 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; + // designers function DesignerCount: integer; override; function GetDesigner(Index: integer): TIDesigner; override; @@ -223,6 +233,7 @@ each control that's dropped onto the form 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; @@ -268,16 +279,6 @@ each control that's dropped onto the form function ComponentDependsOnClass(AComponent: TComponent; AClass: TComponentClass): Boolean; - // 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; - // define properties procedure FindDefineProperty(const APersistentClassName, AncestorClassName, Identifier: string; @@ -1514,12 +1515,16 @@ end; procedure TCustomFormEditor.RegisterDesignerMediator( MediatorClass: TDesignerMediatorClass); begin + if FDesignerMediatorClasses.IndexOf(MediatorClass)>=0 then + raise Exception.Create('TCustomFormEditor.RegisterDesignerMediator already registered: '+DbgSName(MediatorClass)); FDesignerMediatorClasses.Add(MediatorClass); + RegisterDesignerBaseClass(MediatorClass.FormClass); end; procedure TCustomFormEditor.UnregisterDesignerMediator( MediatorClass: TDesignerMediatorClass); begin + UnregisterDesignerBaseClass(MediatorClass.FormClass); FDesignerMediatorClasses.Remove(MediatorClass); end; @@ -1528,6 +1533,20 @@ 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; + end; +end; + function TCustomFormEditor.GetComponentEditor(AComponent: TComponent ): TBaseComponentEditor; var diff --git a/ide/main.pp b/ide/main.pp index 767706800d..7f90255a56 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -85,7 +85,7 @@ uses // help manager IDEContextHelpEdit, IDEHelpIntf, HelpManager, CodeHelp, HelpOptions, // designer - JITForms, ComponentPalette, ComponentList, ComponentReg, + JITForms, ComponentPalette, ComponentList, ComponentReg, FormEditingIntf, ObjInspExt, Designer, FormEditor, CustomFormEditor, ControlSelection, AnchorEditor, MenuEditorForm, @@ -3123,6 +3123,7 @@ end; procedure TMainIDE.CreateDesignerForComponent(AComponent: TComponent); var DesignerForm: TCustomForm; + MediatorClass: TDesignerMediatorClass; begin {$IFDEF IDE_DEBUG} writeln('[TMainIDE.CreateDesignerForComponent] A ',AComponent.Name,':',AComponent.ClassName); @@ -3132,6 +3133,11 @@ begin DesignerForm := TCustomForm(AComponent) else DesignerForm := FormEditor1.CreateNonFormForm(AComponent); + // set component and designer form into design mode (csDesigning) + SetDesigning(AComponent, True); + if AComponent <> DesignerForm then + SetDesigning(DesignerForm, True); + SetDesignInstance(AComponent, True); // create designer DesignerForm.Designer := TDesigner.Create(DesignerForm, TheControlSelection); {$IFDEF IDE_DEBUG} @@ -3158,12 +3164,11 @@ begin ShowEditorHints:=EnvironmentOptions.ShowEditorHints; ShowComponentCaptions := EnvironmentOptions.ShowComponentCaptions; end; - // set component and designer form into design mode (csDesigning) - SetDesigning(AComponent, True); - if AComponent <> DesignerForm then - SetDesigning(DesignerForm, True); - if (AComponent is TForm) or (AComponent is TFrame) or (AComponent is TDataModule) then - SetDesignInstance(AComponent, True); + + // finally: create the mediator, if needed + MediatorClass:=FormEditor1.GetDesignerMediatorClass(TComponentClass(AComponent.ClassType)); + if MediatorClass<>nil then + TDesigner(DesignerForm.Designer).Mediator:=MediatorClass.CreateMediator(AComponent); end; {------------------------------------------------------------------------------- diff --git a/ideintf/formeditingintf.pas b/ideintf/formeditingintf.pas index 7f2633f845..c185118971 100644 --- a/ideintf/formeditingintf.pas +++ b/ideintf/formeditingintf.pas @@ -89,12 +89,12 @@ type To edit designer forms which do not use the LCL register a TDesignerMediator, which will emulate the painting and handle the mouse. } - TDesignerMediator = class + TDesignerMediator = class(TInterfacedObject) public class function FormClass: TComponentClass; virtual; abstract; - class function CreateMediator(Form: TComponent): TDesignerMediator; virtual; abstract; + class function CreateMediator(aForm: TComponent): TDesignerMediator; virtual; abstract; end; - TDesignerMediatorClass = TDesignerMediator; + TDesignerMediatorClass = class of TDesignerMediator; { TAbstractFormEditor } @@ -150,6 +150,12 @@ type function GetDesignerByComponent(AComponent: TComponent ): TIDesigner; virtual; abstract; + // mediators for non LCL forms + procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; // auto calls RegisterDesignerBaseClass + procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; // auto calls UnregisterDesignerBaseClass + function DesignerMediatorCount: integer; virtual; abstract; + property DesignerMediators[Index: integer]: TDesignerMediatorClass read GetDesignerMediators; + // selection function SaveSelectionToStream(s: TStream): Boolean; virtual; abstract; function InsertFromStream(s: TStream; Parent: TWinControl; @@ -161,12 +167,6 @@ type function CutSelectionToClipboard: Boolean; virtual; abstract; function PasteSelectionFromClipboard(Flags: TComponentPasteSelectionFlags ): Boolean; virtual; abstract; - - // mediators for non LCL forms - procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; - procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; - function DesignerMediatorCount: integer; virtual; abstract; - property DesignerMediators[Index: integer]: TDesignerMediatorClass read GetDesignerMediators; end; type