lcl: fix LM_CONTEXTMENU handling - use another message structure (windows compatible). also hopefully fixes 64bit compilation (issue #0016000)

git-svn-id: trunk@24011 -

lcl/controls.pp

@@ -1076,7 +1076,7 @@ type
   protected
     // protected messages
     procedure WMCancelMode(var Message: TLMessage); message LM_CANCELMODE;
-    procedure WMContextMenu(var Message: TLMMouse); message LM_CONTEXTMENU;
+    procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU;
 
     procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
     procedure WMRButtonDown(var Message: TLMRButtonDown); message LM_RBUTTONDOWN;

lcl/include/control.inc

@@ -1771,7 +1771,7 @@ end;
   ContextMenu event handler
  ------------------------------------------------------------------------------}
 
-procedure TControl.WMContextMenu(var Message: TLMMouse);
+procedure TControl.WMContextMenu(var Message: TLMContextMenu);
 var
   TempPopupMenu: TPopupMenu;
   P2: TPoint;
@@ -1779,11 +1779,11 @@ var
 begin
   if (csDesigning in ComponentState) or (Message.Result <> 0) then Exit;
   P2 := SmallPointToPoint(Message.Pos);
-  Handled:=False;
-  DoContextPopup(P2,Handled);
+  Handled := False;
+  DoContextPopup(P2, Handled);
   if Handled then
   begin
-    Message.Result:=1;
+    Message.Result := 1;
     Exit;
   end;
 
@@ -1794,7 +1794,7 @@ begin
     TempPopupMenu.PopupComponent := Self;
     P2 := ClientToScreen(P2);
     TempPopupMenu.Popup(P2.X, P2.Y);
-    Message.Result:= 1;
+    Message.Result := 1;
     Exit;
   end;
 end;
@@ -2184,6 +2184,7 @@ procedure TControl.WMRButtonUp(var Message: TLMRButtonUp);
 var
   Control: TControl;
   P: TPoint;
+  ContextMenuMsg: TLMContextMenu;
 begin
   DoBeforeMouseMessage;
   if (csCaptureMouse in ControlStyle) and (mbRight in CaptureMouseButtons) then
@@ -2197,9 +2198,17 @@ begin
   // VCL like behavior. we need to have a child-parent recursion
   Control := Self;
   P := SmallPointToPoint(Message.Pos);
+  if InheritsFrom(TWinControl) then
+    ContextMenuMsg.hWnd := TWinControl(Self).Handle
+  else
+  if Parent <> nil then
+    ContextMenuMsg.hWnd := Parent.Handle
+  else
+    ContextMenuMsg.hWnd := 0;
   while (Control <> nil) and (Message.Result = 0) do
   begin
-    Message.Result := Control.Perform(LM_CONTEXTMENU, TLMessage(Message).lParam, LPARAM(PointToSmallPoint(P)));
+    ContextMenuMsg.Pos := PointToSmallPoint(P);
+    Message.Result := Control.Perform(LM_CONTEXTMENU, TLMessage(ContextMenuMsg).wParam, TLMessage(ContextMenuMsg).lParam);
     if Message.Result = 0 then
     begin
       with P, Control do

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -345,7 +345,7 @@ function CarbonCommon_ContextualMenuClick(ANextHandler: EventHandlerCallRef;
   AEvent: EventRef;
   AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
 var
-  Msg: TLMMouse;
+  Msg: TLMContextMenu;
   P: TPoint;
 begin
   {$IFDEF VerboseCommonEvent}
@@ -355,8 +355,9 @@ begin
 
   P := AWidget.GetMousePos;
 
-  FillChar(Msg, SizeOf(TLMMouse), 0);
+  FillChar(Msg, SizeOf(TLMContextMenu), 0);
   Msg.Msg := LM_CONTEXTMENU;
+  Msg.hWnd := HWND(AWidget)
   Msg.Pos.X := P.X;
   Msg.Pos.Y := P.Y;
   

lcl/interfaces/gtk2/gtk2widgetset.inc

@@ -117,13 +117,13 @@ end;
 
 function gtk2PopupMenuCB(Widget: PGtkWidget; data: gPointer): gboolean; cdecl;
 var
-  Msg: TLMMouse;
+  Msg: TLMContextMenu;
   x, y: gint;
 begin
   FillChar(Msg, SizeOf(Msg), #0);
 
   Msg.Msg := LM_CONTEXTMENU;
-  Msg.Keys := 0; // todo: true keystate
+  Msg.hWnd := HWND(Widget); // todo: true keystate
   gtk_widget_get_pointer(Widget, @x, @y);
 
   if x > Widget^.allocation.width then

lcl/interfaces/qt/qtwidgets.pas

@@ -2842,7 +2842,7 @@ end;
 
 procedure TQtWidget.SlotContextMenu(Sender: QObjectH; Event: QEventH); cdecl;
 var
-  Msg: TLMMouse;
+  Msg: TLMContextMenu;
   Modifiers: QtKeyboardModifiers;
   MousePos: TQtPoint;
   QtEdit: IQtEdit;
@@ -2888,7 +2888,7 @@ begin
   Modifiers := QInputEvent_modifiers(QInputEventH(Event));
 
   Msg.Msg := LM_CONTEXTMENU;
-  Msg.Keys := QtKeyModifiersToKeyState(Modifiers);
+  Msg.hWnd := HWND(Self);
   Msg.XPos := SmallInt(MousePos.X);
   Msg.YPos := SmallInt(MousePos.Y);
 

lcl/interfaces/win32/win32callback.inc

@@ -247,6 +247,7 @@ var
   LMKey: TLMKey; // used by WM_KEYDOWN WM_KEYUP
   LMChar: TLMChar; // used by WM_CHAR
   LMMouse: TLMMouse; // used by WM_LBUTTONDBLCLK
+  LMContextMenu: TLMContextMenu;
   LMMouseMove: TLMMouseMove; // used by WM_MOUSEMOVE
   LMMouseEvent: TLMMouseEvent; // used by WM_MOUSEWHEEL
   LMMove: TLMMove; // used by WM_MOVE
@@ -2009,19 +2010,20 @@ begin
     begin
       WinProcess := false;
       NotifyUserInput := True;
-      PLMsg:=@LMMouse;
-      with LMMouse do
+      PLMsg:=@LMContextMenu;
+      with LMContextMenu do
       begin
         Msg := LM_CONTEXTMENU;
         XPos := GET_X_LPARAM(LParam);
         YPos := GET_Y_LPARAM(LParam);
+        hWnd := Window;
         //Only keyboard triggered contextmenu (Shift-F10) should be sent to LCL
         //but calling default handler is necessary. This schema avoids parent recursion
         //and also keeps default popupmenu (TMemo)
         if XPos = -1 then
           Pos := GetClientCursorPos(Window)
         else
-          lWinControl:=nil; // make sure no message is sent to the LCL
+          lWinControl := nil; // make sure no message is sent to the LCL
         Result := 0;
       end;
     end;

lcl/lmessages.pp

@@ -861,6 +861,24 @@ type
     Result: LRESULT;
   end;
 
+  TLMContextMenu = record
+    Msg: Cardinal;
+    {$ifdef cpu64}
+    UnusedMsg: Cardinal;
+    {$endif}
+    hWnd: HWND;
+    case Integer of
+    0: (
+       XPos: Smallint;
+       YPos: Smallint
+       );
+    1: (
+       Pos: TSmallPoint;
+       );
+    2: (
+       Dummy: LPARAM; // needed for64 bit alignment
+       Result: LResult);
+  end;
 
 { Combo Box Notification Codes }