Delphi 向button类添加长按事件的最佳方法是什么？

长按，我指的是按下按钮/面板并保持一段时间（比如2秒），而不释放或拖动。这在手机和触摸设备中很常见

我试过使用手势，在桌面选项中选择了topress和hold，并选择了所有的InteractiveGestureOptions，但长时间按下不会导致任何感觉调用

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

有没有更好的方法来实现这一点

---

编辑：

到NGLN

哇，干得好！加上你对这些滚动效果的回答，VCL几乎可以实现移动操作系统的外观和感觉

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

无法检测到对表单的长时间单击（原因与表单相同） 不是自身的父级）我将Find FChild代码移到separate 从WMParentNotify和FormMouseDown到的过程和调用 解决它

我有一些自定义按钮，其中有一些禁用的HTML 覆盖原始标签的标签（页眉、标题、页脚） 表面，使用您的代码，FChild将是其中一个标签，但它 不要用鼠标夹。我添加以下行来克服它：

而不是TControlAccess（FChild） FChild:=FChild.Parent

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

总之，我们可以创建一个支持LongPress的表单/面板来承载所有其他控件。这比逐个组件实现LongPress功能更容易！非常感谢

---

编辑2：

到NGLN

再次感谢您的组件版本，这是一个极好的方法，不需要对现有组件进行任何修改，并且可以检测到到处都有长时间的按压

供你参考，我做了几次修改以满足我自己的需要

TCustomForm vs TWinControl：由于我的大多数应用程序只有一个主窗体，而所有其他可视单元都是我自己创建的框架（不是从TFrame而是TcsrollingWinControl，支持ccpack），假设TCustomForm不适用于我。所以我删除了属性表单（但保留了ActiveControl的FForm），并创建了一个已发布的属性主机：TWinControl作为父主机。这样，我也可以将检测限制在某个有限的面板上。分配主机时，我使用GetParentForm（FHost）检查并查找FForm

禁用控件：正如我前面所说，我得到了一些禁用的TJvHTLabel，它覆盖了我的按钮和标签上的组件工作。我当然可以找到标签旁边的按钮，但我认为如果它是由新组件处理的话会更方便。所以我添加了一个属性SkipDisabled，如果设置为turn，则在其父行中循环以查找第一个启用的控件

我添加了一个PreserveFocus属性，让组件用户选择是否保留最后一个activecontrol

控件与项目一起使用。我更改了TlongPress事件，添加ClickPos作为第二个参数。因此，我现在可以使用ClickPos来查找列表框或类似列表框中的哪个项目被长期保留

在我看来，FindVCLWindow与您的FindControlAtPos具有相同的效果

---

再次感谢您的出色工作

在每次鼠标左键单击时，都会发送给所单击控件的所有（主要）父控件。因此，这可以用于跟踪长时间按压的起始点，并且按压的持续时间可以通过计时器计时。剩下的就是决定什么时候一个新闻应该被称为长新闻。当然，这一切都要用一个很好的组件来总结

在下面编写的组件中，当满足以下条件时，将触发

OnLongPress

事件处理程序：

• 间隔后，控件仍有鼠标捕获、焦点或被禁用
• 间隔结束后，鼠标移动的距离不超过

  鼠标。拖动阈值

关于代码的一些解释：

• 它临时替换控件的

  OnMouseUp

  事件处理程序，否则连续单击也可能导致长按。中间事件处理程序禁用跟踪计时器，调用原始事件处理程序并将其替换回来
• 长按之后，活动控件被重置，因为我认为长按并不是为了聚焦控件。但这只是我的猜测，它可能是一个属性的候选人
• 还跟踪窗体本身（而不仅仅是其子窗体）上的长时间按压
• 有一个自定义的

  FindControlAtPos

  例程，可在任意窗口上执行深度搜索。备选方案有：（1）

  TWinControl.ControlAtPos

  ，但它只搜索一级深度；和（2）

  Controls.FindDragTarget

  ，但尽管有

  AllowDisabled

  参数，它无法找到禁用的控件

---

计时器将是错误的。按下鼠标上的按钮。不能在鼠标仍处于按下状态时触发动作。“秒表更合理。”大卫·费弗南，谢谢。然而，在Android桌面上，当你按下大约2秒钟时，它会变成另一种模式，让你添加快捷方式或小部件。媒体尚未发布，但我认为此后不会有点击/鼠标事件。我认识安德烈

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;