问题
Normally, while scrolling the contents of a "scroll box", no event functions are fired from the sub-components of a scroll box, e. g. in native apps. But in FireMonkey, if a TVertScrollBox contains sub-elements like TRectangle (which I want to use as menu entries for a custom menu), scrolling the TVertScrollBox on Android with a finger sometimes triggers the event functions (like OnClick) of the sub-elements and this is very confusing for me and our customers - They don't want to tap a specific element while scrolling.
In native apps this never happens. I couldn't figure out how to prevent this behaviour. I tried to set the HitTest property to FALSE for all sub-elements in the OnMouseEnter and OnMouseLeave (I also tried other events) with something like this:
procedure TframeCornerMenu.VertScrollBox1MouseEnter(Sender: TObject);
var
list: TRectangle;
i: Integer;
begin
list := FindComponent('rectMenuList') as TRectangle;
for i := 0 to list.ChildrenCount - 1 do
begin
if list.Children[i] is TRectangle then
TRectangle(list.Children[i]).HitTest := false;
end;
end;
But this obviously doesn't (and can't) work, because the user taps the sub-elements first which are lying on top of the TVertScrollBox.
Is this a bug / not implemented feature in FireMonkey? I appreciate all ideas solving this scrolling problem. If possible, without third-party components.
I am using Delphi Community Edition 10.3.2 (26.0.34749.6593).
回答1:
Is this a bug / not implemented feature in FireMonkey?
No to both parts of that question, though it'd be nice to have as a feature. Here's one possible solution:
unit MainFrm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls;
type
TMouseInfo = record
Down: Boolean;
DownPt: TPointF;
Moved: Boolean;
procedure MouseDown(const X, Y: Single);
procedure MouseMove(const X, Y: Single);
procedure MouseUp;
end;
TButton = class(FMX.StdCtrls.TButton)
private
FMouseInfo: TMouseInfo;
protected
procedure Click; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
end;
TfrmMain = class(TForm)
MessagesMemo: TMemo;
VertScrollBox: TVertScrollBox;
private
procedure ControlClickHandler(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
{ TMouseInfo }
procedure TMouseInfo.MouseDown(const X, Y: Single);
begin
Down := True;
Moved := False;
DownPt := PointF(X, Y);
end;
procedure TMouseInfo.MouseMove(const X, Y: Single);
begin
if Down and not Moved then
Moved := (Abs(X - DownPt.X) > 10) or (Abs(Y - DownPt.Y) > 10);
end;
procedure TMouseInfo.MouseUp;
begin
Down := False;
end;
{ TButton }
procedure TButton.Click;
begin
if not FMouseInfo.Moved then
inherited;
end;
procedure TButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseDown(X, Y);
end;
procedure TButton.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseMove(X, Y);
end;
procedure TButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseUp;
end;
{ TfrmMain }
constructor TfrmMain.Create(AOwner: TComponent);
var
I: Integer;
LButton: TButton;
begin
inherited;
for I := 0 to 29 do
begin
LButton := TButton.Create(Self);
LButton.Name := 'Button' + (I + 1).ToString;
LButton.Width := 120;
LButton.Height := 32;
LButton.Position.X := (Width - LButton.Width) / 2;
LButton.Position.Y := I * 80;
LButton.OnClick := ControlClickHandler;
LButton.Parent := VertScrollBox;
end;
end;
procedure TfrmMain.ControlClickHandler(Sender: TObject);
begin
MessagesMemo.Lines.Add(TComponent(Sender).Name + ' was clicked');
end;
end.
Here I'm using what's often referred to as an "interposer" class that descends from TButton, to override the methods necessary to detect whether the mouse has moved, so that Click is called only when the mouse has not moved (very much). When a button receives a MouseDown the Down flag and location is set, then when a MouseMove is received it calculates how far it has moved. If too far, when Click is finally called, the inherited method is not called and so no OnClick event fires.
You could use the same technique for your TRectangle or whatever can receive clicks
回答2:
On mobile devices you don't use OnClick but OnTap!
If you use OnTap then there won't be any misfiring while scrolling.
To still be able to test my app as a win32 application, I use this:
procedure TForm1Rectangle.Click;
begin
inherited;
{$IFDEF MSWINDOWS}
// Screen.MousePos ist in reference to the current screen:
Tapped(Self.ScreenToLocal(Screen.MousePos));
{$ENDIF}
end;
procedure TForm1Rectangle.Tap(const Point:TPointF);
begin
inherited;
// 'Point' is in reference to the current window:
Tapped(Self.AbsoluteToLocal(Point));
end;
procedure TForm1Rectangle.Tapped(const Point:TPointF);
begin
// Here 'Point' is in reference to TopLeft of the rectangle
end;
来源:https://stackoverflow.com/questions/57452568/prevent-firing-events-while-scrolling-tvertscrollbox