DELPHI/Часто задаваемые вопросы и ответы на них/Компоненты



На главную

Подписка

Новости

Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Компоненты / Как перехватить сообщения прокрутки в 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 < 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;

Источник: Дельфи. Вокруг да около.

Источник получения информации: http://www.delphimaster.ru