- type
- PFPSCalcerItem = ^TFPSCalcerItem;
- TFPSCalcerItem = record
- PrevItem: PFPSCalcerItem;
- NextItem: PFPSCalcerItem;
- Time: Int64;
- end;
- TFPSCalcer = class(TObject)
- private
- FCount: Integer;
- FFirst: PFPSCalcerItem;
- FLast: PFPSCalcerItem;
- FMaxTime: Int64;
- public
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- property MaxTime: Int64 read FMaxTime write FMaxTime;
- procedure AddTime(Time: Int64);
- function GetAverageFPS: Single;
- procedure ClearAll;
- end;
- implementation
- procedure TFPSCalcer.AddTime(Time: Int64);
- var
- TempItem: PFPSCalcerItem;
- begin
- TempItem := FLast;
- while (Assigned(TempItem)) do begin
- if ((Time - TempItem^.Time) > FMaxTime) then begin
- if (FFirst = FLast)
- then FFirst := TempItem^.PrevItem;
- FLast := TempItem^.PrevItem;
- Dispose(TempItem);
- TempItem := FLast;
- Dec(FCount);
- end
- else Break;
- end;
- New(TempItem);
- TempItem^.Time := Time;
- TempItem^.PrevItem := nil;
- TempItem^.NextItem := FFirst;
- if (Assigned(FFirst))
- then FFirst^.PrevItem := TempItem;
- FFirst := TempItem;
- if (not Assigned(FLast))
- then FLast := FFirst;
- Inc(FCount);
- end;
- procedure TFPSCalcer.AfterConstruction;
- begin
- inherited;
- FFirst := nil;
- FLast := nil;
- FCount := 0;
- end;
- procedure TFPSCalcer.BeforeDestruction;
- begin
- inherited;
- ClearAll;
- end;
- procedure TFPSCalcer.ClearAll;
- var
- Temp: PFPSCalcerItem;
- begin
- while (Assigned(FFirst)) do begin
- Temp := FFirst^.NextItem;
- Dispose(FFirst);
- FFirst := Temp;
- Dec(FCount);
- end;
- FLast := nil;
- end;
- function TFPSCalcer.GetAverageFPS: Single;
- begin
- if (Assigned(FFirst) and Assigned(FLast) and (FCount > 1))
- then Result := (FCount - 1) / (FFirst^.Time - FLast^.Time) * FMaxTime
- else Result := FCount;
- end;