// 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;
|