delphi - 如何修复 TScrollBar MouseWheel 故障？

Question

我有一个TScrollBox内部，TFrame当我使用鼠标滚轮时，它根本不会上下滚动框滚动。

我试过用

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;