paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 20:47:58 +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 OnClose;
property OnCloseQuery;
property OnContextPopup;
property OnCreate;
property OnDblClick;
property OnDeactivate;

48
lcl/include/control.inc
View File

@ -1773,7 +1773,6 @@ end;
procedure TControl.WMContextMenu(var Message: TLMMouse);
var
Control: TControl;
TempPopupMenu: TPopupMenu;
P2: TPoint;
Handled: Boolean;
@ -1788,23 +1787,15 @@ begin
Exit;
end;
Control := Self;
while Control <> nil do
TempPopupMenu := GetPopupMenu;
if (TempPopupMenu <> nil) then
begin
TempPopupMenu := Control.GetPopupMenu;
if (TempPopupMenu <> nil) then
begin
if not TempPopupMenu.AutoPopup then Exit;
// SendCancelMode(nil);
TempPopupMenu.PopupComponent := Control;
//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;
if not TempPopupMenu.AutoPopup then Exit;
TempPopupMenu.PopupComponent := Self;
P2 := ClientToScreen(P2);
TempPopupMenu.Popup(P2.X, P2.Y);
Message.Result:= 1;
Exit;
end;
end;
@ -2190,6 +2181,9 @@ end;
Mouse event handler
------------------------------------------------------------------------------}
procedure TControl.WMRButtonUp(var Message: TLMRButtonUp);
var
Control: TControl;
P: TPoint;
begin
DoBeforeMouseMessage;
if (csCaptureMouse in ControlStyle) and (mbRight in CaptureMouseButtons) then
@ -2199,9 +2193,23 @@ begin
{$ENDIF}
MouseCapture := False;
end;
Message.Result := Perform(LM_CONTEXTMENU,TLMessage(Message).WParam,
TLMessage(Message).LParam);
// VCL like behavior. we need to have a child-parent recursion
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
DoMouseUp(Message, mbRight);
end;