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

IDEIntf: designer mediator: mouse events

Browse Source 
git-svn-id: trunk@21730 -
This commit is contained in:
mattias 2009-09-16 09:59:02 +00:00
parent 522164c337
commit 3d4e211dbf
3 changed files with 109 additions and 59 deletions

135
designer/designer.pp
View File

@ -138,7 +138,7 @@ type
MouseDownComponent: TComponent;
MouseDownSender: TComponent;
MouseDownPos: TPoint;
MouseDownClickCount: integer;
MouseDownShift: TShiftState;
MouseUpPos: TPoint;
LastMouseMovePos: TPoint;
PopupMenuComponentEditor: TBaseComponentEditor;
@ -158,6 +158,8 @@ type
procedure KeyDown(Sender: TControl; var TheMessage: TLMKEY);
procedure KeyUp(Sender: TControl; var TheMessage: TLMKEY);
function HandleSetCursor(var TheMessage: TLMessage): boolean;
procedure GetMouseMsgShift(TheMessage: TLMMouse; var Shift: TShiftState;
var Button: TMouseButton);
// procedures for working with components and persistents
function GetDesignControl(AControl: TControl): TControl;
@ -1253,6 +1255,45 @@ begin
end;
end;
procedure TDesigner.GetMouseMsgShift(TheMessage: TLMMouse;
var Shift: TShiftState; var Button: TMouseButton);
begin
Shift := [];
if (TheMessage.keys and MK_Shift) = MK_Shift then
Include(Shift,ssShift);
if (TheMessage.keys and MK_Control) = MK_Control then
Include(Shift,ssCtrl);
case TheMessage.Msg of
LM_LBUTTONUP,LM_LBUTTONDBLCLK,LM_LBUTTONTRIPLECLK,LM_LBUTTONQUADCLK:
begin
Include(Shift,ssLeft);
Button:=mbLeft;
end;
LM_MBUTTONUP,LM_MBUTTONDBLCLK,LM_MBUTTONTRIPLECLK,LM_MBUTTONQUADCLK:
begin
Include(Shift,ssMiddle);
Button:=mbMiddle;
end;
LM_RBUTTONUP,LM_RBUTTONDBLCLK,LM_RBUTTONTRIPLECLK,LM_RBUTTONQUADCLK:
begin
Include(Shift,ssRight);
Button:=mbRight;
end;
else
Button:=mbExtra1;
end;
case TheMessage.Msg of
LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK:
Include(Shift,ssDouble);
LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK:
Include(Shift,ssTriple);
LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK:
Include(Shift,ssQuad);
end;
end;
function TDesigner.GetDesignControl(AControl: TControl): TControl;
// checks if AControl is designable.
// if not check Owner.
@ -1313,6 +1354,8 @@ var
ParentForm: TCustomForm;
Shift: TShiftState;
DesignSender: TControl;
Button: TMouseButton;
Handled: Boolean;
begin
FHintTimer.Enabled := False;
Exclude(FFLags, dfHasSized);
@ -1342,28 +1385,8 @@ begin
end;
MouseDownSender := DesignSender;
case TheMessage.Msg of
LM_LBUTTONDOWN, LM_MBUTTONDOWN, LM_RBUTTONDOWN:
MouseDownClickCount := 1;
LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK:
MouseDownClickCount := 2;
LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK:
MouseDownClickCount := 3;
LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK:
MouseDownClickCount := 4;
else
MouseDownClickCount := 1;
end;
Shift := [];
if (TheMessage.keys and MK_Shift) = MK_Shift then
Include(Shift, ssShift);
if (TheMessage.keys and MK_Control) = MK_Control then
Include(Shift, ssCtrl);
GetMouseMsgShift(TheMessage,Shift,Button);
MouseDownShift:=Shift;
{$IFDEF VerboseDesigner}
DebugLn('************************************************************');
@ -1384,9 +1407,15 @@ begin
DebugLn(', No CTRL down');
{$ENDIF}
if Mediator<>nil then begin
Handled:=false;
Mediator.MouseDown(Button,Shift,MouseDownPos,Handled);
if Handled then exit;
end;
SelectedCompClass := GetSelectedComponentClass;
if (TheMessage.Keys and MK_LButton) > 0 then begin
if Button=mbLeft then begin
// left button
// -> check if a grabber was activated
ControlSelection.ActiveGrabber:=
@ -1460,6 +1489,7 @@ procedure TDesigner.MouseUpOnControl(Sender : TControl;
var
ParentCI, NewCI: TComponentInterface;
NewLeft, NewTop, NewWidth, NewHeight: Integer;
Button: TMouseButton;
Shift: TShiftState;
SenderParentForm: TCustomForm;
RubberBandWasActive: boolean;
@ -1468,28 +1498,6 @@ var
SelectionChanged, NewRubberbandSelection: boolean;
DesignSender: TControl;
procedure GetShift;
begin
Shift := [];
if (TheMessage.keys and MK_Shift) = MK_Shift then
Include(Shift,ssShift);
if (TheMessage.keys and MK_Control) = MK_Control then
Include(Shift,ssCtrl);
case TheMessage.Msg of
LM_LBUTTONUP: Include(Shift,ssLeft);
LM_MBUTTONUP: Include(Shift,ssMiddle);
LM_RBUTTONUP: Include(Shift,ssRight);
end;
if MouseDownClickCount=2 then
Include(Shift,ssDouble);
if MouseDownClickCount=3 then
Include(Shift,ssTriple);
if MouseDownClickCount=4 then
Include(Shift,ssQuad);
end;
procedure AddComponent;
var
NewParent: TComponent;
@ -1665,7 +1673,7 @@ var
begin
// select only the mouse down component
ControlSelection.AssignPersistent(MouseDownComponent);
if (MouseDownClickCount = 2) and (ControlSelection.SelectionForm = Form) then
if (ssDouble in MouseDownShift) and (ControlSelection.SelectionForm = Form) then
begin
// Double Click -> invoke 'Edit' of the component editor
FShiftState := Shift;
@ -1682,6 +1690,8 @@ var
end;
end;
var
Handled: Boolean;
Begin
FHintTimer.Enabled := False;
SetCaptureControl(nil);
@ -1705,7 +1715,7 @@ Begin
RubberBandWasActive:=ControlSelection.RubberBandActive;
SelectedCompClass:=GetSelectedComponentClass;
GetShift;
GetMouseMsgShift(TheMessage,Shift,Button);
MouseUpPos:=GetFormRelativeMousePosition(Form);
{$IFDEF VerboseDesigner}
@ -1716,7 +1726,13 @@ Begin
DebugLn('');
{$ENDIF}
if TheMessage.Msg=LM_LBUTTONUP then begin
if Mediator<>nil then begin
Handled:=false;
Mediator.MouseUp(Button,Shift,MouseUpPos,Handled);
if Handled then exit;
end;
if Button=mbLeft then begin
if SelectedCompClass = nil then begin
// layout mode (selection, moving and resizing)
if not (dfHasSized in FFlags) then begin
@ -1733,7 +1749,7 @@ Begin
// create new a component on the form
AddComponent;
end;
end else if TheMessage.Msg=LM_RBUTTONUP then begin
end else if Button=mbRight then begin
// right click -> popup menu
DisableRubberBand;
if EnvironmentOptions.RightClickSelects
@ -1763,6 +1779,7 @@ end;
procedure TDesigner.MouseMoveOnControl(Sender: TControl;
var TheMessage: TLMMouse);
var
Button: TMouseButton;
Shift : TShiftState;
SenderParentForm:TCustomForm;
OldMouseMovePos: TPoint;
@ -1771,13 +1788,15 @@ var
SelectedCompClass: TRegisteredComponent;
CurSnappedMousePos, OldSnappedMousePos: TPoint;
DesignSender: TControl;
Handled: Boolean;
begin
GetMouseMsgShift(TheMessage,Shift,Button);
if [dfShowEditorHints]*FFlags<>[] then begin
FHintTimer.Enabled := False;
// hide hint
FHintTimer.Enabled :=
(TheMessage.keys or (MK_LButton and MK_RButton and MK_MButton) = 0);
FHintTimer.Enabled := Shift*[ssLeft,ssRight,ssMiddle]=[];
if FHintWindow.Visible then
FHintWindow.Visible := False;
end;
@ -1792,6 +1811,12 @@ begin
if (OldMouseMovePos.X=LastMouseMovePos.X)
and (OldMouseMovePos.Y=LastMouseMovePos.Y) then exit;
if Mediator<>nil then begin
Handled:=false;
Mediator.MouseMove(Shift,LastMouseMovePos,Handled);
if Handled then exit;
end;
if ControlSelection.SelectionForm=Form then
Grabber:=ControlSelection.GrabberAtPos(
LastMouseMovePos.X, LastMouseMovePos.Y)
@ -1812,12 +1837,6 @@ begin
exit;
end;
Shift := [];
if (TheMessage.keys and MK_Shift) = MK_Shift then
Include(Shift,ssShift);
if (TheMessage.keys and MK_Control) = MK_Control then
Include(Shift,ssCtrl);
if (ControlSelection.SelectionForm=nil)
or (ControlSelection.SelectionForm=Form)
then begin

7
ideintf/docs/formeditingintf.xml
View File

@ -181,6 +181,13 @@ When you handled a key, set Key:=0.</descr>
<element name="TDesignerMediator.Root">
<short>The designed Root component.</short>
</element>
<element name="TDesignerMediator.MouseDown"/>
<element name="TDesignerMediator.MouseMove">
<short>Called by the IDE before it handles a mouse move message</short>
</element>
<element name="TDesignerMediator.MouseUp">
<short>Called by the IDE before it handles a mouse up message</short>
</element>
</module>
</package>
</fpdoc-descriptions>

26
ideintf/formeditingintf.pas
View File

@ -119,7 +119,6 @@ type
procedure GetClientArea(AComponent: TComponent; out CurClientArea: TRect;
out ScrollOffset: TPoint); virtual;
function GetComponentOriginOnForm(AComponent: TComponent): TPoint; virtual;
procedure Paint; virtual;
function ComponentIsIcon(AComponent: TComponent): boolean; virtual;
function ParentAcceptsChild(Parent: TComponent; Child: TComponentClass): boolean; virtual;
function ComponentIsVisible(AComponent: TComponent): Boolean; virtual;
@ -127,9 +126,16 @@ type
function ComponentAtPos(p: TPoint; MinClass: TComponentClass;
Flags: TDMCompAtPosFlags): TComponent; virtual;
procedure GetChilds(Parent: TComponent; ChildComponents: TFPList); virtual;
// events
procedure InitComponent(AComponent, NewParent: TComponent; NewBounds: TRect); virtual;
procedure Paint; virtual;
procedure KeyDown(Sender: TControl; var Key: word; Shift: TShiftState); virtual;
procedure KeyUp(Sender: TControl; var Key: word; Shift: TShiftState); virtual;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; p: TPoint; var Handled: boolean); virtual;
procedure MouseMove(Shift: TShiftState; p: TPoint; var Handled: boolean); virtual;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; p: TPoint; var Handled: boolean); virtual;
property LCLForm: TForm read FLCLForm write SetLCLForm;
property Designer: TComponentEditorDesigner read FDesigner write SetDesigner;
property Root: TComponent read FRoot write SetRoot;
@ -541,5 +547,23 @@ begin
end;
procedure TDesignerMediator.MouseDown(Button: TMouseButton; Shift: TShiftState;
p: TPoint; var Handled: boolean);
begin
end;
procedure TDesignerMediator.MouseMove(Shift: TShiftState; p: TPoint;
var Handled: boolean);
begin
end;
procedure TDesignerMediator.MouseUp(Button: TMouseButton; Shift: TShiftState;
p: TPoint; var Handled: boolean);
begin
end;
end.