home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d4567 / ADVANTMR.ZIP / advantmr.pas
Pascal/Delphi Source File  |  2002-11-01  |  4KB  |  158 lines
  1. unit AdvancedTimer;
  2.  
  3. {
  4.  
  5. TAdvancedTimer v1.3
  6. Copyright (C) 2002 Johan Stokking (johan@stokking.com)
  7. ___________________
  8.  
  9. }
  10.  
  11. {$R AdvancedTimer.dcr}
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, Windows, Classes, Forms, Messages, Consts;
  17.  
  18. type
  19.   TTimerActivateEvent = procedure(Interval: Cardinal) of object;
  20.   TTimerDeactivateEvent = procedure(Intervals: Cardinal) of object;
  21.   TTimerMaxIntervals = procedure(Intervals: Cardinal) of object;
  22.  
  23.   TAdvancedTimer = class(TComponent)
  24.   private
  25.     FInterval: Cardinal;
  26.     FWindowHandle: HWND;
  27.     FOnTimer: TNotifyEvent;
  28.     FOnActivate: TTimerActivateEvent;
  29.     FOnDeactivate: TTimerDeactivateEvent;
  30.     FOnMaxIntervals: TTimerMaxIntervals;
  31.     FIntervals: Integer;
  32.     FMaxIntervals: Integer;
  33.     FStopAtMax: Boolean;
  34.     FEnabled: Boolean;
  35.     procedure UpdateTimer;
  36.     procedure SetEnabled(Value: Boolean);
  37.     procedure SetInterval(Value: Cardinal);
  38.     procedure SetOnTimer(Value: TNotifyEvent);
  39.     procedure WndProc(var Msg: TMessage);
  40.   protected
  41.     procedure Timer; dynamic;
  42.   public
  43.     constructor Create(AOwner: TComponent); override;
  44.     destructor Destroy; override;
  45.   published
  46.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  47.     property Interval: Cardinal read FInterval write SetInterval default 1000;
  48.     property Intervals: Integer read FIntervals;
  49.     property MaxIntervals: Integer read FMaxIntervals write FMaxIntervals default 0;
  50.     property StopAtMax: Boolean read FStopAtMax write FStopAtMax default True;
  51.     property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  52.     property OnActivate: TTimerActivateEvent read FOnActivate write FOnActivate;
  53.     property OnDeactivate: TTimerDeactivateEvent read FOnDeactivate write FOnDeactivate;
  54.     property OnMaxIntervals: TTimerMaxIntervals read FOnMaxIntervals write FOnMaxIntervals;
  55.   end;
  56.  
  57. procedure Register;
  58.  
  59. implementation
  60.  
  61. procedure Register;
  62. begin
  63.   RegisterComponents('System', [TAdvancedTimer]);
  64. end;
  65.  
  66. { TAdvancedTimer }
  67.  
  68. constructor TAdvancedTimer.Create(AOwner: TComponent);
  69. begin
  70.   inherited Create(AOwner);
  71.   FEnabled := True;
  72.   FInterval := 1000;
  73.   FIntervals := 0;
  74.   FStopAtMax := True;
  75. {$IFDEF MSWINDOWS}   
  76.   FWindowHandle := Classes.AllocateHWnd(WndProc);
  77. {$ENDIF}
  78. {$IFDEF LINUX}   
  79.   FWindowHandle := WinUtils.AllocateHWnd(WndProc);
  80. {$ENDIF}   
  81. end;
  82.  
  83. destructor TAdvancedTimer.Destroy;
  84. begin
  85.   FEnabled := False;
  86.   UpdateTimer;
  87. {$IFDEF MSWINDOWS}   
  88.   Classes.DeallocateHWnd(FWindowHandle);
  89. {$ENDIF}
  90. {$IFDEF LINUX}
  91.   WinUtils.DeallocateHWnd(FWindowHandle);
  92. {$ENDIF}   
  93.   inherited Destroy;
  94. end;
  95.  
  96. procedure TAdvancedTimer.WndProc(var Msg: TMessage);
  97. begin
  98.   with Msg do
  99.     if Msg = WM_TIMER then
  100.       try
  101.         Timer;
  102.       except
  103.         Application.HandleException(Self);
  104.       end
  105.     else
  106.       Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  107. end;
  108.  
  109. procedure TAdvancedTimer.UpdateTimer;
  110. begin
  111.   KillTimer(FWindowHandle, 1);
  112.   if (FInterval <> 0) and FEnabled then
  113.     if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
  114.       raise EOutOfResources.Create(SNoTimers);
  115. end;
  116.  
  117. procedure TAdvancedTimer.SetEnabled(Value: Boolean);
  118. begin
  119.   if Value <> FEnabled then begin
  120.     FEnabled := Value;
  121.     UpdateTimer;
  122.     if Value and Assigned(FOnActivate) then
  123.       OnActivate(FInterval)
  124.     else if not Value and Assigned(FOnDeactivate) then
  125.       OnDeactivate(FIntervals);
  126.     FIntervals := 0;
  127.   end;
  128. end;
  129.  
  130. procedure TAdvancedTimer.SetInterval(Value: Cardinal);
  131. begin
  132.   if Value <> FInterval then
  133.   begin
  134.     FInterval := Value;
  135.     UpdateTimer;
  136.   end;
  137. end;
  138.  
  139. procedure TAdvancedTimer.SetOnTimer(Value: TNotifyEvent);
  140. begin
  141.   FOnTimer := Value;
  142.   UpdateTimer;
  143. end;
  144.  
  145. procedure TAdvancedTimer.Timer;
  146. begin
  147.   if Assigned(FOnTimer) then
  148.     FOnTimer(Self);
  149.   FIntervals := FIntervals +1;
  150.   if FIntervals = FMaxIntervals then begin
  151.     OnMaxIntervals(FIntervals);
  152.     if FStopAtMax then
  153.       SetEnabled(False);
  154.   end;
  155. end;
  156.  
  157. end.
  158.