こんにちは、
おひさしぶり。
やましょうです。
Delphi Fmx Edit+SpinEditButtonで長押しが効かない
久々にWindowsでDelphiのお仕事があったのですが、
仕様書ちょっとボタンの色 が青だったので、いいやFmxでって作って
SpinEdit痛い目にあったので、対応方法含めまとめてみました。
1.VCLでの動作
まずVclで確認です。
ってVCLでまぁ長押しで連続UP/DOWNはできているのですが、なぜ、押してすぐに±１しないってバグ？というか仕様といかという部分はありますが、動画のように連続UP/DOWNできます。
2.FMXでの確認
FMXで動かすSpinEditButtonのイベントはOnUpClickかOnDownClickしかありません。
しかも、離した時に動作します。
（これでは外から押されたときに処理を開始、
離されたらやめるということもできません。）
以下動画
ほぼユーザーの確認が終わって最後の変更時に言われたので超絶焦りました。
ってかC#だと簡単にできているので、Delphiでもできると思い込んでいた（笑）。
（やっぱ事前確認は必要だね。)
2.対応策の検討
対応するとこうなります。
ってことでめでたしめでたしでした。
対応コード
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;
以上
やましょうでした。
