android - 滚动 TVertScrollBox 时防止触发事件

Question

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

在 native 应用程序中，这永远不会发生。我不知道如何防止这种行为。我尝试将 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

Is this a bug / not implemented feature in 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 时，Down 标志和位置被设置，然后当接收到 MouseMove 时，它​​计算它移动了多远。如果太远，当最终调用 Click 时，不会调用继承的方法，因此不会触发 OnClick 事件。

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