Delphi線程定時器TThreadedTimer及用法--還有TThreadList用法可以locklist

Delphi線程定時器 - -人生如歌- - 博客園
http://www.cnblogs.com/zhengwei0113/p/4192010.html

 

(*


  自己編寫的線程計時器，沒有采用消息機制，很有效

  Cobbler續寫

  不用 TTimer 的原因:

  要說TTimer類的使用問題，先要說一下它響應用戶定義的回調函數(OnTimer)的方法。
  TTimer擁有一個HWnd類型的成員變量FWindowHandle，用於捕捉系統消息。
  TTimer在Enable的情況下，每隔Interval時間，就拋一個系統消息WM_TIMER,FWindowHandle捕捉到這個消息后，
  就會執行用戶的回調函數，實現用戶需要的功能。就是這個消息機制引發了下面兩個問題：

  問題1: 還不算嚴重，TTimer與系統共用一個消息隊列，也就是說，在用戶回調函數處理完之前，
  所有的系統消息都處於阻塞狀態，包括界面的更新的消息。
  如果你的回調函數瞬間執行完畢那就一切看着還正常，如果你要執行一個復雜耗時的操作，
  比如數據庫查詢什么的（萬一遇到數據庫聯接不正常，等待20秒），
  那你的界面就必死無疑，直到回調函數執行完。如果是后台系統還好，
  要是給用戶使用的就沒法交待了。即使你在子線程里面使用也不會解決的。

  問題2: 一般系統定義消息的優先級比用戶定義消息的優先級要低。
  在子線程中使用TTimer時，如果線程間通信也大量使用自定義消息，
  並且用戶定義自己的消息處理函數，那WM_TIMER經常就會被丟棄了，
  計時器就徹底失效了。

  摘抄自網絡

*)

unit UntThreadTimer;

interface

uses
  Windows, Classes, Winapi.Messages;

type
  TTimerStatus = (TS_ENABLE, TS_CHANGEINTERVAL, TS_DISABLE, TS_SETONTIMER);
  TThreadedTimer = class;
  TTimerThread = class;
  PTimerThread = ^TTimerThread;

  TTimerThread = class(TThread)
    OwnerTimer: TThreadedTimer;
    Interval: DWord;
    Enabled: Boolean;
    Status: TTimerStatus;
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure Execute; override;
    procedure DoTimer;
  end;

  TThreadedTimer = class(TComponent)
  private
    FHandle: THandle;
    FEnabled: Boolean;
    FInterval: DWord;
    FOnTimer: TNotifyEvent;
    FTimerThread: TTimerThread;
    FThreadPriority: TThreadPriority;
  protected
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: DWord);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure Timer; dynamic;
  public
    constructor Create(AHandle: THandle; AOwner: TComponent);
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: DWord read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

implementation

procedure WakeupDownThrdproc(const evenFlag: Integer); stdcall;
begin

end;

{ TTimerThread }
constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  Interval := 1000;
  Enabled := False;
  Status := TS_DISABLE;
end;

destructor TTimerThread.Destroy;
begin
  inherited;
end;

procedure TTimerThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    // SleepEx(Interval, True);
    if (not Terminated) and (Status = TS_ENABLE) then
      Synchronize(DoTimer);
    if Status <> TS_ENABLE then
    begin
      case Status of
        TS_CHANGEINTERVAL:
          begin
            Status := TS_ENABLE;
            SleepEx(0, True);
          end;
        TS_DISABLE:
          begin
            Status := TS_ENABLE;
            SleepEx(0, True);
            if not Terminated then
              Suspend;
          end;
        TS_SETONTIMER:
          begin
            Status := TS_ENABLE;
          end
      else
        Status := TS_ENABLE;
      end;
    end;
    SleepEx(Interval, True);
  end;
end;

procedure TTimerThread.DoTimer;
begin
  OwnerTimer.Timer;
end;

{ TThreadedTimer }
constructor TThreadedTimer.Create(AHandle: THandle; AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := AHandle;
  FInterval := 1000;
  FThreadPriority := tpNormal;
  FTimerThread := TTimerThread.Create(True);
  FTimerThread.OwnerTimer := self;
end;

destructor TThreadedTimer.Destroy;
begin
  inherited Destroy;
  FTimerThread.Terminate;
  QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWord(FTimerThread));
  FTimerThread.Free;
end;

procedure TThreadedTimer.UpdateTimer;
begin
  if (FEnabled = False) then
  begin
    FTimerThread.OwnerTimer := self;
    FTimerThread.Interval := FInterval;
    FTimerThread.Priority := FThreadPriority;
    FTimerThread.Resume;
  end;
  if (FEnabled = True) then
  begin
    QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWord(FTimerThread));
  end;
end;

procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    if Value then
    begin
      FTimerThread.Status := TS_ENABLE;
      FTimerThread.Resume;
    end
    else
    begin
      FTimerThread.Status := TS_DISABLE;
      QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle,
        DWord(FTimerThread));
    end;
  end;
end;

procedure TThreadedTimer.SetInterval(Value: DWord);
begin
  if Value <> FInterval then
  begin
    if (not Enabled) then
    begin
      FInterval := Value;
      FTimerThread.Interval := FInterval;
    end
    else
    begin
      FInterval := Value;
      FTimerThread.Interval := FInterval;
      FTimerThread.Status := TS_CHANGEINTERVAL;
      QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle,
        DWord(FTimerThread));
    end;
  end;
end;

procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
end;

procedure TThreadedTimer.Timer;
var
  Msg: TMessage;
begin
  Msg.Msg := WM_USER + 100;
  // if Assigned(FOnTimer) then FOnTimer(Self);
  SendMessage(FHandle, Msg.Msg, 0, 0);
end;

end.

用法：

delphi新語法之泛型實現的對象池模板 - 詠南 delphi - 博客園--TThreadList;//對象池 中 對象 列表

http://www.cnblogs.com/hnxxcxg/archive/2013/07/15/3191622.html
數據模塊池 - 詠南 delphi - 博客園
http://www.cnblogs.com/hnxxcxg/p/3619672.html