Constant frame rate aka limit FPS

[gintasdx]

Only if this drivers configured to do not use VSync, or if drivers just a cr*p

Well I found the solution. Seems DirectX9 version of this engine works just fine with VSync. It gives around
55 FPS DirectX8 only about 28FPS with VSync. With OpenGL I only could get stable 60FPS with VSync in fullscreen mode,but on Linux everything is fine with the latest Intel drivers.

[vgo]

Some old code that I've used in my projects, not sure where it originally came from...

unit glThread;

interface

uses
	Forms, Windows, Classes, MMSystem;

type
	TThreadProcedure  = procedure of object;

	TGLDrawEvent = procedure(Sender: TObject) of object;

	TGLRunThread = class(TThread)
	private
		FIsTerminated: Boolean;
		fAverageDrawList  : TList;
		fAverageDrawTime  : single;
		fFrameRate        : single;
		fIdleTime         : Single;
		fAverageIdleTime  : single;
		fMaxFrameRate     : integer;
		fThreadProc       : TThreadProcedure;
		fGLPriority       : TThreadPriority;
		fUnlimited        : boolean;
		FrameCount  : integer;
		FrameTicks  : Single;
		procedure   SetfGLPriority  (Value : TThreadPriority);
		procedure DoIt;
	protected
		QPFrequency: Int64;
		QPCurrentTime: Int64;
		QPLastTime: Int64;
		QPEnabled: Boolean;
		procedure   Execute;        override;
		function GetTime: Single;
	public
		constructor Create          (CreateSuspended : boolean; ThreadProc : TThreadProcedure);
		destructor  Destroy;        override;
		property    GLPriority      : TThreadPriority   read fGLPriority write SetfGLPriority;
		property    ThreadProc      : TThreadProcedure  write fThreadProc;
		property    IdleTime        : Single           read fIdleTime;
		property    AverageDrawTime : single            read fAverageDrawTime;
		property    AverageIdleTime : single            read fAverageIdleTime;
		property    FrameRate       : single            read fFrameRate;
		property    MaxFrameRate    : integer           read fMaxFrameRate write fMaxFrameRate;
		property    Unlimited       : boolean           read fUnlimited write fUnlimited;
		property IsTerminated: Boolean read FIsTerminated;
	end;

	TGLThread = class(TComponent)
	private
		procedure ThreadProc;
	protected
		RunThread: TGLRunThread;
		FOnDraw: TGLDrawEvent;
		function GetAverageDrawTime: Single;
		function GetFrameRate: Single;
		function GetMaxFrameRate: Integer;
		procedure SetMaxFrameRate(Value: Integer);
		function GetRunning: Boolean;
		function GetUnlimited: Boolean;
		procedure SetUnlimited(Value: Boolean);
	public
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		procedure Start;
		procedure Stop;

		property FrameRate: Single read GetFrameRate;
		property AverageDrawTime: Single read GetAverageDrawTime;
		property Running: Boolean read GetRunning;
	published
		property OnDraw: TGLDrawEvent read FOnDraw write FOnDraw;
		property MaxFrameRate: Integer read GetMaxFrameRate write SetMaxFrameRate;
		property Unlimited: Boolean read GetUnlimited write SetUnlimited;
	end;

procedure Register;

implementation

procedure Register;
begin
	RegisterComponents('OpenGL', [TGLThread]);
end;

{---------------------------------------------------------------------------
-----------------------}

function TGLRunThread.GetTime: Single;
var
	Time: Int64;
begin
	QueryPerformanceCounter(Time);
	Result := (Time / QPFrequency);
end;

//TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest, tpTimeCritical);

constructor TGLRunThread.Create(CreateSuspended : boolean; ThreadProc : TThreadProcedure);
begin
  inherited Create(CreateSuspended);
  fAverageDrawList  := TList.Create;
  fFrameRate        := 0;
  fMaxFrameRate     := 60;                                              // Need a frame rate of 60 frames / second.
  fThreadProc       := ThreadProc;
  //FreeOnTerminate   := true;
  FreeOnTerminate   := FALSE;
  //GLPriority        := tpIdle;
  GLPriority        := tpNormal;
  fUnlimited        := false;
  FIsTerminated := FALSE;
  QueryPerformanceFrequency(QPFrequency);
end; {constructor}

{---------------------------------------------------------------------------
-----------------------}

destructor TGLRunThread.Destroy;
begin
  fAverageDrawList.Free;
  inherited;
end; {destructor}

{---------------------------------------------------------------------------
-----------------------}

procedure TGLRunThread.SetfGLPriority(Value : TThreadPriority);
begin
  if (fGLPriority <> Value) then begin
	 fGLPriority := Value;
	 Priority    := fGLPriority;
  end; {if}
end; {SetfGLPriority}

