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
Caption := IntToStr(FCont);
Inc(FCont);
Application.ProcessMessages;
end;
procedure TForm1.btnComenzarClick(Sender: TObject);
begin
if not Assigned(TimeThread) then
begin
FCont := 1;
TimeThread:= TTimeThread.Create;
TimeThread.Interval := 100000;
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 !