zoukankan      html  css  js  c++  java
  • delphi 线程的使用

    delphi 线程的使用
    https://www.cnblogs.com/china1/archive/2004/01/13/3395141.html

    unit untWorkThread;
    
    interface
    
    uses
      Windows,Classes,SysUtils;
    
    type
      TWorkItem=class
      end;
      TProcessWork=procedure (Sender:TObject;Work:TWorkItem) of Object;
      TWorkThread=class(TThread)
      private
        FCriticalSection:TRTLCriticalSection;
        hEvent:Cardinal;
        FList:TList;
        FProcessWork:TProcessWork;
        procedure ProcessWork(Work:TWorkItem);
        function GetWork(var AWork:TWorkItem):Boolean;
      protected
        procedure Execute;override;
      public
        procedure AddWork(AWork:TWorkItem);
        constructor Create;
        destructor Destroy; override;
        property OnProcessWork:TProcessWork read FProcessWork write FProcessWork;
      end;
    
    implementation
    
    {TWorkThread}
    
    constructor TWorkThread.Create;
    begin
      InitializeCriticalSection(FCriticalSection);
      hEvent:=CreateEvent(nil,False,False,nil);
      FList:=TList.Create;
      Self.FreeOnTerminate:=False;
      inherited Create(False);
    end;
    
    destructor TWorkThread.Destroy;
    var
      i:Integer;
    begin
      for i:=FList.Count-1 downto 0 do TWorkItem(FList.Items[i]).Free;
      DeleteCriticalSection(FCriticalSection);
      FList.Free;
      CloseHandle(hEvent);
    end;
    
    function TWorkThread.GetWork(var AWork:TWorkItem):Boolean;
    begin
      Result:=False;
      EnterCriticalSection(FCriticalSection);
      try
        if FList.Count>0 then
        begin
          AWork:=TWorkItem(FList.Items[0]);
          FList.Delete(0);
          Result:=True;
        end;
      finally
        LeaveCriticalSection(FCriticalSection);
      end;
    end;
    
    procedure TWorkThread.Execute;
    var
      Work:TWorkItem;
    begin
      while not Self.Terminated do
      begin
        WaitForSingleObject(hEvent,INFINITE);
        while GetWork(Work) do
        begin
          ProcessWork(Work);
          Work.Free;
        end;
      end;
    end;
    
    procedure TWorkThread.ProcessWork(Work:TWorkItem);
    begin
      if Assigned(FProcessWork) then FProcessWork(Self,Work);
    end;
    
    procedure TWorkThread.AddWork(AWork:TWorkItem);
    begin
      EnterCriticalSection(FCriticalSection);
      try
        FList.Add(AWork);
      finally
        LeaveCriticalSection(FCriticalSection);
      end;
      SetEvent(hEvent);
    end;
    
    end.
  • 相关阅读:
    C#.net开发 List与DataTable相互转换
    asp.net 7.分页
    PostgreSQL 创建触发器 Trigger
    PostgreSQL 的命令行工具 psql 的常用命令
    安装SQL Server DQS 和 MDS
    Ubuntu ssh-keygen 生成公钥并添加到远程服务器上
    阿里云code基础文档
    忘记本地MySQL数据库密码的解决方法
    谷歌浏览器安装jsonview
    phpstorm汉化包
  • 原文地址:https://www.cnblogs.com/fhweixin/p/13743236.html
Copyright © 2011-2022 走看看