unit untWorkThread;

interface

uses
Windows,Classes,SysUtils; type
TWorkItem=class
end;
TProcessWork=procedure (Sender:TObject;Work:TWorkItem) of Object;
TWorkThread=class(TThread)
private
FCriticalSection:TRTLCriticalSection;
hEvent:Cardinal;
FList:TList;
FProcessWork:TProcessWork;
procedure ProcessWork(Work:TWorkItem);
function GetWork(var AWork:TWorkItem):Boolean;
protected
procedure Execute;override;
public
procedure AddWork(AWork:TWorkItem);
constructor Create;
destructor Destroy; override;
property OnProcessWork:TProcessWork read FProcessWork write FProcessWork;
end; implementation {TWorkThread} constructor TWorkThread.Create;
begin
InitializeCriticalSection(FCriticalSection);
hEvent:=CreateEvent(nil,False,False,nil);
FList:=TList.Create;
Self.FreeOnTerminate:=False;
inherited Create(False);
end; destructor TWorkThread.Destroy;
var
i:Integer;
begin
for i:=FList.Count- downto do TWorkItem(FList.Items[i]).Free;
DeleteCriticalSection(FCriticalSection);
FList.Free;
CloseHandle(hEvent);
end; function TWorkThread.GetWork(var AWork:TWorkItem):Boolean;
begin
Result:=False;
EnterCriticalSection(FCriticalSection);
try
if FList.Count> then
begin
AWork:=TWorkItem(FList.Items[]);
FList.Delete();
Result:=True;
end;
finally
LeaveCriticalSection(FCriticalSection);
end;
end; procedure TWorkThread.Execute;
var
Work:TWorkItem;
begin
while not Self.Terminated do
begin
WaitForSingleObject(hEvent,INFINITE);
while GetWork(Work) do
begin
ProcessWork(Work);
Work.Free;
end;
end;
end; procedure TWorkThread.ProcessWork(Work:TWorkItem);
begin
if Assigned(FProcessWork) then FProcessWork(Self,Work);
end; procedure TWorkThread.AddWork(AWork:TWorkItem);
begin
EnterCriticalSection(FCriticalSection);
try
FList.Add(AWork);
finally
LeaveCriticalSection(FCriticalSection);
end;
SetEvent(hEvent);
end; end.

delphi 线程的使用的更多相关文章

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

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

  2. TMsgThread, TCommThread -- 在delphi线程中实现消息循环(105篇博客,好多研究消息的文章)

    在delphi线程中实现消息循环 在delphi线程中实现消息循环 Delphi的TThread类使用很方便,但是有时候我们需要在线程类中使用消息循环,delphi没有提供.   花了两天的事件研究了 ...

  3. delphi 线程教学第六节:TList与泛型

    第六节: TList 与泛型   TList 是一个重要的容器,用途广泛,配合泛型,更是如虎添翼. 我们先来改进一下带泛型的 TList 基类,以便以后使用. 本例源码下载(delphi XE8版本) ...

  4. Delphi线程定时器TThreadedTimer及用法--还有TThreadList用法可以locklist

    Delphi线程定时器 - -人生如歌- - 博客园http://www.cnblogs.com/zhengwei0113/p/4192010.html (* 自己编写的线程计时器,没有采用消息机制, ...

  5. delphi 线程教学第二节:在线程时空中操作界面(UI)

    第二节:在线程时空中操作界面(UI)   1.为什么要用 TThread ?   TThread 基于操作系统的线程函数封装,隐藏了诸多繁琐的细节. 适合于大部分情况多线程任务的实现.这个理由足够了吧 ...

  6. delphi 线程教学第一节:初识多线程

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

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

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

  8. Delphi线程的终止

    当线程对象的Execute()执行完毕,我们就认为此线程终止了.这时候,它会调用Delphi的一个标准例程EndThread(),这个例程再调用API函数ExitThread().由ExitThrea ...

  9. Delphi线程基础知识

    参考http://blog.chinaunix.net/uid-10535208-id-2949323.html 一.概述 Delphi提供了好几种对象以方便进行多线程编程.多线程应用程序有以下几方面 ...

  10. Delphi 线程同步技术(转)

    上次跟大家分享了线程的标准代码,其实在线程的使用中最重要的是线程的同步问题,如果你在使用线程后,发现你的界面经常被卡死,或者无法显示出来,显示混乱,你的使用的变量值老是不按预想的变化,结果往往出乎意料 ...

随机推荐

  1. JavaScript中this关键字的使用比较

    JavaScript中this关键字的使用比较 this关键字在JavaScript中,用的不能说比较多,而是非常多.那么熟悉this关键字的各种用法则显得非常关键. this有时候就是我们经常说的上 ...

  2. 死循环的/etc/profile

    用户服务器登陆后停在以下界面 Connecting to ... Connection established. To escape to local shell, press 'Ctrl+Alt+] ...

  3. Java 关于assert

    昨天在看NIO源码的时候,看到这样一句,顿时懵逼了 : assert (i >= 0); assert关键词我是有映像的, 中文叫断言.但是从来没有去了解过它的功能, 今天在感冒中抽出时间, 把 ...

  4. mysql 创建数据库 并设置utf8格式

    CREATE DATABASE `database` CHARACTER SET utf8 COLLATE utf8_general_ci; 设置utf8之后,不容易出现中文乱码.

  5. java-四则运算-四

    题目要求:查找数组连成环形的和最大的连续子数组 实验代码: package zuoYe; import java.util.Scanner; public class MaxSubArray { pu ...

  6. 编辑器上的vim插件,常用到的快捷件

    [vim]常用到的插件命令 [Esc] 退出编辑(输入,插入)模式,回到命令模式中(常用)i, I进入插入模式(Insert mode):i 为『从目前光标所在处插入』, I 为『在目前所在行的第一个 ...

  7. Ajax-07 基于Ajax实现跨域请求

    跨域 跨域名访问,如c1.com域名向c2.com域名发送请求 本质:浏览器存在同源策略机制,同源策略阻止从一个源加载的文档或脚本获取或设置另一个源加载的文档的属性. django服务端准备 url. ...

  8. SPOJ - VLATTICE

    链接 题意:三维平面,找从(0,0,0)看(n,n,n)能看到的点 题解:很明显就是求gcd(i,j,k)==1的(i,j,k)对数,改一下公式即可,记得要算平行坐标轴的三个平面,还有含0的三个坐标 ...

  9. LeetCode OJ:Remove Duplicates from Sorted Array II(移除数组中的重复元素II)

    Follow up for "Remove Duplicates":What if duplicates are allowed at most twice? For exampl ...

  10. linux initcall机制

    Linux系统启动过程很复杂,因为它既需要支持模块静态加载机制也要支持动态加载机制.模块动态加载机制给系统提供了极大的灵活性,驱动程序既可支持静态编译进内核,也可以支持动态加载机制.Linux系统中对 ...