Как перехватить сообщения прокрутки в TScrollBox?

Вопрос:

Как перехватить сообщения прокрутки в TScrollBox?

Ответ:

Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью переопределения окнной процедуры (WinProc) ScrollBox'а.

Пример:

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  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, heRangeMin, TheRangeMax);
    {Get the horizontal scroll box position}
    TheRange := GetScrollPos(WindowHandle, SB_HORZ);
    {Make sure we wont exceed the range}
    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;