明天去坐火车,回家,今天就没有事做,本来在弄一个跨进程获取其他程序里面组件,如ListView,ListBox,Button等的信息,突然有个想法自己写个Timer,不用SetTimer函数,我们自己用个多线程也正好实现这个.反正前段时间多线程也弄得比较多,本来想单独讲讲的,现在就用个例子来说明吧.
写成一个控件:utTimer.pas

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
unit utTimer;
 
interface
uses
  Windows,SysUtils,Classes;
 
type
  THuangJackyTimerThread = class;
  THuangJackyTimer = class(TComponent)
  private
    FTimeInterval:Integer;
    FOnTimerDo:TNotifyEvent;
    FTimerThread:THuangJackyTimerThread;
    FEnable:Boolean;
    procedure SetEnable(bBool:Boolean);
    procedure SetTimeInterval(aValue:Integer);
 
    procedure StopThread;
    procedure StartThread;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property TimeInterval:Integer  read FTimeInterval write SetTimeInterval;
    property OnTimerDo:TNotifyEvent  read FOnTimerDo write FOnTimerDo;
    property Enable:Boolean  read FEnable write SetEnable;
  end;
 
  THuangJackyTimerThread = class(TThread)
  private
    FTimer:THuangJackyTimer;
    FTerminateHandle,FExitHandle,FStartHandle,FStopHandle:Cardinal;
 
    procedure DoTimerEvent;
  protected
    procedure Execute;override;
  public
    constructor Create(AOwner: THuangJackyTimer);
    destructor Destroy; override;
  end;
 
procedure Register;
 
 
implementation
 
procedure Register;
begin
  RegisterComponents('HuangJacky',[THuangJackyTimer]);
end;
 
{ THuangJackyTimer }
 
constructor THuangJackyTimer.Create(AOwner: TComponent);
begin
  inherited;
  FTimeInterval:=1000;
  FTimerThread:=THuangJackyTimerThread.Create(Self);
  FTimerThread.Resume;
end;
 
destructor THuangJackyTimer.Destroy;
begin
  SetEvent(FTimerThread.FTerminateHandle);
  WaitForSingleObject(FTimerThread.FExitHandle,5000);
  FTimerThread.Free;
  inherited;
end;
 
procedure THuangJackyTimer.SetEnable(bBool: Boolean);
begin
  if Enable = bBool then
    Exit;
  if csDesigning in ComponentState then
    Exit;
  if Enable then
  begin
    StopThread;
    FEnable:=False;
  end
  else
  begin
    StartThread;
    FEnable:=True;
  end;
end;
 
procedure THuangJackyTimer.SetTimeInterval(aValue: Integer);
begin
  if FTimeInterval = aValue then
    Exit;
  InterlockedExchange(FTimeInterval,aValue);
end;
 
procedure THuangJackyTimer.StartThread;
begin
  SetEvent(FTimerThread.FStartHandle);
end;
 
procedure THuangJackyTimer.StopThread;
begin
  SetEvent(FTimerThread.FStopHandle)
end;
 
{ THuangJackyTimerThread }
 
constructor THuangJackyTimerThread.Create(AOwner: THuangJackyTimer);
var
  sTmp,sTmp1:string;
begin
  inherited Create(True);
  Assert(Assigned(AOwner));
  //自己创建,自己释放,这样能保证100%不内存泄露,个人习惯
  FreeOnTerminate:=False;
  FTimer:=AOwner;
  sTmp:=FTimer.Name;
  sTmp1:=DateTimeToStr(Now());
  FTerminateHandle:=CreateEvent(nil,True,False,PChar(sTmp + sTmp1 + 'T'));
  Assert(FTerminateHandle<>0);
  //用这个Event来通知主线程:Timer线程已经执行完了
  FExitHandle:=CreateEvent(nil,True,False,PChar(sTmp + sTmp1 + 'E'));
  Assert(FExitHandle<>0);
  FStartHandle:=CreateEvent(nil,True,False,PChar(sTmp + sTmp1 +'Sa'));
  Assert(FStartHandle<>0);
  FStopHandle:=CreateEvent(nil,True,False,PChar(sTmp + sTmp1 + 'So'));
  Assert(FStopHandle<>0);
end;
 
