Hola.
Poné en un form un
TTimer un
TProgressBar y un
TLabel y probá si este código hace más o menos lo que buscas:
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
ProgressBar1: TProgressBar;
Label1: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FLapsoIni: Int64;
FDTIni: TDateTime;
public
end;
var
Form1: TForm1;
implementation {$R *.dfm}
uses DateUtils;
function ObtenerLapso(const Ini,Fin: TDateTime): Int64;
var
h,m,s: Word;
begin
h:= 0;
if DaysBetween(Ini,Fin) > 0 then
h:= DaysBetween(Ini, Fin) * 24;
h:= h + HourOf(Ini - Fin);
m:= MinuteOf(Ini - Fin);
s:= SecondOf(Ini - Fin);
Result:= h*3600+m*60+s;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
FDTIni:= IncMinute(Now, 2); FLapsoIni:= ObtenerLapso(Now, FDTIni); Timer1.Enabled:= False;
Timer1.Interval:= 1000;
ProgressBar1.Max:= FLapsoIni;
ProgressBar1.Step:= 1;
Timer1.Enabled:= True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
LapsoAct: Int64;
begin
LapsoAct:= ObtenerLapso(Now, FDTIni); ProgressBar1.StepIt;
Label1.Caption:= Format('%3.0f %%',[100-LapsoAct/FLapsoIni*100]);
if LapsoAct <= 0 then
begin
Timer1.Enabled:= False;
MessageBeep(MB_ICONEXCLAMATION);
end;
end;
end.
Como verás las pruebas las hice con minutos, si usaba días u horas estaría más seguro, pero la respuesta hubiera llegado un poco tarde...
Saludos.