?? aatimer.pas

?? 進(jìn)度條進(jìn)度條進(jìn)度條進(jìn)度條進(jìn)度條進(jìn)度條
?? PAS
?? 第 1 頁(yè) / 共 2 頁(yè)
字號(hào):
12 下一頁(yè)
{*******************************************************************************

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

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

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

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

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

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

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

interface

{$I AAFont.inc}

uses
  Windows, SysUtils, Classes, Forms;

type

//==============================================================================
// 高精度定時(shí)器對(duì)象
//==============================================================================

{ 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;

//==============================================================================
// 高精度定時(shí)器組件
//==============================================================================

{ TAATimer }

  TAATimer = class(TComponent)
  {* 線程定時(shí)器組件，使用方法類似 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;
    {* 類構(gòu)造器}
    destructor Destroy; override;
    {* 類析構(gòu)器}
    property ActualFPS: Double read GetActualFPS;
    {* 實(shí)際的定時(shí)器速率，次每秒}
    property ExecCount: Cardinal read GetExecCount;
    {* 已經(jīng)執(zhí)行過的次數(shù)}
  published
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    {* 定時(shí)器是否啟用}
    property FPS: Double read GetFPS write SetFPS stored False;
    {* 定時(shí)器速度，次每秒}
    property Interval: Cardinal read GetInterval write SetInterval default 1000;
    {* 定時(shí)間隔，毫秒}
    property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
    {* 定時(shí)事件}
    property RepeatCount: Cardinal read GetRepeatCount write SetRepeatCount
      default 0;
    {* 定時(shí)事件次數(shù)，當(dāng)定時(shí)事件發(fā)生指定次數(shù)后自動(dòng)關(guān)閉。如果為 0 表示不限制}
    property SyncEvent: Boolean read GetSyncEvent write SetSyncEvent default
      True;
    {* 是否使用同步方式在主線程中產(chǎn)生定時(shí)事件，如果為 false 將在定時(shí)線程中產(chǎn)生事件}
  end;

//==============================================================================
// 高精度定時(shí)器列表集合子項(xiàng)
//==============================================================================

{ TAATimerItem }

  TAATimerItem = class(TCollectionItem)
  {* 線程定時(shí)器列表子項(xiàng)，使用方法類似 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;
    {* 類構(gòu)造器}
    destructor Destroy; override;
    {* 類析構(gòu)器}
    procedure Assign(Source: TPersistent); override;
    {* 賦值方法}
    property ActualFPS: Double read GetActualFPS;
    {* 實(shí)際的定時(shí)器速率，次每秒}
    property ExecCount: Cardinal read GetExecCount;
    {* 已經(jīng)執(zhí)行過的次數(shù)}
  published
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    {* 定時(shí)器是否啟用}
    property FPS: Double read GetFPS write SetFPS stored False;
    {* 定時(shí)器速度，次每秒}
    property Interval: Cardinal read GetInterval write SetInterval default 1000;
    {* 定時(shí)間隔，毫秒}
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    {* 定時(shí)事件}
    property RepeatCount: Cardinal read GetRepeatCount write SetRepeatCount
      default 0;
    {* 定時(shí)事件次數(shù)，當(dāng)定時(shí)事件發(fā)生指定次數(shù)后自動(dòng)關(guān)閉。如果為 0 表示不限制}
    property SyncEvent: Boolean read GetSyncEvent write SetSyncEvent default
      True;
    {* 是否使用同步方式在主線程中產(chǎn)生定時(shí)事件，如果為 false 將在定時(shí)線程中產(chǎn)生事件}
  end;

//==============================================================================
// 高精度定時(shí)器列表集合類
//==============================================================================

{ TAATimerCollection }

  TAATimerList = class;

  TAATimerCollection = class(TOwnedCollection)
  {* 線程定時(shí)器列表集合}
  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);
    {* 類構(gòu)造器}
    property Items[Index: Integer]: TAATimerItem read GetItems write SetItems; default;
    {* 定時(shí)器數(shù)組屬性}
  end;

//==============================================================================
// 高精度定時(shí)器列表組件
//==============================================================================

{ TAATimerList }

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

implementation

type

//==============================================================================
// 高精度定時(shí)器線程（私有類）
//==============================================================================

{ 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;

//==============================================================================
// 高精度定時(shí)器管理器（私有類）
//==============================================================================

{ 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;

//==============================================================================
// 高精度定時(shí)器線程（私有類）
//==============================================================================

{ TAATimerThread }

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

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

//==============================================================================
// 高精度定時(shí)器管理器（私有類）
//==============================================================================

{ 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 下一頁(yè)
?? 文件大小 395 K
?? 上傳用戶 ilovexzhu
?? 所屬分類 Delphi控件源碼
?? 快捷鍵說明

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

?? aatimer.pas

?? 快捷鍵說明
