procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if WheelDelta < 0 then
ScrollBox1.Perform(WM_VSCROLL,SB_LINEDOWN,0)
else
ScrollBox1.Perform(WM_VSCROLL,SB_LINEUP,0);
end;
ScrollBox1.Perform(WM_VSCROLL,SB_LINEDOWN,0) 改成 SendMessage(ScrollBox1.Handle,WM_VSCROLL,SB_LINEDOWN,0),
ScrollBox1.Perform(WM_VSCROLL,SB_LINEUP,0) 改成 SendMessage(ScrollBox1.Handle,WM_VSCROLL,SB_LINEUP,0) 也行。
一样的原理。
分别在OnMouseWheelDown和OnMouseWheelUp时间里发送鼠标滚轮上滚和下滚的消息也行。
type
TFormDemo = class(TForm)
ScrollBox: TScrollBox;
Panel: TPanel;
procedure FormCreate(Sender: TObject);
private
OldScrollBoxWindowProc: TWndMethod;
procedure NewScrollBoxWindowProc(var Message: TMessage);
procedure OnMessageOwn(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;
var
FormDemo: TFormDemo;
implementation
{$R *.dfm}
{ TFormDemo }
procedure TFormDemo.NewScrollBoxWindowProc(var Message: TMessage);
var
Pace: Integer;
begin
if Message.Msg = WM_MouseWheel then
begin
Pace := Message.wParam ;
if Pace > 120 then
ScrollBox.VertScrollBar.Position := ScrollBox.VertScrollBar.Position + 10
else
ScrollBox.VertScrollBar.Position := ScrollBox.VertScrollBar.Position - 10;
end;
OldScrollBoxWindowProc(Message);
end;
procedure TFormDemo.FormCreate(Sender: TObject);
begin
OldScrollBoxWindowProc := ScrollBox.WindowProc;
ScrollBox.WindowProc := NewScrollBoxWindowProc;
Application.OnMessage := OnMessageOwn;
end;
procedure TFormDemo.OnMessageOwn(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = WM_MOUSEWHEEL then
begin
SendMessage(ScrollBox.Handle, WM_MouseWheel, HiWord(Msg.wParam), Msg.lParam);
Handled := False;
end;
end;
上面是截获滚轮消息并传递给ScrollBox, 滚动的步长我设为10