Trap scrolling messages for the ScrollBars of a TScrollBox
Question:
How can I trap the scrolling messages for the ScrollBars of a
TScrollBox component?
Answer:
The following example traps the scrolling messages for a
TScrollBox component, keeping the two scroll bars in sync. If either
of the scroll bars are scrolled, then the position of the other scroll
bar is changed to the same value. The scroll messages are trapped by
subclassing the scroll box's WinProc.
Example:
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;
The information above has been extracted from the "Borland Web Site" with permission from Borland UK