需要一些线程的代码:实现间断显示(100分)

量我需要一段代码(涉及线程)完成如下功能:
1.每隔1秒读主程序中的一个字符串(STRING)
2.显示字符串到主程序中的一个TMEMO中
3.当字符串等于特定值时,线程退出.

请不要用TIMER,一定要线程.

每秒都进行查询的线程，会不会和Timer的效果一样啊？

主窗体
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CheckLst, Unit2, ExtCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
CheckListBoxTasks: TCheckListBox;
ButtonAddRandomTask: TButton;
ButtonStopCurTask: TButton;
ButtonPauseTask: TButton;
ButtonExit: TButton;
ButtonAddTask: TButton;
EditTaskTime: TEdit;
ButtonDelTask: TButton;
ButtonContinueTask: TButton;
TimerRefreshList: TTimer;
procedure ButtonAddTaskClick(Sender: TObject);
procedure ButtonAddRandomTaskClick(Sender: TObject);
procedure ButtonStopCurTaskClick(Sender: TObject);
procedure ButtonPauseTaskClick(Sender: TObject);
procedure ButtonContinueTaskClick(Sender: TObject);
procedure ButtonDelTaskClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
procedure TimerRefreshListTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FTaskList: TTaskList;
FTaskIdx: Integer;
FThreads: array of TTaskThread;
public
{ Public declarations }
end;

var
Form1: TForm1;
const
THREAD_COUNT = 4;

implementation
{$R *.dfm}
procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.ButtonAddTaskClick(Sender: TObject);
begin
Inc(FTaskIdx);
FTaskList.AddTask(Format('Task%d', [FTaskIdx]),
StrToIntDef(EditTaskTime.Text, 1000));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
FTaskList := TTaskList.Create;
FTaskIdx := 0;
Randomize;
SetLength(FThreads, THREAD_COUNT);
for I := 0 to High(FThreads)do
FThreads := TTaskThread.Create(FTaskList);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
I, J: Integer;
begin
for I := 0 to High(FThreads)do
FThreads.Terminate;
for I := 0 to High(FThreads)do
while FThreads.Suspendeddo
FThreads.Resume;
for I := 0 to High(FThreads)do
begin
//等待线程退出
while WaitForSingleObject(FThreads.Handle, 0) <> WAIT_OBJECT_0do
for J := 0 to 1000do
Application.ProcessMessages;
end;

FTaskList.Free;
end;

procedure TForm1.TimerRefreshListTimer(Sender: TObject);
var
AList: TList;
Item: PTaskRecord;
I, C: Integer;
S: string;
begin
AList := FTaskList.LockList;
try
C := CheckListBoxTasks.Count;
if CheckListBoxTasks.Count < AList.Count then
for I := AList.Count - 1do
wnto CheckListBoxTasks.Countdo
begin
Item := AList.Items;
S := Format('%s %d %s %d%%', [Item.Name, Item.Time,
TTaskStatusNames[Item.Status], Round(Item.DoneTimes / Item.Time * 100)]);
CheckListBoxTasks.Items.Add(S);
end;

if CheckListBoxTasks.Count > AList.Count then
begin
C := AList.Count;
for I := CheckListBoxTasks.Count - 1do
wnto AList.Count - 1do
CheckListBoxTasks.Items.Delete(I);
end;

for I := C - 1do
wnto 0do
begin
Item := AList.Items;
S := Format('%s %d %s %d%%', [Item.Name, Item.Time,
TTaskStatusNames[Item.Status], Round(Item.DoneTimes / Item.Time * 100)]);
if CheckListBoxTasks.Items.Strings <> S then
CheckListBoxTasks.Items.Strings := S;
end;

finally
FTaskList.UnlockList;
end;

for I := 0 to High(FThreads)do
if FThreads.Suspended then
FThreads.CheckTask;
end;

procedure TForm1.ButtonAddRandomTaskClick(Sender: TObject);
begin
Inc(FTaskIdx);
FTaskList.AddTask(Format('Task%d', [FTaskIdx]),
Random(3000) + 1000);
end;

procedure TForm1.ButtonDelTaskClick(Sender: TObject);
var
ID: Integer;
begin
if CheckListBoxTasks.ItemIndex >= 0 then
begin
ID := CheckListBoxTasks.ItemIndex;
if FTaskList.Items[ID].Status <> tsRunning then
CheckListBoxTasks.DeleteSelected;
FTaskList.DelTask(ID);
if CheckListBoxTasks.Count > ID then
CheckListBoxTasks.ItemIndex := ID;
end;
end;

