TScrollBox,
Если мы говорим о классе TScrollBox, то наиболее простой и эффективный код – обработать MousewheelUp и MouseWheelDown у компонента ScrollBox, но этого недостаточно, нужно ещё присвоить SetFocus, компоненту ScrollBox, тогда это удовольствие будет работать.
Вот простой пример обработки данных событий
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
procedure TVisualFrame_PSFTPClient.ScrollBoxUploadsMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position+4; end; procedure TVisualFrame_PSFTPClient.ScrollBoxUploadsMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position-4; end; |
|
1 2 3 4 5 6 |
procedure TVisualFrame_PSFTPClient.SomeProcedure; begin SomeComponentWithScrollBox.SetFocus; end; |
При разработке компонента со ScrollBox
Я столкнулся c тем, что где попало SetFocus не поставишь. Это какая-то внутренняя кухня VCL. Control has no ParentWindow. У меня TScrollBox был на фрэйме, который я динамически добавлял. Поэтому приходилось выкручиваться. В итоге SetFocus я поставил в одну из процедур, которая вызывается извне, после создания компонента.
TForm with TForm.VertScrollBar.Visible:=true
Стандартный код, который можно встретить на многих форумах вот такой…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
//прокручиваем вниз procedure TMainForm.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin Scrollbox1.VertScrollBar.Position:= Scrollbox1.VertScrollBar.Position+4; end; //прокручиваем вверх procedure TMainForm.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin Scrollbox1.VertScrollBar.Position:= Scrollbox1.VertScrollBar.Position-4; end; |
Но это в случае, если у нас scrollbox находится на форме. У меня же, например, он находился на фрэйме и там такого добра не было. Поэтому пришлось углубляться в WinAPI и смотреть как это всё работает изнутри. Получились следующие варианты. Возможно не идеальные, но начало положено.
TScrollBox, again
Вариант 1
Кладем на форму TApplicationEvents и в событии OnMessage…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
procedure TVisualFrame_PSFTPClient.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); var i:integer; iPos:integer; zDelta: Integer; Delta: Integer; begin // --------------------Ловим MouseWheel if Msg.message=WM_Mousewheel then begin i:=HiWord(Msg.wParam); Delta:=20; //Если колесо движется от пользователя if i=120 then begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position-Delta; ScrollBoxUploads.ScrollBy(0,-Delta); end else //Если колесо движется к пользователю begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position+Delta; ScrollBoxUploads.ScrollBy(0,Delta); end; end; end; |
Есть ещё и 2 вариант – через написание процедуры, при котором программа у меня работала более стабильно – не было “подергиваний” при обработке сообщений.
Вариант 2
Пишем процедуру, которая будет отлавливать сообщения…
|
1 2 3 4 |
... private procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL; ... |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
procedure TVisualFrame_PSFTPClient.WMMOUSEWHEEL(var Msg: TMessage); var i: integer; Delta: Integer; begin // --------------------Ловим MouseWheel i:=HiWord(Msg.wParam); Delta:=20; //Если колесо движется от пользователя if i=120 then begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position-Delta; ScrollBoxUploads.ScrollBy(0,-Delta); end else //Если колесо движется к пользователю begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position+Delta; ScrollBoxUploads.ScrollBy(0,Delta); end; end; |
Вариант 3. При разработке компонента…
При разработке компонента, скажем, на основе TPanel, можно поступить вот так
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
constructor TVisualFrame_PSFTPClient.Create(AOwner: TComponent); begin inherited; if (AOwner is TForm) then with (AOwner as TForm) do begin OnMouseWheelDown:=FormMouseWheelDown; OnMouseWheelUp:=FormMouseWheelUp; end else FWMMOUSEWHEEL_Enabled:=true; end; |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
procedure TVisualFrame_PSFTPClient.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position-20; end; procedure TVisualFrame_PSFTPClient.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position+20; end; |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
procedure TVisualFrame_PSFTPClient.WMMOUSEWHEEL(var Msg: TMessage); var i: integer; Delta: Integer; begin if not FWMMOUSEWHEEL_Enabled then Exit; // --------------------Ловим MouseWheel i:=HiWord(Msg.wParam); Delta:=20; //Если колесо движется от пользователя if i=120 then begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position-Delta; ScrollBoxUploads.ScrollBy(0,-Delta); end else //Если колесо движется к пользователю begin ScrollBoxUploads.VertScrollBar.Position:= ScrollBoxUploads.VertScrollBar.Position+Delta; ScrollBoxUploads.ScrollBy(0,Delta); end; end; |