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

    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.
  • 相关阅读:
    010 排序: 冒泡 选择
    洛谷 P1540 机器翻译
    洛谷 P1011 车站
    周期串
    2019.03.29 大数据图解
    2019.03.29 算法解读
    2019.03.28 博客反省
    2019.03.27 常用的模块
    2019.03.25 git
    2019.03.25 Ajax三级联动
  • 原文地址:https://www.cnblogs.com/china1/p/3395141.html
Copyright © 2011-2022 走看看