Zdarzenie OnMouseWheel na TPanel

Na TPanel mam ułożone kilka TLabel. Niestety niektóre się nie mieszczą, dlatego musiałem stworzyć ScrollBar. Zrobiłem swój własny na podstawie kilka komponentów TPanel. Przesuwam wszystko po naciśnięciu przycisków.
Teraz chciałbym dodać możliwość przesuwania za pomocą kółka myszki, dwóch palców na TouchPadzie i lewym przyciskiem myszy przeciągnięcia paska. Czy jest to możliwe?

Nie musisz tworzyć własnego, skoro do dyspozycji jest komponent klasy TScrollBox, który obsługuje takie rzeczy.

Z tego sobie zdaję sprawę. Mimo wszystko chciałbym spróbować zrobić to po swojemu, o ile jest to wgl realne?

Wszystko jest realne; W takim razie potrzebujesz zaimplementować obsługę komunikatu LM_MOUSEWHEEL; Na podstawie dostarczonych w parametrze danych komunikatu należy określić w którą stronę obrócono rolkę myszy;

Poniżej przykład dla klasy własnego komponentu, dziedziczącego z klasy TPanel:

uses
  LMessages;

type
  TScrollPanel = class(TPanel)
  {..}
  protected
    procedure WMMouseWheel(var AMessage: TLMMouseEvent); message LM_MOUSEWHEEL;
  end;
  
  procedure TScrollPanel.WMMouseWheel(var AMessage: TLMMouseEvent);
  begin
    AMessage.Result := 1;
  end;

Powyższe to szkielet zdarzenia obsługi komunikatu; Przypisanie wartości 1 do pola AMessage.Result parametru oznacza obsłużenie komunikatu, więc o tym nie zapomnij; Gdzie są dane określające kierunek obrotu rolki? W polu AMessage.WheelDelta - wartość mniejsza od zera oznacza obrót rolki w dół (do siebie), a większa od zera - w górę (od siebie);

Poniżej przykład rozpoznania kierunku obrotu i wywołanie własnych zdarzeń:

uses
  LMessages;

type
  TScrollPanel = class(TPanel)
  {..}
  private
    FOnWheelDown: TNotifyEvent;
    FOnWheelUp: TNotifyEvent;
  private
    procedure DoWheelDown();
    procedure DoWheelUp();
  protected
    procedure WMMouseWheel(var AMessage: TLMMouseEvent); message LM_MOUSEWHEEL;
  published
    property OnWheelDown: TNotifyEvent read FOnWheelDown write FOnWheelDown;
    property OnWheelUp: TNotifyEvent read FOnWheelUp write FOnWheelUp;
  end;
  
  procedure TScrollPanel.DoWheelDown();
  begin
    if Assigned(FOnWheelDown) then
      FOnWheelDown(Self);
  end;
  
  procedure TScrollPanel.DoWheelUp();
  begin
    if Assigned(FOnWheelUp) then
      FOnWheelUp(Self);
  end;
  
  procedure TScrollPanel.WMMouseWheel(var AMessage: TLMMouseEvent);
  begin
    if AMessage.WheelDelta < 0 then
      DoWheelDown()
    else
      DoWheelUp();
  
    AMessage.Result := 1;
  end;

Jeżeli wszystkie komponenty klasy TPanel mają posiadać obsługę wyżej wymienionych zdarzeń to zawsze możesz zadeklarować klasę typu helper dla klasy TPanel i wstrzyknąć do niej nowe funkcje:

type
  TPanelHelper = class helper for TPanel
    { tu nowe funkcje w odpowiednich sekcjach }
  end;

Wszystko co napisałem powyżej jest napisane z palca, więc gdzieś coś mogłem pokiełbasić;

Edit: Klasa TPanel ma już zdarzenie OnMouseWheel, które dostarcza nieco więcej informacji, więc z niego powinieneś skorzystać; Parametr Shift zawiera dane o klawiszach specjalnych, WheelDelta zawiera zakodowany kierunek obrotu rolki, MousePos to relatywne współrzędne kursora; Do argumentu Handled wpisz wartość True, jeśli w zdarzeniu obsługujesz rolkę;

Kod który podałem wyżej traktuj jako ciekawostkę - pozostawiam go tutaj, bo może się komuś przydać, jak będzie od podstaw pisał swój komponent i będzie potrzebował obsłużyć rolkę myszy.

To i do tego powrócę. Jak dodać obsługę touchpada? O ile wertykalnie działa tak jak kółko myszy, to mam problem z horyzontalnym przesuwaniem. Chodzi mi o to, aby po przeciągnięciu dwóch palców w bok, przesuwała się też zawartość Panelu.

