Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Курс видеоуроков КРЭКЕРСТВО + ПРОГРАММИРОВАНИЕ 2017
(актуальность: апрель 2017)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как перехватить сообщения прокрутки в 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;





<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS