为什么 FMX TScrollBar OnMouseUp 不工作？

Question

我有一个 ScrollBar，鼠标事件分配给了 onChange、onMouseWheel 和 onMouseUp。 onChange 和 wheel 事件工作正常，但 onMouseUp 事件不会触发。在调试时深入到 TControl 方法，我注意到事件变量 (FOnMouseUp) 为空。该事件在 IDE 中分配，我将其放在表单的 onCreate 事件中，另外我尝试在创建表单后在其他各个地方分配它，但无济于事。给出了什么？

这是一个简单的可重现示例，其中所有三个滚动条鼠标事件均未触发：

 `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.`

还有.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`

Answer 1

原因是滚动条包含轨道、拇指和最小和最大按钮等子对象。响应鼠标事件的是这些对象，而不是父对象。所以解决方案是将鼠标事件设置为这些对象。问题是那些对象是受保护的，因此您必须创建一个新的滚动条 class 来设置这些事件。 TScrollBar 构造函数中尚不存在子对象，因此我发现分配它们的最佳位置是在第一次绘制事件中。

几周前我问了几乎完全相同的问题。在这里查看我自己的答案。

这是您的示例，现在可以使用了。我还将您的一个标签替换为 4 个标签，以便更容易查看调用了哪些事件。

响应鼠标事件的新滚动条class：

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.

表格单位：

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.

表单（滚动条被删除，因为它是在运行时间创建的）：

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

这是使用 Delphi 10.4 和运行在 Windows 10 中构建的。

为什么 FMX TScrollBar OnMouseUp 不工作？

Why is FMX TScrollBar OnMouseUp not working?

delphi

firemonkey

mouseup

onmouseup