Thread로 Timer 만들기

uses
  .., System.Classes, System.SyncObjs, Winapi.Windows;

type
  TDevelopistThreadTimer = class(TThread)
  private
    FStop: TEvent;
    FEnabled: TEvent;

    FInterval: Cardinal;
    FStartImmediately: Boolean; //타이머 Enabled 시 즉시 시작여부
    FOnTimer: TNotifyEvent;

    FFinishTick: Integer;

    function GetEnabled: Boolean;
    procedure SetEnabled(const Value: Boolean);
    procedure SetInterval(const Value: Cardinal);
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;

    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property StartImmediately: Boolean read FStartImmediately write FStartImmediately default False;
	
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

---

{ TDevelopistThreadTimer }

constructor TDevelopistThreadTimer.Create;
var
  GUID: TGUID;
begin
  inherited Create(False);

  FStop := TEvent.Create(nil, True, False, 'DevelopistThreadTimer_StopEvent' + GUID.NewGuid.ToString);
  FEnabled := TEvent.Create(nil, True, False, 'DevelopistThreadTimer_EnabledEvent' + GUID.NewGuid.ToString);

  FInterval := 1000;
  FStartImmediately := False;
  FOnTimer := nil;

  FFinishTick := 0;

  FreeOnTerminate := False;
end;

destructor TDevelopistThreadTimer.Destroy;
begin
  Terminate;

  FEnabled.ResetEvent;
  FStop.SetEvent;

  WaitFor;

  CloseHandle(FStop.Handle);
  CloseHandle(FEnabled.Handle);

  FStop.Free;
  FEnabled.Free;

  inherited;
end;

procedure TDevelopistThreadTimer.SetEnabled(const Value: Boolean);
begin
  if Value then begin
    if StartImmediately then
      FFinishTick := Interval
    else
      FFinishTick := 0;

    FEnabled.SetEvent;
  end else
    FEnabled.ResetEvent;
end;

procedure TDevelopistThreadTimer.SetInterval(const Value: Cardinal);
begin
  FInterval := Value;
end;

function TDevelopistThreadTimer.GetEnabled: Boolean;
begin
  Result := FEnabled.WaitFor(0) = wrSignaled;
end;

procedure TDevelopistThreadTimer.Execute;
  function GetWaitTime: Cardinal;
  begin
    Result := 0;
    
    if FInterval > FFinishTick then
      Result := FInterval - FFinishTick;
  end;
var
  arrCtrlEventHandle: array[0..1] of THandle;
  nStartTick: Integer;
begin
  arrCtrlEventHandle[0] := FEnabled.Handle;
  arrCtrlEventHandle[1] := FStop.Handle;

  while not Terminated do begin
    if WaitForMultipleObjects(2, @arrCtrlEventHandle[0], False, INFINITE) <> WAIT_OBJECT_0 then
      Break;

    if WaitForSingleObject(arrCtrlEventHandle[1], GetWaitTime) <> WAIT_TIMEOUT then
      Break;

    nStartTick := GetTickCount;

    if Assigned(FOnTimer) then
      if Enabled then
        FOnTimer(Self);

    FFinishTick := GetTickCount - nStartTick;
  end;
end;

---

• 사용법

type
  TForm1 = class(TForm)
  private
    FThreadTimer: TDevelopistThreadTimer;
    procedure ThreadTimerEvent(Sender: TObject);
  ..
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThreadTimer := TDevelopistThreadTimer.Create;
  FThreadTimer.Interval := 1000;
  FThreadTimer.OnTimer := ThreadTimerEvent;
  FThreadTimer.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FThreadTimer) then FThreadTimer.Free;
end;

procedure ThreadTimerEvent(Sender: TObject);
begin
  ShowMessage('Alert!');
end;