delphifiremonkeymouseuponmouseup

Why is FMX TScrollBar OnMouseUp not working?


I have a ScrollBar with mouse events assigned to onChange, onMouseWheel and onMouseUp. The onChange and wheel events work fine, but the onMouseUp 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
    OnMouseDown = ScrollBar1MouseDown
    OnMouseMove = ScrollBar1MouseMove
    OnMouseUp = ScrollBar1MouseUp
  end
  object Label1: TLabel
    Position.X = 568.000000000000000000
    Position.Y = 152.000000000000000000
    Text = 'Label1'
    TabOrder = 1
  end
end`

Solution

  • 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;
      protected
        procedure Paint; override;
      public
        constructor Create(AOwner: TComponent); override;
      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) and Assigned(Track.Thumb)
        and Assigned(MinButton) and Assigned(MaxButton) then begin
        Track.OnMouseDown       := OnMouseDown;
        Track.OnMouseUp         := OnMouseUp;
        Track.OnMouseMove       := OnMouseMove;
        Track.Thumb.OnMouseDown := OnMouseDown;
        Track.Thumb.OnMouseUp   := OnMouseUp;
        Track.Thumb.OnMouseMove := OnMouseMove;
        MinButton.OnMouseDown   := OnMouseDown;
        MinButton.OnMouseUp     := OnMouseUp;
        MinButton.OnMouseMove   := OnMouseMove;
        MaxButton.OnMouseDown   := OnMouseDown;
        MaxButton.OnMouseUp     := OnMouseUp;
        MaxButton.OnMouseMove   := OnMouseMove;
        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;
        OnMouseDown := ScrollBar1MouseDown;
        OnMouseUp := ScrollBar1MouseUp;
        OnMouseMove := 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.