Nedtælling til dato

const
  HoursPerDay  = 24;
  MinsPerHour  = 60;
  SecsPerMin    = 60;
  MSecsPerSec  = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay  = SecsPerDay * MSecsPerSec;

Function FormatSeconds(TotalSeconds : Double; WholeSecondsOnly : Boolean = True; DisplayAll : Boolean = False): String;
Var
  Centuries,Years,Months,Minutes,Hours,Days,Weeks : Word;
  Secs : Double;
  TmpStr: Array[1..8] of String;
  SecondsPerCentury: Int64;
  FS : String;
begin
  (** Suppress the decimal part if Whole Seconds Only is desired **)
  If WholeSecondsOnly then
    FS:='%.0f'
  else
    FS:='%.2f';

  (** Split the calculation to avoid an overflow **)
  SecondsPerCentury:= 36500*24;
  SecondsPerCentury:= SecondsPerCentury * 3600;
  SecondsPerCentury:= SecondsPerCentury + ( {4 Leap years per century} 4 * 24 * 3600);
  (** Get centuries **)
  Centuries:=Trunc(TotalSeconds / SecondsPerCentury);
  TotalSeconds:=TotalSeconds-(Centuries * SecondsPerCentury);

  (** Get years **)
  Years:=Trunc(TotalSeconds / (SecondsPerCentury / 100));
  TotalSeconds:=TotalSeconds-(Years * (SecondsPerCentury / 100));

  (** Get months **)
  Months:=Trunc(TotalSeconds / (SecondsPerCentury / 1200));
  TotalSeconds:=TotalSeconds-(Months * (SecondsPerCentury / 1200));

  (** Get weeks **)
  Weeks:=Trunc(TotalSeconds / (24 * 3600 * 7));
  TotalSeconds:=TotalSeconds-(Weeks * (24 * 3600 * 7));

  (** Get days **)
  Days:=Trunc(TotalSeconds / (24 * 3600));
  TotalSeconds:=TotalSeconds-(Days * (24 * 3600));

  (** Get Hours **)
  Hours:=Trunc(TotalSeconds / 3600);
  TotalSeconds:=TotalSeconds-(Hours * 3600);

  (** Get minutes **)
  Minutes:=Trunc(TotalSeconds / 60);
  TotalSeconds:=TotalSeconds-(Minutes * 60);

  (** Get seconds **)
  If WholeSecondsOnly then
    Secs:=Trunc(TotalSeconds)
  else
    Secs:=TotalSeconds;

  (** Deal with single values **)
  if Centuries = 1 then
    TmpStr[1] := ' Century, '
  else
    TmpStr[1] := ' Centuries, ';

  if Years = 1 then
    TmpStr[2] := ' Year, '
  else
    TmpStr[2] := ' Years, ';

  if Months = 1 then
    TmpStr[3] := ' Month, '
  else
    TmpStr[3] :=' Months, ';

  if Weeks = 1 then
    TmpStr[4] := ' Week, '
  else
    TmpStr[4] := ' Weeks, ';

  if Days = 1 then
    TmpStr[5] := ' Day, '
  else
    TmpStr[5] := ' Days, ';

  if Hours = 1 then
    TmpStr[6] :=' Hour, '
  else
    TmpStr[6]:=' Hours, ';

  if Minutes = 1 then
    TmpStr[7] :=' Minute, '
  else
    TmpStr[7]:=' Minutes, ';

  if Secs = 1 then
    TmpStr[8] :=' Second.'
  else
    TmpStr[8]:=' Seconds.';

  If DisplayAll then
  Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Centuries,TmpStr[1],Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]])
  else
    begin
      if Centuries >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Centuries,TmpStr[1],Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Years >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',[Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Months >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',[Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Weeks >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Days >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s%.0d%s' + FS + '%s', [Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Hours >= 1 then
      begin
        Result:= Format('%.0d%s%.0d%s' + FS + '%s', [Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
        Exit;
      end;

      if Minutes >= 1 then
      begin
        Result:= Format('%.0d%s' + FS + '%s', [Minutes,TmpStr[7],Secs,TmpStr[8]]);
        exit;
      end;

      Result:= Format(FS + '%s', [Secs,TmpStr[8]]);
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  EndDate : TDateTime;
begin
EndDate := StrToDate('31-12-03');
Caption := FormatSeconds( (EndDate - Now) * SecsPerDay);
end;

Jens B

Aww den gjorde ondt ;)