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

IDEIntf: form designer: added AddClicked hook, called whenever the user selected a component class and clicked on the designer to add a new component

Browse Source 
git-svn-id: trunk@44335 -
This commit is contained in:
mattias 2014-03-03 20:03:24 +00:00
parent ca052fe4aa
commit 02b09d18e6
2 changed files with 67 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
components/ideintf/propedits.pp
View File

@ -1165,6 +1165,11 @@ type
TPropHookGetComponentNames = procedure(TypeData: PTypeData;
Proc: TGetStrProc) of object;
TPropHookGetRootClassName = function:ShortString of object;
TPropHookAddClicked = function(ADesigner: TIDesigner;
MouseDownComponent: TComponent; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer;
var AComponentClass: TComponentClass;
var NewParent: TComponent): boolean of object;
TPropHookBeforeAddPersistent = function(Sender: TObject;
APersistentClass: TPersistentClass;
Parent: TPersistent): boolean of object;
@ -1210,6 +1215,7 @@ type
htGetComponentName,
htGetComponentNames,
htGetRootClassName,
htAddClicked, // user selected a component class and clicked on a form to add a component
htComponentRenamed,
// persistent selection
htBeforeAddPersistent,
@ -1273,6 +1279,11 @@ type
function GetComponentName(AComponent: TComponent): ShortString;
procedure GetComponentNames(TypeData: PTypeData; const Proc: TGetStrProc);
function GetRootClassName: ShortString;
function AddClicked(ADesigner: TIDesigner;
MouseDownComponent: TComponent; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer;
var AComponentClass: TComponentClass;
var NewParent: TComponent): boolean;
function BeforeAddPersistent(Sender: TObject;
APersistentClass: TPersistentClass;
Parent: TPersistent): boolean;
@ -1354,6 +1365,8 @@ type
const OnGetComponentNames: TPropHookGetComponentNames);
procedure RemoveHandlerGetComponentNames(
const OnGetComponentNames: TPropHookGetComponentNames);
procedure AddHandlerAddClicked(const Handler: TPropHookAddClicked);
procedure RemoveHandlerAddClicked(const Handler: TPropHookAddClicked);
procedure AddHandlerGetRootClassName(
const OnGetRootClassName: TPropHookGetRootClassName);
procedure RemoveHandlerGetRootClassName(
@ -5503,6 +5516,27 @@ begin
Result := LookupRoot.ClassName;
end;
function TPropertyEditorHook.AddClicked(ADesigner: TIDesigner;
MouseDownComponent: TComponent; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer; var AComponentClass: TComponentClass; var NewParent: TComponent
): boolean;
var
i: Integer;
Handler: TPropHookAddClicked;
begin
i := GetHandlerCount(htAddClicked);
while GetNextHandlerIndex(htAddClicked, i) do
begin
Handler := TPropHookAddClicked(FHandlers[htAddClicked][i]);
Result := Handler(ADesigner,MouseDownComponent,Button,Shift,X,Y,
AComponentClass,NewParent);
if not Result then exit;
if AComponentClass=nil then
exit(false);
end;
Result := True;
end;
function TPropertyEditorHook.BeforeAddPersistent(Sender: TObject;
APersistentClass: TPersistentClass; Parent: TPersistent): boolean;
var
@ -5950,6 +5984,18 @@ begin
RemoveHandler(htGetComponentNames,TMethod(OnGetComponentNames));
end;
procedure TPropertyEditorHook.AddHandlerAddClicked(
const Handler: TPropHookAddClicked);
begin
AddHandler(htAddClicked,TMethod(Handler));
end;
procedure TPropertyEditorHook.RemoveHandlerAddClicked(
const Handler: TPropHookAddClicked);
begin
RemoveHandler(htAddClicked,TMethod(Handler));
end;
procedure TPropertyEditorHook.AddHandlerGetRootClassName(
const OnGetRootClassName: TPropHookGetRootClassName);
begin

28
designer/designer.pp
View File

@ -2190,9 +2190,13 @@ var
//debugln(['AddComponent NewComponentClass=',DbgSName(NewComponentClass)]);
// find a parent for the new component
NewParent := FLookupRoot;
NewParent:=nil;
PropertyEditorHook.AddClicked(Self,MouseDownComponent,Button,Shift,
MouseUpPos.X,MouseUpPos.Y,NewComponentClass,NewParent);
if Mediator<>nil then begin
NewParent:=MouseDownComponent;
// mediator, non LCL components
if NewParent=nil then
NewParent:=MouseDownComponent;
while (NewParent<>nil)
and (not Mediator.ParentAcceptsChild(NewParent,NewComponentClass)) do
NewParent:=NewParent.GetParentComponent;
@ -2200,7 +2204,14 @@ var
NewParent:=FLookupRoot;
end else if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame)
then begin
if MouseDownComponent is TWinControl then
// LCL controls
if NewParent<>nil then begin
if not (NewParent is TWinControl) then begin
debugln(['ERROR: AddComponent failed: AddClicked returned not a TWinControl: ',DbgSName(NewParent)]);
exit;
end;
NewParentControl := TWinControl(NewParent);
end else if MouseDownComponent is TWinControl then
NewParentControl := TWinControl(MouseDownComponent)
else
NewParentControl := WinControlAtPos(MouseUpPos.X, MouseUpPos.Y, true, true);
@ -2212,14 +2223,17 @@ var
NewParentControl := NewParentControl.Parent;
NewParent := NewParentControl;
//debugln(['AddComponent NewParent=',DbgSName(NewParent)]);
end else begin
// TDataModule
NewParent := FLookupRoot;
end;
if not Assigned(NewParent) then exit;
if not PropertyEditorHook.BeforeAddPersistent(Self,
SelectedCompClass.ComponentClass,NewParent)
NewComponentClass,NewParent)
then begin
DebugLn('TDesigner.AddComponent ',
SelectedCompClass.ComponentClass.ClassName,' not possible');
DebugLn('Note: TDesigner.AddComponent BeforeAddPersistent failed: ComponentClass=',
NewComponentClass.ClassName,' NewParent=',DbgSName(NewParent));
exit;
end;
@ -2232,7 +2246,7 @@ var
// adjust left,top to parent origin
dec(NewLeft,ParentClientOrigin.X);
dec(NewTop,ParentClientOrigin.Y);
end else if SelectedCompClass.ComponentClass.InheritsFrom(TControl) then
end else if NewComponentClass.InheritsFrom(TControl) then
begin
ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent);
// adjust left,top to parent origin