FMXのTNumberBoxでカンマ編集

解決

---

Hideと申します。
Delphi11でFMXアプリケーション開発を行っています。
TNumberBoxでカンマ編集を行いたいのですが、VCLの様にWMKeyDownなどのwindowsイベントが使えないと思われます。
何か良い方法はありますでしょうか？
何卒宜しくお願い致します。

編集 削除

---

試しに次の様に記述してみましたが、上手く行きませんでした（Textプロパティが置き換えられない様な挙動でして、入力文字も反映されませんねぇ）。この辺でお困りなのでしょうね、きっと。。。
procedure MyNumBox.KeyDown(var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
  inherited;
  Text := FormatFloat('#,##0.##', Value);
end;
答えになっておらずすみません。

編集 削除

---

Moeさん、コメント有難うございます。
そうなんです。textプロパティとvalueが連動していると思うので、上手く行かない状態なんです。
継承元を変更すべきなのかも知れないですね。

編集 削除

---

Edit だけど

var
  KeyDownCount: Integer = 0;

procedure TForm2.FormCreate(Sender: TObject);
begin
    Edit1.FilterChar := '1234567890,';   //数値と,のみ表示可
    Edit1.TextSettings.HorzAlign := FMX.Types.TTextAlign.Trailing;  //右寄せ
    Edit1.OnKeyUp   := Edit1KeyUp;
    Edit1.OnKeyDown := Edit1KeyDown;

end;

procedure TForm2.Edit1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
  C: Char;
  SaveCaret: TPointF;
  SaveCaretPosition: Integer;

  procedure XXX;
  var
    I,J: Integer;
    S1,S2: String;
  begin
    // , を取り除く
    S1 := ReplaceText(Edit1.Text,',','');
    //3行毎に , を入れる
    S2 := '';
    J := 3- (Length(S1) mod 3);
    for I := 1 to Length(S1) do
    begin
      S2 := S2 + S1[I];
      J := (J + 1) mod 3;
      if (J=0) and (I <> Length(S1)) then S2 := S2 + ',';
    end;
    Edit1.Text := S2;
  end;

begin

    case Key of
       0:
      begin
        case KeyChar of
          ',':
          begin
            KeyChar := Char(0);
          end
          else
          begin
            //0..9
            if KeyDownCount > 0 then
            begin
              Edit1.Caret.BeginUpdate;
              SaveCaret := Edit1.Caret.Pos;
              SaveCaretPosition := Edit1.CaretPosition;

              XXX;

              Edit1.Caret.Pos := SaveCaret;
              Edit1.CaretPosition := SaveCaretPosition +1;
              Edit1.Caret.EndUpdate;
            end;

            Inc(KeyDownCount);
          end;
        end;
      end;
       8://BS
      begin
        //KeyUp で処理
      end;
      37:// ←
      begin
        try
          // , を飛ばして移動
          C := Edit1.Text[Edit1.CaretPosition-1];
          if C = ',' then
          begin
            Edit1.CaretPosition := Edit1.CaretPosition - 1;
          end;
        except
        end;
      end;
      39://→
      begin
        try
        　// , を飛ばして移動
          C := Edit1.Text[Edit1.CaretPosition+1];
          if C = ',' then
          begin
            Edit1.CaretPosition := Edit1.CaretPosition + 1;
          end;
        except
        end;
      end;
      46://DEL
      begin
        try
          // , の左隣では [DEL] は無効
          C := Edit1.Text[Edit1.CaretPosition+1];
          if C = ',' then Key := 0;
        except
        end;
　     end;
    end;

end;

procedure TForm2.Edit1KeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
  SaveCaret: TPointF;
  SaveCaretPosition: Integer;

  procedure XXX;
  var
    I,J: Integer;
    S1,S2: String;
  begin
    // , を取り除く
    S1 := ReplaceText(Edit1.Text,',','');
    //3行毎に , を入れる
    S2 := '';
    J := 3- (Length(S1) mod 3);
    for I := 1 to Length(S1) do
    begin
      S2 := S2 + S1[I];
      J := (J + 1) mod 3;
      if (J=0) and (I <> Length(S1)) then S2 := S2 + ',';
    end;
    Edit1.Text := S2;
  end;

begin
    KeyDownCount :=0;

    case Key of
       0:
      begin
        case KeyChar of
          ',':
          begin
            KeyChar := Char(0);
          end;
          else
          begin
            //0..9
            Edit1.Caret.BeginUpdate;
            SaveCaret := Edit1.Caret.Pos;
            SaveCaretPosition := Edit1.CaretPosition;
            XXX;
            Edit1.Caret.Pos := SaveCaret;
            Edit1.CaretPosition := SaveCaretPosition +1;
            Edit1.Caret.EndUpdate;
          end;
        end
      end;
       8://BS
      begin
        Edit1.Caret.BeginUpdate;
        SaveCaret := Edit1.Caret.Pos;
        SaveCaretPosition := Edit1.CaretPosition;

        XXX;

        //, を飛ばして移動
        Edit1.Caret.Pos := SaveCaret;
        try
          if Edit1.Text[SaveCaretPosition] = ',' then
          begin
            Dec(SaveCaretPosition);
          end;
        except
        end;

        Edit1.CaretPosition := SaveCaretPosition;
        Edit1.Caret.EndUpdate;
      end;
      37://←
      begin
        //KeyDown で処理
      end;
      39://→
      begin
        //KeyDown で処理
      end;
      46://DEL
      begin
        Edit1.Caret.BeginUpdate;
        SaveCaret := Edit1.Caret.Pos;
        SaveCaretPosition := Edit1.CaretPosition;

        XXX;

        Edit1.Caret.Pos := SaveCaret;
        Edit1.CaretPosition := SaveCaretPosition;
        Edit1.Caret.EndUpdate;
      end;
    end;

end;

編集 削除

---

AAAAAさん、サンプルソースの掲載有難うございます。
参考にさせて頂き、コンポーネント化してみます。結果をまたご報告致します。

編集 削除

---

  TNumberCommaEdit = class(FMX.TEdit)
  private
    KeyDownCount: Integer;
    FCommaChar: Char;
    FCommaDigit: Integer;
    function GetText: String;
    procedure SetText(Value: String);
    procedure SetCommaChar(Value: Char);
  protected
    procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Text: String read GetText write SetText;
    property CommaChar: Char read FCommaChar write SetCommaChar;
    property CommaDigit: Integer read FCommaDigit write FCommaDigit;
  end;

procedure TNumberCommaEdit.SetCommaChar(Value: Char);
begin
    FilterChar := '1234567890' + Value;   //数値と,のみ表示可
end;

function TNumberCommaEdit.GetText: String;
begin
    RESULT := ReplaceText(inherited Text,CommaChar,'');
end;

procedure TNumberCommaEdit.SetText(Value: String);
var
    I,J: Integer;
    S1,S2: String;
begin
    // Comma を取り除く
    S1 := ReplaceText(Value,CommaChar,'');
    //3行毎に , を入れる
    S2 := '';
    J := CommaDigit - (Length(S1) mod CommaDigit);
    for I := 1 to Length(S1) do
    begin
      S2 := S2 + S1[I];
      J := (J + 1) mod CommaDigit;
      if (J=0) and (I <> Length(S1)) then S2 := S2 + CommaChar;
    end;
    inherited Text := S2;
end;

constructor TNumberCommaEdit.Create(AOwner: TComponent);
begin
    inherited;
    FCommaChar  := ',';
    FCommaDigit := 3;
    FilterChar  := '1234567890,';   //数値と,のみ表示可
    TextSettings.HorzAlign := FMX.Types.TTextAlign.Trailing;  //右寄せ
    KeyDownCount := 0;
end;

destructor TNumberCommaEdit.Destroy;
begin
    inherited;
end;


procedure TNumberCommaEdit.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
var
  C: Char;
  SaveCaret: TPointF;
  SaveCaretPosition: Integer;

begin
    inherited;

    case Key of
       0:
      begin
        case KeyChar of
          ',':
          begin
            KeyChar := Char(0);
          end
          else
          begin
            //0..9
            if KeyDownCount > 0 then
            begin
              Caret.BeginUpdate;
              SaveCaret := Caret.Pos;
              SaveCaretPosition := CaretPosition;

              TEXT := TEXT;

              Caret.Pos := SaveCaret;
              CaretPosition := SaveCaretPosition +1;
              Caret.EndUpdate;
            end;

            Inc(KeyDownCount);
          end;
        end;
      end;
       8://BS
      begin
        //KeyUp で処理
      end;
      37:// ←
      begin
        try
          // , を飛ばして移動
          C := inherited Text[CaretPosition-1];
          if C = CommaChar then
          begin
            CaretPosition := CaretPosition - 1;
          end;
        except
        end;
      end;
      39://→
      begin
        try
        　// , を飛ばして移動
          C := inherited Text[CaretPosition+1];
          if C = CommaChar then
          begin
            CaretPosition := CaretPosition + 1;
          end;
        except
        end;
      end;
      46://DEL
      begin
        try
          // , の左隣では [DEL] は無効
          C := inherited Text[CaretPosition+1];
          if C = CommaChar then Key := 0;
        except
        end;
　     end;
    end;
end;

procedure TNumberCommaEdit.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
var
  SaveCaret: TPointF;
  SaveCaretPosition: Integer;
begin
    inherited;

    KeyDownCount :=0;

    case Key of
       0:
      begin
        case KeyChar of
          ',':
          begin
            KeyChar := Char(0);
          end;
          else
          begin
            //0..9
            Caret.BeginUpdate;
            SaveCaret := Caret.Pos;
            SaveCaretPosition := CaretPosition;

            TEXT := TEXT;

            Caret.Pos := SaveCaret;
            CaretPosition := SaveCaretPosition +1;
            Caret.EndUpdate;
          end;
        end
      end;
       8://BS
      begin
        Caret.BeginUpdate;
        SaveCaret := Caret.Pos;
        SaveCaretPosition := CaretPosition;

        TEXT := TEXT;

        //, を飛ばして移動
        Caret.Pos := SaveCaret;
        try
          if inherited Text[SaveCaretPosition] = CommaChar then
          begin
            Dec(SaveCaretPosition);
          end;
        except
        end;

        CaretPosition := SaveCaretPosition;
        Caret.EndUpdate;
      end;
      37://←
      begin
        //KeyDown で処理
      end;
      39://→
      begin
        //KeyDown で処理
      end;
      46://DEL
      begin
        Caret.BeginUpdate;
        SaveCaret := Caret.Pos;
        SaveCaretPosition := CaretPosition;

        TEXT := TEXT;

        Caret.Pos := SaveCaret;
        CaretPosition := SaveCaretPosition;
        Caret.EndUpdate;
      end;
    end;

end;

編集 削除

---

編集時は , があるけど
 property Text 書き込み時 , は不要
 property Text 読み込み時 , が取り除かれている

編集 削除

---

AAAAAさん
コンポーネントの形にして頂き有難うございます。
素晴らしいです。
FilterCharというプロパティがある事を初めて知りました。キャレットの調整が出来るのもポイントですね。もしかすると、キャレットを必ず末尾にするともう少し簡単になるのかも知れませんね。少し改造してみたいと思います。

編集 削除

---

キャレット位置気にしないって事は、電卓みたいのが欲しいのかな？

procedure TForm2.FormCreate(Sender: TObject);
begin

　　//Edit の 文字の色を背景色と同じにして
       //上に Label を乗せる
       //入力は Edit で 表示を Label で行う

    Label1.Text := '';
    Edit1.Text  := '';

    Edit1.FilterChar := '1234567890'; //0-9のみ
    Edit1.TextSettings.FontColor := TAlphaColorRec.White;
    Label1.TextAlign := TTextAlign.Trailing;

    Label1.Position := Edit1.Position;
    Label1.Width    := Edit1.Width;
    Label1.Height   := Edit1.Height;
end;

procedure TForm2.Label1Click(Sender: TObject);
begin
    Edit1.SetFocus;
end;

procedure TForm2.Edit1KeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
    case Key of
      37: Key := 0; //←
      39: Key := 0; //→
    end;
end;

procedure TForm2.Edit1KeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
var
    I,J: Integer;
    S1,S2: String;
begin
    if (KEY = 0) or (KEY = 8) then
    begin
      S1 := Edit1.Text;
      //3行毎に , を入れる
      S2 := '';
      J := 4 - (Length(S1) mod 4);
      for I := 1 to Length(S1) do
      begin
        S2 := S2 + S1[I];
        J := (J + 1) mod 4;
        if (J=0) and (I <> Length(S1)) then S2 := S2 + ',';
      end;
      Label1.Text := S2;
    end;
end;

こんだけ

編集 削除

---

AAAAAさん
有難うございます。
TLabelを使うという発想が凄いです。
最終的にはAAAAAさんから提示頂いたコードの方が簡潔なので、使わせて頂きます。

因みに、自分でもトライはしてみました。未だ未だですけど。
{ THmNumberEdit }

const
  CST_MAX_DIGITS = 5;

constructor THmNumberEdit.Create(AOwner: TComponent);
begin
  inherited;
  FDecimalDigits := 0;
  FilterChar := '1234567890-,.';
  Period := False;
end;

destructor THmNumberEdit.Destroy;
begin
  inherited;
end;

// KeyDownイベント（やっぱりKeyUpの方が良さそうです）
procedure THmNumberEdit.KeyDown(var AKey: Word; var AKeyChar: System.WideChar;
  AShift: TShiftState);
var
  iPos: Integer;
  sDec: String;
begin
  // ピリオド判定
  iPos := Pos('.', Text);
  if iPos = 0 then
    Period := False
  else
    Period := True;

  // マイナス符号が押下された場合
  if AKeyChar = '-' then
  begin
    AKeyChar := Char(0);
    SetValue(Text, True);
  end
  // ピリオドが押下された場合
  else if AKeyChar = '.' then
  begin
    // 小数点以下が0桁の場合、入力は無かったことに
    if DecimalDigits = 0 then
      AKeyChar := Char(0)
    else
    // 小数点以下が指定されている場合
    begin
      // 既に小数点が存在する場合は、入力は無かったことに
      if Period then
        AKeyChar := Char(0)
      else
      // ピリオドは最後に付加する
      begin
        Text := Text + AKeyChar;
        Period := True;
        SetValue(Text, False);
      end;
    end;
  end
  // 上記以外
  else
  begin
    // 小数点が存在する場合、指定の小数点以下桁数を超えない様にする
    if Period then
    begin
      sDec := Copy(Text, Pos('.', Text)+1, DecimalDigits);
      if Length(sDec) >= DecimalDigits then
        AKeyChar := Char(0);
    end;
    inherited;
    SetValue(Text, False);
  end;
  // おまじない
  SelStart := Length(Text);
end;

// Valueプロパティ設定
procedure THmNumberEdit.SetValue(const AValue: Extended);
begin
  try
    FValue := AValue;
    if DecimalDigits = 0 then
      SetIntegerFormatText
    else
      SetFloatFormatText;
  except
    FValue := 0;
    Text := '';
  end;
end;

// Valueプロパティ設定（KeyDownなどのイベントから呼ばれる）
procedure THmNumberEdit.SetValue(const AValue: String; MinusSign: Boolean);
var
  sVal: String;
begin
  if AValue = '' then
  begin
    Value := 0;
    Text := '';
  end
  else
  begin
    try
      sVal := StringReplace(AValue, ',', '', [rfReplaceAll]);
      if AValue.EndsWith('.') then
        sVal := StringReplace(sVal, '.', '', [rfReplaceAll]);
      if MinusSign then
        Value := -1 * StrToFloat(sVal)
      else
        Value := StrToFloat(sVal);
      if DecimalDigits = 0 then
        SetIntegerFormatText
      else
        SetFloatFormatText;
    except
      Value := 0;
    end;
  end;
end;

// DecimalDigitsプロパティ設定
procedure THmNumberEdit.SetDecimalDigits(const ADecimalDigits: Integer);
begin
  if ADecimalDigits > CST_MAX_DIGITS then
    FDecimalDigits := CST_MAX_DIGITS
  else
    FDecimalDigits := ADecimalDigits;
end;

// 整数フォーマットText設定
procedure THmNumberEdit.SetIntegerFormatText;
begin
  //Text := FormatFloat('#,##0', Int(Value));
  Text := FormatCurr('#,', Int(Value));
end;

// 浮動小数点フォーマットText設定
procedure THmNumberEdit.SetFloatFormatText;
var
  fVal: Currency;
begin
  fVal := Currency(Value);
  if Text.EndsWith('.') then
    Text := FormatCurr('#,',　fVal) + '.'
  else
    Text := FormatCurr('#,.#####', fVal);
end;

編集 削除

---

上記の通りAAAAAさんのお陰で解決したので、本件をクローズさせて頂きます。

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する