PureBoard

Code: Alles auswählen

;In WindowCreate

If QueryPerformanceFrequency_(@*GDI\Performance\Frequency)
  If QueryPerformanceCounter_(@*GDI\Performance\TimeStart)
    ;...
    
    
;In #WM_PAINT - Render Cycle!

*GDI\Performance\Count + 1
If *GDI\Performance\Count > 1000 ;1000 Zyklen warten -> Genauigkeit
  *GDI\Performance\Count = 0 ;Counter zurücksetzen
  If QueryPerformanceCounter_(@*GDI\Performance\TimeStop)
    *GDI\Performance\Framerate = (1000 / ((*GDI\Performance\TimeStop - *GDI\Performance\TimeStart) / *GDI\Performance\Frequency)) ;FPS berechnen !?
    QueryPerformanceCounter_(@*GDI\Performance\TimeStart)
  EndIf
EndIf

Debug "FPS: " + StrF(*GDI\Performance\Framerate)

Code: Alles auswählen

Structure _FPS
  Counter.l
  Timer.l
  FPS.l
EndStructure 

Global FPS._FPS

Procedure GetFPS()
  
  If FPS\Timer + 1000 < ElapsedMilliseconds()
    FPS\FPS = FPS\Counter  
    FPS\Timer = ElapsedMilliseconds()
    FPS\Counter = 0
  Else 
    FPS\Counter + 1
  EndIf 
  
  ProcedureReturn FPS\FPS
EndProcedure 

OpenConsole("FPS")

Repeat 
  Delay(Random(100))
  PrintN("FPS: "+Str(GetFPS()))
ForEver 

Code: Alles auswählen

#averaging = 1000
Procedure.d getFPS()
	Protected now.q = ElapsedMilliseconds(), diff.i = 0
	Protected fps.d
	Static NewList frames.i()
	Static sum.i = 0, lastNow.q = -1
	
	If sum > #averaging
		If FirstElement(frames())
			sum - frames()
			DeleteElement(frames())
		EndIf
	EndIf
	diff = now - lastNow
	If lastNow >= 0 
		LastElement(frames())
		
		If AddElement(frames())
			frames() = diff
			sum + diff
		EndIf
	EndIf
	
	lastNow = now
	
	If sum = 0
		ProcedureReturn 0.0
	Else
		ProcedureReturn ListSize(frames()) * 1000.0 / sum
	EndIf
EndProcedure

Repeat
	Delay(1500)
	Debug "FPS: " + StrD(getFPS())
ForEver

Code: Alles auswählen

Procedure.f FPS(Calc = #True)			; Calc = #False um den letzten Wert auszulesen ohne neu zu berechnen
  #ProcInternal_Max_FPS_Count = 5
  Static Dim FPS_Array(#ProcInternal_Max_FPS_Count)
  Static Count, Ticks, lastTime
  Static ret.f = 0
  Protected i, Time
  
  
  ; ===== Prevent low FPS at start =====
;   If lastTime = 0
;     For i = 0 To #ProcInternal_Max_FPS_Count
;       FPS_Array(i) = 60
;     Next
;   EndIf
  
  
  ; ===== Calc FPS =====
  If Calc
  	
  	Ticks + 1
  	Time = ElapsedMilliseconds()  
  	If Time - lastTime > 999
  		FPS_Array(Count) = Ticks
  		Ticks = 0
  		lastTime = Time
  		Count + 1
  		If Count > #ProcInternal_Max_FPS_Count
  			Count = 0
  		EndIf
  	EndIf
  	
  	
  	; Durchschnitt der letzten FPS (#ProcInternal_Max_FPS_Count + 1)
  	ret = 0
  	For i = 0 To #ProcInternal_Max_FPS_Count
  		ret + FPS_Array(i)
  	Next
  	ret = ret / (#ProcInternal_Max_FPS_Count + 1)
  	
  EndIf
  
  ProcedureReturn ret  
EndProcedure 


; ----- Beispiel -----
If InitSprite()
	If OpenWindow(0, 0, 0, 320, 200, "FPS-Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
		If OpenWindowedScreen(WindowID(0), 0, 0, 320, 200)
			
			Repeat
				StartDrawing(ScreenOutput())
				DrawText(0, 0, StrF(FPS(), 2))
				StopDrawing()
				FlipBuffers()
			Until WindowEvent() = #PB_Event_CloseWindow
			
		EndIf
	EndIf
EndIf