Why is FMX TScrollBar OnMouseUp not working?-CodePudding

I have a ScrollBar with mouse events assigned to onChange, onm ouseWheel and onm ouseUp. The onChange and wheel events work fine, but the onm ouseUp event does not fire. Drilling down to the TControl method on debug, I noticed that the event variable (FOnMouseUp) is nill. The event is assigned in the IDE and I put it in the onCreate event of the form, plus I tried assigning it in various other places after the form is created, but to no avail. What gives?

Here is a simple reproducible example, in which all three scroll bar mouse events do not fire:

 `TForm4 = class(TForm)
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    procedure ScrollBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure ScrollBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.fmx}

procedure TForm4.ScrollBar1Change(Sender: TObject);
begin
  Label1.Text := 'onChange: '   Screen.MousePos.Y.ToString;
end;

procedure TForm4.ScrollBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Label1.Text := 'mousedown: '   Y.ToString;
end;

procedure TForm4.ScrollBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  Label1.Text := 'mousemove: '   Y.ToString;
end;

procedure TForm4.ScrollBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Label1.Text := 'mouseUP: '   Y.ToString;
end;

end.`

And the .FMX:

`object Form4: TForm4
  Left = 0
  Top = 0
  Caption = 'Form4'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object ScrollBar1: TScrollBar
    SmallChange = 0.000000000000000000
    Orientation = Vertical
    Position.X = 616.000000000000000000
    Position.Y = 8.000000000000000000
    Size.Width = 18.000000000000000000
    Size.Height = 449.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    OnChange = ScrollBar1Change
    onm ouseDown = ScrollBar1MouseDown
    onm ouseMove = ScrollBar1MouseMove
    onm ouseUp = ScrollBar1MouseUp
  end
  object Label1: TLabel
    Position.X = 568.000000000000000000
    Position.Y = 152.000000000000000000
    Text = 'Label1'
    TabOrder = 1
  end
end`

CodePudding user response：

The reason is that the scroll bar contains child objects such as a track, a thumb and min and max buttons. It's these objects that respond to mouse events, not the parent object. So the solution is to set your mouse events to those objects. The problem is that those object are protected, so you'll have to create a new Scroll bar class that sets those events. The child objects don't yet exist in the TScrollBar constructor, so the best place to assign them I've found is on the first paint event.

I asked almost exactly the same question a couple of weeks ago. See my own answer here.

FMX: TScrollBar MouseDown and MouseUp events not triggering

Here's your example, which now works. I've also replaced your one label with 4 labels to make it easier to see which events get called.

New scroll bar class that does respond to mouse events:

unit ScrollBarMouse;

interface

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

type

  // A scroll bar that responds to mouse events
  TScrollBarMouse = class(TScrollBar)
  private
    FMouseEventsSet : Boolean;
    FOnMouseDown : TMouseEvent;
    FOnMouseUp : TMouseEvent;
    FOnMouseMove : TMouseMoveEvent;

  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;

    property onm ouseDown2 : TMouseEvent write FOnMouseDown;
    property onm ouseUp2 : TMouseEvent write FOnMouseUp;
    property onm ouseMove2 : TMouseMoveEvent write FOnMouseMove;
  end;


implementation

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

  FMouseEventsSet := False;
end;

procedure TScrollBarMouse.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)
    and Assigned(FOnMouseDown) and Assigned(FOnMouseUp)
    and Assigned(FOnMouseMove) then begin
    Track.OnMouseDown       := FOnMouseDown;
    Track.OnMouseUp         := FOnMouseUp;
    Track.OnMouseMove       := FOnMouseMove;
    Track.Thumb.OnMouseDown := FOnMouseDown;
    Track.Thumb.OnMouseUp   := FOnMouseUp;
    Track.Thumb.OnMouseMove := FOnMouseMove;
    MinButton.OnMouseDown   := FOnMouseDown;
    MinButton.OnMouseUp     := FOnMouseUp;
    MinButton.OnMouseMove   := FOnMouseMove;
    MaxButton.OnMouseDown   := FOnMouseDown;
    MaxButton.OnMouseUp     := FOnMouseUp;
    MaxButton.OnMouseMove   := FOnMouseMove;
    FMouseEventsSet := True;
  end;
end;

end.

Form unit:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, ScrollBarMouse;

type

TForm4 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure ScrollBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure ScrollBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ScrollBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ScrollBar1 : TScrollBarMouse;
  end;

var
  Form4: TForm4;

implementation

{$R *.fmx}

procedure TForm4.FormCreate(Sender: TObject);
begin
  // Create the scroll bar object
  ScrollBar1 := TScrollBarMouse.Create(Self);
  with ScrollBar1 do begin
    Parent := Self;
    Orientation := TOrientation.Vertical;
    Position.X := 616;
    Position.Y := 8;
    Size.Width := 18;
    Size.Height := 449;
    onm ouseDown2 := ScrollBar1MouseDown;
    onm ouseUp2 := ScrollBar1MouseUp;
    onm ouseMove2 := ScrollBar1MouseMove;
    OnChange := ScrollBar1Change;
  end;
end;

procedure TForm4.ScrollBar1Change(Sender: TObject);
begin
  Label1.Text := 'onChange: '   IntToStr(Round(Screen.MousePos.Y));
end;

procedure TForm4.ScrollBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Label2.Text := 'mousedown: '   IntToStr(Round(Y));
end;

procedure TForm4.ScrollBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  Label3.Text := 'mousemove: '   IntToStr(Round(Y));
end;

procedure TForm4.ScrollBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Label4.Text := 'mouseUP: '   IntToStr(Round(Y));
end;

end.

Form (scroll bar is removed since it's created at run time):

object Form4: TForm4
  Left = 0
  Top = 0
  Caption = 'Form4'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  DesignerMasterStyle = 0
  object Label1: TLabel
    Position.X = 424.000000000000000000
    Position.Y = 144.000000000000000000
    Size.Width = 121.000000000000000000
    Size.Height = 17.000000000000000000
    Size.PlatformDefault = False
    Text = 'Label1'
    TabOrder = 3
  end
  object Label2: TLabel
    Position.X = 424.000000000000000000
    Position.Y = 168.000000000000000000
    Size.Width = 121.000000000000000000
    Size.Height = 17.000000000000000000
    Size.PlatformDefault = False
    Text = 'Label1'
    TabOrder = 2
  end
  object Label3: TLabel
    Position.X = 424.000000000000000000
    Position.Y = 192.000000000000000000
    Size.Width = 121.000000000000000000
    Size.Height = 17.000000000000000000
    Size.PlatformDefault = False
    Text = 'Label1'
    TabOrder = 1
  end
  object Label4: TLabel
    Position.X = 424.000000000000000000
    Position.Y = 216.000000000000000000
    Size.Width = 121.000000000000000000
    Size.Height = 17.000000000000000000
    Size.PlatformDefault = False
    Text = 'Label1'
    TabOrder = 0
  end
end

This was built using Delphi 10.4 and run in Windows 10.