Как перехватить сообщения прокрутки в 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 < 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, heRangeMin, 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;
 
Следующая статья »