How to enter dates into a TDateTimePicker by keyboard only

Problem/Question/Abstract:

We have decided to replace all occurrences of TMaskEdit in our applications with TDateTimePicker's (of course only where they were used for entering dates). The problem is making the transition as easy as possible for the users. TDateTimePicker as it is is not very well-suited for keyboard-only input. The first annoyance is that you have to explicitly enter the separators. TMaskEdit just jumped to the next figure if you entered a number instead of the separator character. It becomes worse still when ShowCheckbox is True. In that case the focus is automatically shifted to the checkbox after having entered the first two digits, essentially making it impossible to enter a date by keyboard only (unless you manually cursor to the every single figure). Does anyone know if it possible at all to overcome these limitations by simply subclassing TDateTimePicker?

Answer:

Here is the routine that I use for date entry edits. Feel free to use it if you just want keyboard entry of dates. Here's the way it works: As the user types in the edit, it's checked against the current ShortDateFormat setting to determine whether it's in the month, day or year portion. If, for instance, they are in the month portion and they type a '3', it knows that it must be the third month and so puts '03' and goes to the next section (if any). If you want to default any portion to the current day, month or year, simply hit the space bar. This gives users a really fast way to fill in dates, especially the current day's. All you need to do is assign the OnKeyPress event of any edit control and make a simple call:

DateKeyPress(self, Key);

{Included because I use it to tab to the next control when the date is complete}

procedure PressTabKey(Shift: boolean = false);
begin
  if Shift then
    keybd_event(VK_SHIFT, 0, 0, 0);
  keybd_event(VK_TAB, 0, 0, 0);
  keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0);
  if Shift then
    keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
end;

procedure DateKeyPress(Sender: TObject; var Key: char);
const
  Zero: char = '0';
  DateParts: array[1..3] of string = ('', '', '');
  SeparatorChar: string = '';

  procedure GetDateParts;
  var
    x, y: integer;
    s: string;
    c: char;
  begin
    s := ShortDateFormat;
    y := 1;
    c := s[1];
    for x := 1 to length(s) do
      if (s[x] <> DateSeparator) then
      begin
        if (s[x] <> c) then
        begin
          c := s[x];
          inc(y);
        end;
        DateParts[y] := DateParts[y] + s[x];
      end
      else
      begin
        inc(y);
        c := s[x + 1];
      end;
    if pos(DateSeparator, s) <> 0 then
      SeparatorChar := DateSeparator
    else
      SeparatorChar := '';
  end;

  function FixDatePart(s: string; Part: integer): string;
  begin
    if (s <> '') and (s[length(s)] = DateSeparator) then
      delete(s, length(s), 1);
    if (s = '') then
      s := FormatDateTime(DateParts[Part], Now);
    if (DateParts[Part][1] in ['m', 'M', 'd', 'D']) then
      result := format('%.' + IntToStr(length(DateParts[Part])) + 'd', [StrToInt(s)])
    else if (length(s) < length(DateParts[Part])) then
      result := copy(FormatDateTime(DateParts[Part], Now), 1,
        length(Dateparts[Part]) - length(s)) + s
    else
      result := s;
  end;

var
  s: string;
  x,
    sepLength: integer;
begin
  if DateParts[1] = '' then
    GetDateParts;
  if ord(Key) in ActionKeys then
    exit;
  s := copy(TEdit(Sender).Text, 1, TEdit(Sender).SelStart);
  x := length(s);
  sepLength := length(SeparatorChar);
  case Key of
    ' ':
      begin
        if (x = length(DateParts[1]) + sepLength) then
          s := s + FixDatePart('', 2) + SeparatorChar
        else if (x = length(DateParts[1] + DateParts[2]) + (sepLength * 2)) then
          s := s + FixDatePart('', 3)
        else if (x = 0) then
          s := FixDatePart('', 1) + SeparatorChar
        else if (x <= length(DateParts[1])) then
          s := FixDatePart(s, 1) + SeparatorChar + FixDatePart('', 2) + SeparatorChar
        else if (x <= (length(DateParts[1] + DateParts[2]) + (sepLength * 2))) then
          s := copy(s, 1, length(DateParts[1]) + sepLength) + FixDatePart(copy(s, length(DateParts[1]) + sepLength + 1, length(s)), 2) + SeparatorChar + FormatDateTime(DateParts[3], Now)
        else
          s := copy(s, 1, length(DateParts[1] + DateParts[2]) + (sepLength * 2)) +
            FixDatePart(copy(s, length(DateParts[1] + DateParts[2]) +
            (sepLength * 2) + 1, length(s)), 3);
        TEdit(Sender).Text := s;
        Key := #0;
        TEdit(Sender).SelStart := length(s);
      end;
    '0'..'9':
      begin
        if (x in [length(DateParts[1]), length(DateParts[1] + DateParts[2]) + sepLength]) then
          s := s + SeparatorChar + Key
        else if (x = 0) and (((DateParts[1][1] in ['m', 'M']) and (Key in ['2'..'9'])) or((DateParts[1][1] in ['d', 'D']) and (Key in ['4'..'9']))) then
          s := FixDatePart(Key, 1) + SeparatorChar
        else if (x = length(DateParts[1]) + sepLength) and (((DateParts[2][1] in ['m', 'M']) and (Key in ['2'..'9'])) or ((DateParts[2][1] in ['d', 'D']) and (Key in ['4'..'9']))) then
          s := s + FixDatePart(Key, 2) + SeparatorChar
        else
          s := s + Key;
        if (length(s) = length(DateParts[1])) or (length(s) = length(DateParts[1] + DateParts[2]) + sepLength) then
          s := s + SeparatorChar;
        TEdit(Sender).Text := s;
        Key := #0;
        TEdit(Sender).SelStart := length(s);
      end;
    { uncomment this to use N/A values
    'n','N':
      begin
        TEdit(Sender).Text := 'N/A';
        TEdit(Sender).SelStart := 0;
        TEdit(Sender).SelLength := 3;
        Key := #0;
      end;}
  else
    begin
      if (Key = DateSeparator) then
      begin
        if s[x] <> DateSeparator then
        begin
          if x = length(DateParts[1]) - 1 then
            s := Zero + s + DateSeparator
          else if x = 4 then
          begin
            insert(Zero, s, 4);
            s := s + '/';
          end;
        end;
        TEdit(Sender).Text := s;
        Key := #0;
        TEdit(Sender).SelStart := length(s);
      end
      else
        Key := #0;
    end;
  end;
  if length(TEdit(Sender).Text) = length(ShortDateFormat) then
    PressTabKey;
end;