0

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 OnMouseDown 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;
  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.
XylemFlow
  • 963
  • 5
  • 12

1 Answers1

1

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.
XylemFlow
  • 963
  • 5
  • 12