Recent

Author Topic: Capture right mouse button click with qualifier pressed  (Read 2481 times)

Pascal

  • Hero Member
  • *****
  • Posts: 932
Capture right mouse button click with qualifier pressed
« on: December 12, 2017, 08:01:22 am »
What would be the best way to capture a right mouse button click with a pressed qualifier (shift, ctrl, alt)
and prevent invoking popup menu.
So the popup should only be opened when no qualifier is pressed.
I would like to do this for a TPanel and all of it's childs.

For my COBOL IDE if've managed to do this but it's more a hack than a real solution. Is there
a general way to not invoke the popup when a qualifier is pressed?

This only needs to be a windows solution.

Regards
Pascal
laz trunk x64 - fpc trunk i386 (cross x64) - Windows 10 Pro x64 (21H2)

balazsszekely

  • Guest
Re: Capture right mouse button click with qualifier pressed
« Reply #1 on: December 12, 2017, 08:15:37 am »
Hi Pacal,

Don't assign by default a PopUp menu to the panel, then on MouseDown:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  2.   Shift: TShiftState; X, Y: Integer);
  3. var
  4.   P: TPoint;
  5. begin
  6.   if ssShift in Shift then  //check other qualifier too
  7.     Exit;
  8.   P.X := X;
  9.   P.Y := Y;
  10.   P := Panel1.ClientToScreen(P);
  11.   PopupMenu1.PopUp(P.X, P.Y);
  12. end;
  13.  

regards,
GetMem

Mr.Madguy

  • Hero Member
  • *****
  • Posts: 844
Re: Capture right mouse button click with qualifier pressed
« Reply #2 on: December 12, 2017, 08:33:19 am »
High level solution is something like this:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   Menus, Types;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     MenuItem1: TMenuItem;
  17.     MyItem1: TMenuItem;
  18.     Panel1: TPanel;
  19.     PopupMenu1: TPopupMenu;
  20.     procedure Panel1ContextPopup(Sender: TObject; MousePos: TPoint;
  21.       var Handled: Boolean);
  22.     procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  23.       Shift: TShiftState; X, Y: Integer);
  24.   private
  25.     { private declarations }
  26.   public
  27.     { public declarations }
  28.     DontShowPopup:Boolean;
  29.   end;
  30.  
  31. var
  32.   Form1: TForm1;
  33.  
  34. implementation
  35.  
  36. {$R *.lfm}
  37.  
  38. { TForm1 }
  39.  
  40. procedure TForm1.Panel1ContextPopup(Sender: TObject; MousePos: TPoint;
  41.   var Handled: Boolean);
  42. begin
  43.   Handled := DontShowPopup;
  44.   DontShowPopup := False;
  45. end;
  46.  
  47. procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  48.   Shift: TShiftState; X, Y: Integer);
  49. begin
  50.   DontShowPopup := (Button = mbRight) and (ssCtrl in Shift);
  51. end;
  52.  
  53. end.
  54.  

Low level solution would require capturing WM_RBUTTONUP message, as according to MSDN WM_CONTEXTMENU is generated there.
Is it healthy for project not to have regular stable releases?
Just for fun: Code::Blocks, GCC 13 and DOS - is it possible?

Pascal

  • Hero Member
  • *****
  • Posts: 932
Re: Capture right mouse button click with qualifier pressed
« Reply #3 on: December 12, 2017, 09:11:57 am »
Many thanks,

Good ideas! I will try them in i new, refactored version of my COBOL IDE.
laz trunk x64 - fpc trunk i386 (cross x64) - Windows 10 Pro x64 (21H2)

zoltanleo

  • Sr. Member
  • ****
  • Posts: 486
Re: Capture right mouse button click with qualifier pressed
« Reply #4 on: December 13, 2017, 01:43:25 pm »
@Pascal

Code: Pascal  [Select][+][-]
  1. uses
  2. ... , LCLType ...
  3.  
  4. TForm1 = class(TForm)
  5.   AppProp: TApplicationProperties;
  6. ...
  7.  
  8. procedure TForm1.FormCreate(Sender: TObject);
  9. begin  
  10. ...
  11.   KeyPreview:= True;
  12. end;
  13.  
  14. procedure TForm1.AppPropUserInput(Sender: TObject; Msg: Cardinal);
  15. var
  16.   WC: TWinControl;
  17. begin
  18.   WC:= FindLCLWindow(Mouse.CursorPos);
  19.  
  20.   if not Assigned(WC) then Exit;
  21. ...
  22.   case Msg of
  23.     LM_RBUTTONDOWN:
  24.         DontShowPopup:= ((WC.Name = 'MyPanel') or (WC.Parent = MyPanel))
  25.           and ((GetKeyState(VK_CONTROL) < 0) or (GetKeyState(VK_MENU) < 0) or (GetKeyState(VK_SHIFT) < 0));  
  26. ...
« Last Edit: December 13, 2017, 01:51:53 pm by zoltanleo »
Win10 LTSC x64/Deb 11 amd64(gtk2/qt5)/Darwin Cocoa (Monterey):
Lazarus x32/x64 2.3(trunk); FPC 3.3.1 (trunk), FireBird 3.0.10; IBX by TonyW

Sorry for my bad English, I'm using translator ;)

 

TinyPortal © 2005-2018