Delphi Countdown timer

Question

I am trying to make a countdown timer, the idea is to set the time in text edit property and after i click set timer(button), that time to be sent to Label, which will then start the countdown to 0. I have gotten to this part, but i cant figure out a way to make seconds countdown, If any of you guys can help I would appreciate it.

I tried this from an example I found online but it didnt work because this is Firemonkey application.

dec(TotalTime); {decrement the total time counter}


// Timer code..
procedure TForm1.ButtonSetTimerClick(Sender: TObject);
var
 GetTime : TDateTime;
begin
 Timer3.Enabled := True;
 Label11.Text := Edit1.Text;
 ButtonSetTimer.Enabled := False;
 Edit1.Enabled := False;
 GetTime := StrToTime(Edit1.Text);

end;

procedure TForm1.ButtonStopTimerClick(Sender: TObject);
begin
 Timer3.Enabled := False;
 ButtonSetTimer.Enabled := True;
 Edit1.Enabled := True;
end;

procedure TForm1.Timer3Timer(Sender: TObject);
var
 GetTime : TDateTime;
 Hour, Min, Sec, MSec: Word;
begin

 DecodeTime(GetTime, Hour, Min, Sec, Msec);
 Label11.Text := TimeToStr(GetTime);
 Label11.Text := IntToStr(Hour)  + ':'+ IntToStr(Min) + ':'+ IntToStr(Sec);
 Label11.Text := Format('%2.2u:%2.2u:%2.2u',[Hour,Min,Sec]);
end;

Cheers.

Answer 1

You did not say how (in which format) the time is to be entered in the TEdit, so here are three alternative time entry possibilities. The output is anyway formatted as H:M:S.

I modified the code from yesterday to use TryStrToInt / TryStrToTime to catch errors. Also, a Seconds counter together with OnTimer event as in my previous example has a poor accuracy and can drift several seconds within 5 minutes. Edijs solution to compare Now with a calculated end time is insensitive to the inaccuracy of OnTimer events, so I adopted that too.

var
  TimeOut: TDateTime;

function SecsToHmsStr(ASecs: integer):string;
begin
  Result := Format('%2d:%2.2d:%2.2d',
    [ASecs div 3600, ASecs mod 3600 div 60, ASecs mod 3600 mod 60]);
;end;

procedure TForm6.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
  if Now > Timeout then Timer1.Enabled := False;
end;

Time entry alternative one, Timeout after a given number of seconds

// Timeout after a given number of seconds
procedure TForm6.Button1Click(Sender: TObject);
var
  Seconds: integer;
begin
  if TryStrToInt(Edit1.Text, Seconds) then
  begin
    TimeOut := IncSecond(Now, Seconds);
    Timer1.Enabled := True;
    Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
  end
  else
    ShowMessage('Error in number of seconds');
end;

Time entry alternative two, Timeout after a given number of hours, minutes and seconds

// Timeout after a given number of hours, minutes and seconds
procedure TForm6.Button2Click(Sender: TObject);
begin
  if TryStrToTime(Edit1.Text, TimeOut) then
  begin
    TimeOut := Now + TimeOut;
    Timer1.Enabled := True;
    Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
  end
  else
    ShowMessage('Error in time format');
end;

Time entry alternative three, Timeout at a given time within 24 hours

// Timeout at a given time within 24 hours
procedure TForm6.Button3Click(Sender: TObject);
begin
  if TryStrToTime(Edit1.Text, TimeOut) then
  begin
    if TimeOut <= Time then
      TimeOut := Tomorrow + TimeOut
    else
      TimeOut := Today + TimeOut;
    Timer1.Enabled := True;
    Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
  end
  else
    ShowMessage('Error in time format');
end;

Answer 2

This should do it:

Uses
  System.DateUtils;

type
..
private
  FDateTimeTo: TDateTime;
end;

function IntToTimeStr(const ASeconds: Int64): string;
begin
  Result := Format('%2d:%2.2d:%2.2d', [ASeconds div 3600, ASeconds mod 3600 div 60,
    ASeconds mod 3600 mod 60]);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  FDateTimeTo := StrToDateTime(FormatDateTime('yyyy' + FormatSettings.DateSeparator + 'mm' +
    FormatSettings.DateSeparator + 'dd 00:00:00', Now)) + StrToTime(Edit1.Text);

  if CompareDateTime(Now, FDateTimeTo) = 1 then
    FDateTimeTo := IncDay(FDateTimeTo);
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := IntToTimeStr(SecondsBetween(Now, FDateTimeTo));
end;