destructor THuangJackyTimerThread.Destroy;
begin
   CloseHandle(FStopHandle);
   CloseHandle(FStartHandle);
   CloseHandle(FExitHandle);
   CloseHandle(FTerminateHandle);
  inherited;
end;
 
procedure THuangJackyTimerThread.DoTimerEvent;
begin
  if Assigned(FTimer.OnTimerDo) then
    FTimer.OnTimerDo(FTimer);
end;
 
procedure THuangJackyTimerThread.Execute;
var
  Waits1:array[0..2] of Cardinal;
  Waits2:array[0..1] of Cardinal;
 
  procedure DoTerminate;
  begin
    ResetEvent(FTerminateHandle);
    Terminate;
  end;
 
begin
  Waits1[0]:=FStartHandle;
  Waits1[1]:=FTerminateHandle;
  Waits1[2]:=FStopHandle;
  Waits2[0]:=FStopHandle;
  Waits2[1]:=FTerminateHandle;
  //循环等待.
  while not Terminated do
    //每一次Wait后我们都需要判断下Terminate,不然在你等待的时候,线程就被Terminate了.
    //不过不判断也不要紧
    //因为Terminate只是将Terminated设置成True.
    //也就是如果不判断,就多运行一次.
    //但是这个例子里面因为内层也有一个While循环,所以必须判断
    case WaitForMultipleObjects(3,@Waits1,False,INFINITE) of
      WAIT_OBJECT_0 + 0:
        begin
          ResetEvent(FStartHandle);
          if Terminated then
            Break;
          while True do
          begin
            case WaitForMultipleObjects(2,@Waits2,False,FTimer.TimeInterval) of
              WAIT_OBJECT_0 + 0:
                begin
                  ResetEvent(FStopHandle);
                  Break
                end;
              WAIT_OBJECT_0 + 1:
                begin
                  DoTerminate;
                  Break;
                end;
            end;
            if Terminated then
              Break;
            //执行Timer事件.
            Synchronize(DoTimerEvent);
          end;
        end;
      WAIT_OBJECT_0 + 1:
        DoTerminate;
      WAIT_OBJECT_0 + 2:
        ResetEvent(FStopHandle);
    end;
  SetEvent(FExitHandle);
end;
 
end.

两百行的代码,比较简单,就是一个线程在循环等待事件,然后相应的事件做相应的事.
其实主要是想说如何使用线程,我不喜欢将线程的FreeOnTerminate设置为True,因为感觉不安全,心里不踏实呀.
测试例子:Unit1.pas

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,utTimer;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Timer:THuangJackyTimer;
    III:Integer;
    procedure DoTimer(S:TObject);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.DoTimer(S: TObject);
begin
//这个Timer不存在重入的情况,所以不需要先设置Enable为True
  Caption:=IntToStr(III);
  Inc(III);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer:=THuangJackyTimer.Create(Self);
  Timer.TimeInterval:=2000;
  Timer.OnTimerDo:=DoTimer;
  Timer.Enable:=True;
end;
 
end.

D7和D2010上面都测试了一下,米有发现问题.
如果有什么问题欢迎拍砖.哈哈

http://www.cnblogs.com/huangjacky/archive/2010/02/10/1667217.html

