Velocidad de un timer

[ecfisa]

Hola Nerox.

Te muestro como podes ajustar la cantidad de veces por segundo que deseas que se dispare el evento con bastante márgen:

Código Delphi [-]
unit uTimeThread;

interface

uses Windows, Classes;

type
  TTimeEvent = procedure of object;
  TTimeThread = class(TThread)
  private
    FFreq, FDesde, FHasta: Int64;
    FInterval : Integer;
    FOnTime : TTimeEvent;
    procedure SetInterval(const Value: Integer);
    procedure WaitInterval;
  public
    constructor Create;  reintroduce; overload;
    property Interval : Integer read FInterval write SetInterval;
    property OnTime   : TTimeEvent read FOnTime write FOnTime;
    procedure Execute; override;
    destructor Destroy; override;
  end;

var
  TimeThread: TTimeThread;

implementation

constructor TTimeThread.Create;
begin
  inherited Create(False);
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FDesde);
  Priority := tpNormal;
  FreeOnTerminate := True;
end;

procedure TTimeThread.SetInterval(const Value: Integer);
begin
  if (Value <> FInterval) then
    FInterval := Value
end;

procedure TTimeThread.WaitInterval;
begin
  QueryPerformanceCounter(FHasta);
  if (FHasta - FDesde) * 1000000 div FFreq >= FInterval then
  begin
    if Assigned(OnTime) then OnTime;
    FDesde := FHasta;
  end;
end;

procedure TTimeThread.Execute;
begin
  while not Terminated do
    Synchronize(WaitInterval);
end;

destructor TTimeThread.Destroy;
begin
  inherited ;
  TimeThread := nil;
end;

end.

Ejemplo de uso:

Código Delphi [-]
type
  TForm1 = class(TForm)
    btnComenzar: TButton;
    btnTerminar: TButton;
    procedure btnComenzarClick(Sender: TObject);
    procedure btnTerminarClick(Sender: TObject);
  private
    FCont: Integer;
    procedure TimeThreadOnTime;
  public
  end;
...

implementation 

uses uTimeThread; 

procedure TForm1.TimeThreadOnTime;
begin
  // aquí el proceso que desees
  Caption := IntToStr(FCont);
  Inc(FCont);
  // fin proceso 
  Application.ProcessMessages;
end;

procedure TForm1.btnComenzarClick(Sender: TObject);
begin
  if not Assigned(TimeThread) then
  begin
    FCont := 1;
    TimeThread:= TTimeThread.Create;
    // Intervalo expresado: 1/1000000 seg. (µs)
    TimeThread.Interval := 100000; {1/10 seg }
    TimeThread.OnTime   := TimeThreadOnTime;
    TimeThread.Execute;
  end;
end;

procedure TForm1.btnTerminarClick(Sender: TObject);
begin
  if Assigned(TimeThread) then
    TimeThread.Terminate;
end;

Saludos.

Edito: Casi me olvido... ¡ Bienvenido a Club Delphi !

[Casimiro Notevi]

Impresionante ejemplo

[[nlsgarcia]]

ecfisa,

Excelente

Nelson.

[ozsWizzard]

Empezado por ecfisa

Hola Nerox.

Te muestro como podes ajustar la cantidad de veces por segundo que deseas que se dispare el evento con bastante márgen:

...

Solamente puedo decir +1

[Nerox]

Saludos ecfisa.

Muchas gracias el código funciono.

[Badillo]

Gracias por al ayuda, esta muy buena la clase que propuso ecfisa, pero no logro que me funcione como necesito, quizas es que estoy haciendo algo mal o omitiendo algo, pudieran ayudarme.

Básicamente lo que necesito es que en lo que se va procesando el procedmiento ProcessFile, me actualice los contadores en pantalla (Label0000 hasta Label2110), pero no lo hace, solo cuando hago clic en el label para detener el hilo es que se ejecuta todo. de lo contrario nunca termina y le tengo puesto a la clase F835File la propiedad EndParse que inicia en falso y cuando termina el proceso toma el valor verdadero, para poder tener referencia que terminó el proceso. La duración de este proceso depende del tamaño del fichero que estoy procesando y me ha durado entre 30seg hasta 2 minutos en los casos que tengo como refrencia.

