对线程的使用,是每个开发者都应该熟练掌握的,也是进阶的重要一环。

可以这样说,没有线程,连界面假死的问题都解决不了,就更别谈并行处理来提高效率了。

本例对线程进行改进,打造一个基础的线程,以后线程应用都从此类继承,大大节省了代码,提高了效率。

经长期实践,此代码能够应付许多情况,值得一学。

它的应用1:TReadHtmlThread (读网页)

它的应用2: TElegantThread (把多个线程的请求阻塞到另一个线程)

它的应用3: TThreadTimer 多线程 Timer

 unit uSimpleThread;
interface
uses
System.Classes, System.SysUtils, System.SyncObjs; type // 显示信息,调用方法 DoOnStatusMsg(AMsg);
TOnStatusMsg = procedure(AMsg: string) of object; // 显示调试信息,一般用于显示出错信息,用法 DoOnDebugMsg(AMsg);
TOnDebugMsg = TOnStatusMsg; TSimpleThread = class(TThread)
public type // "执行过程"的类别定义 TGeneralProc = procedure; // 普通的,即 procedure DoSomeThing;
TObjectProc = procedure of object; // 类的,即 TXxxx.DoSomeThign; 用得多
TAnonymousProc = reference to procedure; // 匿名的
private type
TProcKind = (pkGeneral, pkObject, pkAnonymous); // "执行过程"的类别
private FGeneralProc: TGeneralProc;
FObjProc: TObjectProc;
FAnoProc: TAnonymousProc; FProcKind: TProcKind; FEvent: TEvent; // 用于阻塞,它是一个信号量
FActiveX: boolean; // 是否在线程中支持 Com ,如果你要在线程中访问 IE 的话,就设定为 True FOnStatusMsg: TOnStatusMsg;
FOnDebugMsg: TOnDebugMsg; FTagID: integer; // 给线程一个代号,在线程池的时候用来作区别
FParam: integer; // 给线程一个参数,方便识别 procedure SelfStart; // 触发线程运行 procedure DoExecute; // 这个函数里面运行的代码是“线程空间”
procedure DoOnException(e: exception); // 异常信息显示 调用 DoOnDebugMsg(AMsg); procedure SetTagID(const Value: integer);
procedure SetParam(const Value: integer); procedure SetOnStatusMsg(const Value: TOnStatusMsg);
procedure SetOnDebugMsg(const Value: TOnDebugMsg); protected FWaitStop: boolean; // 结束标志,可以在继承类中使用它,以确定线程是否停止运行 procedure DoOnStatusMsg(AMsg: string); // 显示普通信息
procedure DoOnDebugMsg(AMsg: string); // 显示调式信息 procedure Execute; override; // 重载 TThread.Execute procedure OnThreadProcErr(e: exception); virtual; // 异常发生事件 procedure WaitThreadStop; // 等待线程结束 procedure BeforeExecute; virtual; // 看名字,不解释
Procedure AfterExecute; virtual; // 看名字,不解释 procedure SleepExceptStopped(ATimeOut: Cardinal); // 这个高大上了,要解释一下。
{ 有时线程没有任务时,就会休息一会儿,但是,休息的时候,可能会接收到退出线程的指令
此函数就是在休息的时候也检查一下停止指令
} public // 改变一下 Create 的参数,AllowedActiveX:是否允许线程代码访问 Com
constructor Create(AllowedActiveX: boolean = false); reintroduce; destructor Destroy; override; procedure ExeProcInThread(AProc: TGeneralProc); overload; // 这三个,对外的接口。
procedure ExeProcInThread(AProc: TObjectProc); overload;
procedure ExeProcInThread(AProc: TAnonymousProc); overload; procedure StartThread; virtual;
{ 启动线程,一般只调用一次。
以后就由线程的响应事件来执行了
} procedure StopThread; virtual; // 停止线程 property OnStatusMsg: TOnStatusMsg read FOnStatusMsg write SetOnStatusMsg;
property OnDebugMsg: TOnDebugMsg read FOnDebugMsg write SetOnDebugMsg;
property WaitStop: boolean read FWaitStop;
property TagID: integer read FTagID write SetTagID;
property Param: integer read FParam write SetParam; end; implementation uses
ActiveX; procedure TSimpleThread.AfterExecute;
begin
end; procedure TSimpleThread.BeforeExecute;
begin
end; constructor TSimpleThread.Create(AllowedActiveX: boolean);
var
BGUID: TGUID;
begin
inherited Create(false);
FActiveX := AllowedActiveX;
FreeOnTerminate := false; // 我们要手动Free线程
CreateGUID(BGUID);
FEvent := TEvent.Create(nil, true, false, GUIDToString(BGUID));
end; destructor TSimpleThread.Destroy;
begin
StopThread; // 先停止
WaitThreadStop; // 再等待线程停止
{
在继承类的 Destroy 中,也要写上这两句. 如:
暂时未找到更好的办法,这点代码省不了
destructor TXXThread.Destroy;
begin
StopThread;
WaitThreadStop;
xxx.Free;
Inherited;
end;
}
FEvent.Free;
inherited;
end; procedure TSimpleThread.DoExecute; // 此函数内执行的代码,就是在多线程空间里运行
begin
BeforeExecute;
repeat FEvent.WaitFor;
FEvent.ResetEvent; // 下次waitfor 一直等
{ 这里尝试了很多些,总 SelfStart 觉得有冲突,经过多次修改并使用证明,
没有必要在这里加锁,因为只调用 startThread 一次,剩下的交给线程影应事件
} if not Terminated then // 如果线程需要退出
begin try case FProcKind of
pkGeneral: FGeneralProc;
pkObject: FObjProc;
pkAnonymous: FAnoProc;
end; except on e: exception do
begin
DoOnException(e);
end; end; end; until Terminated;
AfterExecute;
//代码运行到这里,就表示这个线程不存在了。再也回不去了,必须释放资源了。
end; procedure TSimpleThread.DoOnDebugMsg(AMsg: string);
begin
if Assigned(FOnDebugMsg) then
FOnDebugMsg(AMsg);
end; procedure TSimpleThread.DoOnException(e: exception);
var
sErrMsg: string;
begin
sErrMsg := 'ClassName:' + ClassName + ##;
sErrMsg := sErrMsg + 'TagID:' + IntToStr(FTagID) + ##;
sErrMsg := sErrMsg + 'Param:' + IntToStr(Param) + ##;
sErrMsg := sErrMsg + 'ErrMsg:' + e.Message + ##;
DoOnDebugMsg(sErrMsg);
OnThreadProcErr(e);
end; procedure TSimpleThread.DoOnStatusMsg(AMsg: string);
begin
if Assigned(FOnStatusMsg) then
FOnStatusMsg(AMsg);
end; procedure TSimpleThread.Execute;
begin
//是否支持 Com
if FActiveX then
begin
CoInitialize(nil);
try
DoExecute;
finally
CoUninitialize;
end;
end
else
DoExecute;
end; procedure TSimpleThread.ExeProcInThread(AProc: TGeneralProc);
begin
FGeneralProc := AProc;
FProcKind := pkGeneral;
SelfStart;
end; procedure TSimpleThread.ExeProcInThread(AProc: TObjectProc);
begin
FObjProc := AProc;
FProcKind := pkObject;
SelfStart;
end; procedure TSimpleThread.ExeProcInThread(AProc: TAnonymousProc);
begin
FAnoProc := AProc;
FProcKind := pkAnonymous;
SelfStart;
end; procedure TSimpleThread.OnThreadProcErr(e: exception);
begin;
end; procedure TSimpleThread.SelfStart;
begin
//经常多次尝试,最终写成这样,运行没有问题
if FEvent.WaitFor() <> wrSignaled then
FEvent.SetEvent; // 让waitfor 不再等
end; procedure TSimpleThread.StopThread;
begin
//继承类的代码中,需要检查 FWaitStop ,来控制线程结束
FWaitStop := true;
end; procedure TSimpleThread.SetOnDebugMsg(const Value: TOnDebugMsg);
begin
FOnDebugMsg := Value;
end; procedure TSimpleThread.SetOnStatusMsg(const Value: TOnStatusMsg);
begin
FOnStatusMsg := Value;
end; procedure TSimpleThread.SetParam(const Value: integer);
begin
FParam := Value;
end; procedure TSimpleThread.SetTagID(const Value: integer);
begin
FTagID := Value;
end; procedure TSimpleThread.SleepExceptStopped(ATimeOut: Cardinal);
var
BOldTime: Cardinal;
begin
// sleep 时检测退出指令,以确保线程顺序退出
// 多个线程同时工作,要保证正确退出,确实不容易
BOldTime := GetTickCount;
while not WaitStop do
begin
sleep();
if (GetTickCount - BOldTime) > ATimeOut then
break;
end;
end; procedure TSimpleThread.StartThread;
begin
FWaitStop := false;
end; procedure TSimpleThread.WaitThreadStop;
begin
//等待线程结束
StopThread;
Terminate;
SelfStart;
WaitFor;
end; end.

