More precise countdown

[johnnydp 16]

Hello,

 

I need to fire some action very precisely AFAIK I cannot fully trust to Ttimer(accuracy)

Maybe question is stupid or trivial but how get something similar like below but using the most precise method(TStopwatch)

 

procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Do something every 1 second(timer interval set to 1000ms)
end;

 

 

 

[programmerdelphi2k 235]

try this for verify your time:

implementation

{$R *.dfm}

uses
  System.DateUtils;

var
  LOldNow: TDateTime = 0;
  LText  : string;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval := 1 { ms }; // 15ms mininum to return a value!
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LText          := '';
  LOldNow        := now;
  Timer1.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := false;
  //
  Memo1.Lines.Delimiter     := '=';
  Memo1.Lines.DelimitedText := LText.Remove(0, 1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // processing time "without" visual interference!!! in release mode
  LText := LText + '=' + MilliSecondSpan(now, LOldNow).ToString;
  //
  LOldNow := now;
end;

end.

I think that you'll need some "library" 3rd-party for that or you can read this article  https://www.thedelphigeek.com/2007/10/calculating-accurate.html

 

     

Edited February 2, 2023 by programmerdelphi2k

[programmerdelphi2k 235]

You could try your own "Timer", but maybe you could get a little frustrated if you don't have much knowledge about "messages" from system....
In the end, the "Timer" just keeps listening and receiving messages from the operating system and filtering to see if it's a "timer" message, and, if true, it just calls a procedure to execute its "OnTimer" event. It's a session of: KillTimer(), SetTimer() non-stop.
You could try to create a new class using a "Thread", and do your own calculation, and call your preferred procedure, but if Embarcadero hasn't done it better yet, it's adequate for most needs!
Don't forget that every iteration with the UI will determine the delay of the triggered event, that is, its final result.

[johnnydp 16]

Thanks for your input, I doubt I will do that better than anyone did already,  I do not feel much strong  to make it good enough.

so after only quick initial research seems that topic  with meassuring time is definetely not trivial.

 

Edited February 2, 2023 by johnnydp

[programmerdelphi2k 235]

you can try use "TStopWatch" in System.Diagnostic.pas... works like a timer to measure a time, with more precision because dont use any UI event!

https://www.thoughtco.com/accurately-measure-elapsed-time-1058453

Edited February 2, 2023 by programmerdelphi2k

[johnnydp 16]

27 minutes ago, programmerdelphi2k said:

you can try use "TStopWatch" in System.Diagnostic.pas... works like a timer to measure a time, with more precision because dont use any UI event!

https://www.thoughtco.com/accurately-measure-elapsed-time-1058453

This was my initial question...;) Still don't know how to know do effecient check if X time was passed to fire action using stopwatch

Edited February 2, 2023 by johnnydp

[KodeZwerg 54]

unit Unit1;

interface

uses
  Winapi.MMSystem,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btnTimerOn: TButton;
    btnTimerOff: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnTimerOffClick(Sender: TObject);
    procedure btnTimerOnClick(Sender: TObject);
  strict private
    FMMRESULT: MMRESULT;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TimerCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD); pascal;
begin
  Form1.Memo1.Lines.Add('Hello from Multimedia Timer!');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMMRESULT := DWORD(-1);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  btnTimerOffClick(Sender);
  Action := caFree;
end;

procedure TForm1.btnTimerOnClick(Sender: TObject);
var
  LDelay: UINT;
begin
  if (FMMRESULT <> DWORD(-1)) then
    btnTimerOffClick(Sender);
  LDelay := 1000; // Timer in millisecond (1000 = 1 second)
  FMMRESULT := TimeSetEvent(LDelay, 0, @TimerCallBack, 0, TIME_PERIODIC);
end;

procedure TForm1.btnTimerOffClick(Sender: TObject);
begin
  if (FMMRESULT <> DWORD(-1)) then
  begin
    TimeKillEvent(FMMRESULT);
    FMMRESULT := DWORD(-1);
  end;
end;

end.

In my experience, nothing beats a multimedia timer.
I hope it helps.

Quote

The multimedia timer runs in its own thread

 

Edited February 2, 2023 by KodeZwerg
corrected.

[limelect 47]

Not mine

 

VeryFastTimer.zip

 

Enjoy

[limelect 47]

Found on my disk

microsecnd timer.zip

