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?
0
2
Nie musisz tworzyć własnego, skoro do dyspozycji jest komponent klasy TScrollBox, który obsługuje takie rzeczy.
0
Z tego sobie zdaję sprawę. Mimo wszystko chciałbym spróbować zrobić to po swojemu, o ile jest to wgl realne?
1
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.
0
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.
0
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.
0
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.
2
Poziome kółko jest obsługiwane w komunikacie WM_MOUSEHWHEEL.
furious programming napisał(a):
procedure TScrollPanel.WMMouseWheel(var AMessage: TLMMouseEvent);
begin
if AMessage.WheelDelta < 0 then
DoWheelDown()
else
DoWheelUp();
AMessage.Result := 1;
end;
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
1
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.
0
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 ;)
0
Było by dobrze, gdybyś pochwalił się tym działającym kodem - przyda się potomnym.
0
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;
0
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.
0
A no wiem jak to zadziała wtedy, ale celowo napisałem tak jak jest. ;)
0
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 :]
0
@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ę.
0
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.
0
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.
0
Nadal nie działa przesuwanie. Program wgl nie wyłapuje komunikatu LM_MOUSEHWHEEL.
0
Pisałem Ci wcześniej abyś sprawdził, jaki komunikat odbiera okno w momencie poziomego przewijania tym Twoim kółkiem myszy; Podepnij się pod ogólną metodę przetwarzającą komunikaty kontrolki i do niej wrzuć własny kod:
protected
procedure WndProc(var AMessage: TLMessage); override;
procedure TMyControl.WndProc(var AMessage: TLMessage);
begin
{ tu kod analizy komunikatu }
inherited WndProc(AMessage);
end;
W miejsce komentarza wstaw swój kod, dzięki któremu będziesz mógł podglądnąć wartość pola AMessage.msg; Jeżeli swój kod wstawisz po Inherited to odczytasz najpewniej zmodyfikowane dane, za sprawą obsługi danego komunikatu przez metodę WndProc klas o wyższej abstrakcji; Ale one najpewniej zmodyfikują tylko wartość pola AMessage.Result;
Możliwe, że Twoja mysz wcale nie wysyła (pośrednio) komunikatu WM_MOUSEHWHEEL.