zoukankan      html  css  js  c++  java
  • 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
  • 相关阅读:
    class-决策树Decision Tree
    class-朴素贝叶斯NaiveBayes
    class-k近邻算法kNN
    [linux环境配置]个人用持续更新ing~
    [python基础] python生成wordcloud并保存
    [算法基础]快排、归并、堆排序比较
    [算法基础]斐波那契(recursion+loop)两种方式执行时间对比
    [python基础]xml_rpc远程调控supervisor节点进程
    [Supervisor]supervisor监管gunicorn启动DjangoWeb时异常退出
    [python基础] csv.wirterow()报错UnicodeEncodeError
  • 原文地址:https://www.cnblogs.com/FKdelphi/p/7506041.html
Copyright © 2011-2022 走看看