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

fix bug #659 and #660: LM_RBUTTONUP message returns true whenever popupmenu was invoked

Browse Source 
git-svn-id: trunk@7040 -
This commit is contained in:
micha 2005-03-30 18:34:42 +00:00
parent b93d3d7b64
commit 55c52e0e16
3 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -793,7 +793,7 @@ type
function IsOnClickStored: Boolean;
function IsShowHintStored: Boolean;
function IsVisibleStored: Boolean;
procedure CheckMenuPopup(const P: TSmallPoint);
function CheckMenuPopup(const P: TSmallPoint): boolean;
procedure DoBeforeMouseMessage;
procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer);
procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
@ -2890,6 +2890,9 @@ end.
{ =============================================================================
$Log$
Revision 1.291 2005/03/30 18:34:42 micha
fix bug 659 and 660: LM_RBUTTONUP message returns true whenever popupmenu was invoked
Revision 1.290 2005/03/25 16:41:00 micha
make DestroyHandle method protected again, use global RecreateWnd procedure

19
lcl/include/control.inc
View File

@ -443,20 +443,21 @@ end;
{------------------------------------------------------------------------------
TControl.CheckMenuPopup
returns whether was handled
------------------------------------------------------------------------------}
Procedure TControl.CheckMenuPopup(const P: TSmallPoint);
function TControl.CheckMenuPopup(const P: TSmallPoint): boolean;
var
Control: TControl;
TempPopupMenu: TPopupMenu;
P2: TPoint;
Handled: Boolean;
begin
Result:=false;
if csDesigning in ComponentState then Exit;
P2 := SmallPointToPoint(P);
Handled:=false;
DoContextPopup(P2,Handled);
if Handled then exit;
DoContextPopup(P2,Result);
if Result then exit;
Control := Self;
while Control <> nil do
@ -469,6 +470,7 @@ begin
TempPopupMenu.PopupComponent := Control;
P2 := ClientToScreen(P2);
TempPopupMenu.Popup(P2.X, P2.Y);
Result := true;
Exit;
end;
Control := Control.Parent;
@ -1772,7 +1774,9 @@ procedure TControl.WMRButtonUp(var Message: TLMRButtonUp);
begin
DoBeforeMouseMessage;
DoMouseUp(Message, mbRight);
if Message.Result = 0 then CheckMenuPopup(Message.pos);
if Message.Result = 0 then
if CheckMenuPopup(Message.pos) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------
@ -3500,6 +3504,9 @@ end;
{ =============================================================================
$Log$
Revision 1.253 2005/03/30 18:34:42 micha
fix bug 659 and 660: LM_RBUTTONUP message returns true whenever popupmenu was invoked
Revision 1.252 2005/03/19 08:55:32 mattias
updated french translation from Robert Calmas

10
lcl/interfaces/win32/win32callback.inc
View File

@ -1094,6 +1094,7 @@ Begin
WM_RBUTTONUP:
Begin
NotifyUserInput := True;
WinProcess := false;
PLMsg:=@LMMouse;
With LMMouse Do
Begin
@ -1317,9 +1318,9 @@ Begin
// respond to result of LCL handling the message
case PLMsg^.Msg of
LM_ERASEBKGND, LM_SETCURSOR:
LM_ERASEBKGND, LM_SETCURSOR, LM_RBUTTONUP:
begin
if LMessage.Result = 0 then
if PLMsg^.Result = 0 then
WinProcess := true;
end;
@ -1336,7 +1337,7 @@ Begin
WinProcess := LMKey.CharCode <> VK_UNKNOWN;
WParam := LMKey.CharCode;
end;
else
case Msg of
WM_NCDESTROY:
@ -1520,6 +1521,9 @@ end;
{
$Log$
Revision 1.196 2005/03/30 18:34:42 micha
fix bug 659 and 660: LM_RBUTTONUP message returns true whenever popupmenu was invoked
Revision 1.195 2005/03/14 22:11:03 micha
return value too inconsistent to be used, fixes 775 (by uberto)