delphi判断线程是否正在运行

相关资料：
http://www.delphitop.com/html/xiancheng/376.html

 

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 8 
 9 type
10   TMyThread = class(TThread)//自定义的线程
11   protected
12     procedure Execute; override;
13   end;
14 
15   TForm1 = class(TForm)
16     Button1: TButton;
17     procedure Button1Click(Sender: TObject);
18   private
19     { Private declarations }
20   public
21     { Public declarations }
22   end;
23 
24 var
25   Form1: TForm1;
26   mytd: TMyThread;//线程对像
27 implementation
28 
29 {$R *.dfm}
30 
31 //返回值：0-已释放；1-正在运行；2-已终止但未释放；3-未建立或不存在
32 function CheckThreadFreed(aThread: TThread): Byte;
33 var
34   I: DWord;
35   IsQuit: Boolean;
36 begin
37   if Assigned(aThread) then
38   begin
39     IsQuit := GetExitCodeThread(aThread.Handle, I);
40     if IsQuit then //If the function succeeds, the return value is nonzero.
41     //If the function fails, the return value is zero.
42     begin
43       if I = STILL_ACTIVE then //If the specified thread has not terminated,
44       //the termination status returned is STILL_ACTIVE.
45       Result := 1
46     else
47       Result := 2; //aThread未Free，因为Tthread.Destroy中有执行语句
48     end
49     else
50     Result := 0; //可以用GetLastError取得错误代码
51   end
52   else
53   Result := 3;
54 end;
55 
56 procedure TMyThread.Execute;
57 var
58  I: Integer;
59 begin
60   for I := 0 to 500000 do
61   begin
62     Form1.Canvas.Lock;
63     Form1.Canvas.TextOut(10, 10, IntToStr(I));
64     Form1.Canvas.Unlock;
65   end;
66 end;
67 
68 procedure TForm1.Button1Click(Sender: TObject);
69 begin
70   if CheckThreadFreed(mytd)<>1 then //判断线程是否存在
71   begin
72     mytd := TMyThread.Create(True);
73     mytd.FreeOnTerminate := True;
74     mytd.Resume;
75   end;
76 end;
77 
78 end.
View Code

 

posted on 2017-09-11 17:32  疯狂delphi  阅读(1632)  评论(0)  编辑  收藏  举报

导航