uSimpleThread.pas

附:delphi 进阶基础技能说明

delphi 对TThread扩充TSimpleThread的更多相关文章

  1. Delphi的TThread中的FreeOnTerminate成员

    类 Create 了就要 Free;  但 TThread(的子类) 有特殊性, 很多时候我们不能确定新建的线程什么时候执行完(也就是什么时候该释放);  如果线程执行完毕自己知道释放就好了, 所以 ...

  2. 一个Windows C++的线程类实现(封装API,形成一个类,但不完善。其实可以学习一下Delphi的TThread的写法)

    Thread.h #ifndef __THREAD_H__ #define __THREAD_H__ #include <string> #include   <windows.h& ...

  3. 转:学习笔记: Delphi之线程类TThread

    学习笔记: Delphi之线程类TThread - 5207 - 博客园http://www.cnblogs.com/5207/p/4426074.html 新的公司接手的第一份工作就是一个多线程计算 ...

  4. 学习笔记: Delphi之线程类TThread

    新的公司接手的第一份工作就是一个多线程计算的小系统.也幸亏最近对线程有了一些学习,这次一接手就起到了作用.但是在实际的开发过程中还是发现了许多的问题,比如挂起与终止的概念都没有弄明白,导致浪费许多的时 ...

  5. Synchronization in Delphi TThread class : Synchronize, Queue

    http://embarcadero.newsgroups.archived.at/public.delphi.rtl/201112/1112035763.html > Hi,>> ...

  6. DELPHI 多线程(TThread类的实现)

    之前学习了用API实现,让我们再学习下用DELPHI的TThread类. 先新建一个普通的工程,再新建一个线程类File>>New>>Othre>>Delphi F ...

  7. 多线程的基本概念和Delphi线程对象Tthread介绍

    多线程的基本概念和Delphi线程对象Tthread介绍 作者:xiaoru    WIN 98/NT/2000/XP是个多任务操作系统,也就是:一个进程可以划分为多个线程,每个线程轮流占用CPU运行 ...

  8. delphi的多线程编程

    多线程的基本概念 win 98/nt/2000/xp 是个多任务操作系统,也就是:一个进程可以划分为多个线程,每个线程轮流占用cpu 运行时间和资源,或者说,把cpu 时间划成片,每个片分给不同的线程 ...

  9. TMsgThread, TCommThread -- 在delphi线程中实现消息循环

    http://delphi.cjcsoft.net//viewthread.php?tid=635 在delphi线程中实现消息循环 在delphi线程中实现消息循环 Delphi的TThread类使 ...

随机推荐

  1. javaSE读取Properties文件的六种方法

    使用JavaSEAPI读取Properties文件的六种方法 1.使用java.util.Properties类的load()方法 示例:InputStreamin=lnewBufferedInput ...

  2. python之列表、字典的使用

    一.概述:以后你在Linux里面写Python脚本的时候会经常用到Python列表.字典,因为你在以后写脚本的时候,大多数情况下都是对文件进行操作处理,使用字典和列表可以很好的操作文件,得出你想要的结 ...

  3. Leetcode算法刷题:217和219题 Contains Duplicate

    从题目名字就可以看出这两道题是相似的,219是217的加强版 217:Contains Duplicate 题目 给予一个数组,判断是否有重复的元素.如果有就返回True,没有就返回False.以下是 ...

  4. SQL Server 主动防止阻塞的 1 方法

    方法 1. set lock_timeout 5000;  这里设置超时为5秒; 例子: 连接A begin tran             update dbo.TestTable        ...

  5. NEC遥控信号解码(包含完整代码)

    一.遥控器解码说明 1.遥控器的编码格式常见有两种,一种是NEC 格式,一种是RC5 格式.遥控器发出的信号,通过一个红外的接收头之后,信号被送到MCU 的一个中断引脚.通过MCU 来识别不同的时序, ...

  6. apache的斜杠问题

    APACHE默认情况下,网页目录的最后必须加入斜杠“/",比如 可以浏览http://www.example.com/abc/,但是不能浏览http://www.example.com/ab ...

  7. [week1]每周总结与工作计划

    实在不想说这句俗话,因为实在太俗了.但是俗话说,“吾日三省吾身”,我虽然难以做到每天反省那么多次,但是每周来一次就很不错了.于是我决定: 从这周开始准备每周都写每周总结与工作计划. 很好,就这样说定了 ...

  8. Top k问题(线性时间选择算法)

    问题描述:给定n个整数,求其中第k小的数. 分析:显然,对所有的数据进行排序,即很容易找到第k小的数.但是排序的时间复杂度较高,很难达到线性时间,哈希排序可以实现,但是需要另外的辅助空间. 这里我提供 ...

  9. 【枚举+贪心】【ZOJ3715】【Kindergarten Electiond】

    题目大意: n 个人 在选取班长 1号十分想当班长,他已经知道其他人选择了谁,但他可以贿赂其他人改选他,问贿赂的最小值 ps.他自己也要投一个人 要处理一个问题是,他自己投谁 其实这个问题在这种局面下 ...

  10. 一点用JS写控制权限的心得

    <!DOCTYPE html><html lang="en"><head> <meta charset="UTF-8" ...