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

lcl: rework LM_CONTEXTPOPUP - recursively call it on right mouse button up (issue #0015709)

Browse Source 
git-svn-id: trunk@24005 -
This commit is contained in:
paul 2010-03-15 07:56:44 +00:00
parent b67e10007a
commit e513f0292c
2 changed files with 29 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -710,6 +710,7 @@ type
property OnClick; property OnClick;
property OnClose; property OnClose;
property OnCloseQuery; property OnCloseQuery;
property OnContextPopup;
property OnCreate; property OnCreate;
property OnDblClick; property OnDblClick;
property OnDeactivate; property OnDeactivate;

48
lcl/include/control.inc
View File

@ -1773,7 +1773,6 @@ end;
procedure TControl.WMContextMenu(var Message: TLMMouse); procedure TControl.WMContextMenu(var Message: TLMMouse);
var var
Control: TControl;
TempPopupMenu: TPopupMenu; TempPopupMenu: TPopupMenu;
P2: TPoint; P2: TPoint;
Handled: Boolean; Handled: Boolean;
@ -1788,23 +1787,15 @@ begin
Exit; Exit;
end; end;
Control := Self; TempPopupMenu := GetPopupMenu;
while Control <> nil do if (TempPopupMenu <> nil) then
begin begin
TempPopupMenu := Control.GetPopupMenu; if not TempPopupMenu.AutoPopup then Exit;
if (TempPopupMenu <> nil) then TempPopupMenu.PopupComponent := Self;
begin P2 := ClientToScreen(P2);
if not TempPopupMenu.AutoPopup then Exit; TempPopupMenu.Popup(P2.X, P2.Y);
// SendCancelMode(nil); Message.Result:= 1;
TempPopupMenu.PopupComponent := Control; Exit;
//DebugLn(['TControl.WMContextMenu ',DbgSName(Self),' Message.pos=',dbgs(P2)]);
P2 := ClientToScreen(P2);
//DebugLn(['TControl.WMContextMenu ',DbgSName(Self),' P2=',dbgs(P2)]);
TempPopupMenu.Popup(P2.X, P2.Y);
Message.Result:= 1;
Exit;
end;
Control := Control.Parent;
end; end;
end; end;
@ -2190,6 +2181,9 @@ end;
Mouse event handler Mouse event handler
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TControl.WMRButtonUp(var Message: TLMRButtonUp); procedure TControl.WMRButtonUp(var Message: TLMRButtonUp);
var
Control: TControl;
P: TPoint;
begin begin
DoBeforeMouseMessage; DoBeforeMouseMessage;
if (csCaptureMouse in ControlStyle) and (mbRight in CaptureMouseButtons) then if (csCaptureMouse in ControlStyle) and (mbRight in CaptureMouseButtons) then
@ -2199,9 +2193,23 @@ begin
{$ENDIF} {$ENDIF}
MouseCapture := False; MouseCapture := False;
end; end;
Message.Result := Perform(LM_CONTEXTMENU,TLMessage(Message).WParam, // VCL like behavior. we need to have a child-parent recursion
TLMessage(Message).LParam); Control := Self;
P := SmallPointToPoint(Message.Pos);
while (Control <> nil) and (Message.Result = 0) do
begin
Message.Result := Control.Perform(LM_CONTEXTMENU, TLMessage(Message).lParam, LPARAM(PointToSmallPoint(P)));
if Message.Result = 0 then
begin
with P, Control do
begin
X := X + Left;
Y := Y + Top;
end;
Control := Control.Parent;
end;
end;
//MouseUp event is independent of return values of contextmenu //MouseUp event is independent of return values of contextmenu
DoMouseUp(Message, mbRight); DoMouseUp(Message, mbRight);
end; end;