滚动 TVertScrollBox 时防止触发事件

Question

通常，在滚动“滚动框”的内容时，不会从滚动框的子组件中触发任何事件函数，例如。 G。在本机应用程序中。但是在 FireMonkey 中，如果 TVertScrollBox 包含 TRectangle 之类的子元素（我想将其用作自定义菜单的菜单条目），则在 Android 上用手指滚动 TVertScrollBox 有时会触发子元素的事件函数（如 OnClick）这让我和我们的客户非常困惑 - 他们不想在滚动时点击特定元素。

在本机应用程序中，这永远不会发生。我不知道如何防止这种行为。我尝试将 OnMouseEnter 和 OnMouseLeave （我也尝试过其他事件）中的所有子元素的 HitTest 属性设置为 FALSE，如下所示：

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;

但这显然不起作用（也不能），因为用户首先点击位于 TVertScrollBox 顶部的子元素。

这是 FireMonkey 中的错误/未实现的功能吗？我感谢所有解决此滚动问题的想法。如果可能，不使用第三方组件。

我正在使用 Delphi Community Edition 10.3.2 (26.0.34749.6593)。

Answer 1

这是 FireMonkey 中的错误/未实现的功能吗？

对这个问题的两个部分都否决，尽管作为一项功能会很好。这是一种可能的解决方案：

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.

在这里，我使用了通常被称为“插入器”的类，它从 TButton 派生，覆盖检测鼠标是否移动所需的方法，以便仅在鼠标未移动时调用 Click（非常很多）。当一个按钮接收到一个 MouseDown 标志并设置位置时，当接收到一个 MouseMove 时，它​​会计算它移动了多远。如果太远，最终调用 Click 时，不会调用继承的方法，因此不会触发 OnClick 事件。

您可以对您的 TRectangle 或任何可以接收点击的东西使用相同的技术

Answer 2

在移动设备上，您使用的不是 OnClick，而是 OnTap！

如果您使用 OnTap，那么滚动时不会出现任何失火。

为了仍然能够将我的应用程序作为 win32 应用程序进行测试，我使用了这个：

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;