procedure TForm1.ButtonStopCurTaskClick(Sender: TObject);
begin
if CheckListBoxTasks.ItemIndex >= 0 then
FTaskList.TaskCommand(CheckListBoxTasks.ItemIndex, tcStop);
end;

procedure TForm1.ButtonPauseTaskClick(Sender: TObject);
begin
if CheckListBoxTasks.ItemIndex >= 0 then
FTaskList.TaskCommand(CheckListBoxTasks.ItemIndex, tcPause);
end;

procedure TForm1.ButtonContinueTaskClick(Sender: TObject);
begin
if CheckListBoxTasks.ItemIndex >= 0 then
FTaskList.TaskCommand(CheckListBoxTasks.ItemIndex, tcRun);
end;

end.

线程单元
unit Unit2;
interface
uses
Classes, Windows, SysUtils;
type
//状态：未知，等待，运行，暂停，完成
TTaskStatus = (tsUnknow, tsWaiting, tsRunning, tsPause, tsFinished);
//命令：无，运行，暂停，停止
TTaskCommandd = (tcNone, tcRun, tcPause, tcStop);
TTaskRecord = record
Name: string;
Time: Integer;
Command: TTaskCommandd;
Status: TTaskStatus;
do
neTimes: Integer;
end;
PTaskRecord = ^TTaskRecord;
TTaskList = class(TThreadList)
private
function GetItems(Index: Integer): TTaskRecord;
procedure SetItems(Index: Integer;
const Value: TTaskRecord);
function SetCount: Integer;
{ Private declarations }
protected
public
destructor Destroy;
override;
procedure AddTask(AName: string;
ATime: Integer);
procedure DelTask(Index: Integer);
procedure TaskCommand(Index: Integer;
Command: TTaskCommandd);
property Count:Integer read SetCount;
property Items[Index: Integer]: TTaskRecord read GetItems write SetItems;
end;

TTaskThread = class(TThread)
private
FTaskList: TTaskList;
FCurTask: PTaskRecord;
FRunTimes: Integer;
function GetTaskFinished: Boolean;
{ Private declarations }
protected
procedure Execute;
override;
public
procedure CheckTask;
constructor Create(TaskList: TTaskList);
property TaskFinished: Boolean read GetTaskFinished;
end;

const
TTaskStatusNames: array[TTaskStatus] of string =
('未知', '等待', '运行', '暂停', '完成');
implementation
uses Unit1;
{ TTaskList }
function TTaskList.SetCount: Integer;
var
AList: TList;
begin
AList := LockList;
try
Result := AList.Count;
finally
UnlockList;
end;
end;

procedure TTaskList.AddTask(AName: string;
ATime: Integer);
var
AList: TList;
Item: PTaskRecord;
begin
AList := LockList;
try
Item := New(PTaskRecord);
Item.Name := AName;
Item.Time := ATime;
Item.DoneTimes := 0;
Item.Command := tcNone;
Item.Status := tsWaiting;
AList.Add(Item);
finally
UnlockList;
end;
end;

procedure TTaskList.DelTask(Index: Integer);
var
AList: TList;
Item: PTaskRecord;
begin
AList := LockList;
try
Item := AList.Items[Index];
if Item.Status = tsRunning then
begin
Item.Command := tcPause;
Exit;
end;
AList.Remove(Item);
Dispose(Item);
finally
UnlockList;
end;
end;

destructor TTaskList.Destroy;
var
AList: TList;
Item: PTaskRecord;
I: Integer;
begin
AList := LockList;
try
for I := AList.Count - 1do
wnto 0do
begin
Item := AList.Items;
//AList.Remove(Item);
Dispose(Item);
end;
finally
UnlockList;
end;
inherited;
end;

function TTaskList.GetItems(Index: Integer): TTaskRecord;
var
AList: TList;
begin
AList := LockList;
try
Result := TTaskRecord(AList.Items[Index]^);
finally
UnlockList;
end;
end;

procedure TTaskList.SetItems(Index: Integer;
const Value: TTaskRecord);
var
AList: TList;
begin
AList := LockList;
try
TTaskRecord(AList.Items[Index]^) := Value;
finally
UnlockList;
end;
end;

