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

长按是指按住一个按钮/面板一段时间（比如2秒），不释放或拖动。这在手机和触摸设备中很常见。
我试过使用手势，在平板电脑选项中检查了按下并保持，并在交互式手势选项中检查了所有内容，但长时间按下导致没有OnGesture调用。
我能想到的另一个实现是添加一个计时器，在MouseDown中启动它，并在TimerFired、StartDrag、MouseUp或MouseLeave中结束它。然而，由于我想将此行为添加到几个不同的按钮和面板组件中，我必须覆盖每个类中的一系列过程，并为每个组件复制代码。
有没有更好的方法来实现这一目标？
编辑：
至NGLN
哇，伟大的作品!加上你对那些滚动效果的回答，VCL几乎可以达到移动操作系统的外观和感觉!
您的代码完美地与公共控件，但我有两个问题，在我的情况
1.长时间单击表单无法检测到（原因是表单不是自身的父级），我将查找FChild代码转移到单独的过程，并从WMParentNotify和FormMouseDown调用来解决它。
1.我得到了一些自定义按钮，其中有一些被禁用的HTML标签（页眉，标题，页脚）覆盖了标签的原始表面，使用您的代码，FChild将是这些标签之一，但它没有得到MouseCapture。
而不是TControlAccess（FChild）。启用时执行FChild：= FChild. Parent;
最后，对于一些更复杂的控件，如TCategoryButtons或TListBox，事件的用户可能不需要检查整个控件，而是检查控件中的指定项。因此，我认为我们需要保存原始CursorPos，并在计时器触发时触发另一个事件，以便手动确定是否满足长按条件。如果满足或未分配事件，然后使用默认代码进行确定。
总之，我们可以创建一个支持LongPress的窗体/面板来托管所有其他控件。这比逐个组件实现LongPress功能要容易得多!非常感谢!
编辑2：
至NGLN
再次感谢您的组件版本，这是一个很好的方法，不需要做任何修改现有的组件，可以检测长按无处不在!
供你参考，我已做了几处修改以适应我自己的需要.

TCustomForm与双控件：由于我的大部分应用程序只有一个主窗体，所有其他的可视化单元都是我自己创建的框架（不是来自TFrame，而是来自带有ccpack支持的TScrollingWinControl），假设TCustomForm不适合我，所以我删除了属性form（但保留ActiveControl的FForm）并创建了一个发布属性Host：TWinControl作为父主机。这样，我也可以限制检测一些有限的面板。当分配主机，我检查并找到FForm使用GetParentForm（FHost）。
1.禁用控件：正如我之前所说的，我得到了一些禁用的TJvHTLabel，它覆盖了我的按钮，而您的组件在标签上工作。我当然可以通过标签找到按钮，但我认为如果它由新组件处理会更方便。所以我添加了一个属性SkipDisabled，如果设置为turn，则在其父行中循环以找到第一个启用的控件。
1.我添加了一个PreserveFocus属性，让组件用户选择是否保留最后一个活动控件。
1.我修改了你的TLongPressEvent，添加了ClickPos作为第二个参数。所以，我现在可以使用ClickPos来查找列表框或类似物中的哪个项被长时间保留。
1.在我看来，FindVCLWindow与您的FindControlAtPos具有相同的效果？
再次感谢你的出色工作。

每次单击鼠标左键时，WM_PARENTNOTIFY都会发送到所单击控件的所有（祖父）父控件。因此，这可以用于跟踪长按的起始点，并且可以使用计时器计时长按的持续时间。剩下的是决定何时将某个按称为“长按”。当然，要将所有这些都 Package 在一个漂亮的组件中。
在下面编写的组件中，OnLongPress事件处理程序将在满足以下条件时激发：

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

对代码的一些解释：

它临时替换控件的OnMouseUp事件处理程序，否则连续单击也可能导致 * 长按 *。中间事件处理程序禁用跟踪计时器，调用原始事件处理程序并将其替换回来。
长按后，活动控件被重置，因为我认为长按不是为了聚焦控件。但这只是我的猜测，它可能是一个属性的候选对象。
还跟踪窗体本身的长时间按下（而不是仅跟踪其查尔兹窗体）。
有一个自定义的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;

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

1条答案

相关问题

热门标签

最新问答