FormatMillisec

program new;

type
  TFormatEnum = (
    fmtYearsNoPad,   fmtYears,
    fmtMonthsNoPad,  fmtMonths,
    fmtWeeksNoPad,   fmtWeeks,
    fmtDaysNoPad,    fmtDays,
    fmtHoursNoPad,   fmtHours,
    fmtMinutesNoPad, fmtMinutes,
    fmtSecondsNoPad, fmtSeconds,
    fmtMillisecondsNoPad, fmtMilliseconds
  );

function String.Count(substr: string): Int32;
var
  i: Int32;
begin
  Result := Length(PosMulti(substr, self));
end;

//Y-m-d h:i:s
function FormatMillisec(Time: Double; Fmt: string): string;
var
  p, q: Int32;
  flags: set of TFormatEnum;
  flag: TFormatEnum;
  function Next(step: Int32=1): Char;
  begin
    Inc(p, step);
    if p <= Length(Fmt) then
      Exit(Fmt[p]);
    Result := #0;
  end;
var
  timeLeft: Double;
  years, months, weeks, days, hours, minutes, sec, ms: Double;
begin
  // with this we create the needed flags
  Fmt += #0;
  p := 1;
  while (p <= Length(fmt)) and (Fmt[p] <> #0) do
  begin
    q := p;
    case Fmt[p] of
      '\': Next(2);
      'Y': begin
             while Next() = 'Y' do ;
             case p-q of
               1: flags += fmtYearsNoPad;
               2: flags += fmtYears;
               else raise 'Illegal format';
             end;
           end;
      'M': begin
             while Next() = 'M' do ;
             case p-q of
               1: flags += fmtMonthsNoPad;
               2: flags += fmtMonths;
               else raise 'Illegal format';
             end;
           end;
      'W': begin
             while Next() = 'W' do ;
             case p-q of
               1: flags += fmtWeeksNoPad;
               2: flags += fmtWeeks;
               else raise 'Illegal format';
             end;
           end;
      'D': begin
             while Next() = 'D' do ;
             case p-q of
               1: flags += fmtDaysNoPad;
               2: flags += fmtDays;
               else raise 'Illegal format';
             end;
           end;
      'h': begin
             while Next() = 'h' do ;
             case p-q of
               1: flags += fmtHoursNoPad;
               2: flags += fmtHours;
               else raise 'Illegal format';
             end;
           end;
      'm': begin
             while Next() = 'm' do ;
             case p-q of
               1: flags += fmtMinutesNoPad;
               2: flags += fmtMinutes;
               else raise 'Illegal format';
             end;
           end;
      's': begin
             while Next() = 's' do ;
             case p-q of
               1: flags += fmtSecondsNoPad;
               2: flags += fmtSeconds;
               else raise 'Illegal format';
             end;
           end;
      'u': begin
             while Next() = 'u' do ;
             case p-q of
               1: flags += fmtMillisecondsNoPad;
               2: flags += fmtMilliseconds;
               else raise 'Illegal format';
             end;
           end;
      else
        Next();
    end;
  end;

  // with this we reduce in the order of flags
  timeLeft := time;
  for flag in flags do
  begin
    case flag of
      fmtYearsNoPad, fmtYears:
        begin
          years := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 365);
          timeLeft -= years * 365 * 24 * 60 * 60 * 1000;
        end;
      fmtMonthsNoPad,  fmtMonths:
        begin
          months := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 30.5);
          timeLeft -= months * 30.5 * 24 * 60 * 60 * 1000;
        end;
      fmtWeeksNoPad,  fmtWeeks:
        begin
          weeks := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 7);
          timeLeft -= weeks * 7 * 24 * 60 * 60 * 1000;
        end;
      fmtDaysNoPad, fmtDays:
        begin
          days := Trunc(timeLeft / 1000 / 60 / 60 / 24);
          timeLeft -= days * 24 * 60 * 60 * 1000;
        end;
      fmtHoursNoPad, fmtHours:
        begin
          hours := Trunc(timeLeft / 1000 / 60 / 60);
          timeLeft -= hours * 60 * 60 * 1000;
        end;
      fmtMinutesNoPad, fmtMinutes:
        begin
          minutes := Trunc(timeLeft / 1000 / 60);
          timeLeft -= minutes * 60 * 1000;
        end;
      fmtSecondsNoPad, fmtSeconds:
        begin
          sec := Trunc(timeLeft / 1000);
          timeLeft -= sec * 1000;
        end;
      fmtMillisecondsNoPad, fmtMilliseconds:
        begin
          ms := timeLeft;
          timeLeft -= ms * 1000;
        end;
    end;
  end;

  // now we rebuild the result based on the format
  Result := '';
  p := 1;
  while (p <= Length(fmt)) and (Fmt[p] <> #0) do
  begin
    q := p;
    case Fmt[p] of
      '\': begin
             Next();
             Result += Fmt[p];
             Next();
           end;
      'Y': begin
             while Next() = 'Y' do ;
             if fmtYearsNoPad in flags then
               Result += ToString(Trunc(years))
             else begin
               if years < 10 then Result += '0';
               Result += ToString(Trunc(years));
             end;
           end;
      'M': begin
             while Next() = 'M' do ;
             if fmtMonthsNoPad in flags then
               Result += ToString(Trunc(months))
             else begin
               if months < 10 then Result += '0';
               Result += ToString(Trunc(months));
             end;
           end;
      'W': begin
             while Next() = 'W' do ;
             if fmtWeeksNoPad in flags then
               Result += ToString(Trunc(weeks))
             else begin
               if weeks < 10 then Result += '0';
               Result += ToString(Trunc(weeks));
             end;
           end;
      'D': begin
             while Next() = 'D' do ;
             if fmtDaysNoPad in flags then
               Result += ToString(Trunc(days))
             else begin
               if days < 10 then Result += '0';
               Result += ToString(Trunc(days));
             end;
           end;
      'h': begin
             while Next() = 'h' do ;
             if fmtHoursNoPad in flags then
               Result += ToString(Trunc(hours))
             else begin
               if hours < 10 then Result += '0';
               Result += ToString(Trunc(hours));
             end;
           end;
      'm': begin
             while Next() = 'm' do ;
             if fmtMinutesNoPad in flags then
               Result += ToString(Trunc(minutes))
             else begin
               if minutes < 10 then Result += '0';
               Result += ToString(Trunc(minutes));
             end;
           end;
      's': begin
             while Next() = 's' do ;
             if fmtSecondsNoPad in flags then
               Result += ToString(Trunc(sec))
             else begin
               if sec < 10 then Result += '0';
               Result += ToString(Trunc(sec));
             end;
           end;
      'u': begin
             while Next() = 'u' do ;
             if fmtMillisecondsNoPad in flags then
               Result += ToString(Trunc(ms))
             else begin
               if ms < 1000 then Result += '0';
               if ms < 100 then  Result += '0';
               if ms < 10 then   Result += '0';

               Result += ToString(Trunc(ms));
             end;
           end;
      else
      begin
        Result += Fmt[p];
        Next();
      end;
    end;
  end;
end;

function FormatMillisec(Time: Int64; TimeSymbols: Boolean=False): string; overload;
var
  timeLeft: Double;
  years, months, weeks, days, hours, minutes, sec, ms: Double;
begin
  timeLeft := Time;
  years := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 365);
  timeLeft -= years * 365 * 24 * 60 * 60 * 1000;

  months := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 30.5);
  timeLeft -= months * 30.5 * 24 * 60 * 60 * 1000;

  weeks := Trunc(timeLeft / 1000 / 60 / 60 / 24 / 7);
  timeLeft -= months * 7 * 24 * 60 * 60 * 1000;

  days := Trunc(timeLeft / 1000 / 60 / 60 / 24);
  timeLeft -= days * 24 * 60 * 60 * 1000;

  hours := Trunc(timeLeft / 1000 / 60 / 60);
  timeLeft -= hours * 60 * 60 * 1000;

  minutes := Trunc(timeLeft / 1000 / 60);
  timeLeft -= minutes * 60 * 1000;

  sec := Trunc(timeLeft / 1000);
  timeLeft -= sec * 1000;

  ms := timeLeft;
  timeLeft -= ms * 1000;
  if not TimeSymbols then
  begin
    if      years  > 0 then Result := FormatMillisec(time, 'YY:MM:WW:DD:hh:mm:ss:uu')
    else if months > 0 then Result := FormatMillisec(time, 'MM:WW:DD:hh:mm:ss:uu')
    else if weeks  > 0 then Result := FormatMillisec(time, 'WW:DD:hh:mm:ss:uu')
    else if days   > 0 then Result := FormatMillisec(time, 'DD:hh:mm:ss:uu')
    else if hours  > 0 then Result := FormatMillisec(time, 'hh:mm:ss:uu')
    else if minutes> 0 then Result := FormatMillisec(time, 'mm:ss:uu')
    else if sec    > 0 then Result := FormatMillisec(time, 'ss:uu')
    else                    Result := FormatMillisec(time, 'uu');
  end else
  begin
    if      years  > 0 then Result := FormatMillisec(time, 'YY\y:MM\m:WW\w:DD\d:hh\h:mm\m:ss\s:uu\m\s')
    else if months > 0 then Result := FormatMillisec(time, 'MM\m:WW\w:DD\d:hh\h:mm\m:ss\s:uu\m\s')
    else if weeks  > 0 then Result := FormatMillisec(time, 'WW\w:DD\d:hh\h:mm\m:ss\s:uu\m\s')
    else if days   > 0 then Result := FormatMillisec(time, 'DD\d:hh\h:mm\m:ss\s:uu\m\s')
    else if hours  > 0 then Result := FormatMillisec(time, 'hh\h:mm\m:ss\s:uu\m\s')
    else if minutes> 0 then Result := FormatMillisec(time, 'mm\m:ss\s:uu\m\s')
    else if sec    > 0 then Result := FormatMillisec(time, 'ss\s:uu\m\s')
    else                    Result := FormatMillisec(time, 'uu\m\s');
  end;
end;


begin
  WriteLn FormatMillisec(GetTickCount(), 's\s\e\c, m\m\i\n');
  WriteLn FormatMillisec(GetTickCount(), 'hh\h:mm\m:ss\s:uu\m\s');
  WriteLn FormatMillisec(GetTickCount(), 'YY-MM-DD h:m:s:u');
  WriteLn FormatMillisec(GetTickCount());
  WriteLn FormatMillisec(GetTickCount(), True);
end.