delphi - 将长按事件添加到按钮类的最佳方法是什么？

Question

长按是指按下按钮/面板并按住一段时间(例如 2 秒)而不释放或拖动。常见于手机和触摸设备中。

我尝试过使用手势，在 TabletOptions 中检查了 toPressAndHold 并在 InteractiveGestureOptions 中检查了所有内容，但长按导致没有 OnGesture Call。

我能想到的另一个实现是添加一个计时器，在 MouseDown 中启动它，并在 Timer Fired、StartDrag、MouseUp 或 MouseLeave 中结束它。但是，由于我想将此行为添加到几个不同的按钮和面板组件中，因此我必须重写每个类中的一些过程，并复制每个组件的代码。

是否有更好的方法来实现这一目标？

<小时/>

编辑:

至 NGLN

哇，伟大的作品!结合您对滚动效果的回答，VCL 几乎可以实现移动操作系统的外观和感觉!

您的代码与常见控件完美配合，但我遇到了 2 个问题

1. 无法检测到长按表单(原因是表单不是其自身的父级)我将查找 FChild 代码移至单独的过程并从 WMParentNotify 和 FormMouseDown 调用解决这个问题。

2. 我有一些自定义按钮，其中有一些禁用的 HTML标签(页眉、标题、页脚)覆盖原始标签表面上，使用您的代码，FChild 将是这些标签之一，但它没有得到MouseCapture。我添加以下行来克服它:

   当不是 TControlAccess(FChild).Enabled 时执行 FChild := FChild.Parent;

最后，对于一些更复杂的控件，例如 TCategoryButtons 或 TListBox，事件的用户可能需要检查的不是整个控件，而是控件中的指定项目。所以我认为我们需要保存原始的 CursorPos 并在计时器触发时触发另一个事件，以便手动确定是否满足长按条件。如果是或未分配事件，则使用您的默认代码进行确定。

总而言之，我们可以创建一个支持 LongPress 的表单/面板来托管所有其他控件。这比逐个组件实现 LongPress 功能要容易得多!非常感谢!

<小时/>

编辑2:

至 NGLN

再次感谢您的组件版本，这是一个很好的方法，不需要对现有组件进行任何修改，并且可以在任何地方检测长按!

供您引用，我做了一些修改以满足我自己的需要。

1. TCustomForm 与 TWinControl :由于我的大多数应用程序只有 1 个主窗体，所有其他视觉单元都是我自己创建的框架(不是来自 TFrame，而是带有 ccpack 支持的 TScrollingWinControl)，假设 TCustomForm 不适合我。因此，我删除了属性表单(但保留 ActiveControl 的 FForm)并创建一个已发布的属性 Host : TWinControl 来充当父主机。这样，我也可以将检测限制在某些有限的面板上。分配主机时，我使用 GetParentForm(FHost) 检查并找到 FForm。
2. 禁用控件:正如我之前所说，我有一些禁用的 TJvHTLabel 覆盖了我的按钮和标签上的组件工作。我当然可以通过标签找到按钮，但我认为如果它由新组件处理会更方便。因此，我添加了一个属性 SkipDisabled，如果设置为“turn”，则在其父行中循环以查找第一个启用的控件。
3. 我添加了 PreserveFocus 属性，让组件用户选择是否保留最后一个事件控件。
4. 控制项目。我更改了您的 TLongPressEvent，添加 ClickPos 作为第二个参数。因此，我现在可以使用 ClickPos 来查找列表框等中的哪个项目已被长期保留。
5. 在我看来，FindVCLWindow 与您的 FindControlAtPos 具有相同的效果？

再次感谢您所做的出色工作。

Answer 1

每次单击鼠标左键，WM_PARENTNOTIFY发送给被单击控件的所有(祖) parent 。因此，这可以用于跟踪长按的起点，并且可以使用计时器来计时按下的持续时间。剩下的就是决定何时将按下称为长按。当然，要将这一切包装在一个很好的组件中。

在下面编写的组件中，当满足以下条件时会触发 OnLongPress 事件处理程序:

• 在该时间间隔之后，控件仍然具有鼠标捕获功能，或者仍然具有焦点，或者被禁用，
• 在该时间间隔之后，鼠标的移动量没有超过 Mouse.DragThreshold。

代码的一些解释:

• 它暂时替换控件的 OnMouseUp 事件处理程序，否则连续单击也可能导致长按。中间事件处理程序禁用跟踪计时器，调用原始事件处理程序并将其替换回来。
• 长按后，事件控件将被重置，因为我认为长按并不是为了使控件聚焦。但这只是我的猜测，它可能是属性(property)的候选者。
• 还跟踪对表单本身(而不是其子表单)的长按。
• 有一个自定义的FindControlAtPos例程，可以在任意窗口上执行深度搜索。替代方案是 (1) TWinControl.ControlAtPos，但它仅搜索一层深度，以及 (2) Controls.FindDragTarget，但尽管有 AllowDisabled参数，它无法找到禁用的控件。

unit LongPressEvent;

interface

uses
  Classes, Controls, Messages, Windows, Forms, ExtCtrls;

