paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 00:37:18 +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 IsOnClickStored: Boolean;
function IsShowHintStored: Boolean; function IsShowHintStored: Boolean;
function IsVisibleStored: Boolean; function IsVisibleStored: Boolean;
procedure CheckMenuPopup(const P: TSmallPoint); function CheckMenuPopup(const P: TSmallPoint): boolean;
procedure DoBeforeMouseMessage; procedure DoBeforeMouseMessage;
procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer); procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer);
procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton; procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
@ -2890,6 +2890,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.290 2005/03/25 16:41:00 micha
make DestroyHandle method protected again, use global RecreateWnd procedure make DestroyHandle method protected again, use global RecreateWnd procedure

19
lcl/include/control.inc
View File

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

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

@ -1094,6 +1094,7 @@ Begin
WM_RBUTTONUP: WM_RBUTTONUP:
Begin Begin
NotifyUserInput := True; NotifyUserInput := True;
WinProcess := false;
PLMsg:=@LMMouse; PLMsg:=@LMMouse;
With LMMouse Do With LMMouse Do
Begin Begin
@ -1317,9 +1318,9 @@ Begin
// respond to result of LCL handling the message // respond to result of LCL handling the message
case PLMsg^.Msg of case PLMsg^.Msg of
LM_ERASEBKGND, LM_SETCURSOR: LM_ERASEBKGND, LM_SETCURSOR, LM_RBUTTONUP:
begin begin
if LMessage.Result = 0 then if PLMsg^.Result = 0 then
WinProcess := true; WinProcess := true;
end; end;
@ -1520,6 +1521,9 @@ end;
{ {
$Log$ $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 Revision 1.195 2005/03/14 22:11:03 micha
return value too inconsistent to be used, fixes 775 (by uberto) return value too inconsistent to be used, fixes 775 (by uberto)