[Lars Fosdal 1732]

@johnnydp - What is the time precision that you need? 

Do you need start/one-shot/stop precision, or do you need start/repeat task every interval until/stop?

If you are talking more accurate than 15.6ms (Windows default), you are most likely looking at highly CPU intensive custom code or kernel driver assisted timing.

In addition, you need to factor in the code required to "complete" the event.

 

[aehimself 388]

You can give a try to TThreadedTimer. Not sure if it's that precise at millisecond level but it beats TTimer on everyday use.

 

[KodeZwerg 54]

Whats the benefit compared to multimedia timer that already run in its own thread? @aehimself

(No complain against your timer project!!! Lots of kudos for you for sharing it!)

[aehimself 388]

Precision-wise probably nothing, multimedia timers are supposed to be the closest you can get.

It is transparent though (you can see what is happening under the hood) and it is a drop-in replacement for TTimer which means 0 code change is required.

 

It's also good to leave a variety of options so OP and future visitors can choose their favorite flavor.

[KodeZwerg 54]

// removed obsolete

Edited February 5, 2023 by KodeZwerg
outdated

[programmerdelphi2k 235]

Quote

REMARK: in case, it's specific for mSwInDoWs

timeSetEvent function  https://learn.microsoft.com/en-us/previous-versions/dd757634(v=vs.85)
Article 06/06/2016  2 minutes to read
The timeSetEvent function starts a specified timer event. The multimedia timer runs in its own thread. After the event is activated, it calls the specified callback function or sets or pulses the specified event object.

 

Note  This function is obsolete. New applications should use CreateTimerQueueTimer to create a timer-queue timer. 

https://learn.microsoft.com/en-us/windows/win32/api/threadpoollegacyapiset/nf-threadpoollegacyapiset-createtimerqueuetimer?redirectedfrom=MSDN

Article 10/13/2021  4 minutes to read

 

Edited February 5, 2023 by programmerdelphi2k

[aehimself 388]

1 hour ago, KodeZwerg said:

Here is my try to do a "drop-in replacement", just by multimedia timer 😛

implementation

var
  IOnTimer: TNotifyEvent;

This will work as long as you have one instance in your application, or all your timers have the same handler.

[KodeZwerg 54]

@programmerdelphi2k updated to the method you mentioned, thanks
@aehimself updated to a more stable version that can run multiple times

unit kz.Windows.Timer;

interface

uses
  Winapi.Windows, Winapi.Messages,
  Vcl.Forms,
  System.Classes;

type
  TkzTimer = class(TComponent)
  strict private
    FEnabled: Boolean;
    FInterval: DWORD;
    FOnTimer: TNotifyEvent;
    FHandle: THandle;
  private
    FHWND: HWND;
  private
    procedure EnableTimer;
    procedure DisableTimer;
    procedure SetEnabled(const AValue: Boolean);
    procedure SetInterval(const AValue: DWORD);
  protected
    procedure WndProc(var Message: TMessage);
    procedure DoTimer; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default False;
    property Interval: DWORD read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

implementation

procedure TimerCallback(lpParameter: TkzTimer; TimerOrWaitFired: Boolean); StdCall;
begin
  Winapi.Windows.PostMessage(lpParameter.FHWND,
                             (WM_APP + 666),
                             0,
                             0);
end;

procedure TkzTimer.DoTimer;
begin
  if Assigned(FOnTimer) then
    FOnTimer(Self);
end;

procedure TkzTimer.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    (WM_APP + 666): try
                      DoTimer;
                    except
                      Vcl.Forms.Application.HandleException(Self);
                    end
    else
      Message.Result := Winapi.Windows.DefWindowProc(FHWND,
                                                     Message.Msg,
                                                     Message.WParam,
                                                     Message.LParam);
  end;
end;

constructor TkzTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled  := False;
  FInterval := 1000;
  FOnTimer  := nil;
  FHandle   := Winapi.Windows.INVALID_HANDLE_VALUE;
  FHWND     := System.Classes.AllocateHWnd(WndProc);
end;

destructor TkzTimer.Destroy;
begin
  FOnTimer := nil;
  DisableTimer;
  System.Classes.DeallocateHWnd(FHWND);
  inherited Destroy;
end;

procedure TkzTimer.SetEnabled(const AValue: Boolean);
begin
  if AValue then
    EnableTimer
  else
    DisableTimer;
