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

Delphi , Компоненты и Классы , TScrollBox

Следующий пример перхватывает сообщения скроллирования в компоненте TScrollBox, тем самым синхронизируя два скролбара. Если один из скролбаров изменяет своё положение, то значение второго скролбара изменяется на такую же величину. Сообщения скролирования перехватываются путём сабклассинга оконной процедуры (WinProc) у скролбара.

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;

Код, предоставленный в примере, является примером интерцепции сообщений скролла в компоненте TScrollBox Delphi. Цель состоит в синхронизации двух полосок прокрутки, изменяя позицию одной полоски прокрутки при изменении позиции другой полоски прокрутки.

Вот разбивка того, что код делает:

1. Он определяет новый процедурный вызов NewWindowProc, который будет использоваться для обработки сообщений скролла.
2. В NewWindowProc он проверяет, является ли сообщение WM_VSCROLL (вертикальное скроллинг) или WM_HSCROLL (горизонтальное скроллинг).
3. Для каждого типа сообщения скролла он получает диапазон и позицию полоски прокрутки с помощью GetScrollRange и GetScrollPos.
4. Затем он корректирует позицию другой полоски прокрутки, чтобы она оставалась в пределах допустимого диапазона.
5. Наконец, он вызывает старый процедурный вызов (CallWindowProc) для обработки сообщения.

Код также включает два процедура:

1. FormCreate: Это вызывается при создании формы. Он устанавливает новый процедурный вызов для компонента TScrollBox и запоминает старый.
2. FormDestroy: Это вызывается при уничтожении формы. Он возвращает процедурный вызов обратно к старому.

Код использует функции Windows API, такие как SetWindowLong, GetScrollRange, GetScrollPos и SetScrollPos, для взаимодействия с компонентом TScrollBox.

Этот код может быть полезен в ситуациях, когда вам нужно синхронизировать несколько полосок прокрутки или компонентов, которые имеют возможности скроллинга.

В статье описывается способ перехвата сообщений прокрутки в компоненте TScrollBox для синхронизации скроллинга двух скролбаров.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TScrollBox ::