SetTimerで、タイマーを作るには？ (ID:966)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんなのを作ってみました。

簡単に説明すると、TTimerのSetTimer部分で、nIDEventが1固定だったのを、Tagを私用するに変更しました。
KillTimerでも、同じくTagを使用するようにしました。

unit SomeTime;

interface

uses
  Windows, Consts, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
  TSomeTime = class(TTimer)
  private
    FTag, FOldTag: Cardinal;
    FWindowHandle: HWND;
    procedure SetTag(Value: Cardinal);
    procedure UpdateTimer;
  protected
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Tag: Cardinal read FTag write SetTag; 
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System', [TSomeTime]);
end;

{ TSomeTime }
constructor TSomeTime.Create(AOwner: TComponent);
begin
  FTag := 1;
  FOldTag := 1;
  inherited Create(AOwner);
  FWindowHandle := AllocateHWnd(WndProc);
end;
destructor TSomeTime.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TSomeTime.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TSomeTime.SetTag(Value: Cardinal);
begin
  FTag := Value;
  UpdateTimer;
end;

procedure TSomeTime.UpdateTimer;
begin
  KillTimer(FWindowHandle, FOldTag);
  FOldTag := FTag;
  if (Interval <> 0) and Enabled and Assigned(OnTimer) then
    if SetTimer(FWindowHandle, Tag, Interval, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る