Поддержка / Donate
 

WebMoney

Яндекс.Деньги

SMS.Копилка
Деньги@Mail.ru
Rupay
E-gold
PayPal

 

Благодарю за поддержку!

Лента RSS - Новости сайта Новости сайта
Лента RSS - Новости форума Новости форума
Добавить в закладки и поделиться Bookmark and Share

 

Архив исходников

 


Automatic translation

 
English German French
Italian Spanish Portuguese
Greece Japan Chinese
  Korean  

  

 

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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




Источник - Проект "Delphi World" © Выпуск 2002 - 2004
Автор проекта: Акулов Николай



   Rambler's Top100             Яндекс цитирования