編集

名前

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

本文

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;

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

FMXのTNumberBoxでカンマ編集 (ID:151287)