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.

 

转载于:https://www.cnblogs.com/Jekhn/archive/2012/12/23/2829959.html