Question

我有一个TScrollBar在OnScroll事件中有代码。

我想使用鼠标滚轮滚动它，但转动鼠标滚轮不会滚动滚动条并且不会触发OnScroll事件。

有什么想法吗？

Answer 1

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  I: Integer;
begin
  Handled := PtInRect(ScrollBox1.ClientRect, ScrollBox1.ScreenToClient(MousePos));
  if Handled then
    for I := 1 to Mouse.WheelScrollLines do
    try
      if WheelDelta > 0 then
        ScrollBox1.Perform(WM_VSCROLL, SB_LINEUP, 0)
      else
        ScrollBox1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
    finally
      ScrollBox1.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
    end;
end;

Answer 2

默认的TScrollBar组件确实似乎没有OnMouseWheel *事件。但您可以简单地分配它们，如下所示：

type
  TForm1 = class(TForm)
    ScrollBar1: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
  private
    procedure ScrollBarMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBar1.OnMouseWheel := ScrollBarMouseWheel;
end;

procedure TForm1.ScrollBarMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  NewScrollPos: Integer;
begin
  NewScrollPos := ScrollBar1.Position - WheelDelta;
  //Trigger the OnScroll event:
  ScrollBar1.Scroll(scPosition, NewScrollPos);
  //Scroll the bar into the new position:
  ScrollBar1.Position := NewScrollPos;
  Handled := True;
end;

您可以自由地实施更具创意的内容：

  if WheelDelta > 0 then
    NewScrollPos := ScrollBar1.Position - ScrollBar1.PageSize
  else
    NewScrollPos := ScrollBar1.Position + ScrollBar1.PageSize;

您可以插入TScrollBar类以防止在运行时分配事件：

type
  TScrollBar = class(StdCtrls.TScrollBar)
  protected
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
  end;

function TScrollBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  NewScrollPos: Integer;
begin
  NewScrollPos := Position - WheelDelta;
  Scroll(scPosition, NewScrollPos);
  Position := NewScrollPos;
  Result := True;
end;

Answer 3

只是增加位置值就太容易了。

your_company_lists_div_id

Answer 4

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + 20;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - 20;
end;

Answer 5

我不知道这是否会有多大帮助，但这里是如何用TMemo做的。滚动条必须是一个类似的过程，除非Delphi版本比我的使用晚一些其他更好的方法。

procedure TForm1.Memo1WindowProc(var msg: TMessage);
  var
    ticks: ShortInt;
    ScrollMsg: TWMVScroll;
  begin
    if msg.Msg = WM_MOUSEWHEEL then
      begin
        ScrollMsg.Msg := WM_VSCROLL;
        ticks := HiWord(msg.wparam);
        if ticks > 0 then
          ScrollMsg.ScrollCode := sb_LineUp
        else
          ScrollMsg.ScrollCode := sb_LineDown;
        ScrollMsg.Pos:=0;
        Memo1.Dispatch(ScrollMsg) ;
      end
    else
      OldMemo1(msg);
    end;

procedure TForm1.FormCreate(Sender: TObject);
 // save old window proc, assign mine.
  begin
    OldMemo1 := Memo1.WindowProc;
    Memo1.WindowProc := Memo1WindowProc;
  end;

HTH。

Answer 6

老帖子，但我找到了解决方案。只需做

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  inherited;

  ScrollBox1.ScrollBy(WheelDelta, 0);
end;

适合我。

Answer 7

同样，这是一则古老的文章，它使我大体上了解了我想要的内容，但进一步调整了Stefan的答案，将滚动限制在鼠标悬停在滚动条上时。在接受鼠标滚轮输入之前，这将检测到鼠标位于滚动框的滚动条（非工作区）上。/我需要这样做，因为我的scollbox包含组合框，用户希望该组合框可以使用scrool进行滚动以及滚动滚动框（或任何使用滚动条的控件）：

  Handled := PtInRect(scrollbox.BoundsRect, scrollbox.ScreenToClient(MousePos)) 
             and not PtInRect(scrollbox.ClientRect, scrollbox.ScreenToClient(MousePos));
  if Handled then
    for I := 1 to Mouse.WheelScrollLines do
    try
      if WheelDelta > 0 then
        scrollbox.Perform(WM_VSCROLL, SB_LINEUP, 0)
      else
        scrollbox.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
    finally
      scrollbox.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
    end;

如何使用鼠标滚轮滚动滚动条？

7 个答案: