aatimer.pas

平滑特效字体控件包是一个基于平滑（Anti-aliasing）和特效（Effect）字体 技术的控件包

      begin
        TimerObject.Free;
        Delete(i);
        Exit;
      end;
  finally
    FTimerList.UnlockList;
  end;
end;

procedure TAATimerMgr.DoTimer(Sycn: Boolean);
var
  i: Integer;
  CurrTick: Cardinal;
begin
  with FTimerList.LockList do
  try
    CurrTick := GetTickCount;
    for i := 0 to Count - 1 do
      with TAATimerObject(Items[i]) do
        if Enabled and (Interval <> 0) and (SyncEvent = Sycn) and
          (CurrTick - FLastTickCount >= Interval) and Assigned(FOnTimer) then
        begin
          if CurrTick <> FLastTickCount then
            FActualFPS := 1000 / (CurrTick - FLastTickCount)
          else
            FActualFPS := 0;
          FLastTickCount := CurrTick;
          Timer;
        end;
  finally
    FTimerList.UnlockList;
  end;
end;

procedure TAATimerMgr.SyncTimer;
begin
  try
    DoTimer(True);
  except
    Application.HandleException(Self);
  end
end;

procedure TAATimerMgr.Timer;
begin
  try
    DoTimer(False);
  except
    Application.HandleException(Self);
  end
end;

var
  TimerMgr: TAATimerMgr;

function GetTimerMgr: TAATimerMgr;
begin
  if TimerMgr = nil then
    TimerMgr := TAATimerMgr.Create;
  Result := TimerMgr;
end;

//==============================================================================
// 高精度定时器对象
//==============================================================================

{ TAATimerObject }

constructor TAATimerObject.Create;
begin
  inherited Create;
  FEnabled := True;
  FExecCount := 0;
  FInterval := 1000;
  FLastTickCount := GetTickCount;
  FRepeatCount := 0;
  FSyncEvent := True;
end;

destructor TAATimerObject.Destroy;
begin
end;

function TAATimerObject.GetFPS: Double;
begin
  if Interval = 0 then
    Result := 0
  else
    Result := 1000 / Interval;
end;

procedure TAATimerObject.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    FExecCount := 0;
    if FEnabled then
    begin
      FLastTickCount := GetTickCount;
    end;
  end;
end;

procedure TAATimerObject.SetFPS(Value: Double);
begin
  if Value < 0 then
    Exit
  else if Value < 1 / High(Word) then
    Value := 1 / High(Word)
  else if Value > 1000 then
    Value := 1000;
  FInterval := Round(1000 / Value);
end;

procedure TAATimerObject.SetInterval(Value: Cardinal);
begin
  if FInterval <> Value then
  begin
    FInterval := Value;
    FLastTickCount := GetTickCount;
  end;
end;

procedure TAATimerObject.SetRepeatCount(Value: Cardinal);
begin
  if FRepeatCount <> Value then
  begin
    FRepeatCount := Value;
  end;
end;

procedure TAATimerObject.Timer;
begin
  Inc(FExecCount);
  if Assigned(FOnTimer) then FOnTimer(Self);
  if (RepeatCount <> 0) and (FExecCount >= RepeatCount) then
  begin
    Enabled := False;
  end;
end;

//==============================================================================
// 高精度定时器组件
//==============================================================================

{ TAATimer }

constructor TAATimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimerObject := GetTimerMgr.AddTimer;
end;

destructor TAATimer.Destroy;
begin
  GetTimerMgr.DeleteTimer(FTimerObject);
  inherited Destroy;
end;

function TAATimer.GetActualFPS: Double;
begin
  Result := FTimerObject.ActualFPS;
end;

function TAATimer.GetEnabled: Boolean;
begin
  Result := FTimerObject.Enabled;
end;

function TAATimer.GetExecCount: Cardinal;
begin
  Result := FTimerObject.ExecCount;
end;

function TAATimer.GetFPS: Double;
begin
  Result := FTimerObject.FPS;
end;

function TAATimer.GetInterval: Cardinal;
begin
  Result := FTimerObject.Interval;
end;

function TAATimer.GetOnTimer: TNotifyEvent;
begin
  Result := FTimerObject.OnTimer;
end;

function TAATimer.GetRepeatCount: Cardinal;
begin
  Result := FTimerObject.RepeatCount;
end;

function TAATimer.GetSyncEvent: Boolean;
begin
  Result := FTimerObject.SyncEvent;
