Delphi 从鼠标滚轮捕获垂直和水平滚动

我需要在我的应用程序中捕获鼠标滚轮事件，以便像现代UI一样移动视图区域，因为我的应用程序将主要在笔记本电脑上运行

我查看了Windows消息，显然只有继承自

TWinControl

的控件才能接收鼠标滚轮消息

我正在使用

TApplicationEvents

，它也可以捕获那些Mesagge。我尝试处理

WM_mouseweel

消息，但它只适用于垂直滚动。我还尝试过处理

WM\u HSCROLL

和

WM\u HSCROLL剪贴板

消息，但它们根本没有被捕获

---

如何捕获垂直和水平鼠标滚轮消息并在我的软件中使用它们？

您只需响应

WM\u鼠标滚轮

消息即可。例如，下面是我的一个类的摘录，它将水平鼠标滚轮滚动添加到滚动框中：

procedure TMyScrollBox.WndProc(var Message: TMessage);
begin
  if Message.Msg=WM_MOUSEHWHEEL then begin
    (* For some reason using a message handler for WM_MOUSEHWHEEL doesn't work.
       The messages don't always arrive. It seems to occur when both scroll bars 
       are active. Strangely, if we handle the message here, then the messages 
       all get through. Go figure! *)
    if TWMMouseWheel(Message).Keys=0 then begin
      HorzScrollBar.Position := HorzScrollBar.Position 
        + TWMMouseWheel(Message).WheelDelta;
      Message.Result := 0;
    end else begin
      Message.Result := 1;
    end;
  end else begin
    inherited;
  end;
end;

---

您只需响应

WM_mouseheel

消息即可。例如，下面是我的一个类的摘录，它将水平鼠标滚轮滚动添加到滚动框中：

procedure TMyScrollBox.WndProc(var Message: TMessage);
begin
  if Message.Msg=WM_MOUSEHWHEEL then begin
    (* For some reason using a message handler for WM_MOUSEHWHEEL doesn't work.
       The messages don't always arrive. It seems to occur when both scroll bars 
       are active. Strangely, if we handle the message here, then the messages 
       all get through. Go figure! *)
    if TWMMouseWheel(Message).Keys=0 then begin
      HorzScrollBar.Position := HorzScrollBar.Position 
        + TWMMouseWheel(Message).WheelDelta;
      Message.Result := 0;
    end else begin
      Message.Result := 1;
    end;
  end else begin
    inherited;
  end;
end;

---

首先，您需要处理消息WM\u mouseheel

请注意，字母“H”在那里（WM_鼠标H轮）

我添加了一个TApplicationEvent组件，并添加了以下代码 到OnMessage事件：

uses VCL.Controls;

.....

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  var ctrl: TWinControl;
begin
  ctrl := FindVCLWindow(Mouse.CursorPos); //first I need to find the control under the mouse

  if ctrl is T3DWorldViewerComponent then //then I need to make sure
                                          //that the control under the mouse
                                          //is the 3D World Viewer contains my graphics

    if msg.message = WM_MOUSEHWHEEL then //then I need to make sure that I want to scroll Horizontally
    begin
      if msg.wParam=4287102976 then //this indicates that I'm scrolling to the left
        world.CameraMoveTo(MyCamera.Position.X+0.03, MyCamera.Position.Y, MyCamera.Position.Z)
      else
      if msg.wParam=7864320 then //and this indicates that I'm scrolling to the right
        world.CameraMoveTo(MyCamera.Position.X-0.03, MyCamera.Position.Y, MyCamera.Position.Z);
  end;
end;

---

完成了

首先，您需要处理消息WM\u mouseheel

请注意，字母“H”在那里（WM_鼠标H轮）

我添加了一个TApplicationEvent组件，并添加了以下代码 到OnMessage事件：

uses VCL.Controls;

.....

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  var ctrl: TWinControl;
begin
  ctrl := FindVCLWindow(Mouse.CursorPos); //first I need to find the control under the mouse

  if ctrl is T3DWorldViewerComponent then //then I need to make sure
                                          //that the control under the mouse
                                          //is the 3D World Viewer contains my graphics

    if msg.message = WM_MOUSEHWHEEL then //then I need to make sure that I want to scroll Horizontally
    begin
      if msg.wParam=4287102976 then //this indicates that I'm scrolling to the left
        world.CameraMoveTo(MyCamera.Position.X+0.03, MyCamera.Position.Y, MyCamera.Position.Z)
      else
      if msg.wParam=7864320 then //and this indicates that I'm scrolling to the right
        world.CameraMoveTo(MyCamera.Position.X-0.03, MyCamera.Position.Y, MyCamera.Position.Z);
  end;
end;

---

完成了

处理呢？@LURD我也在看。刚刚结束回答。处理如何？@LURD我也在看这个。我只是在总结一个答案，这是不对的。您当然不应该为每个输入事件调用

Mouse.CursorPos

和

FindVCLWindow

。这是一个巨大的性能打击。然后，您根本不应该调用

Mouse.CursorPos

，因为它是异步的。您更希望在生成输入事件时使用

GetMessagePos

获取鼠标位置。至少你需要在一开始就测试

WM_mouseheel

。只需将

WM_mouseheel

的处理程序添加到控件中可能会容易得多。好的。我必须在我的软件中改变这一点。谢谢David提供的信息。但是在这种情况下，您不会使用GetMessagePos。lParam值具有坐标。是的，关于wParam，我不知道如何解释它。你有一些信息给我吗？如果你按照我的答案做了WndProc覆盖，你可以按照我在答案中显示的方式进行转换。该记录允许您分离参数。否则，您可以从文档中计算出来。我想我已经给了你一个像样的答案。我不知道你的答案是什么。它有很多问题，这是不对的。您当然不应该为每个输入事件调用

Mouse.CursorPos

和

FindVCLWindow

。这是一个巨大的性能打击。然后，您根本不应该调用

Mouse.CursorPos

，因为它是异步的。您更希望在生成输入事件时使用

GetMessagePos

获取鼠标位置。至少你需要在一开始就测试

WM_mouseheel

。只需将

WM_mouseheel

的处理程序添加到控件中可能会容易得多。好的。我必须在我的软件中改变这一点。谢谢David提供的信息。但是在这种情况下，您不会使用GetMessagePos。lParam值具有坐标。是的，关于wParam，我不知道如何解释它。你有一些信息给我吗？如果你按照我的答案做了WndProc覆盖，你可以按照我在答案中显示的方式进行转换。该记录允许您分离参数。否则，您可以从文档中计算出来。我想我已经给了你一个像样的答案。我不知道你的答案是什么。它有很多问题。