2020年9月10日木曜日

Delphi Fmx Edit+SpinEditButtonで長押しが効かない問題対応

こんにちは、

おひさしぶり。

やましょうです。

Delphi Fmx Edit+SpinEditButtonで長押しが効かない

 久々にWindowsでDelphiのお仕事があったのですが、

仕様書ちょっとボタンの色 が青だったので、いいやFmxでって作って

SpinEdit痛い目にあったので、対応方法含めまとめてみました。

1.VCLでの動作

まずVclで確認です。 

ってVCLでまぁ長押しで連続UP/DOWNはできているのですが、なぜ、押してすぐに±1しないってバグ?というか仕様といかという部分はありますが、動画のように連続UP/DOWNできます。

2.FMXでの確認

FMXで動かすSpinEditButtonのイベントはOnUpClickかOnDownClickしかありません。
しかも、離した時に動作します。
(これでは外から押されたときに処理を開始、
離されたらやめるということもできません。)
以下動画


 変更のタイミング、この長押し(連続押し)対応言われたの
ほぼユーザーの確認が終わって最後の変更時に言われたので超絶焦りました。
ってかC#だと簡単にできているので、Delphiでもできると思い込んでいた(笑)。
(やっぱ事前確認は必要だね。)

2.対応策の検討

ひとつ前の動画をみればわかりますが、現状離されたら処理になっています。
 
こんな感じで処理がされています。

希望のタイミング
押されたとき+1、500ms以上の長押し時 100ms/stepでup/downする。

対応するとこうなります。

ってことでめでたしめでたしでした。

 

 対応コード

FMX.Edit.pasを以下の赤色の部分を追加もしくは変更してください。

  TSpinEditButton = class(TStyledControl, IEditControl)
  strict private
    FUpButton: TCustomButton;
    FDownButton: TCustomButton;
    { Events }
    FOnUpClick: TNotifyEvent;
    FOnDownClick: TNotifyEvent;
    FLongPushTimer: TTimer;
  protected
    { Style }
    procedure ApplyStyle; override;
    procedure FreeStyle; override;
    function GetDefaultStyleLookupName: string; override;
    function GetDefaultSize: TSizeF; override;
    { Events }
//  procedure DoUpButtonClick(Sender: TObject);
//  procedure DoDownButtonClick(Sender: TObject);
    procedure LongPushTimerFired(Sender: TObject);
    procedure DoUpMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoDownMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoUpMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoDownMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);

    { IEditControl }
 

{ TSpinEditButton }

procedure TSpinEditButton.ApplyStyle;
begin
  inherited ApplyStyle;

   FLongPushTimer := TTimer.Create(Self);
   FLongPushTimer.Interval := 100;
   FLongPushTimer.OnTimer  := LongPushTimerFired;
   FLongPushTimer.Enabled  := False;
   FLongPushTimer.Tag      := 0;


  if FindStyleResource<TCustomButton>('upbutton', FUpButton) then
  begin
    FUpButton.TouchTargetExpansion.Bottom := 0;
//    FUpButton.OnClick     := DoUpButtonClick;
    FUpButton.OnMouseDown := DoUpMousedown;
    FUpButton.OnMouseUp   := DoUpMouseUp;

  end;
  if FindStyleResource<TCustomButton>('downbutton', FDownButton) then
  begin
    FDownButton.TouchTargetExpansion.Top := 0;
///     FDownButton.OnClick     := DoDownButtonClick;
    FDownButton.OnMouseDown := DoDownMousedown;
    FDownButton.OnMouseUp   := DoDownMouseUp
;
  end;
end;

procedure TSpinEditButton.LongPushTimerFired(Sender: TObject);
begin
  if( FLongPushTimer.tag = $10) then
  begin {up 方向連続押し}
   if Assigned(FOnUpClick) then
      FOnUpClick(Self);
  end
  else
  if( FLongPushTimer.tag = $20) then
  begin {up 方向連続押し}
   if Assigned(FOnDownClick) then
      FOnDownClick(Self);
  end
  else
  if( FLongPushTimer.tag and $0f <> 0) then
  begin
    FLongPushTimer.tag := Round(FLongPushTimer.tag.ToSingle-1);
  end;
end;


procedure TSpinEditButton.DoUpMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
 FLongPushTimer.Enabled  := true;
 FLongPushTimer.Tag      := $15;
 if Assigned(FOnUpClick) then
    FOnUpClick(Self);
end;

procedure TSpinEditButton.DoDownMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FLongPushTimer.Enabled  := true;
  FLongPushTimer.Tag      := $25;
  if Assigned(FOnDownClick) then
    FOnDownClick(Self);
end;



procedure TSpinEditButton.DoUpMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FLongPushTimer.Enabled  := false;
  FLongPushTimer.Tag      := $00;
end;

procedure TSpinEditButton.DoDownMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FLongPushTimer.Enabled  := false;
  FLongPushTimer.Tag      := $00
end;


procedure TSpinEditButton.FreeStyle;
begin
  if(FUpButton <> nil ) then  FUpButton.OnMouseDown := Nil;
  if(FUpButton <> nil ) then  FUpButton.OnMouseUp   := Nil;
  if(FDownButton <> nil ) then  FDownButton.OnMouseDown := Nil;
  if(FDownButton <> nil ) then  FDownButton.OnMouseUp   := Nil;
  if(FLongPushTimer <> Nil) then FLongPushTimer.DisposeOf();

  if FUpButton <> nil then
    FUpButton.OnClick := nil;
  FUpButton := nil;
  if FDownButton <> nil then
    FDownButton.OnClick := nil;
  FDownButton := nil;

  FOnUpClick  := nil;
  FOnDownClick:= nil;
  inherited FreeStyle;
end;
 

以上

 やましょうでした。