One-Shot Timers

Question

Dear Delphi programmers,

I'm looking for help how to write a one-shot timer (No GUI, so VCL Timers out of question)...

Let me explain a little bit more.

In my code (explaining with VCL timer but in this particular project I have no forms):

1. Call a procedure which send a char over serial port
2. Enable a timer with a X amount of Interval

In the OnTimer event:

I have a code which send a char then disable the timer itself to never be executed again.

The problem is that I need to make the creation of these timers dynamic. I thought of the function SetTimer() then KillTimer() in the "OnTimer event" to disable it (free it).

Is it a good (safe) way?

Thank you!

Answer 1

Is it safe to kill timer from inside of a timer event ?

Yes, that's perfectly safe.

How to implement simplest one shot timer ?

The easiest implementation of a 1 second one shot timer is this, but note, that if you start more of them, you won't be able to distinguish which one of them elapsed its interval:

procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;
  dwTime: DWORD); stdcall;
begin
  KillTimer(0, idEvent);
  ShowMessage('I''m done!');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetTimer(0, 0, 1000, @TimerProc);
end;

Answer 2

The multimedia timer API provides support for a one shot timer. The benefit is, that the timing is much more precise than the SetTimer/KillTimer solution and you can use it with intervals <50 ms. This comes at a price, as the callback does not return in the context of the main thread. Here is my implementation of a one-shot timer using the multimedia timer API:

unit MMTimer;

interface
uses windows, Classes, mmsystem, SysUtils;
TOneShotCallbackEvent = procedure (const UserData: Pointer) of object;

(*
  The MMOneShotCallback function calls the Callback after the Interval passed.
  ** Attention: **
  The Callback is not called within the context of the main thread.
*)

type TMMOneShotTimer = class(TObject)
  private
    FTimeCaps: TTimeCaps;
    FResult: Integer;
    FResolution: Cardinal;
  public
    constructor Create;
    function MMOneShotCallback(const Interval: Cardinal; UserData: Pointer; Callback: TOneShotCallbackEvent): Boolean;
    property Result: Integer read FResult;
    property Resolution: Cardinal read FResolution;
end;
implementation
type
  TOneShotCallbackData = record
    Callback: TOneShotCallbackEvent;
   UserData: Pointer;
  end;
  POneShotCallbackData = ^TOneShotCallbackData;

procedure OneShotCallback(TimerID, Msg: UINT;
                    dwUser, dw1, dw2: DWord); pascal;
var pdata: POneShotCallbackData;
begin
  pdata := Pointer(dwUser);
  pdata.Callback(pdata.UserData);
  FreeMemory(pdata);
end;

constructor TMMOneShotTimer.Create;
begin
  FResult := timeGetDevCaps(@FTimeCaps, SizeOF(FTimeCaps));
  Assert(FResult=TIMERR_NOERROR, 'Call to timeGetDevCaps failed');
  FResolution := FTimeCaps.wPeriodMin;
  FResult := timeBeginPeriod(FResolution);
  Assert(FResult=TIMERR_NOERROR, 'Call to timeBeginPeriod failed');
end;

function TMMOneShotTimer.MMOneShotCallback(const Interval: Cardinal; UserData: Pointer; Callback: TOneShotCallbackEvent): Boolean;
var pdata: POneShotCallbackData;
begin
  GetMem(pdata, SizeOf(TOneShotCallbackData));
  pdata.Callback := Callback;
  pdata.UserData := UserData;
  result := (0 <> timeSetEvent(Interval, FResolution, @OneShotCallback, DWord(pdata), TIME_ONESHOT));
  if not result then
    FreeMemory(pdata);
  end;
end.