[FMX]开年第一弹:修改 FMX.Controls 避免按住编辑框移动时弹出输入法的问题

在 FMX 中,当用户在编辑框上按下时,许多场景下,是要拖动位置,但是,FMX.Controls 在 MouseDown 事件中,就调用了控件的 SetFocus ,结果就造成按下时,弹出输入法,影响拖动操作。我们可以将相应的代码那到 MouseUp 中来解决这一问题。同时,我们加一个判断,以避免将拖动识别为点击。

所以,我们要做的第一步是打开 FMX.Controls.pas,找到下面的这段代码:

procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if (not (csDesigning in ComponentState)) and (not FIsFocused) then
    SetFocus;

  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
  if FAutoCapture then
    Capture;
  if (ssDouble in Shift) then
  begin
    DblClick;
    FDoubleClick := True;
  end
  else if Button = TMouseButton.mbLeft then
  begin
    FPressed := True;
    FPressedPosition := TPointF.Create(X, Y);
    StartTriggerAnimation(Self, 'Pressed');
  end;
end;seButton.mbLeft then
  begin
    FPressed := True;
    FPressedPosition := TPointF.Create(X, Y);
    StartTriggerAnimation(Self, 'Pressed');
  end;
end;

将第一句删除,以避免它设置焦点,修正成下面这样:

procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
  if FAutoCapture then
    Capture;
  if (ssDouble in Shift) then
  begin
    DblClick;
    FDoubleClick := True;
  end
  else if Button = TMouseButton.mbLeft then
  begin
    FPressed := True;
    FPressedPosition := TPointF.Create(X, Y);
    StartTriggerAnimation(Self, 'Pressed');
  end;
end;seButton.mbLeft then
  begin
    FPressed := True;
    FPressedPosition := TPointF.Create(X, Y);
    StartTriggerAnimation(Self, 'Pressed');
  end;
end;

然后,我们需要找到 TControl.MouseUp 的代码(原始):

procedure TControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  ReleaseCapture;

  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
  if FPressed then
  begin
    FPressed := False;
    StartTriggerAnimation(Self, 'Pressed');
  end;
  FDoubleClick := False;
end;

我们要修改下它,以在用户松开时,将如果用户是点击在相应的按钮(移动距离小于10,这个阀值大家可以自己调节,一般为5-10),则设置焦点:

procedure TControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if (not (csDesigning in ComponentState)) and (not FIsFocused) and (FPressedPosition.Distance(PointF(X,Y))<10) then
    SetFocus;
  ReleaseCapture;

  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
  if FPressed then
  begin
    FPressed := False;
    StartTriggerAnimation(Self, 'Pressed');
  end;
  FDoubleClick := False;
end;

好了,剩下的就是将修改后的源码复制到你工程的当前目录下,用来替换系统自带的FMX.Controls。

实际运行效果视频:

分享到: