如何修复TScrollBar MouseWheel故障？ [英] How can I fix the TScrollBar MouseWheel malfunction?

问题描述

我有一个 TScrollBox TF里的，而当我使用鼠标滚轮时，它根本不会上升或下滑滚动滚动。

I have a TScrollBox inside of a TFrame and when I use my mouse's wheel it simply does not goes up nor down the ScrollBox scrolling.

我试图使用

TScrollBox(Sender).Perform(WM_VSCROLL,1,0); 

在 FrameMouseWheelDown 但不会触发

任何想法？

推荐答案

我的滚动框看起来像这样：

My scroll box looks like this:

type
  TMyScrollBox = class(TScrollBox)
  protected
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
    procedure WndProc(var Message: TMessage); override;
  end;

function TMyScrollBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  if not Result then begin
    if Shift*[ssShift..ssCtrl]=[] then begin
      VertScrollBar.Position := VertScrollBar.Position - WheelDelta;
      Result := True;
    end;
  end;
end;

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;

这篇关于如何修复TScrollBar MouseWheel故障？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！