CODEWITHSUNDEEP
windowsdelphizoomingmousewheelwindow-messages
Andreas Rejbrand
Andreas Rejbrand

Reputation: 108929

LButton-scroll registers as Ctrl-scroll if VCL control has a child control

It seems like a windowed VCL control registers LButton-scroll as Ctrl-scroll if the window has a windowed child control. At least this happens if the user is using a Logitech MX Master mouse.

Consider the following minimal example:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    procedure ZoomIn;
    procedure ZoomOut;
  public
  end;

implementation

{$R *.dfm}

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ssCtrl in Shift then
    ZoomOut;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ssCtrl in Shift then
    ZoomIn;
end;

procedure TForm1.ZoomIn;
begin
  Font.Size := Font.Size + 1;
end;

procedure TForm1.ZoomOut;
begin
  if Font.Size >= 6 then
    Font.Size := Font.Size - 1;
end;

end.

This allows me to zoom using Ctrl+wheel:

Screen recording of a zooming label.

Now, let's add a button to the form:

Screenshot of form with a button.

I can still zoom using Ctrl+wheel, but now the form is also zoom if I scroll the mouse wheel while having the left mouse button depressed:

Screen recording of zooming label

This is very annoying. Is there a known workaround for this?

Upvotes: 1

Views: 94

Answers (1)

Andreas Rejbrand
Andreas Rejbrand

Reputation: 108929

One obvious solution is simply not to use the apparently unreliable Shift parameter:

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if GetKeyState(VK_CONTROL) < 0 then
    ZoomOut;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if GetKeyState(VK_CONTROL) < 0 then
    ZoomIn;
end;

Upvotes: 0

Related Questions