// Diese Variante ist für Leute, die TMaskEdit nicht für ein Datum verwenden
// möchten. Es werden bei Eingabe eines Datums in Edit1 Punkte bzw. Vornullen
// automatisch erzeugt, sowie bei Enter oder Verlassen des Feldes das Datum
// geprüft und die Jahreszahl auf vier Stellen ergänzt. Bei Jahreszahlen von
// 51 bis 99 mit dem 19. Jahrhundert, von 0 bis 50 mit dem 20. Jahrhundert
// (beispielweise wird 49 zu 2049, und 55 wird zu 1955). 

// Getestet mit D4 unter Win98

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  edit1.maxlength := 10; 
end; 
 
procedure ergaenzen; 
var p, d: integer; 
  hlp: TDate; 
begin 
  with form1 do begin 
    p := pos('.', edit1.text); 
    if p > 0 then begin 
      d := lastdelimiter('.', edit1.text); 
      if (p <> d) and (length(edit1.text) - 2 = d) then begin 
        if copy(edit1.text, d + 1, 2) > '50' then 
          edit1.text := copy(edit1.text, 1, d) + '19' + copy(edit1.text, d + 
            1, 2) else 
          edit1.text := copy(edit1.text, 1, d) + '20' + copy(edit1.text, d + 
            1, 2); 
      end; 
    end; 
    try 
      hlp := strtodate(edit1.text); 
    except 
      beep; 
      showmessage('Fehlerhaftes Datum in Edit1'); 
      exit; 
    end; 
    edit1.text := formatdatetime('dd.mm.yyyy', hlp); 
  end; 
end; 
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
var p, st: integer; 
begin 
  if key = '.' then begin 
    p := pos('.', edit1.text); 
    st := edit1.selstart; 
    if (st = 0) or (edit1.text[st] = '.') or 
      ((st - p > 2) or (length(edit1.text) - st > 4)) and (p > 0) or 
      (p <> lastdelimiter('.', edit1.text)) 
      then key := #0; 
  end else 
    if key = #13 then ergaenzen; 
  if not (key in [#8, '0'..'9', '.']) 
    then key := #0; 
end; 
 
procedure TForm1.Edit1Exit(Sender: TObject); 
begin 
  ergaenzen; 
end; 
 
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var 
  lg: integer; 
begin 
  lg := length(edit1.text); 
  if key in [$30..$39, $60..$69] then begin 
    case lg of 
      2, 5: begin 
          edit1.text := edit1.text + '.'; 
          edit1.selstart := lg + 1; 
        end; 
      3, 6: begin 
          if edit1.text[lg] <> '.' then 
            edit1.text := copy(edit1.text, 1, lg - 1) + '.' + edit1.text[lg]; 
          edit1.selstart := lg + 1; 
        end; 
    end; 
  end else if key = 190 then begin 
    case lg of 
      2: begin 
          edit1.text := '0' + edit1.text; 
          edit1.selstart := lg + 1; 
        end; 
      5: begin 
          edit1.text := copy(edit1.text, 1, 3) + '0' + 
            edit1.text[4] + '.'; 
          edit1.selstart := lg + 1; 
        end; 
    end; 
  end; 
end;



Zugriffe seit 6.9.2001 auf Delphi-Ecke