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

名前

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

本文

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;

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

戻る