当前位置：主页>销售管理软件> 列表

需要一些线程的代码:实现间断显示 找电脑管理软件

进销存软件版1楼: 量我需要一段代码(涉及线程)完成如下功能:

1.每隔1秒读主程序中的一个字符串(STRING)
2.显示字符串到主程序中的一个TMEMO中
3.当字符串等于特定值时,线程退出.


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

2楼: 每秒都进行查询的线程，会不会和Timer的效果一样啊？ 如电脑管理软件

3楼: 主窗体
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[I] := TTaskThread.Create(FTaskList);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
I, J: Integer;
begin
for I := 0 to High(FThreads) do
FThreads[I].Terminate;
for I := 0 to High(FThreads) do
while FThreads[I].Suspended do
FThreads[I].Resume;
for I := 0 to High(FThreads) do
begin
//等待线程退出
while WaitForSingleObject(FThreads[I].Handle, 0) <> WAIT_OBJECT_0 do
for J := 0 to 1000 do
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 - 1 downto CheckListBoxTasks.Count do
begin
Item := AList.Items[I];
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 - 1 downto AList.Count - 1 do
CheckListBoxTasks.Items.Delete(I);
end;

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

finally
FTaskList.UnlockList;
end;

for I := 0 to High(FThreads) do
if FThreads[I].Suspended then
FThreads[I].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;
DoneTimes: 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 - 1 downto 0 do
begin
Item := AList.Items[I];
//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 - 1 do
begin
ATask := AList.Items[I];
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 Suspended do
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 Terminated do
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.

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

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

end;

5楼: while not terminated do
begin
if str1=str2 then
break
else begin
memo1.lines.add(str2);
sleep(1000);
end;

end;

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

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

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

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

10楼: 随机等待时间是从网页中获取的,一般是20到60秒,这是必须等待的,如果不等待这下面的的一个idhttp.get(url2),将不会加积分,这是广告联盟规定的


我只会在子线程中用sleep,这样程序就不会死了