type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
ListBox1: TListBox;
Button2: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TListThread = class(TThread)
protected
procedure Execute; override;
end;
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
TYouThread = class(TThread)
protected
procedure Execute; override;
end;

var
Form1: TForm1;
threadList1: TThreadList;
mythreadRunning, youthreadRunning, listThreadRunning: Boolean;
globalCount: Integer;
listProcess: TListThread; { TListThread is a custom descendant of TThread. }
secondProcess: TMyThread; { TMyThread is a custom descendant of TThread. }
otherSecondProcess: TYouThread; { TMyThread is a custom descendant of TThread. }

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if (mythreadRunning = FALSE) then
begin
mythreadRunning:= TRUE;
secondProcess := TMyThread.Create(True); { Create suspended--secondProcess does not run yet. }
secondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
secondProcess.Priority := tpLower; // Set the priority to lower than normal.
secondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;

procedure TMyThread.Execute;
var
I: Integer;
myRadio: TRadioButton;
begin
for I := 0 to 20 do
begin
if (Terminated) then
begin
mythreadRunning:= FALSE;
exit;
end;
myRadio:= TRadioButton.Create(Form1);
globalCount:= globalCount + 1;
myRadio.Name:= 'RadioButton' + IntToStr(globalCount);
threadList1.Add(myRadio);
Sleep(1000);
end;
mythreadRunning:= FALSE;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if (listthreadRunning = FALSE) then
begin
listThreadRunning:= TRUE;
listProcess := TListThread.Create(True); { Create suspended--secondProcess does not run yet. }
listProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
listProcess.Priority := tpLower; // Set the priority to lower than normal.
listProcess.Resume; { Now run the thread. }
end;
end;

procedure TListThread.Execute;
var
I: Integer;
Temp: TControl;
myList: TList;
begin
while(True) do
begin
if (Terminated) then
begin
listthreadRunning:= FALSE;
exit;
end;
Form1.ListBox1.Clear;
myList:= threadList1.LockList;
try
for I := 0 to myList.Count-1 do
begin
Temp:= myList.Items[I];
Form1.ListBox1.Items.Add(Temp.Name);
end;
finally
threadList1.UnlockList;
end;
Sleep(1000);
end;
listthreadRunning:= FALSE;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if (youthreadRunning = FALSE) then
begin
youthreadRunning:= TRUE;
otherSecondProcess := TYouThread.Create(True); { Create suspended--secondProcess does not run yet. }
otherSecondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
otherSecondProcess.Priority := tpLower; // Set the priority to lower than normal.
otherSecondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if (listProcess <> nil) then
listProcess.Terminate;
if (secondProcess <> nil) then
secondProcess.Terminate;
if (otherSecondProcess <> nil) then
otherSecondProcess.Terminate;
end;

procedure TYouThread.Execute;
var
I: Integer;
Temp: TControl;
begin
for I := 0 to 10 do
begin
if (Terminated) then
begin
youThreadRunning:= FALSE;
exit;
end;
with threadList1.LockList do
try
if (2*I < Count) then
begin
Temp:= Items[2*I];
threadList1.Remove(Temp);
end;
finally
threadList1.UnlockList;
end;
if (Terminated) then
MessageDlg('youThread has been asked to terminate, but is still running!',
mtInformation, [mbOk], 0);
Sleep(3000);
end;
youthreadRunning:= FALSE;
end;

http://docwiki.embarcadero.com/CodeExamples/Tokyo/en/TThreadList_(Delphi)

