Ver Mensaje Individual
  #6  
Antiguo 14-05-2013
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
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 !
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 14-05-2013 a las 20:57:16.
Responder Con Cita