Delphi 線程Timer (TThreadTimer)

標籤：

delphi 內建的Timer控制項，使用方便，但它的 OnTimer 事件是在主線程中引發的。

如果在事件中執行較耗時的代碼，會引起主介面假死。故實現一個線程的Timer就有必要了。

TThreadTimer 基於 TSimpleThread 繼承而來。

本例源碼下載

  1 unit uThreadTimer;  2   3 interface  4   5 uses  6   uSimpleThread;  7   8 type  9  10   TThreadTimer = class; // 提前申明 TThreadTimer 是一個類 11  12   TOnThreadTimer = procedure(Sender: TThreadTimer) of object; 13   // 此處就可以引用 TThreadTimer,這種寫法避免將 Sender 寫為 TObject; 14   // 為什麼要寫這個 sender ，主要是為了區別是誰引發了事件，並且 sender 上可以帶參數 15   // 方便進一步使用 16  17   TThreadTimer = Class(TSimpleThread) 18   private 19     FInterval: Cardinal; 20     FOnThreadTimer: TOnThreadTimer; 21  22     procedure CountTimer; 23     procedure DoCountTimer; 24     procedure SetInterval(val: Cardinal); 25     procedure SetOnThreadTimer(val: TOnThreadTimer); 26  27     procedure DoOnThreadTimer; // 請學習此寫法 28  29   public 30     constructor Create(AAllowActiveX: Boolean = false); // AAlowActiveX 在父類中有說明 31     procedure StartThread; override; // 重載父類的 StartThread 32     property Interval: Cardinal read FInterval write SetInterval default 1000; 33  34     // 這個 default 1000 是給人看的，不會產生實際作用。 35     // 故還需要在 Create 事件中指定 FInterval:=1000; 36     // 如果可視化控制項的 published 塊中，此值會顯示在屬性編輯框中 37  38     property OnThreadTimer: TOnThreadTimer read FOnThreadTimer write SetOnThreadTimer; 39  40   End; 41  42 implementation 43  44 { TThreadTimer } 45  46 procedure TThreadTimer.CountTimer; 47 begin 48   ExeProcInThread(DoCountTimer); 49   // 將 DoCountTimer 置入線程中去執行 50   // 這是 TSimpleThread 的用法 51 end; 52  53 constructor TThreadTimer.Create(AAllowActiveX: Boolean); 54 begin 55   inherited Create(AAllowActiveX); 56   FInterval := 1000; // 預設間隔時間為 1 秒 57 end; 58  59 procedure TThreadTimer.DoCountTimer; 60 begin 61  62   if WaitStop then // 這是父類的一個屬性,表示線程現在需要停止了。 63     exit; 64  65   SleepExceptStopped(FInterval); // sleep 指定的時間,如果中途接到退出指令，則馬上響應。 66   // 父類中有源碼，可看一看 67  68   if not WaitStop then 69   begin 70     DoOnThreadTimer; // 引發時間到事件 71   end; 72  73   CountTimer; // 再次線上程中執行 DoCountTimer; 74   // 父類已經設計好了，就這樣簡單地調用，即可實現線上程中執行本過程，但又不會引起“遞迴” 75  76 end; 77  78 procedure TThreadTimer.DoOnThreadTimer; 79 begin 80   if Assigned(FOnThreadTimer) then 81     FOnThreadTimer(Self); 82   // 把這句寫為一個過程，看似囉嗦，但為了程式可讀性，是值得的。 83 end; 84  85 procedure TThreadTimer.StartThread; 86 begin 87   inherited; 88   CountTimer; // 啟動計時 89 end; 90  91 procedure TThreadTimer.SetInterval(val: Cardinal); 92 begin 93   FInterval := val; 94 end; 95  96 procedure TThreadTimer.SetOnThreadTimer(val: TOnThreadTimer); 97 begin 98   FOnThreadTimer := val; 99 end;100 101 end.

uThreadTimer.pas

附：delphi 進階基礎技能說明

Delphi 線程Timer (TThreadTimer)