Mega Code Archive
Precise timer thread using messages
<![CDATA[
Title: Precise timer thread using messages
Question: When programming realtime interfaces and computergames, you need a precise timing signal.
The game engine must run at the same rate, no matter what your framerate are.
One way of doing this is to calculate how many moves your game engine must have done since last frame was drawn.
But if you have all the clock cycles in the world (common when doing smaller games), you can create 2 timers: One with high priority that controls all the game movements and one with low priority doing the screen updates.
This example shows a game timer implementation using a thread and messaging.
Answer:
unit gametimer;
// -----------------------------------------------------------------------------
//
// Very precise timer running in its own thread.
//
// Usage: Add the following line to the public section of your game form:
// procedure MoveGame( var Msg : TMsg ); message WM_MOVEGAME;
//
// MoveGame is the code where you do all the moves for your game.
//
// You could then create a timer that draws your game. This timer must
// have a lower priority than your game timer. Your game will then have the same
// game timer, but a slower framerate if the PC lacks resources.
//
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
interface
// -----------------------------------------------------------------------------
uses
Windows, Messages, Classes, MmSystem, Sysutils, forms;
const
WM_MOVEGAME = WM_USER + 203;
TIMERVALUE = 20; { 10 = 100 fps / 20 = 50 fps / 40 = 25 fps / 50 = 20 fps }
Type
TGameTimer = class( TThread )
private
Msg : TMsg;
FHeartbeat : UINT;
fisBeating : boolean;
FGameBeat : integer;
fForm : TForm;
fCount : longword;
procedure Execute; override;
public
constructor Create( AForm : TForm ); overload;
constructor Create( AForm : TForm; AFps : integer ); overload;
destructor Destroy; override;
procedure StartBeat;
procedure StopBeat;
procedure PauseBeat;
property GameBeat : integer read fGameBeat write fGameBeat;
property isBeating : boolean read fisBeating;
property Count : longword read fCount;
end;
// -----------------------------------------------------------------------------
implementation
// -----------------------------------------------------------------------------
var
gSelf : TGameTimer;
procedure GameUpdate(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
begin
gSelf.Resume;
end;
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
constructor TGameTimer.Create( AForm : TForm );
begin
inherited Create( TRUE );
inherited priority := tpTimeCritical;
fForm := AForm;
fGameBeat := TIMERVALUE;
fCount := 0;
end;
// -----------------------------------------------------------------------------
constructor TGameTimer.Create( AForm : TForm; AFps : integer );
begin
Create( AForm );
fGameBeat := round( 1000 / AFps );
end;
// -----------------------------------------------------------------------------
Destructor TGameTimer.Destroy;
begin
try
gSelf := nil;
finally
inherited Destroy;
end;
end;
// -----------------------------------------------------------------------------
procedure TGameTimer.Execute;
begin
while not Terminated do
begin
PostMessage( fForm.Handle, WM_MOVEGAME, 0, 0 );
inc( fCount );
Suspend;
end;
end;
// -----------------------------------------------------------------------------
procedure TGameTimer.PauseBeat;
var
r : integer;
begin
if FHeartbeat 0 then
begin
r := TimeKillEvent(FHeartbeat);
if r TIMERR_NOERROR then
raise Exception.CreateFmt('Cannot stop heartbeat: %d', [r])
else
fisBeating := FALSE;
end;
end;
// -----------------------------------------------------------------------------
procedure TGameTimer.StartBeat;
begin
gSelf := self;
FHeartbeat := TimeSetEvent(FGameBeat, FGameBeat, GameUpdate, UINT(Self), TIME_PERIODIC);
if FHeartbeat = 0 then
raise Exception.Create( 'Cannot start heartbeat' )
else
fisBeating := TRUE;
end;
// -----------------------------------------------------------------------------
procedure TGameTimer.StopBeat;
begin
PauseBeat;
FHeartbeat := 0;
fCount := 0;
gSelf := nil;
end;
end.
TfrmMain = class(TForm)
private
{ Private declarations }
fGameTimer : TGameTimer;
public
{ Public declarations }
procedure MoveGame( var Msg : TMsg ); message WM_MOVEGAME;
end;
procedure TfrmMain.MoveGame( var Msg : TMsg );
begin
{ Do your game movements here }
end;
]]>