如何修复TScrollBar MouseWheel故障？

Question

我在TFrame中有一个TScrollBox，当我使用鼠标滚轮时，它既不能上下滚动ScrollBox也不能滚动。

我试着用

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

在FrameMouseWheelDown上，但不会触发。

有什么想法吗？

Answer 1

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

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;

Answer 2

您可以使用OnMouseWheel事件处理程序：

ScrollBar1.OnMouseWheel := ScrollBoxMouseWheel;
...
procedure TFrame1.ScrollBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Handled := True;
  if WheelDelta < 0 then
    TScrollBox(Sender).VertScrollBar.Position := TScrollBox(Sender).VertScrollBar.Position + TScrollBox(Sender).VertScrollBar.Increment 
  else
    TScrollBox(Sender).VertScrollBar.Position := TScrollBox(Sender).VertScrollBar.Position - TScrollBox(Sender).VertScrollBar.Increment;
end;