testtimer.pp 1.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. {$mode objfpc}
  2. {$H+}
  3. program testtimer;
  4. uses
  5. {$ifdef unix}
  6. cthreads,
  7. {$endif}
  8. sysutils,classes,custapp,fptimer;
  9. Type
  10. TTestTimerApp = Class(TCustomApplication)
  11. Private
  12. FTimer : TFPTimer;
  13. FCount : Integer;
  14. FTick : Integer;
  15. Public
  16. Procedure DoRun; override;
  17. Procedure DoTick(Sender : TObject);
  18. end;
  19. Procedure TTestTimerApp.DoRun;
  20. begin
  21. FTimer:=TFPTimer.Create(Self);
  22. FTimer.Interval:=100;
  23. FTimer.OnTimer:=@DoTick;
  24. FTimer.Enabled:=True;
  25. Try
  26. FTick:=0;
  27. FCount:=0;
  28. While (FCount<10) do
  29. begin
  30. Inc(FTick);
  31. CheckSynchronize; // Needed, because we are not running in a GUI loop.
  32. Sleep(1);
  33. end;
  34. Finally
  35. FTimer.Enabled:=False;
  36. FreeAndNil(FTimer);
  37. end;
  38. Terminate;
  39. end;
  40. Procedure TTestTimerApp.DoTick(Sender : TObject);
  41. begin
  42. Inc(FCount);
  43. Writeln('Received timer event ',FCount,' after ',FTick,' ticks.');
  44. FTick:=0;
  45. end;
  46. begin
  47. With TTestTimerApp.Create(Nil) do
  48. Try
  49. Run
  50. finally
  51. Free;
  52. end;
  53. end.