截获滚动条消息 type {$IFDEF WIN32} WParameter = LongInt; {$ELSE} WParameter = Word; {$ENDIF} LParameter = LongInt; {Declare a variable to hold the window procedure we are replacing} var OldWindowProc : Pointer; function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt {$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF} var TheRangeMin : integer; TheRangeMax : integer; TheRange : integer; begin if TheMessage = WM_VSCROLL then begin {Get the min and max range of the horizontal scroll box} GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax); {Get the vertical scroll box position} TheRange := GetScrollPos(WindowHandle, SB_VERT); {Make sure we wont exceed the range} if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax; {Set the horizontal scroll bar} SetScrollPos(WindowHandle, SB_HORZ, TheRange, true); end; if TheMessage = WM_HSCROLL then begin {Get the min and max range of the horizontal scroll box} GetScrollRange(WindowHandle, SB_VERT, TheRangeMin, TheRangeMax); {Get the horizontal scroll box position} TheRange := GetScrollPos(WindowHandle, SB_HORZ); {Make sure we wont exceed the range} if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax; {Set the vertical scroll bar} SetScrollPos(WindowHandle, SB_VERT, TheRange, true); end; { Call the old Window procedure to } { allow processing of the message. } NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL); end; procedure TForm1.FormCreate(Sender: TObject); begin { Set the new window procedure for the control } { and remember the old window procedure. } OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc))); end; procedure TForm1.FormDestroy(Sender: TObject); begin { Set the window procedure back } { to the old window procedure. } SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc)); end;
