Clase para medir tiempo de ejecución.

Si bien esta entrada que escribí hace exactamente dos años (increíble, juro que es coincidencia) acerca de medir el tiempo de ejecución de un proceso es totalmente válida y funcional, mejor aún es hacer una clase (class) que haga lo mismo. Las ventajas son muchas, desde la legibilidad del código hasta la manera más simple se su reutilización.

La clase es simple:

type
  TMedirTiempo=class(TObject)
private
  FInicio:TTime;
  FFinaliza:TTime;
  FTranscurrido:TTime;
public
  constructor Create (Owner:TComponent);
  function Iniciar:TTime;
  function Finalizar:TTime;
  function Transcurrido:TTime;
end;

Cómo estoy comenzando a implementar clases, luego de leer bastante, voy a explicar un poco algunas cosas que la mayoría de los colegas programadores ya saben, pero los que retomamos la programación luego de muchos años, no.

Por ejemplo, la clase la definimos como class(TObject) porque es una clase que no hereda de ninguna otra clase y la más "primitiva" es TObject. Ahora:
TMedirTiempo=class así sin TObject también es válido, pero no recomendado.
FInicio es un campo (Field) por eso se acostumbra a empezar con la letra F; los campos son variables que pertenecen a una clase. Si se declaran en la "sección" (en realidad no es sección aunque lo aparenta muy bien, private es un identificador) private solo podrá se accedido por otros miembros de la clase y clases heredadas pero no por la instancia de la clase, por ejemplo:

var
  Medidor:TMedirTiempo;
begin
  Medir:=TMedirTiempo.Create(nil);
  Medir.Finicio:= // esto no se puede.

¿Por qué usamos un constructor? Porque en él inicializamos los campos, pero muchas veces no es necesario definirlo, en tal caso se utiliza el heredado de TObject. Y sí, el constructor es público, lo mismo que las funciones, lo que implica que se pueden invocar en la unidad donde instanciamos la clase.

Hasta aquí la interfaz, vamos ahora a la implementación de la clase.

constructor TMedirTiempo.Create(Owner: TComponent);
begin
  FInicio:=StrToTime('0');
  FFinaliza:=StrToTime('0');
  FTranscurrido:=StrToTime('0');
end;

function TMedirTiempo.Iniciar: TTime;
begin
  FInicio:=Now;
end;

function TMedirTiempo.Finalizar: TTime;
begin
  FFinaliza:=Now;
end;

function TMedirTiempo.Transcurrido: TTime;
begin
  FTranscurrido:=FFinaliza-FInicio;
  Result:=FTranscurrido;
end;

Y para utilizarla es muy simple, por ejemplo:

Procedure CargarSList;
var
  MedirTiempo:TMedirTiempo;
  sl:TStringList;
  i:Integer;
begin
  sl:=TStringList.Create;
  MedirTiempo:=TMedirTiempo.Create(nil);
  MedirTiempo.Iniciar;
  for i:=1 to 100000 do
    sl.Add(IntToStr(i));
  MedirTiempo.Finalizar;
  ShowMessage('Tiempo transcurrido: '+TimeToStr(MedirTiempo.Transcurrido));
  sl.Free;
  MedirTiempo.Free;
end;


También podríamos mostrar la hora de inicio y fin de la medición, porque ambas son funciones que devuelven el tiempo.

Puede pasar (y pasa) que el tiempo es menor a un segundo, entonces se muestra 0 (cero). Una opción para agregar los milisegundos es utilizar la misma función TimeToStr (que se ubica en la unidad DateUtils) con la opción FormatSettings.
Sería algo así:

Procedure CargarSList;
var
  MedirTiempo:TMedirTiempo;
  sl:TStringList;
  i:Integer;
  fs:TFormatSettings;
begin
  fs:=DefaultFormatSettings;
  fs.LongTimeFormat:='hh:nn:ss.zzz';
  sl:=TStringList.Create;
  MedirTiempo:=TMedirTiempo.Create(nil);
  MedirTiempo.Iniciar;
  for i:=1 to 100000 do
    sl.Add(IntToStr(i));
  MedirTiempo.Finalizar;
  ShowMessage('Tiempo transcurrido: '+TimeToStr(MedirTiempo.Transcurrido,fs));
  sl.Free;
  MedirTiempo.Free;
