FMX: TScrollBar MouseDown和MouseUp事件未触发



我创建了下面的类来尝试改进滚动条的响应。原因是,如果滚动条的onchange事件中的代码稍微慢一点,那么更新不会生效,直到你停止拖动拇指。例如,如果在onchange事件中重新绘制画布,这是很烦人的。然而,在TTimer事件中更新画布是平滑的。我的猜测是,这与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.

下面的页面为我回答了这个问题(从日语翻译过来)。

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

TScrollBar包含一个Track对象,而Track对象又包含一个Thumb对象。是这些对象,而不是滚动条响应鼠标事件。这些对象在TScrollBar构造函数中还不存在,所以我在Paint过程中设置了鼠标事件。然后触发鼠标事件,这解决了我的性能问题。拖动滚动条现在以更流畅的方式更新我的画布。

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.

相关内容

  • 没有找到相关文章

最新更新