How do I scroll a TScrollbar using the mouse wheel?

I have a TScrollBar having a code in the OnScroll event.

I want to scroll it using the mouse wheel, but turning the mouse 开发者_开发技巧wheel does not scroll the scroll bar and does not trigger the OnScroll event.

Any idea?

---

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;

---

The default TScrollBar component indeed seems not to have the OnMouseWheel* events present. But you can simply assign them, as follows:

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;

You are free to implement this some more creative:

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

And you could interpose the TScrollBar class to prevent to assign the event at runtime:

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;

---

it's too easy just increase the position Value .

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
self.VertScrollBar.Position :=  self.VertScrollBar.Position + WheelDelta;
end;

---

I don't know if this will help much, but here's how to do it with a TMemo. The scrollbar would have to be a similar process, unless there is some other better way that Delphi versions later than mine use.

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 some.

---

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;

---

Old post, but I found solution. Simply do

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

  ScrollBox1.ScrollBy(WheelDelta, 0);
end;

Works for me.

---

Again this is an old post, and it got me most of the way to what i wanted but a little further tweak to the answer by Stefan, restricting scrolling to when the mouse is over the scrollbar. This detects that the mouse is over the scrollbar (non-client area) of the scroll box before accepting the mousewheel input./ I need this because my scollbox contained comboboxes which users wanted to be able to scrool with the wheel, as well as scrolling the scrollbox (or whatever control is using a scrollbar):

  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;