Timed Message Box

Unit TimerQueue.pas

unit TimerQueue;

interface

type
  THandle = Cardinal;
  DWORD = Cardinal;
  ULONG = Cardinal;
  BOOL = Boolean;

type
  WAITORTIMERCALLBACKFUNC = procedure (P: Pointer; B: ByteBool); stdcall;
  WAITORTIMERCALLBACK = WAITORTIMERCALLBACKFUNC;

function CreateTimerQueueTimer(var phNewTimer: THandle; TimerQueue: THandle;
  Callback: WAITORTIMERCALLBACK; Parameter: Pointer; DueTime, Period: DWORD;
  Flags: ULONG): BOOL; stdcall;

function DeleteTimerQueueTimer(TimerQueue, Timer, CompletionEvent: THandle): BOOL; stdcall;

implementation

function CreateTimerQueueTimer; external 'kernel32.dll' name 'CreateTimerQueueTimer';

function DeleteTimerQueueTimer; external 'kernel32.dll' name 'DeleteTimerQueueTimer';

end.

Unit Console :

program TimedMsgBox;

uses
  Windows, TimerQueue;

const
  MSGBOXCAPION = 'Timed Messagebox';
  MSGBOXRESULT = 'Ergebnis';
  ID_MSGBOX_STATIC_TEXT = $0000ffff;

var
  secsleft: Cardinal = 10;

resourcestring
  rsMessage = 'Sie haben %d Sekunden zum Schließen des Meldungsfensters';
  rsRespond = 'Benutzer hat geantwortet';
  rsTimeOut = 'Timeout';

function Format(fmt: string; params: array of const): string;
var
  pdw1, pdw2: PDWORD;
  i: integer;
  pc: PCHAR;
begin
  pdw1 := nil;
  if length(params) > 0 then GetMem(pdw1, length(params) * sizeof(Pointer));
  pdw2 := pdw1;
  for i := 0 to high(params) do begin
    pdw2^ := DWORD(PDWORD(@params[i])^);
    inc(pdw2);
  end;
  GetMem(pc, 1024 - 1);
  try
    SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
  except
    Result := '';
  end;
  if (pdw1 <> nil) then FreeMem(pdw1);
  if (pc <> nil) then FreeMem(pc);
end;

procedure MsgBoxTimeOut(Context: Pointer; TimeOut: Boolean); stdcall;
var
  hWnd: THandle;
  s: String;
begin
  hWnd := FindWindow(nil, MSGBOXCAPION);
  if hWnd <> 0 then
  begin
    Dec(secsleft);
    s := Format(rsMessage, [secsleft]);
    SetDlgItemText(hWnd, ID_MSGBOX_STATIC_TEXT, PChar(s));
    if secsleft = 0 then
      EndDialog(hWnd, 0);
  end;
end;

var
  hTimerQTimer: THandle;
  s: String;
begin
  if CreateTimerQueueTimer(hTimerQTimer, 0, @MsgBoxTimeOut, nil, 1000, 1000, 0) then
  begin
    s := Format(rsMessage, [secsleft]);
    Messagebox(0, PChar(s), MSGBOXCAPION, MB_ICONWARNING);
    DeleteTimerQueueTimer(0, hTimerQTimer, 0);
    if secsleft = 0 then
      Messagebox(0, PChar(rsTimeout), MSGBOXRESULT, MB_ICONSTOP)
    else
      MessageBox(0, PChar(rsRespond), MSGBOXRESULT, MB_ICONASTERISK);
  end;
end.