FMX：TScrollBar MouseDown 和 MouseUp 事件未触发

Question

我创建了以下 class 来尝试改进滚动条的响应。原因是，如果滚动条的 onchange 事件中的代码稍微慢一点，那么更新不会生效，直到您停止拖动拇指。例如，如果在 onchange 事件中重绘 canvas，这很烦人。但是，在 TTimer 事件中更新 canvas 是顺利的。我的猜测是，这与同步的 TScrollBar OnChange 事件有关，而 TTimer 事件是异步的。我的代码尝试通过使用 TTimer 触发事件来解决 TScrollBar 问题，TTimer 使用 MouseDown 事件启用，使用 MouseUp 事件禁用。

问题是 OnMouseDown 事件根本没有触发。我还尝试在设计时向表单添加一个 TScrollBar 组件，然后检查它的 MouseDown 或 MouseUp 事件是否被触发，但它们都没有。我设法从 2013 年找到了一个类似的问题，但从未回答过。

https://codeverge.com/embarcadero.delphi.firemonkey/help-how-to-trap-mouse-down-mou/1057945

那么这些事件没有被触发是有原因的吗？我怎样才能让它们触发？

此外，如果有其他方法可以改善标准 TScrollBar 的响应，请告诉我？我正在使用 Delphi 10.4.

unit ScrollBarSmoothUnit;

interface

uses
  System.Classes, System.UITypes, FMX.StdCtrls, FMX.Types;

type

  TScrollBarSmooth = class(TScrollBar)
  private
    FTimer : TTimer;
    FLastValue : Single;

    procedure ScrollMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure DoChange(Sender: TObject);
  public
    OnChangeSmooth : TNotifyEvent;

    constructor Create(AOwner: TComponent); override;
  end;


implementation

constructor TScrollBarSmooth.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  AutoCapture := True;
  HitTest := True;
  OnMouseDown := ScrollMouseDown;
  OnMouseUp   := ScrollMouseUp;

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 40;
  FTimer.Enabled := False;
  FTimer.OnTimer := DoChange;

  FLastValue := -1;
end;

procedure TScrollBarSmooth.ScrollMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  FTimer.Enabled := True;
end;

procedure TScrollBarSmooth.ScrollMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  FTimer.Enabled := False;

  DoChange(Self);
end;

procedure TScrollBarSmooth.DoChange(Sender: TObject);
begin
  if Value = FLastValue then Exit; // No change
  FLastValue := Value;

  if Assigned(OnChangeSmooth) then OnChangeSmooth(Self);
end;

end.

Answer 1

下面的页面回答了我的问题（从日语翻译后）。

https://www.gesource.jp/weblog/?p=6206

TScrollBar 包含一个 Track 对象，该对象又包含一个 Thumb 对象。响应鼠标事件的是这些对象而不是滚动条。这些对象在 TScrollBar 构造函数中尚不存在，因此我在 Paint 过程中设置了鼠标事件。然后触发鼠标事件，这解决了我的性能问题。拖动滚动条现在可以更流畅地更新我的 canvas。

unit ScrollBarSmoothUnit;

interface

uses
  System.Classes, System.UITypes, FMX.StdCtrls, FMX.Types;

type

  // A scroll bar with smoother response if OnChange event is slow
  TScrollBarSmooth = class(TScrollBar)
  private
    FTimer : TTimer;
    FLastValue : Single;
    FMouseEventsSet : Boolean;
    FOnChangeSmooth : TNotifyEvent;

    procedure ScrollMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure DoChange(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;

    property OnChangeSmooth : TNotifyEvent write FOnChangeSmooth;
  end;


implementation

constructor TScrollBarSmooth.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 40;
  FTimer.Enabled := False;
  FTimer.OnTimer := DoChange;

  FLastValue := -1;
  FMouseEventsSet := False;
end;

procedure TScrollBarSmooth.Paint;
begin
  inherited;

  // Track and Buttons are not assigned in constructor, so set mouse events on first paint
  if not FMouseEventsSet and Assigned(Track.Thumb)
    and Assigned(MinButton) and Assigned(MaxButton) then begin
    Track.OnMouseDown       := ScrollMouseDown;
    Track.OnMouseUp         := ScrollMouseUp;
    Track.Thumb.OnMouseDown := ScrollMouseDown;
    Track.Thumb.OnMouseUp   := ScrollMouseUp;
    MinButton.OnMouseDown   := ScrollMouseDown;
    MinButton.OnMouseUp     := ScrollMouseUp;
    MaxButton.OnMouseDown   := ScrollMouseDown;
    MaxButton.OnMouseUp     := ScrollMouseUp;
    FMouseEventsSet := True;
  end;
end;

procedure TScrollBarSmooth.ScrollMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  FTimer.Enabled := True;
end;

procedure TScrollBarSmooth.ScrollMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  FTimer.Enabled := False;

  DoChange(Self);
end;

procedure TScrollBarSmooth.DoChange(Sender: TObject);
begin
  if Value = FLastValue then Exit; // No change
  FLastValue := Value;

  if Assigned(FOnChangeSmooth) then FOnChangeSmooth(Self);
end;

end.

FMX：TScrollBar MouseDown 和 MouseUp 事件未触发

FMX: TScrollBar MouseDown and MouseUp events not triggering

delphi

firemonkey

delphi-10.4-sydney