德尔福倒数计时器

Question

我正在尝试制作一个倒数计时器，想法是在文本编辑属性中设置时间，然后在我点击设置计时器（按钮）后，该时间被发送到Label，然后将倒计时开始为0。我已经完成了这一部分，但是我无法想出一种让秒倒计时的方法，如果你们中的任何人都可以提供帮助我会很感激。

我从我在网上找到的一个例子中尝试了这个，但它没有用，因为这是Firemonkey应用程序。

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;

干杯。

Answer 1

您没有说明如何（以何种格式）在TEdit中输入时间，因此这里有三种可选的时间输入可能性。无论如何输出格式为H：M：S。

我修改了昨天的代码，使用TryStrToInt / TryStrToTime来捕获错误。另外，Seconds计数器和OnTimer事件一样，我的上一个示例的准确性很差，可能会在5分钟内漂移几秒钟。 Edijs将Now与计算结束时间进行比较的解决方案对OnTimer事件的不准确性不敏感，所以我也采用了它。

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;

时间输入备选方案一，在给定秒数后超时

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

时间输入备选方案2，在给定的小时数，分钟数和秒数后超时

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

时间输入备选方案三，24小时内给定时间超时

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

这应该这样做：

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;