{---------------------------------------------------------------------------
-----------------------}

procedure TGLRunThread.Execute;
begin
	FIsTerminated := FALSE;
	FrameCount  := 0;                                                     // Used to get the frame rate.
	FrameTicks  := GetTime;
	while not Terminated do begin
		//Synchronize(DoIt);
		DoIt;
	end; {while}
	FIsTerminated := TRUE;
end; {Execute}

procedure TGLRunThread.DoIt;
{...........................................................................
.....................}

function AverageTime(TimeList : TList; TimeValue : Single; Samples : integer) : single;
  var
	 lp1 : integer;
  begin
	 TimeList.Add(Pointer(TimeValue));
	 if (TimeList.Count > Samples) then
		TimeList.Delete(0);
	 Result  := 0;
	 for lp1 := 0 to pred(TimeList.Count) do
		Result  := Result + Single(TimeList[lp1]);
	 Result  := Result / TimeList.Count;
  end; {AverageTime}

{...........................................................................
.....................}

var
  StartTicks  : Single;
  DrawTime    : Single;
begin
	 //StartTicks        := GetTickCount;                                  // Get the start time.
	 StartTicks        := GetTime;                                  // Get the start time.
	 if Assigned(fThreadProc) then                                       // Do the drawing ...
		Synchronize(fThreadProc);                                         // <------- The main draw routine
	 //DrawTime          := Integer(GetTickCount-StartTicks);              // Get the draw time.
	 DrawTime          := (GetTime-StartTicks);              // Get the draw time.

	 fAverageDrawTime  := AverageTime(fAverageDrawList, DrawTime, 50);   // Work out the average draw time.

	 if fUnlimited then begin                                            // Frame rate limited ?
		fIdleTime         := 0;                                           // Set these to zero ... then ignore.
		fAverageIdleTime  := 0;
	 end else begin
		fIdleTime         := (1/fMaxFrameRate) - DrawTime;        // Idle time is the difference between the
		fAverageIdleTime  := 1/fMaxFrameRate - fAverageDrawTime;       // wanted frame duration and the draw time.
	 end; {if}

	 if (fIdleTime > 0) then                                             // If there is some idle time then delay
		Sleep(Round(fIdleTime * 1000));                                                 // for the idle time by sleeping.

	 inc(FrameCount);                                                    // Work out the frame rate ... effectively
	 if (StartTicks - FrameTicks > 1) then begin                      // sample every second and count the number
		fFrameRate  := (1*FrameCount) / (StartTicks-FrameTicks);       // of frames.
		FrameCount  := 0;
		//FrameTicks  := GetTickCount;
		FrameTicks  := GetTime;
	 end; {if}


end;

{---------------------------------------------------------------------------
-----------------------}
{ajGLThread}

constructor TGLThread.Create(AOwner: TComponent);
begin
	inherited;
	RunThread := TGLRunThread.Create(TRUE, ThreadProc);
end;

destructor TGLThread.Destroy;
begin
	Stop;
	RunThread.Free;
	inherited;
end;

function TGLThread.GetAverageDrawTime: Single;
begin
	Result := RunThread.AverageDrawTime;
end;

function TGLThread.GetFrameRate: Single;
begin
	Result := RunThread.FrameRate;
end;

function TGLThread.GetMaxFrameRate: Integer;
begin
	Result := RunThread.MaxFrameRate;
end;

procedure TGLThread.SetMaxFrameRate(Value: Integer);
begin
	RunThread.MaxFrameRate := Value;
end;

function TGLThread.GetRunning: Boolean;
begin
	Result := not RunThread.IsTerminated;
end;

function TGLThread.GetUnlimited: Boolean;
begin
	Result := RunThread.Unlimited;
end;

procedure TGLThread.SetUnlimited(Value: Boolean);
begin
   RunThread.Unlimited := Value;
end;

procedure TGLThread.Start;
begin
	RunThread.Resume;
end;

procedure TGLThread.Stop;
begin
	if not RunThread.IsTerminated then
	begin
		RunThread.Terminate;
		RunThread.WaitFor;
	end;
end;

procedure TGLThread.ThreadProc;
begin
	if Assigned(FOnDraw) then
		FOnDraw(Self);
end;

end.

[gintasdx]

The Asphyre Sphinx seems to have a nice way to limit FPS without using a sleep function. Anyways VSync helps to avoid tearing,but I rarely see a games that has it turned on by default. And I wonder does anyone tried the way from GameDev.net

[Andru]

The Asphyre Sphinx seems to have a nice way to limit FPS without using a sleep function.

ORLY? It use SleepEx

[Ñuño Martínez]

I know this is old (long time I don't walk here...) but I wrote an article about how to control time using my Allegro.pas library. It uses "interruption-like". May be you can translate it to your favourite library.