end;


TFormatSettings es un registro (record) por lo tanto ni se crea ni se libera.

El temporizador TIdleTimer

Según la documentación oficial es "Un temporizador para medir el tiempo de inactividad entre procesos." y hereda la mayoría de sus propiedades de la clase TCustomTimer, aunque la clase base es TCustomIdleTimer.

Es como un TTimer pero con más opciones.

Se encuentra en la paleta Systems de Lazarus.

En el siguiente ejemplo haremos que el formulario se oculte por 10 segundos cuando el usuario hace click en el botón, luego de trascurrido dicho lapso, el formulario se muestra nuevamente.

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdleTimer1.Enabled:=False;
  IdleTimer1.Interval:=10000;
end;

Esto también se puede hacer directamente en el inspector de objetos.

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  IdleTimer1.Enabled:=True;
  Hide;
end;      

Activamos el temporizador y ocultamos el formulario.

Desde el inspector de objetos, en eventos de IdleTimer1 definimos el evento OnTimer que es cuando el tiempo estipulado ya transcurrió.

procedure TForm1.IdleTimer1Timer(Sender: TObject);
begin
  IdleTimer1.Enabled:=False;
  Show;
end;         

Es importante desactivar el temporizador, caso contrario seguirá ejecutándose.

El código completo:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons;

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    IdleTimer1: TIdleTimer;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IdleTimer1Timer(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdleTimer1.Enabled:=False;
  IdleTimer1.Interval:=10000;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  IdleTimer1.Enabled:=True;
  Hide;
end;

procedure TForm1.IdleTimer1Timer(Sender: TObject);
begin
  IdleTimer1.Enabled:=False;
  Show;
end;

end.    

Medir el tiempo de ejecución de un proceso

Hacer el "benchmark" de una función, proceso o programa es algo relativamente simple en Lazarus/FreePascal utilizando la unidad dateutils.

En este ejemplo vamos a calcular cuanto se tarda en imprimir 10.000 líneas en un TMemo. También obtendremos la velocidad promedio de líneas por segundo.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics,
  Dialogs, StdCtrls, dateutils;

type

{ TForm1 }

TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  CheckBox1: TCheckBox;
  dtpEmpieza: TDateTimePicker;
  dtpFinaliza: TDateTimePicker;
  dtpTranscurrido: TDateTimePicker;
  edImpps: TEdit;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Label4: TLabel;
  Memo1: TMemo;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
private
  procedure Empezar;
  procedure Finalizar;
{ private declarations }
public
{ public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  i:Integer;
begin
  Empezar;
  if CheckBox1.Checked then
  begin
    for i:=1 to 10000 do
    begin
      Application.ProcessMessages;
      Memo1.Lines.Add(IntToStr(i));
    end;
  end
  else
    begin
      for i:=1 to 10000 do
        Memo1.Lines.Add(IntToStr(i));
    end;
  Finalizar;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Empezar;
begin
  dtpEmpieza.Time:=Now;
end;

procedure TForm1.Finalizar;
begin
  dtpFinaliza.Time:=Now;
  dtpTranscurrido.Time:=dtpFinaliza.Time-dtpEmpieza.Time;
  edImpps.Text:=FloatToStr((10000/((SecondOf(dtpTranscurrido.Time)+((MilliSecondOf(dtpTranscurrido.Time)/1000))))));
end;

end.

Desde ya se pueden quitar los dos TDateTimePicker y reemplazarlos por dos variables del tipo TTime, o ocultar dichos componentes. También reemplazar el valor 10000 por una constante o variable. Se puede jugar un buen rato.

Código fuente: MedirProcesos.7z o en GitLab

Diferencia horaria entre dos fechas

El tipo TDateTime es un número del tipo Double cuya parte entera se utiliza para la parte de la fecha y la parte fraccionaria para la hora.

Free Pascal dispone de una gran cantidad de funciones para el tratamiento de fechas y horas en la unidad dateutils.

En este ejemplo solo veremos como calcular la diferencia horaria, la parte time, de dos TDateTime y también la cantidad de horas entre dos fechas también del tipo TDateTime.

Lo primero que notamos es que el cálculo del tiempo transcurrido entre las 19:00 y 02:27 es correcto, 7 horas y 27 minutos.
Lo segundo, es que si se tomarán en cuenta los días de las fechas, las horas transcurridas serían 55 y 27 minutos.
Lo tercero, la cantidad de horas es correcta, 55, pero se ignoran los minutos.

Pero según lo que se necesite, esto puede servir o resultar insuficiente, en tal caso, hay que buscar la combinación de funciones que nos resuelvan el tema y de última siempre están las funciones Decode* y Encode* mediante las cuales, podemos hacer lo que queramos, aunque deberemos escribir más código.

El código del ejemplo:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, dateutils;

type

        { TForm1 }

    TForm1 = class(TForm)
                btnDiferencia: TButton;
                btnCantidad: TButton;
                Label1: TLabel;
                Label2: TLabel;
                Label3: TLabel;
                Label4: TLabel;
                procedure btnCantidadClick(Sender: TObject);
    procedure btnDiferenciaClick(Sender: TObject);
    private
        fechainicio, fechafin:TDateTime;
        { private declarations }
    public
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnDiferenciaClick(Sender: TObject);
var
  Diferencia:TDateTime;
begin
  fechainicio:=StrToDateTime('05-07-2017 19:00');
  fechafin:=StrToDateTime('08-07-2017 02:27');
  Diferencia:=fechafin-fechainicio;
  Label3.Caption:=TimeToStr(TimeOf(Diferencia));
end;

procedure TForm1.btnCantidadClick(Sender: TObject);
var
  canthoras:Int64;
begin
  fechainicio:=StrToDateTime('05-07-2017 19:00');
  fechafin:=StrToDateTime('08-07-2017 02:27');
  canthoras:=HoursBetween(fechafin,fechainicio);
  Label4.Caption:=IntToStr(canthoras);
end;

end.

La función TimeOf recibe como parámetro un valor del tipo TDateTime y retorna la parte horaria, es decir, le pasamos un TDateTime y nos devuelve un TTime, por tal motivo utilizamos TimeToStr en lugar DateTimeToStr.

La función HoursBetween recibe como parámetros dos valores del tipo TDateTime y retorna un valor del tipo Int64 que serán la cantidad de horas entre las fechas.

Código fuente: Diferencia horaria entre fechas.7z

o en GitLab

Comparar horas

CompareTime es un función que nos permite comparar tiempo entre dos valores del tipo TDateTime o TTime. Si el valor es del tipo TDateTime, la parte del valor correspondiente a la fecha, es ignorada.

Esta función se encuentra en DateUtils por lo tanto debe agregarse en uses.

La función recibe como parámetros dos constantes del tipo TDateTime y devuelve un TValueRelationship cuyos valores están en el rango -1..1

function CompareTime ( const A: TDateTime; const B: TDateTime ) : TValueRelationship;

Definición según la wiki de Free Pascal.

Los parámetros aceptados son tanto del tipo TDateTime como TTime.

Si los valores son iguales, entonces devuelve 0 (cero).

Si el primer valor es anterior o más temprano que el segundo, entonces devuelve un valor menor a 0 (cero), es decir, negativo.

Si el primer valor es posterior o más tarde que el segundo, entonces devuelve un valor mayor a 0 (cero), es decir, positivo.

El valor retornado por la función puede almacenarse en una variable del tipo Integer y si bien la documentación habla de valores mayores, iguales o menores a 0 (cero), siendo del tipo entero entonces solo debería retornar 1, 0 o -1.

Ejemplo:

Código:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics, dateutils,
        Dialogs, StdCtrls;

type

        { TForm1 }

    TForm1 = class(TForm)
                btnComparar: TButton;
                DateTimePicker1: TDateTimePicker;
                DateTimePicker2: TDateTimePicker;
                Label1: TLabel;
                Label2: TLabel;
                Memo1: TMemo;
                procedure btnCompararClick(Sender: TObject);
    private
        { private declarations }
    public
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnCompararClick(Sender: TObject);
begin
   CASE CompareTime(DateTimePicker1.Time,DateTimePicker2.Time) of
     1 : Memo1.Append('Llegó temprano');
     0 : Memo1.Append('Llego en horario.');
    -1 : Memo1.Append('Llegó tarde.');
     end;
end;

end.     

Descargar el código (.pas y .lfm): CompareTime.7z