TThreadList Demo的更多相关文章

  1. 通过一个demo了解Redux

    TodoList小demo 效果展示 项目地址 (单向)数据流 数据流是我们的行为与响应的抽象:使用数据流能帮我们明确了行为对应的响应,这和react的状态可预测的思想是不谋而合的. 常见的数据流框架 ...

  2. 很多人很想知道怎么扫一扫二维码就能打开网站,就能添加联系人,就能链接wifi,今天说下这些格式,明天做个demo

    有些功能部分手机不能使用,网站,通讯录,wifi基本上每个手机都可以使用. 在看之前你可以扫一扫下面几个二维码先看看效果: 1.二维码生成 网址 (URL) 包含网址的 二维码生成 是大家平时最常接触 ...

  3. 在线浏览PDF之PDF.JS (附demo)

    平台之大势何人能挡? 带着你的Net飞奔吧!:http://www.cnblogs.com/dunitian/p/4822808.html#skill 下载地址:http://mozilla.gith ...

  4. 【微框架】Maven +SpringBoot 集成 阿里大鱼 短信接口详解与Demo

    Maven+springboot+阿里大于短信验证服务 纠结点:Maven库没有sdk,需要解决 Maven打包找不到相关类,需要解决 ps:最近好久没有写点东西了,项目太紧,今天来一篇 一.本文简介 ...

  5. vue双向数据绑定原理探究(附demo)

    昨天被导师叫去研究了一下vue的双向数据绑定原理...本来以为原理的东西都非常高深,没想到vue的双向绑定真的很好理解啊...自己动手写了一个. 传送门 双向绑定的思想 双向数据绑定的思想就是数据层与 ...

  6. Android Studio-—使用OpenCV的配置方法和demo以及开发过程中遇到的问题解决

    前提: 1.安装Android Studio(过程略) 2.官网下载OpenCV for Android 网址:http:opencv.org/downloads.html 我下载的是下图的版本 3. ...

  7. iOS之ProtocolBuffer搭建和示例demo

    这次搭建iOS的ProtocolBuffer编译器和把*.proto源文件编译成*.pbobjc.h 和 *.pbobjc.m文件时,碰到不少问题! 搭建pb编译器到时没有什么问题,只是在把*.pro ...

  8. 钉钉开放平台demo调试异常问题解决:hostname in certificate didn't match

    今天研究钉钉的开放平台,结果一个demo整了半天,这帮助系统写的也很难懂.遇到两个问题: 1.首先是执行demo时报unable to find valid certification path to ...

  9. 无限分级和tree结构数据增删改【提供Demo下载】

    无限分级 很多时候我们不确定等级关系的层级,这个时候就需要用到无限分级了. 说到无限分级,又要扯到递归调用了.(据说频繁递归是很耗性能的),在此我们需要先设计好表机构,用来存储无限分级的数据.当然,以 ...

随机推荐

  1. https://github.com/zhangxianyi/Source-Insight-Plugin

    https://github.com/zhangxianyi/Source-Insight-Plugin

  2. 忙里偷闲( ˇˍˇ )闲里偷学【C语言篇】——(7)结构体

    一.为什么需要结构体? 为了表示一些复杂的事物,而普通类型无法满足实际需求 二.什么叫结构体? 把一些基本类型组合在一起形成的一个新的复合数据类型叫做结构体. 三.如何定义一个结构体? 第一种方式: ...

  3. RequiredFieldValidator----验证控件不起作用

    验证码对于网络时代的我们来说实在是太熟悉了.登陆一个站点.注冊一个账户或是各种聊天工具登陆都须要来输入验证码.     为什么要使用验证码呢?     验证码通常是防止有人利用机器人自己主动批量注冊. ...

  4. Eclipse Che安装入门和使用(一)

    Eclipse Che序列博文如下: 安装和调试篇:Eclipse Che安装入门和使用(一) Web进阶篇:Eclipse Che开发Spring Web应用(入门) (二) 本文摘要: Eclip ...

  5. NOIP模拟 Pyramid - 斜率优化DP

    题目大意: 给一个金字塔图(下面的宽度大于等于上面的宽度),每层的高度为1,从中选取k个互不重叠的矩形,使面积最大. 题目分析: \(f[i][j]\)表示选到第i层,选择了j个矩形的最优方案. 转移 ...

  6. Swagger 专题

    随着互联网技术的发展,现在的网站架构基本都由原来的后端渲染,变成了:前端渲染.前后端分离的形态,而且前端和后端在各自的技术道路上越走越远. 前端和后端的唯一联系,变成了API接口:API文档成了前后端 ...

  7. Linux虚拟文件系统(VFS)学习

    虚拟文件系统(Virtual Filesystem)也可称之为虚拟文件系统转换(Virtual Filesystem Switch),是一个内核软件层,用来处理与Unix标准文件系统相关的全部系统调用 ...

  8. .net 程序员 两年工作总结

    2013 年7月毕业,算一算从开始在现任的公司实习到现在已经有小两年的时间了.公司的工作虽然不忙,但也一直没有时间思考一下. 现在决定辞职了,忽然一下轻松的让人想思考. 普通程序员.普通本科生.普通的 ...

  9. 获 Linux 支持的开源指令集 RISC-V 投身存储和 AI 领域

    EETimes 消息,WD 宣布将在 RISC-V 处理器上实现标准化,并投资了一家初创公司 Esperanto Technologies —— 该公司主要采用开源指令集架构设计高级 SoC 和核心. ...

  10. 转:spring MVC HTTP406 Not Acceptable

    springMVC框架下,ajax请求,在用json对象返回的时候,可以用如下的形式: response.setContentType("text/html;charset=UTF-8&qu ...