Delphi - 闲来无事,自己写个Timer玩玩（多线程Timer）的更多相关文章

  1. 多线程-Timer重入

    多线程Timer重入问题 由于使用多线程定时器,就会出现如果一个Timer处理没有完成,到了时间下一个照样会发生,这就会导致重入. 对付重入问题通常的办法是加锁,但是对于 Timer却不能简单的这样做 ...

  2. 发现个delphi调用vc写的Dll中包括pchar參数报错奇怪现象

    发现个delphi调用vc写的Dll中包括pchar參数奇怪现象 procedure中的第一行语句不能直接调用DLL的函数,否则会执行报错,在之前随意加上条语句就不报错了奇怪! vc的DLL源代码地址 ...

  3. [C++] Win32 API 的多线程Timer管理Trick - 利用PostThreadMessage

    有时候我们需要在程序里定时地完成一些任务, 比如5秒后发送, 10秒后弹窗之类的操作. 这就需要一个类似于定时器的组件. 这个组件在windows.h里被称为Timer. 设置一个Timer 第一步当 ...

  4. Forms.Timer、Timers.Timer、Threading.Timer的研究

    .NET Framework里面提供了三种Timer System.Windows.Forms.Timer System.Timers.Timer System.Threading.Timer 一.S ...

  5. Storm-源码分析- timer (backtype.storm.timer)

    mk-timer timer是基于PriorityQueue实现的(和PriorityBlockingQueue区别, 在于没有阻塞机制, 不是线程安全的), 优先级队列是堆数据结构的典型应用 默认情 ...

  6. delphi 线程教学第四节：多线程类的改进

    第四节:多线程类的改进   1.需要改进的地方   a) 让线程类结束时不自动释放,以便符合 delphi 的用法.即 FreeOnTerminate:=false; b) 改造 Create 的参数 ...

  7. delphi 线程教学第一节：初识多线程

    第一节:初识多线程   1.为什么要学习多线程编程?   多线程(多个线程同时运行)编程,亦可称之为异步编程. 有了多线程,主界面才不会因为耗时代码而造成“假死“状态. 有了多线程,才能使多个任务同时 ...

  8. OS: 读者写者问题(写者优先+LINUX+多线程+互斥量+代码)（转）

    一. 引子 最近想自己写个简单的 WEB SERVER ,为了先练练手,熟悉下在LINUX系统使用基本的进程.线程.互斥等,就拿以前学过的 OS 问题开开刀啦.记得当年学读者写者问题,尤其是写者优先的 ...

  9. 用mpvue写个玩意儿玩玩

    下周公司要搞黑客马拉松了,组里可能会做个小程序.然后看到了mpvue感觉还不错,于是就打算试试水.用vue写小程序听上去美滋滋.那么先开始吧! 全局安装 vue-cli $ npm install - ...

随机推荐

  1. delphi DCC32命令行方式编译delphi工程源码

    本文链接地址:http://blog.csdn.net/sushengmiyan/article/details/10284879 作者:苏生米沿 Borland出品的Delphi,在TIOBE公布的 ...

  2. CentOS配置防火墙

    昨天帮朋友配置CentOSserver,一開始为了方便測试直接把防火墙关了.之后便须要配置好防火墙,网上找了几个防火墙规则都有错误,后来发现是博主发帖不认真,有太多字符错误,以下是我整理的亲測可用的防 ...

  3. iOS创建本地通知和删除对应的通知，工作日通知

    本文的代码主要是:创建本地通知,删除对应的本地通知,创建工作日闹钟 直接上代码: // // ViewController.m // LocalNSNotification // // Created ...

  4. ThinkPHP验证码类

    //ThinkPHP验证码类使用$config = array( 'fontSize' => 30, // 验证码字体大小 'length' => 3, // 验证码位数 'useNois ...

  5. iOS5.1下emoji表情显示方框的解决办法

    在iOS5.1的部分设备上,emoji表情无法正常显示.我测试了一下,iOS5.1(9B176 for iPhone 4)无法正常显示emoji,全部是方框iOS5.1(9B179 for iPhon ...

  6. linux 学习：环境变量设置

    一.临时环境变量 临时环境变量,只对当前打开的shell生效,shell关闭后,环境变量失效. 设置方法一: 分两步 MYPARA=hello export MYPARA 设置方法二:一步完成 exp ...

  7. php下载远程图片方法总结（curl手动解析header）curl跳转问题解决

    常用方法一般有:. file_get_contents file_put_contents readfile($file) //效率很高. 一般代码: /** * 抓取远程图片 * * @param ...

  8. 常用位操作，写8位 12864串口模式 I2C 1302 18B20

    /*以1302为例*/ void DS1302InputByte(unsigned char d)  //实时时钟写入一字节(内部函数) {     unsigned char i;     ACC ...

  9. block 解析 - 简介

    简介 block 类似标准的c函数,除了一些函数体一些可执行的代码,还可以把变量绑定到自动栈或者托管堆上.....和js里的闭包.c# lambda表达式有些类似,实质是一个函数指针.与函数指针的区别 ...

  10. 将EC2里的实例导出到RAW文件并进行修改

    你可能有自己的instance在amazon云环境里面,或者是你想深度修改一下marketplace里面提供的那些系统又估计运行中的instance改动不方便 亚马逊作为云计算领域的大哥大,我不得不说 ...