Delphi > Firemonkey

Vlastní posuvný panel - jak simulovat klik myši

(1/1)

age.new:
Vážená komunito,

pro FMX si často dělám vlastní komponenty a rozhodl jsem se nahradit nevhodné ScrollBoxy, které postrádají některé moderní funkce. Narazil jsem ale na problém, který se mi nedaří vyřešit - hlavně z důvodu, že mi v FMX nejde "vynutit" kliknutí myši na mnou požadované pozici.

Rád bych měl posuvný panel u kterého lze posouvat pomocí myši nahoru a dolu i v případě, že dojde ke kliku na jiné komponentě na posuvném panelu. V podstatě událost kliku se má provést jen tehdy, když nedojde k posunu panelu, tj. rozdíl hodnoty osy Y u MouseDown a MouseUp musí být menší než nějaká malá konstanta. Uživatel se tak pro posun nemusí trefovat např. mimo tlačítka. Fungují tak moderní mobilní aplikace. Z nějakého důvodu ale ScrollBoxy tuto funkci postrádají.

Nemá smysl zde popisovat celou komponentu - jen to kritické: nad všema dětma umístěné v posuvné komponentě mám TLayout s HitTest := true, která slouží jako maska. Tato maska zachytí událost MouseDown, MouseUp, MouseMove a MouseLeave. Zde vyhodnotím, zda obsluha chce provést klik a nebo posun panelu.

Kódy níže jsem ořezal tak aby byly co nejjednodušší:


--- Kód: Delphi ---procedure TSimpleScrollPanel.TouchMaskMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);begin  if FMouseDown then    if abs(Y - FMouseY) >= FTouchRange then // pokud má dojít k posunu panelu a ne ke kliku    begin      FBasePosition := FBasePosition - (Y - FMouseY);      FMouseSlided := true; // tato proměnná říká, zda bylo posunuto panelem - pak se neprovede klik      FMouseY := Y;       Update; // aktualizace panelu atd.    end;end; procedure TSimpleScrollPanel.TouchMaskMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);begin  FMouseDown := false;   if not FMouseSlided and Self.PointInObjectLocal(X, Y) then  begin        // pokud to padne sem, má se provést klik na tom objektu nad kterým je myš   end;end; 
V TouchMaskMouseUp jsem zkoušel různé způsoby, rušil jsem HitTest na masce a zkoušel simulovat klik, vyčítal děti a zkoušel vyvolat Click událost (bohužel TControl.Click je v protected, takže nelze provést, i když prý to kdysi šlo)...
Prostě, potřebuji nějak znovu vyvolat klik událost v místě kurzoru. Na panelu můžou být různé objekty a proto asi není jiná možnost. Osobně mě překvapuje, že je u FMX tak problematické vyvolat událost kliku v místě kurzoru... Ale třeba hledám moc komplikované řešení a existuje něco jednoduššího?!

Děkuji za případné rady.
A.

vandrovnik:
K té protected metodě se dá dostat tak, že si vytvoříš potomka, ve kterém tu viditelnosti změníš:

http://hallvards.blogspot.com/2004/05/hack-4-access-to-protected-methods.html

age.new:

--- Citace: vandrovnik  10-12-2020, 09:54:36 ---K té protected metodě se dá dostat tak, že si vytvoříš potomka, ve kterém tu viditelnosti změníš:

http://hallvards.blogspot.com/2004/05/hack-4-access-to-protected-methods.html

--- Konce citace ---

Ano, to jsem zkoušel, ale nevede to k úspěchu. Na posuvném panelu může ležet "cokoliv" a občas samotný Click nestačí, protože se obejde Pressed a podobně...

Ale přišel jsem na jiné řešení, které funguje:


--- Kód: Delphi ---procedure TSimpleScrollPanel.TouchMaskMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);begin  FMouseDown := false;   if not FMouseSlided and Self.PointInObjectLocal(X, Y) then  begin    FTouchMask.HitTest := false;    try      mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);      mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);    finally      FClickTimer.Enabled := false;      FClickTimer.Enabled := true;    end;  end;   Inherited;end; 
V komponentě jsem vytvořil TTimer a dal mu 1ms interval. Tento timer slouží něco jako Application.ProcessMessages, tj. zpoždění pro obsluhu jiných událostí. V momentě, kdy má dojít ke kliku, zruším HitTest na masce, zavolám mouse_event simulující klik myši a spustím timer, který po jeho skončení (teoreticky za 1ms) opět nahodí HitTest na masce.

A ono to funguje!


Navigace

[0] Seznam témat

Přejít na plnou verzi