Obsługa gładzika interpretowana jest przez system jako gesty myszy, więc takie akcje jak przesuwanie kursora, klikanie czy scrollowanie, obsługiwane są za pomocą standardowych komunikatów; Nie wiem natomiast jak wygląda sprawa z bardziej nietypowymi akcjami (jak przewijanie horyzontalne), dlatego też najpierw wypadałoby się dowiedzieć tego, jakie komunikaty płyną do kontrolki podczas tych akcji; A jak już komunikaty będą znane to można zaczerpnąć wiedzy o nich z dokumentacji na MSDN; Implementacja obsługi komunikatu jest uniwersalna;

Niestety nie mam jak u siebie tego sprawdzić, bo mój laptop posiada zwykły, ubogi touchpad.

Znalazłem tylko coś takiego: https://msdn.microsoft.com/en-us/library/windows/desktop/ms645614(v=vs.85).aspx

ale tak na prawdę nie wiem jak tego użyć. LM_MOUSEHWHEEL nie istnieje.

Poziome kółko jest obsługiwane w komunikacie WM_MOUSEHWHEEL.

furious programming napisał(a):

Kopiuj

procedure TScrollPanel.WMMouseWheel(var AMessage: TLMMouseEvent);
begin
if AMessage.WheelDelta < 0 then
DoWheelDown()
else
DoWheelUp();

AMessage.Result := 1;
end;

Kopiuj

Ten kod jest zły. Reaguje na każdą zmianę pozycji kółka, a powinno reagować dopiero na zmianę delty o WHEEL_DELTA. Trzeba sumować kolejne wartości i gdy suma przekroczy WHEEL_DELTA potraktować to jako przeskok „o jeden” i odjąć tę stałą od sumy.

Wiele myszek wysyła deltę równą WHEEL_DELTA, ale niektóre o wyższej rozdzielczości wysyłają komunikaty częściej z mniejszą deltą.

The wheel rotation is a multiple of WHEEL_DELTA, which is set to 120. This is the threshold for action to be taken, and one such action (for example, scrolling one increment) should occur for each delta.

The delta was set to 120 to allow Microsoft or other vendors to build finer-resolution wheels (for example, a freely-rotating wheel with no notches) to send more messages per rotation, but with a smaller value in each message. To use this feature, you can either add the incoming delta values until WHEEL_DELTA is reached (so for a delta-rotation you get the same response), or scroll partial lines in response to more frequent messages. You can also choose your scroll granularity and accumulate deltas until it is reached.

https://msdn.microsoft.com/en-us/library/windows/desktop/ms645614%28v=vs.85%29.aspx

Ten kod (a raczej sposób interpretacji komunikatu) znalazłem na oficjalnym forum Lazarusa, więc takiego też używam; Działa prawidłowo na kilku testowanych myszach, więc nie zagłębiałem się w temat; W sumie to wywołanie zdarzenia dla każdego skoku pasuje w moim przypadku, więc jeśli o mnie chodzi to nie widzę problemu;

Edit: W źródłach modułu LMessages jest komentarz obok deklaracji pola WheelDelta:

WheelDelta: SmallInt; // -1 for up, 1 for down

Też daje trochę do myślenia;

dani17 napisał(a)

ale tak na prawdę nie wiem jak tego użyć. LM_MOUSEHWHEEL nie istnieje.

No to sobie taką stałą zadeklaruj - to tylko nazwa; Wartość liczbową komunikatu znajdziesz na MSDN, tak samo jak informacje, które ten komunikat dostarcza (w lParam i wParam); Trzeba by też pomyśleć nad strukturą dostarczaną w argumencie metody handlera; Później sprawdzę, czy typ TLMMouseEvent się nada do tego.

Właśnie tak robiłem, ale próbowałem to deklarować w jakimś dziwnym miejscu, a jako, że nie byłem pewien czy jest to właściwe rozwiązanie to nie kombinowałem aż tak. Teraz po potwierdzeniu, wszystko już działa ;)

Było by dobrze, gdybyś pochwalił się tym działającym kodem - przyda się potomnym.

Przy czym jednak przerzuciłem się na ScrollBoxa, zamiast tworzyć swój własny, na ten moment mi wystarczy.

 
const
  LM_MOUSEHWHEEL = $020E; 

TTabela = class(TCustomControl)
  private
    { Private declarations }
  protected
    procedure WMMouseMove(var AMessage: TLMMouseMove); message LM_MOUSEMOVE;
    procedure CMMouseLeave(var AMessage: TLMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var AMessage: TLMessage); message CM_MOUSEENTER;
    procedure WMMouseWheel(var AMessage: TLMMouseEvent); message LM_MOUSEWHEEL;
    procedure WMMouseHWheel(var AMessage: TLMMouseEvent); message LM_MOUSEHWHEEL;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent; AWidth, AHeight, AKolumny, AWiersze: Integer);
    destructor Destroy; override;
    procedure Paint; override; 
end;

implementation  