procedure TForm1.TimeThreadOnTime;
begin
  // aquí el proceso que desees
  Inc(FCont);
  if FStopThread = false then
  begin
    FStopThread := true;
    ProcessFile;
  end;

  Label0000.Caption := IntToStr(F835File.Loop0000MaxId);
  Label1000.Caption := IntToStr(F835File.Loop1000MaxId);
  Label2000.Caption := IntToStr(F835File.Loop2000MaxId);
  Label2100.Caption := IntToStr(F835File.Loop2100MaxId);
  Label2105.Caption := IntToStr(F835File.Loop2105MaxId);
  Label2110.Caption := IntToStr(F835File.Loop2110MaxId);

  // fin proceso
  Application.ProcessMessages;
  
  if F835File.EndParse then StopThread;

end;

procedure TForm1.ProcessFile;
begin
  if FileExists(FFileName) then
  begin
    F835File.Parse;
    if F835File <> nil then
    begin
        LabelLoop0000.Caption := IntToStr(F835File.Loop0000MaxId);
        LabelLoop1000.Caption := IntToStr(F835File.Loop1000MaxId);
        LabelLoop2000.Caption := IntToStr(F835File.Loop2000MaxId);
        LabelLoop2100.Caption := IntToStr(F835File.Loop2100MaxId);
        LabelLoop2105.Caption := IntToStr(F835File.Loop2105MaxId);
        LabelLoop2110.Caption := IntToStr(F835File.Loop2110MaxId);
        scMemoSchema.Lines.AddStrings(F835File.getSqlSchema);
        scMemoDelete.Lines.AddStrings(F835File.getSqlDelete);
        scMemoInsert.Lines.AddStrings(F835File.SqlData);
        scMemoFileParser.Lines.AddStrings(F835File.ParsedFile);
        scMemoLogError.Lines.AddStrings(F835File.LogError);
    end;
  end;
end;

procedure TForm1.BeginThread;
begin
  if not Assigned(TimeThread) then
  begin
    FCont := 1;
    TimeThread:= TTimeThread.Create;
    // Intervalo expresado: 1/1000000 seg. (µs)
    TimeThread.Interval := 100000; {1/10 seg }
    TimeThread.OnTime   := TimeThreadOnTime;
    TimeThread.Execute;
  end;
end;

procedure TForm1.StopThread;
begin
  if Assigned(TimeThread) then
    TimeThread.Terminate;
end;

procedure TForm1.scLabel21Click(Sender: TObject);
begin
  StopThread;
end;

Una vez más gracias y aguardo por su ayuda.

[ecfisa]

Hola Badillo.

No puedo saber que hace la clase F835File, pero por lo que comentas mas abajo:

Empezado por Badillo

...

Básicamente lo que necesito es que en lo que se va procesando el procedmiento ProcessFile, me actualice los contadores en pantalla (Label0000 hasta Label2110), pero no lo hace, solo cuando hago clic en el label para detener el hilo es que se ejecuta todo.
...

Creo que la accion de mostrar el valor de los contadores en pantalla y actualizar dichos valores deberías hacerlo en el método TimeThreadOnTimeñ

Código Delphi [-]
procedure TForm1.TimeThreadOnTime;
begin

  //
  // AQUI DEBERIAS ASIGNAR LOS VALORES DE LOS CONTADORES A LOS LABELS (Label0000 hasta Label2110) PARA MOSTRARLOS
  // Y SEGUIDAMENTE ACTUALIZAR LOS VALORES DE DICHOS CONTADORES
  // ( ¿ ProcessFile ? )

  Application.ProcessMessages;
end;

Saludos

[Badillo]

Gracias, estoy fuera de casa por problemas de salud, en cuanto pueda pruebo lo que me recomiendas. La clase F835file lo único que hacer un parseo de un fichero de tipo EDI y pasar la información a sqlserver, por eso demora un poco ese proceso.

Muchas gracias