const 
  minus_rot = true;          // Bei True werden negative Werte rot angezeigt 
  dezimalstellen = 2;        // Je nach Bedarf 
  waehrung: char = '€';      // Währung darf nur 1 Zeichen haben ($, €, ¥, £) 
  trennzeichen = '.';        // Tausendertrennzeichen festsetzen 
  gruppierung = true;        // Tausendertrennzeichen einsetzen 
  WaehrungAnzeigen = true;   // False = keine Währungsanzeige 
  runden = true;             // Bei False werden höhere Dezimalstellen 
                             // einfach abgeschnitten 
 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  edit1.text := ''; 
  edit1.color := clwhite; 
end; 
 
// Eingabe überprüfen 
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
var p1, p2: integer; 
begin 
  if key = #13 then begin 
    key := #0; 
    Edit1Exit(Sender); 
    exit; 
  end; 
  if key = Thousandseparator then key := trennzeichen; 
  p1 := pos(DecimalSeparator, edit1.text); 
  p2 := pos(waehrung, edit1.text); 
  if (not (key in [#8, '0'..'9', trennzeichen, DecimalSeparator, '+', '-', 
    waehrung, #32])) 
    or (key = #32) and (edit1.selstart = 0) 
    or ((key = '+') or (key = '-')) and (edit1.selstart > 0) 
    or (pos('+', edit1.text) + 
    pos('-', edit1.text) > edit1.selstart + edit1.sellength) 
    or (key = DecimalSeparator) and (p1 > 0) and (p1 <= edit1.selstart) 
    or (p2 = edit1.selstart) and (p2 > 0) and (key <> #8) 
    or (key = waehrung) and ((p2 > 0) or (not WaehrungAnzeigen)) 
    then key := #0; 
end; 
 
// Formatieren 
 
procedure TForm1.Edit1Exit(Sender: TObject); 
var 
  frmt, vz, ttz: string; 
  x, p: integer; 
begin 
  if gruppierung then ttz := '#,##0' else ttz := '0'; 
  edit1.text := stringreplace(edit1.text, #32, '', [rfreplaceall]); 
  edit1.text := stringreplace(edit1.text, waehrung, '', [rfreplaceall]); 
  edit1.text := stringreplace(edit1.text, ThousandSeparator, '', [rfreplaceall]); 
  vz := copy(edit1.text, 1, 1); 
  if vz = '-' then edit1.text := copy(edit1.text, 2, length(edit1.text) - 1) 
  else vz := ''; 
  edit1.text := stringreplace(edit1.text, '+', '', [rfreplaceall]); 
  if edit1.text = '' then exit; 
  if dezimalstellen > 0 then begin 
    frmt := '.'; 
    for x := 1 to dezimalstellen do frmt := frmt + '0'; 
  end else frmt := ''; 
  p := pos(DecimalSeparator, edit1.text); 
  if (not runden) and (p > 0) then 
    edit1.text := copy(edit1.text, 1, p + dezimalstellen); 
  try 
    edit1.text := vz + formatfloat(ttz + frmt, strtofloat(edit1.text)); 
    edit1.text := stringreplace(edit1.text, Thousandseparator, trennzeichen, 
      [rfreplaceall]); 
    if WaehrungAnzeigen then edit1.text := edit1.text + #32 + waehrung; 
  except 
    edit1.text := '- Zuweisung ungültig -'; 
    beep; 
  end; 
end; 
 
// immer linksbündig halten 
 
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if (key = vk_back) or (key = vk_delete) then begin 
    while copy(edit1.text, 1, 1) = #32 do edit1.text := 
      copy(edit1.text, 2, length(edit1.text) - 1); 
  end; 
end; 
 
// negative Werte rot ausgeben 
 
procedure TForm1.Edit1Change(Sender: TObject); 
begin 
  if (pos('-', edit1.text) > 0) and minus_rot then 
    edit1.font.color := clred else edit1.font.color := clblack; 
end;