?? aatimer.pas

?? 進度條進度條進度條進度條進度條進度條
?? PAS
?? 第 1 頁 / 共 2 頁
字號:
12 下一頁
{*******************************************************************************

                          AAFont - 平滑特效字體控件包
                          ---------------------------
                           (C)Copyright 2001-2004
                            CnPack 開發組 周勁羽

            這一控件包是自由軟件，您可以遵照自由軟件基金會出版的GNU 較
        寬松通用公共許可證協議來修改和重新發布這一程序，或者用許可證的
        第二版，或者（根據您的選擇）用任何更新的版本。

            發布這一控件包的目的是希望它有用，但沒有任何擔保。甚至沒有
        適合特定目的而隱含的擔保。更詳細的情況請參閱 GNU 較寬松通用公
        共許可證。

            您應該已經和控件包一起收到一份 GNU 較寬松通用公共許可證的
        副本。如果還沒有，寫信給：
            Free Software Foundation, Inc., 59 Temple Place - Suite
        330, Boston, MA 02111-1307, USA.

            單元作者：CnPack 開發組 周勁羽
            下載地址：http://www.yygw.net
            電子郵件：yygw@yygw.net

*******************************************************************************}

unit AATimer;
{* |<PRE>
================================================================================
* 軟件名稱：平滑特效字體控件包
* 單元名稱：高精度定時器組件TAATimer單元
* 單元作者：CnPack 開發組 周勁羽
* 備    注：- Delphi自帶的TTimer使用操作系統以消息方式提供的定時器，在Win9X下
*             定時精度僅為55ms，NT下約10ms。
*           - TAATimer采用單獨的線程進行定時控制，精度比TTimer要高，相應地也占
*             用較多的CPU資源，其使用方式與TTimer完成兼容，并提供了更多的功能。
*           - TAATimerList定時器列表可以同時產生多個定時器。
*           - 所有定時器使用同一個線程定時，適合大量使用的場合。
*           - 由于Win32是搶占式多任務操作系統，各個線程輪流享用CPU時間片，如果
*             其它的線程占用大量CPU時間，即使設置最高精度，也不一定能保證精確
*             的定時間隔。
* 開發平臺：PWin98SE + Delphi 5.0
* 兼容測試：PWin9X/2000/XP + Delphi 5/6
* 本 地 化：該單元中的字符串均符合本地化處理方式
* 更新記錄：2002.11.05 V2.0
*               重寫全部代碼，增加定時器列表，所有定時器使用同一線程定時
*           2002.04.18 V1.0
*               創建單元
================================================================================
|</PRE>}

interface

{$I AAFont.inc}

uses
  Windows, SysUtils, Classes, Forms;

type

//==============================================================================
// 高精度定時器對象
//==============================================================================

{ TAATimerObject }

  TAATimerObject = class(TObject)
  private
    FActualFPS: Double;
    FEnabled: Boolean;
    FExecCount: Cardinal;
    FInterval: Cardinal;
    FLastTickCount: Cardinal;
    FOnTimer: TNotifyEvent;
    FRepeatCount: Cardinal;
    FSyncEvent: Boolean;
    function GetFPS: Double;
    procedure SetEnabled(Value: Boolean);
    procedure SetFPS(Value: Double);
    procedure SetInterval(Value: Cardinal);
    procedure SetRepeatCount(Value: Cardinal);
  protected
    procedure Timer; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
    property ActualFPS: Double read FActualFPS;
    property ExecCount: Cardinal read FExecCount;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property FPS: Double read GetFPS write SetFPS stored False;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property RepeatCount: Cardinal read FRepeatCount write SetRepeatCount
      default 0;
    property SyncEvent: Boolean read FSyncEvent write FSyncEvent default True;
  end;

//==============================================================================
// 高精度定時器組件
//==============================================================================