end;

procedure TAATimer.SetEnabled(Value: Boolean);
begin
  FTimerObject.Enabled := Value;
end;

procedure TAATimer.SetFPS(Value: Double);
begin
  FTimerObject.FPS := Value;
end;

procedure TAATimer.SetInterval(Value: Cardinal);
begin
  FTimerObject.Interval := Value;
end;

procedure TAATimer.SetOnTimer(Value: TNotifyEvent);
begin
  FTimerObject.OnTimer := Value;
end;

procedure TAATimer.SetRepeatCount(Value: Cardinal);
begin
  FTimerObject.RepeatCount := Value;
end;

procedure TAATimer.SetSyncEvent(Value: Boolean);
begin
  FTimerObject.SyncEvent := Value;
end;

//==============================================================================
// 高精度定时器列表集合子项
//==============================================================================

{ TAATimerItem }

constructor TAATimerItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FTimerObject := GetTimerMgr.AddTimer;
  FTimerObject.OnTimer := Timer;
end;

destructor TAATimerItem.Destroy;
begin
  GetTimerMgr.DeleteTimer(FTimerObject);
  inherited Destroy;
end;

procedure TAATimerItem.Assign(Source: TPersistent);
begin
  if Source is TAATimerItem then
  begin
    Enabled := TAATimerItem(Source).Enabled;
    Interval := TAATimerItem(Source).Interval;
    RepeatCount := TAATimerItem(Source).RepeatCount;
    SyncEvent := TAATimerItem(Source).SyncEvent;
  end
  else
    inherited;
end;

function TAATimerItem.GetActualFPS: Double;
begin
  Result := FTimerObject.ActualFPS;
end;

function TAATimerItem.GetEnabled: Boolean;
begin
  Result := FTimerObject.Enabled;
end;

function TAATimerItem.GetExecCount: Cardinal;
begin
  Result := FTimerObject.ExecCount;
end;

function TAATimerItem.GetFPS: Double;
begin
  Result := FTimerObject.FPS;
end;

function TAATimerItem.GetInterval: Cardinal;
begin
  Result := FTimerObject.Interval;
end;

function TAATimerItem.GetRepeatCount: Cardinal;
begin
  Result := FTimerObject.RepeatCount;
end;

function TAATimerItem.GetSyncEvent: Boolean;
begin
  Result := FTimerObject.SyncEvent;
end;

procedure TAATimerItem.SetEnabled(Value: Boolean);
begin
  FTimerObject.Enabled := Value;
end;

procedure TAATimerItem.SetFPS(Value: Double);
begin
  FTimerObject.FPS := Value;
end;

procedure TAATimerItem.SetInterval(Value: Cardinal);
begin
  FTimerObject.Interval := Value;
end;

procedure TAATimerItem.SetRepeatCount(Value: Cardinal);
begin
  FTimerObject.RepeatCount := Value;
end;

procedure TAATimerItem.SetSyncEvent(Value: Boolean);
begin
  FTimerObject.SyncEvent := Value;
end;

procedure TAATimerItem.Timer(Sender: TObject);
begin
  if not TAATimerList(TAATimerCollection(Collection).GetOwner).Timer(Index) then
    if Assigned(FOnTimer) then
      FOnTimer(Self);
end;

//==============================================================================
// 高精度定时器列表集合类
//==============================================================================

{ TAATimerCollection }

constructor TAATimerCollection.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TAATimerItem);
  Assert(AOwner is TAATimerList);
end;

function TAATimerCollection.GetItems(Index: Integer): TAATimerItem;
begin
  Result := TAATimerItem(inherited Items[Index]);
end;

procedure TAATimerCollection.SetItems(Index: Integer; Value: TAATimerItem);
begin
  inherited Items[Index] := Value;
end;

//==============================================================================
// 高精度定时器列表组件
//==============================================================================

{ TAATimerList }

constructor TAATimerList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TAATimerCollection.Create(Self);
end;

destructor TAATimerList.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

procedure TAATimerList.SetItems(Value: TAATimerCollection);
begin
  FItems.Assign(Value);
end;

function TAATimerList.Timer(Index: Integer): Boolean;
begin
  Result := False;
  if Assigned(FOnTimer) then
    FOnTimer(Self, Index, Result);
end;

initialization

finalization
  if TimerMgr <> nil then
    TimerMgr.Free;

end.