zoukankan      html  css  js  c++  java
  • Delphi线程类(四)

    View Code
    {*******************************************************}
    {                                                       }
    {       Delphi Thread Sample 4                          }
    {       Creation Date 2012.12.21                        }
    {       Created By: ming                                }
    {                                                       }
    {*******************************************************}
    unit unitWorkThread;
    
    interface
    
    uses
      Classes,Windows, Messages, SysUtils, Graphics, StdCtrls;
    
    type
      TWorkThread = class(TThread)
      private
        { Private declarations }
        FEvent: HWND;
        FMsg: string;
        FMemo:  TMemo;
        FInterval,FTickTimes: Cardinal;
        procedure doSyncProc1;
        procedure syncOutputMsg;
        procedure addLog(const msg: string); overload;
        procedure addLog(const fmtStr:string; const params: array of const); overload;
        procedure _sleep(millisecond:Cardinal);
      protected
        procedure Execute; override;
      public
        constructor Create(Suspend: boolean); overload;
        constructor Create(Suspend: boolean; mmoOutput: TMemo); overload;
        destructor Destroy; override;
      private
        FThreadPause,FThreadStop: Boolean;
        procedure doSomething;
      public
        function ThreadStart: Boolean;
        function ThreadPause: Boolean;
        function ThreadStop: Boolean;
        procedure ThreadTerminate;
      public
        property Interval:Cardinal read FInterval write FInterval;
      end;
    
    var
      WorkThread: TWorkThread;
    
    implementation
    
    { TWorkThread }
    
    constructor TWorkThread.Create(Suspend: boolean);
    begin
      inherited Create(Suspend);
      FEvent := CreateEvent(nil,True,False,nil);
      FreeOnTerminate := True;
      FInterval := 1000;
    end;
    
    procedure TWorkThread.addLog(const msg: string);
    begin
      FMsg := msg;
      Synchronize(syncOutputMsg);
    end;
    
    procedure TWorkThread.addLog(const fmtStr: string;
      const params: array of const);
    begin
      FMsg := Format(fmtStr,params);
      Synchronize(syncOutputMsg);
    end;
    
    constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
    begin
      inherited Create(Suspend);
      FEvent := CreateEvent(nil,True,False,nil);
      FreeOnTerminate := True;
      FInterval := 1000;
      FMemo := mmoOutput;
    end;
    
    destructor TWorkThread.Destroy;
    begin
      CloseHandle(FEvent);
      inherited;
    end;
    
    procedure TWorkThread.doSomething;
    begin
      addLog(FormatDateTime('c',now));
    end;
    
    procedure TWorkThread.doSyncProc1;
    begin
    
    end;
    
    procedure TWorkThread.syncOutputMsg;
    var
      dt: string;
    begin
      dt := FormatDateTime('hh:nn:ss',now);
      FMsg := Format('[%s] - ',[dt]) + FMsg;
      if Assigned(FMemo) then
        FMemo.Lines.Add(FMsg);
    end;
    
    procedure TWorkThread.Execute;
    begin
      inherited;
      while not Terminated do
      begin
        if WaitForSingleObject(FEvent,100)=WAIT_OBJECT_0 then
        begin
          Break;
        end;
        if (GetTickCount - FTickTimes) >= FInterval then
        try
          if not FThreadStop then
          begin
            doSomething;
            FTickTimes := GetTickCount;
          end;
        except on e:Exception do
          addLog(e.Message);
        end;
        if FThreadStop then
          Suspend;
      end;
    end;
    
    function TWorkThread.ThreadStart: Boolean;
    begin
      FThreadStop := False;
      if Suspended then Resume;
    end;
    
    function TWorkThread.ThreadPause: Boolean;
    begin
      FThreadPause := True;
      if not Suspended then Suspend;
    end;
    
    function TWorkThread.ThreadStop: Boolean;
    begin
      FThreadPause := False;
      FThreadStop := True;
      if Suspended then Resume;
    end;
    
    procedure TWorkThread.ThreadTerminate;
    begin
      FThreadStop := False;
      if FEvent>0 then
      begin
        SetEvent(FEvent);
        if Suspended then Resume;
      end;
    end;
    
    procedure TWorkThread._sleep(millisecond: Cardinal);
    begin
      //WaitForSingleObject(Self.Handle,millisecond);
      WaitForSingleObject(FEvent,millisecond);
    end;
    
    end.
  • 相关阅读:
    ElasticSearch6学习(1)-安装Elasticsearch
    Ubuntu 18.04 安装java8
    windows10 php7安装mongodb 扩展
    https加密解密过程详解
    Beanstalkd,zeromq,rabbitmq的区别
    PHP中的++和--
    win10 git bash 闪退
    谈下WebSocket介绍,与Socket的区别
    Bridge桥接模式(结构型模式)
    Apater适配器模式(结构型模式)
  • 原文地址:https://www.cnblogs.com/Jekhn/p/2829959.html
Copyright © 2011-2022 走看看