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?
Join Stack Overflow to learn, share knowledge, and build your career.
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;