I've created the following class to try to improve the response of a scroll bar. The reason is that if the code in the scrollbar's onchange event is even slightly slow then updates don't take effect until you stop dragging the thumb. This is annoying if redrawing a canvas in the onchange event for example. However, updating the canvas in a TTimer event is smooth. My guess is that this has something to do with the TScrollBar OnChange events being synchronous, whereas the TTimer events are asynchronous. My code attempts to solve the TScrollBar problem by triggering the event using a TTimer, which is enabled using the MouseDown event and disabled using the MouseUp event.
The issue is that the onm ouseDown event doesn't trigger at all. I also tried just adding a TScrollBar component to the form at design time and then checking if its MouseDown or MouseUp events get triggered, but they don't either. I managed to find a similar question from 2013, which was never answered.
https://codeverge.com/embarcadero.delphi.firemonkey/help-how-to-trap-mouse-down-mou/1057945
So is there a reason why these events are not triggered? How can I get them to trigger?
Also, if there's another way to improve the response of a standard TScrollBar then please let me know? I'm using 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;
onm ouseDown := ScrollMouseDown;
onm ouseUp := 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.
CodePudding user response:
The following page answered the question for me (after translating from Japanese).
https://www.gesource.jp/weblog/?p=6206
TScrollBar contains a Track object, which in turn contains a Thumb object. It's these objects and not the scroll bar which responds to mouse events. Those objects don't exist yet in the TScrollBar constructor so I set the mouse events in the Paint procedure. The mouse events then trigger and this has solved my performance issue. Dragging a scroll bar now updates my canvas in a much smoother way.
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.