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

ВИДЕОКУРС
выпущен 4 ноября!


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

БОЛЬШОЙ FAQ ПО 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;
 




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



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



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


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