1 {
2 ***************************************************************************
3 *                                                                         *
4 *   This source is free software; you can redistribute it and/or modify   *
5 *   it under the terms of the GNU General Public License as published by  *
6 *   the Free Software Foundation; either version 2 of the License, or     *
7 *   (at your option) any later version.                                   *
8 *                                                                         *
9 *   This code is distributed in the hope that it will be useful, but      *
10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12 *   General Public License for more details.                              *
13 *                                                                         *
14 *   A copy of the GNU General Public License is available on the World    *
15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16 *   obtain it by writing to the Free Software Foundation,                 *
17 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18 *                                                                         *
19 ***************************************************************************
20 
21 Author: Balázs Székely
22 }
23 unit opkman_timer;
24 
25 {$mode objfpc}{$H+}
26 
27 interface
28 
29 uses
30   Classes, SysUtils;
31 
32 type
33    { TThreadTimer }
34    TThreadTimer = class(TThread)
35    private
36      FTime: QWORD;
37      FInterval: Cardinal;
38      FOnTimer: TNotifyEvent;
39      FEnabled: Boolean;
40      procedure DoOnTimer;
41    protected
42      procedure Execute; override;
43    public
44      constructor Create;
45      destructor Destroy; override;
46    public
47      property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
48      property Interval: Cardinal read FInterval write FInterval;
49      property Enabled: Boolean read FEnabled write FEnabled;
50      procedure StopTimer;
51      procedure StartTimer;
52    end;
53 
54 implementation
55 
56 { TThreadTimer }
57 
58 constructor TThreadTimer.Create;
59 begin
60   inherited Create(True);
61   FreeOnTerminate := True;
62   FInterval := 1000;
63   FEnabled := False;
64 end;
65 
66 destructor TThreadTimer.Destroy;
67 begin
68   //
69   inherited Destroy;
70 end;
71 
72 procedure TThreadTimer.DoOnTimer;
73 begin
74   if Assigned(FOnTimer) then
75     FOnTimer(Self);
76 end;
77 
78 procedure TThreadTimer.Execute;
79 begin
80   while not Terminated do
81   begin
82     Sleep(100);
83     if (GetTickCount64 - FTime > FInterval) and (FEnabled) then
84     begin
85       FTime := GetTickCount64;
86       DoOnTimer;
87     end;
88   end;
89 end;
90 
91 procedure TThreadTimer.StopTimer;
92 begin
93   FEnabled := False;
94 end;
95 
96 procedure TThreadTimer.StartTimer;
97 begin
98   FTime := GetTickCount64;
99   FEnabled := True;
100   if Self.Suspended then
101     Start;
102 end;
103 
104 end.
105 
106