{ Important: Methods and properties of objects in VCL or CLX can only be used
in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TTaskThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
procedure TTaskList.TaskCommand(Index: Integer;
Command: TTaskCommandd);
var
AList: TList;
Item: PTaskRecord;
begin
AList := LockList;
try
Item := AList.Items[Index];
Item.Command := Command;
finally
UnlockList;
end;
end;

{ TTaskThread }
procedure TTaskThread.CheckTask;
var
AList: TList;
I: Integer;
ATask: PTaskRecord;
begin
if Assigned(FCurTask) then
begin
if FRunTimes >= FCurTask.Time then
begin
FTaskList.LockList;
try
FCurTask.Status := tsFinished;
FCurTask.DoneTimes := FRunTimes;
finally
FTaskList.UnlockList;
end;
FCurTask := nil;
end
else
if FCurTask.Command = tcStop then
begin
FTaskList.LockList;
try
FCurTask.Status := tsWaiting;
finally
FTaskList.UnlockList;
end;
FCurTask := nil;
end
else
if FCurTask.Command = tcPause then
begin
FTaskList.LockList;
try
FCurTask.Status := tsPause;
finally
FTaskList.UnlockList;
end;
FCurTask := nil;
end;
end;

if not Assigned(FCurTask) then
begin
FRunTimes := 0;
AList := FTaskList.LockList;
try
for I := 0 to AList.Count - 1do
begin
ATask := AList.Items;
case ATask.Status of
tsWaiting:
begin
FCurTask := ATask;
FCurTask.Status := tsRunning;
end;
tsPause:
if ATask.Command = tcRun then
begin
FCurTask := ATask;
FRunTimes := ATask.DoneTimes;
FCurTask.Command := tcNone;
FCurTask.Status := tsRunning;
end;
end;
if Assigned(FCurTask) then
Break;
end;
finally
FTaskList.UnlockList;
end;
end;

if Assigned(FCurTask) then
while Suspendeddo
Resume;
end;

constructor TTaskThread.Create(TaskList: TTaskList);
begin
inherited Create(True);
FTaskList := TaskList;
end;

procedure TTaskThread.Execute;
begin
{ Place thread code here }
CheckTask;
while not TaskFinished and not Terminateddo
begin
Inc(FRunTimes);
FTaskList.LockList;
try
FCurTask.DoneTimes := FRunTimes;
finally
FTaskList.UnlockList;
end;

Sleep(10);
end;
Suspend;
end;

function TTaskThread.GetTaskFinished: Boolean;
begin
CheckTask;
Result := not Assigned(FCurTask);
end;

end.

看懂后稍微改下就能实现你要的功能

你在多线程版看看我回复的文章，关于waitforsingleobject和waitformultipleobjects方面的文章，当然你也可以自己找一本delphi深度历险来看看，在定时器一张专门有介绍。顺便我给你一个框架：
在多线程的执行函数execute中写如下的代码：
while not terminateddo
begin
if (满足你的退出线程条件) then
break
else
begin
//不满足退出条件
这个部分用waitforsingleobject或者waitformultipleobjects函数来处理了。
end;

end;

while not terminateddo
begin
if str1=str2 then
break
else
begin
memo1.lines.add(str2);
sleep(1000);
end;

end;

听说Timer的Ontime事件就是线程机制来实现的！

timer都是属于主线程的，建议你先看看深度历险吧，很详细的介绍了定时器。
在多线程中，最好少用sleep函数，除非是不得已的情况可以用。

to cqwty:
我创建了5个线程,每个线程都create一个idhttp,然后idhttp.get(url) ,提取出一个链接url2和一个等待时间T秒(随机的时间20-60s),我需要暂停线程T后再idhttp.get(url2)
我之前一直用sleep的,不觉得有什么不妥,以你的看法该怎么写呢?

我想问你几个问题，你的随机等待时间是怎么定义的？目的是什么？为什么随机时间在20到60秒之间呢？关于sleep并不是妥与不妥的问题，我上面强调过，能不用sleep解决的地方，就尽量不要用。因为用了sleep的线程，在退出程序的时候，会出现界面死，等待的状态，如果时间长，比如睡眠5分钟的，那么在退出程序的时候很容易出错的。我对你做的这个部分的功能结构不了解，所以你提的东西我也说不出什么看法来，对不起！

随机等待时间是从网页中获取的,一般是20到60秒,这是必须等待的,如果不等待这下面的的一个idhttp.get(url2),将不会加积分,这是广告联盟规定的
我只会在子线程中用sleep,这样程序就不会死了