end;

procedure TkzTimer.SetInterval(const AValue: DWORD);
begin
  FInterval := AValue;
  if (FInterval < 1) then
    FInterval := 1;
  if FEnabled then
    EnableTimer;
end;

procedure TkzTimer.EnableTimer;
begin
  if (FHandle <> Winapi.Windows.INVALID_HANDLE_VALUE) then
    DisableTimer;
  FEnabled := Winapi.Windows.CreateTimerQueueTimer(FHandle,
                                                   0,
                                                   @TimerCallback,
                                                   Self,
                                                   FInterval,
                                                   FInterval,
                                                   Winapi.Windows.WT_EXECUTEDEFAULT or Winapi.Windows.WT_EXECUTELONGFUNCTION);
end;

procedure TkzTimer.DisableTimer;
begin
  if Winapi.Windows.DeleteTimerQueueTimer(0, FHandle, 0) then
    begin
      FHandle  := Winapi.Windows.INVALID_HANDLE_VALUE;
      FEnabled := False;
    end;
end;

end.

Alpha version 🙂

Edited February 6, 2023 by KodeZwerg

[johnnydp 16]

Apologize delay(illness)

Thank you guys for all of your input and comments, CreateTimerQueueTimer seems to be the best method (cpu time vs accuracy)

 

@KodeZwerg 

 Multimedia timer(your first code posted) works very precise too, however I'm getting AV on form close(with low intervals <=50ms) - not always.

 

As for the latest method, Can you show some basic implementatio like for the first one? Fire action every interval set mean for unit kz.Windows.Timer ;

Probably it would be good to add procedures and properties for Period and DueTime(SetPeriod, SetDueTime)
 

QFP, QPC seems to be non go for such usage like I first wanted, it's very good for meassure execution time for some portion of code e.g. for profiling/optimizations.

But for other purposes CreateTimerQueueTimer seems to be the king.

 

@Lars Fosdal Fire and run until app will be closed/destroyed (launch tasks every X time with precision where ttimer is too weak)

 

Edited February 10, 2023 by johnnydp

[KodeZwerg 54]

7 hours ago, johnnydp said:

Apologize delay(illness)

Thank you guys for all of your input and comments, CreateTimerQueueTimer seems to be the best method (cpu time vs accuracy)

 

@KodeZwerg 

As for the latest method, Can you show some basic implementatio like for the first one? Fire action every interval set mean for unit kz.Windows.Timer ;

Probably it would be good to add procedures and properties for Period and DueTime(SetPeriod, SetDueTime)

I just used it like I would use a standard TTimer.
Here is a sample usage, in attachment a full project you can load in.
 

procedure TForm11.FormCreate(Sender: TObject);
begin

  Timer1 := TkzTimer.Create(Self);
  try
    Timer1.OnTimer := DoTimer1;
    Timer1.LinkIntervalDueTime := False;
    Timer1.DueTime := 5000;
    Timer1.Interval := 1;
  finally
    Timer1.Enabled := True;
  end;

  Timer2 := TkzTimer.Create(Self);
  try
    Timer2.OnTimer := DoTimer2;
    Timer2.Interval := 750;
  finally
    Timer2.Enabled := True;
  end;

end;

I've tested with Delphi Alexandria, 32 and 64 bit.
When you load project and build it, answer the question about "remove does not have corresponding component" with "No"
As you can see and liked to have, DueTime is added, by default it act like the basic TTimer act with a lag of 1000ms or whatever Interval you set.
In demo i used 1ms with a waiting time of 5s and 750ms, works for me flawless and nothing bad happen on closing the demo.
I added a LinkIntervalDueTime boolean that control if values should be in balance (like a basic TTimer would be) or complete seperated from each other.
Anyway, 1ms is in my demo too fast to process for Vcl, lags are on Vcl side, not my Component.

I hope you like it and find it useful for your needs.

kzTimer.zip

[johnnydp 16]

@KodeZwerg Thanks, yes it's useful 

as for crashing I meant your previous code(Multimedia Timer) when set to very low interval. Thanks it's really alpha and ver(lack of Period and some checks) anyway great start.

Thank you

[Lars Fosdal 1732]

You still haven't explicitly defined the required precision?

Anything timing related on Windows is a gamble err, calculated risk, unless you go to driver-level, and even then it depends on Windows not being starved for resource.