• 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
  • 相关阅读:
    兼容火狐回车事件
    html的锚链接位置偏差解决
    jq记住密码
    PHP界面显示中文乱码
    ThinkPHP5.0学习1
    Fatal error: Call to undefined function pasterTempletDiy()
    dede问答模块修改
    PHP:Deprecated: Function set_magic_quotes_runtime() is deprecated 错误
    jq根据文本显示内容设置样式
    Tomcat Remote Debug操作和原理
  • 原文地址:https://www.cnblogs.com/FKdelphi/p/7506041.html
Copyright © 2020-2023  润新知