这是FireMonkey中未实现的功能吗或者是一个bug吗?都不是,尽管作为功能它会很好。这里有一个可能的解决方案:
unit MainFrm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls;
type
TMouseInfo = record
Down: Boolean;
DownPt: TPointF;
Moved: Boolean;
procedure MouseDown(const X, Y: Single);
procedure MouseMove(const X, Y: Single);
procedure MouseUp;
end;
TButton = class(FMX.StdCtrls.TButton)
private
FMouseInfo: TMouseInfo;
protected
procedure Click; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
end;
TfrmMain = class(TForm)
MessagesMemo: TMemo;
VertScrollBox: TVertScrollBox;
private
procedure ControlClickHandler(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
var
frmMain: TfrmMain;
implementation
{$R *.fmx}
procedure TMouseInfo.MouseDown(const X, Y: Single);
begin
Down := True;
Moved := False;
DownPt := PointF(X, Y);
end;
procedure TMouseInfo.MouseMove(const X, Y: Single);
begin
if Down and not Moved then
Moved := (Abs(X - DownPt.X) > 10) or (Abs(Y - DownPt.Y) > 10);
end;
procedure TMouseInfo.MouseUp;
begin
Down := False;
end;
procedure TButton.Click;
begin
if not FMouseInfo.Moved then
inherited;
end;
procedure TButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseDown(X, Y);
end;
procedure TButton.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseMove(X, Y);
end;
procedure TButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
FMouseInfo.MouseUp;
end;
constructor TfrmMain.Create(AOwner: TComponent);
var
I: Integer;
LButton: TButton;
begin
inherited;
for I := 0 to 29 do
begin
LButton := TButton.Create(Self);
LButton.Name := 'Button' + (I + 1).ToString;
LButton.Width := 120;
LButton.Height := 32;
LButton.Position.X := (Width - LButton.Width) / 2;
LButton.Position.Y := I * 80;
LButton.OnClick := ControlClickHandler;
LButton.Parent := VertScrollBox;
end;
end;
procedure TfrmMain.ControlClickHandler(Sender: TObject);
begin
MessagesMemo.Lines.Add(TComponent(Sender).Name + ' was clicked');
end;
end.
在这里,我使用了一个经常被称为“插入器”类的东西,它继承自TButton,覆盖了必要的方法以检测鼠标是否移动,因此只有当鼠标没有(非常)移动时才调用Click。当一个按钮接收到MouseDown时,Down标志和位置被设置,然后当接收到MouseMove时,它计算了移动的距离。如果太远,当最终调用Click时,继承的方法不会被调用,因此没有OnClick事件触发。
您可以使用相同的技术来处理您的TRectangle或任何其他可以接收点击的对象。