paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 12:00:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: implemented registering designer mediators

Browse Source 
git-svn-id: trunk@21613 -
This commit is contained in:
mattias 2009-09-08 10:12:55 +00:00
parent 20cb5e028d
commit 8ad516451b
4 changed files with 67 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
designer/designer.pp
View File

@ -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;

39
ide/customformeditor.pp
View File

@ -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

19
ide/main.pp
View File

@ -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;
{-------------------------------------------------------------------------------

18
ideintf/formeditingintf.pas
View File

@ -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