type
  TLongPressEvent = procedure(Control: TControl) of object;

  TLongPressTracker = class(TComponent)
  private
    FChild: TControl;
    FClickPos: TPoint;
    FForm: TCustomForm;
    FOldChildOnMouseUp: TMouseEvent;
    FOldFormWndProc: TFarProc;
    FOnLongPress: TLongPressEvent;
    FPrevActiveControl: TWinControl;
    FTimer: TTimer;
    procedure AttachForm;
    procedure DetachForm;
    function GetDuration: Cardinal;
    procedure LongPressed(Sender: TObject);
    procedure NewChildMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewFormWndProc(var Message: TMessage);
    procedure SetDuration(Value: Cardinal);
    procedure SetForm(Value: TCustomForm);
    procedure StartTracking;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Form: TCustomForm read FForm write SetForm;
  published
    property Duration: Cardinal read GetDuration write SetDuration
      default 1000;
    property OnLongPress: TLongPressEvent read FOnLongPress
      write FOnLongPress;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TLongPressTracker]);
end;

function FindControlAtPos(Window: TWinControl;
  const ScreenPos: TPoint): TControl;
var
  I: Integer;
  C: TControl;
begin
  for I := Window.ControlCount - 1 downto 0 do
  begin
    C := Window.Controls[I];
    if C.Visible and PtInRect(C.ClientRect, C.ScreenToClient(ScreenPos)) then
    begin
      if C is TWinControl then
        Result := FindControlAtPos(TWinControl(C), ScreenPos)
      else
        Result := C;
      Exit;
    end;
  end;
  Result := Window;
end;

{ TLongPressTracker }

type
  TControlAccess = class(TControl);

procedure TLongPressTracker.AttachForm;
begin
  if FForm <> nil then
  begin
    FForm.HandleNeeded;
    FOldFormWndProc := Pointer(GetWindowLong(FForm.Handle, GWL_WNDPROC));
    SetWindowLong(FForm.Handle, GWL_WNDPROC,
      Integer(MakeObjectInstance(NewFormWndProc)));
  end;
end;

constructor TLongPressTracker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 1000;
  FTimer.OnTimer := LongPressed;
  if AOwner is TCustomForm then
    SetForm(TCustomForm(AOwner));
end;

destructor TLongPressTracker.Destroy;
begin
  if FTimer.Enabled then
  begin
    FTimer.Enabled := False;
    TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
  end;
  DetachForm;
  inherited Destroy;
end;

procedure TLongPressTracker.DetachForm;
begin
  if FForm <> nil then
  begin
    if FForm.HandleAllocated then
      SetWindowLong(FForm.Handle, GWL_WNDPROC, Integer(FOldFormWndProc));
    FForm := nil;
  end;
end;

function TLongPressTracker.GetDuration: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TLongPressTracker.LongPressed(Sender: TObject);
begin
  FTimer.Enabled := False;
  if (Abs(FClickPos.X - Mouse.CursorPos.X) < Mouse.DragThreshold) and
    (Abs(FClickPos.Y - Mouse.CursorPos.Y) < Mouse.DragThreshold) and
    (((FChild is TWinControl) and TWinControl(FChild).Focused) or
      (TControlAccess(FChild).MouseCapture or (not FChild.Enabled))) then
  begin
    FForm.ActiveControl := FPrevActiveControl;
    if Assigned(FOnLongPress) then
      FOnLongPress(FChild);
  end;
  TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
end;

procedure TLongPressTracker.NewChildMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FTimer.Enabled := False;
  if Assigned(FOldChildOnMouseUp) then
    FOldChildOnMouseUp(Sender, Button, Shift, X, Y);
  TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
end;

procedure TLongPressTracker.NewFormWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_PARENTNOTIFY:
      if TWMParentNotify(Message).Event = WM_LBUTTONDOWN then
        StartTracking;
    WM_LBUTTONDOWN:
      StartTracking;
  end;
  with Message do
    Result := CallWindowProc(FOldFormWndProc, FForm.Handle, Msg, WParam,
      LParam);
end;

procedure TLongPressTracker.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FForm) and (Operation = opRemove) then
    DetachForm;
  if (AComponent = FChild) and (Operation = opRemove) then
  begin
    FTimer.Enabled := False;
    FChild := nil;
  end;
end;

procedure TLongPressTracker.SetDuration(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

procedure TLongPressTracker.SetForm(Value: TCustomForm);
begin
  if FForm <> Value then
  begin
    DetachForm;
    FForm := Value;
    FForm.FreeNotification(Self);
    AttachForm;
  end;
end;

procedure TLongPressTracker.StartTracking;
begin
  FClickPos := Mouse.CursorPos;
  FChild := FindControlAtPos(FForm, FClickPos);
  FChild.FreeNotification(Self);
  FPrevActiveControl := FForm.ActiveControl;
  FOldChildOnMouseUp := TControlAccess(FChild).OnMouseUp;
  TControlAccess(FChild).OnMouseUp := NewChildMouseUp;
  FTimer.Enabled := True;
end;

end.

要使该组件正常工作，请将其添加到包中，或使用以下运行时代码:

  ...
  private
    procedure LongPress(Control: TControl);
  end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TLongPressTracker.Create(Self) do
    OnLongPress := LongPress;
end;

procedure TForm1.LongPress(Control: TControl);
begin
  Caption := 'Long press occurred on: ' + Sender.ClassName;
end;