{ TAATimer }

  TAATimer = class(TComponent)
  {* 線程定時器組件，使用方法類似 TTimer。}
  private
    FTimerObject: TAATimerObject;
    function GetActualFPS: Double;
    function GetEnabled: Boolean;
    function GetExecCount: Cardinal;
    function GetFPS: Double;
    function GetInterval: Cardinal;
    function GetOnTimer: TNotifyEvent;
    function GetRepeatCount: Cardinal;
    function GetSyncEvent: Boolean;
    procedure SetEnabled(Value: Boolean);
    procedure SetFPS(Value: Double);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure SetRepeatCount(Value: Cardinal);
    procedure SetSyncEvent(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    {* 類構造器}
    destructor Destroy; override;
    {* 類析構器}
    property ActualFPS: Double read GetActualFPS;
    {* 實際的定時器速率，次每秒}
    property ExecCount: Cardinal read GetExecCount;
    {* 已經執行過的次數}
  published
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    {* 定時器是否啟用}
    property FPS: Double read GetFPS write SetFPS stored False;
    {* 定時器速度，次每秒}
    property Interval: Cardinal read GetInterval write SetInterval default 1000;
    {* 定時間隔，毫秒}
    property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
    {* 定時事件}
    property RepeatCount: Cardinal read GetRepeatCount write SetRepeatCount
      default 0;
    {* 定時事件次數，當定時事件發生指定次數后自動關閉。如果為 0 表示不限制}
    property SyncEvent: Boolean read GetSyncEvent write SetSyncEvent default
      True;
    {* 是否使用同步方式在主線程中產生定時事件，如果為 false 將在定時線程中產生事件}
  end;

//==============================================================================
// 高精度定時器列表集合子項
//==============================================================================

{ TAATimerItem }

  TAATimerItem = class(TCollectionItem)
  {* 線程定時器列表子項，使用方法類似 TTimer。}
  private
    FOnTimer: TNotifyEvent;
    FTimerObject: TAATimerObject;
    function GetActualFPS: Double;
    function GetEnabled: Boolean;
    function GetExecCount: Cardinal;
    function GetFPS: Double;
    function GetInterval: Cardinal;
    function GetRepeatCount: Cardinal;
    function GetSyncEvent: Boolean;
    procedure SetEnabled(Value: Boolean);
    procedure SetFPS(Value: Double);
    procedure SetInterval(Value: Cardinal);
    procedure SetRepeatCount(Value: Cardinal);
    procedure SetSyncEvent(Value: Boolean);
  protected
    procedure Timer(Sender: TObject);
  public
    constructor Create(Collection: TCollection); override;
    {* 類構造器}
    destructor Destroy; override;
    {* 類析構器}
    procedure Assign(Source: TPersistent); override;
    {* 賦值方法}
    property ActualFPS: Double read GetActualFPS;
    {* 實際的定時器速率，次每秒}
    property ExecCount: Cardinal read GetExecCount;
    {* 已經執行過的次數}
  published
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    {* 定時器是否啟用}
    property FPS: Double read GetFPS write SetFPS stored False;
    {* 定時器速度，次每秒}
    property Interval: Cardinal read GetInterval write SetInterval default 1000;
    {* 定時間隔，毫秒}
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    {* 定時事件}
    property RepeatCount: Cardinal read GetRepeatCount write SetRepeatCount
      default 0;
    {* 定時事件次數，當定時事件發生指定次數后自動關閉。如果為 0 表示不限制}
    property SyncEvent: Boolean read GetSyncEvent write SetSyncEvent default
      True;
    {* 是否使用同步方式在主線程中產生定時事件，如果為 false 將在定時線程中產生事件}
  end;

//==============================================================================
// 高精度定時器列表集合類
//==============================================================================

{ TAATimerCollection }

  TAATimerList = class;

  TAATimerCollection = class(TOwnedCollection)
  {* 線程定時器列表集合}
  private
    FTimerList: TAATimerList;
    function GetItems(Index: Integer): TAATimerItem;
    procedure SetItems(Index: Integer; Value: TAATimerItem);
  protected
    property TimerList: TAATimerList read FTimerList;
  public
    constructor Create(AOwner: TPersistent);
    {* 類構造器}
    property Items[Index: Integer]: TAATimerItem read GetItems write SetItems; default;
    {* 定時器數組屬性}
  end;

//==============================================================================
// 高精度定時器列表組件
//==============================================================================

{ TAATimerList }

  TAATimerEvent = procedure(Sender: TObject; Index: Integer; var Handled:
    Boolean) of object;
  {* 線程定時器列表事件。Index 為產生事件的定時器子項序號，Handle 返回是否已處理，
     如果在事件中將 Handle 置為 true，將不產生該定時器子項事件}
    
  TAATimerList = class(TComponent)
  {* 線程定時器列表組件，可以定義多個定時器。}
  private
    FItems: TAATimerCollection;
    FOnTimer: TAATimerEvent;
    procedure SetItems(Value: TAATimerCollection);
  protected
    function Timer(Index: Integer): Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    {* 類構造器}
    destructor Destroy; override;
    {* 類析構器}
  published
    property Items: TAATimerCollection read FItems write SetItems;
    {* 定時器列表}
    property OnTimer: TAATimerEvent read FOnTimer write FOnTimer;
    {* 定時器事件}
  end;

implementation

type

//==============================================================================
// 高精度定時器線程（私有類）
//==============================================================================

{ TAATimerThread }

  TAATimerMgr = class;

  TAATimerThread = class(TThread)
  private
    FTimerMgr: TAATimerMgr;
  protected
    FInterval: Cardinal;
    FStop: THandle;
    procedure Execute; override;
    property TimerMgr: TAATimerMgr read FTimerMgr;
  public
    constructor Create(CreateSuspended: Boolean; ATimerMgr: TAATimerMgr);
  end;

//==============================================================================
// 高精度定時器管理器（私有類）
//==============================================================================

{ TAATimerMgr }

  TAATimerMgr = class(TObject)
  private
    FTimerList: TThreadList;                
    FTimerThread: TAATimerThread;
  protected
    procedure ClearTimer;
    procedure DoTimer(Sycn: Boolean);
    procedure SyncTimer; virtual;
    procedure Timer; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    function AddTimer: TAATimerObject;
    procedure DeleteTimer(TimerObject: TAATimerObject); overload;
  end;

//==============================================================================
// 高精度定時器線程（私有類）
//==============================================================================

{ TAATimerThread }

constructor TAATimerThread.Create(CreateSuspended: Boolean; ATimerMgr:
  TAATimerMgr);
begin
  inherited Create(CreateSuspended);
  Assert(Assigned(ATimerMgr));
  FTimerMgr := ATimerMgr;
  FStop := CreateEvent(nil, False, False, nil); // 創建退出用事件
end;

procedure TAATimerThread.Execute;
begin
  repeat                                // 等待退出事件置位或 FInterval 毫秒后超時退出
    if WaitForSingleObject(FStop, FInterval) = WAIT_TIMEOUT then
    begin
      TimerMgr.Timer;                   // 非同步方式產生定時事件
      Synchronize(TimerMgr.SyncTimer);  // 同步方式產生定時事件
    end;
  until Terminated;
  CloseHandle(FStop);                   // 釋放事件句柄
end;

//==============================================================================
// 高精度定時器管理器（私有類）
//==============================================================================

{ TAATimerMgr }

constructor TAATimerMgr.Create;
begin
  inherited Create;
  FTimerList := TThreadList.Create;
  FTimerThread := TAATimerThread.Create(True, Self);
  FTimerThread.FreeOnTerminate := False;
  FTimerThread.Priority := tpNormal;
  FTimerThread.FInterval := 1;
  FTimerThread.Resume;
end;

destructor TAATimerMgr.Destroy;
begin
  FTimerThread.Terminate;
  SetEvent(FTimerThread.FStop);
  if FTimerThread.Suspended then FTimerThread.Resume;
  FTimerThread.WaitFor;
  ClearTimer;
  FreeAndNil(FTimerThread);
  FreeAndNil(FTimerList);
  inherited Destroy;
end;

function TAATimerMgr.AddTimer: TAATimerObject;
begin
  Result := TAATimerObject.Create;
  with FTimerList.LockList do
  try
    Add(Result);
  finally
    FTimerList.UnlockList;
  end;
end;

procedure TAATimerMgr.ClearTimer;
var
  i: Integer;
begin
  with FTimerList.LockList do
  try
    for i := Count - 1 downto 0 do
    begin
      TAATimerObject(Items[i]).Free;
      Delete(i);
    end;
  finally
    FTimerList.UnlockList;
  end;
end;

procedure TAATimerMgr.DeleteTimer(TimerObject: TAATimerObject);
var
  i: Integer;
begin
  with FTimerList.LockList do
  try
    for i := 0 to Count - 1 do
      if Items[i] = TimerObject then
12 下一頁
?? 文件大小 395 K
?? 上傳用戶 ilovexzhu
?? 所屬分類 Delphi控件源碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? aatimer.pas

?? 快捷鍵說明
