Parsi Coders
unit timers - نسخه قابل چاپ

+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Pascal/Delphi (http://parsicoders.com/forumdisplay.php?fid=45)
+---- انجمن: Delphi (http://parsicoders.com/forumdisplay.php?fid=69)
+---- موضوع: unit timers (/showthread.php?tid=1156)



unit timers - Amin_Mansouri - 10-29-2011

یونیت تایمر دلفی

کد:
{Timer Component by TM
This is a cut down version of TTimer, Uses only a percentage
of the origanal code}
unit Timer;

interface

uses
  Windows;

  type
TNotifyEvent = procedure(Sender: TObject) of object;

TTimer = class(TObject)
  private
    TmrInt: Cardinal;
    TmrID: Cardinal;
    TmrWin: HWND;
    TmrInst: HWND;
    TmrEvnt: TNotifyEvent;
    TmrOn: Boolean;
    procedure Update;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Interval: Cardinal read TmrInt write SetInterval default 1000;
    property OnTimer: TNotifyEvent read TmrEvnt write SetOnTimer;
    property Enabled: Boolean read TmrOn write SetEnabled default False;
  end;

implementation

constructor TTimer.Create;
begin
TmrInst:=GetModuleHandle(nil);
TmrWin:=CreateWindow(nil,nil,0,0,0,0,0,0,0,TmrInst,nil);
end;

destructor TTimer.Destroy;
begin
CloseWindow(TmrWin);
end;

procedure TTimer.SetOnTimer(Value: TNotifyEvent);
begin
TmrEvnt:=Value;
end;

procedure TTimer.SetInterval(Value: Cardinal);
begin
TmrInt:=Value;
end;

procedure TTimer.SetEnabled(Value: Boolean);
begin
TmrOn := Value;
Update;
end;

procedure TTimer.Update;
begin
KillTimer(TmrWin, TmrID);
if TmrOn then
TmrID:=SetTimer(TmrWin, 1, TmrInt,@TmrEvnt);
end;

end.