procedure TTabela.WMMouseWheel(var AMessage: TLMMouseEvent);
begin
  if AMessage.WheelDelta < 0 then
    TScrollBox(Parent).VertScrollBar.Position := TScrollBox(Parent).VertScrollBar.Position + 10
  else
    TScrollBox(Parent).VertScrollBar.Position := TScrollBox(Parent).VertScrollBar.Position - 10;
end;

procedure TTabela.WMMouseHWheel(var AMessage: TLMMouseEvent);
begin
  if AMessage.WheelDelta < 0 then
    TScrollBox(Parent).HorzScrollBar.Position := TScrollBox(Parent).HorzScrollBar.Position + 10
  else
    TScrollBox(Parent).HorzScrollBar.Position := TScrollBox(Parent).HorzScrollBar.Position - 10;
end;

Miałem na myśli raczej sam kod obsługi komunikatu, nie całego komponentu :]

Spróbuj czegoś takiego, w ramach testów:

procedure TTabela.WMMouseHWheel(var AMessage: TLMMouseEvent);
begin
  with Parent as TScrollBox do
    HorzScrollBar.Position := HorzScrollBar.Position + AMessage.WheelDelta;
end;

Podobnie z pionowym paskiem; Ten sposób pochodzi z tego wątku i może działać ciekawiej; Chodzi o drugą linijkę kodu, czyli bezpośrednie dodanie tego co zawiera pole WheelDelta do pozycji scrollbara;

PS: Używaj angielskich identyfikatorów.

A no wiem jak to zadziała wtedy, ale celowo napisałem tak jak jest. ;)

Co ja pitolę... Podany i używany przeze mnie kod nie pochodzi z oficjalnego forum Lazarusa, a ze źródeł LCL:

{------------------------------------------------------------------------------
  Method: TControl.WMMouseWheel
  Params:   Msg: The message
  Returns:  nothing

  event handler.
 ------------------------------------------------------------------------------}
procedure TControl.WMMouseWheel(var Message: TLMMouseEvent);
var
  MousePos: TPoint;
  lState: TShiftState;
begin
  MousePos.X := Message.X;
  MousePos.Y := Message.Y;

  lState := Message.State - [ssCaps, ssNum, ssScroll]; // Remove unreliable states, see http://bugs.freepascal.org/view.php?id=20065
  if DoMouseWheel(lState, Message.WheelDelta, MousePos) then
    Message.Result := 1 // handled, skip further handling by interface
  else
    inherited;
end;

{------------------------------------------------------------------------------
       TControl DoMouseWheel  "Event Handler"
 ------------------------------------------------------------------------------}
function TControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  Result := False;

  if Assigned(FOnMouseWheel)
  then FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);

  if not Result
  then begin
    if WheelDelta < 0
    then Result := DoMouseWheelDown(Shift, MousePos)
    else Result := DoMouseWheelUp(Shift, MousePos);
  end;
end;

Coś mi się pokiełbasiło...

W każdym razie to nie ja jestem winny niezgodności z wytycznymi Microsoftu - brałem przykład z twórców oryginalnego kodu, czyli twórców biblioteki LCL; Tyle że formatowanie kodu mam lepsze :]

@furious programming
https://blogs.msdn.microsoft.com/oldnewthing/20130123-00/?p=5473
https://blogs.msdn.microsoft.com/oldnewthing/20030807-00/?p=42963

@Azarien - ja nie twierdzę, że ten kod jest prawidłowy; Grzecznie zwalam winę na prawidziwego winowajcę, z którego brałem przykład; Trudno tak na każdym kroku sprawdzać, czy RTL/LCL działa prawidłowo i czy nie robi mnie w balona w pewnych kwestiach - po prostu korzystam z tego, co już ktoś napisał;

Natomiast zagłębię się w temat (czytaj: potestuję jakieś kody) i wtedy coś postanowię.

Ten mój kod chyba jednak się nie nadaje :/ dopiero teraz zauważyłem problem. Niby działa to, ale nie na podstawie mojego kodu, ale po prostu dzięki scrollboxowi. Reagowało tylko w momencie gdy kursor był nad Scrollboxem, a nie nad tym co było umieszczone na nim, a więc w tym przypadku TTabela. Gdy kursor jest nad jakiś elementem to nie wyłapuje komunikatu MouseHWhell. Początkowo tak samo było jeśli chodziło o przesuwanie wertykalne, ale po dodaniu obsługi komunikatu MouseWheel to akurat zadziałało.

Jak nie chcesz, aby komunikat był wałkowany przez wiele klas o wyższej abstrakcji to nie wołaj Inherited i ustawiaj AMessage.Result na 1; Powinno rozwiązać problem, o ile znów wierzyć źródłom LCL.

Nadal nie działa przesuwanie. Program wgl nie wyłapuje komunikatu LM_MOUSEHWHEEL.