Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];

Вниз

Заставить ScrollBox реагировать на перетаскивание ползунка?   Найти похожие ветки 

 
AlexeyT ©   (2006-12-07 17:07) [0]

Хочется реакции на перетаскивание ползунка. Кажется, в API это соотв-ет параметру SB_THUMBTRACK сооб-я WM_V/HSCROLL. Что делать?


 
kivadim   (2006-12-07 17:49) [1]

может поможет... но правда др компонент..

Нижеприведенный пример передвигает второй ScrollBar на такое же количество едениц, на которое передвинет пользователь первый. Т.е. синхронизирует их.



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,
     TheRangeMin,
     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;


 
AlexeyT ©   (2006-12-07 18:10) [2]

Мм.. даже на знаю. Тут заменяется оконная процедура в формы - как то же сделать для scrollbox"а, можно у него заменить оконную процедуру или нет?


 
Gadenysh   (2006-12-07 18:40) [3]

tracking := true


 
AlexeyT ©   (2006-12-07 18:50) [4]


> tracking := true


:-)

Спасибо.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.042 c
15-1164879601
Fox
2006-11-30 12:40
2006.12.24
Вакансия Технический писатель


2-1165518789
serko
2006-12-07 22:13
2006.12.24
вычитание даты и времени...


4-1155386184
apic
2006-08-12 16:36
2006.12.24
Drag&amp;Drop


2-1165425453
Master_
2006-12-06 20:17
2006.12.24
Возможно запустить мою программу как OLE обьект?


15-1164879083
inew
2006-11-30 12:31
2006.12.24
Признаки выхода в Интернет





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский