My name is Vasyl Khrystiuk‎ > ‎pub‎ > ‎else‎ > ‎

Delphi WinAPI thread control

Tags: delphi_tag

Делать было нечего. Все правда не дописали до конца. Но самую интересную часть реализовали неплохо я думаю.

Здесь решена проблема thread sleep и suspend. При остановке потока через suspend во время выполнения sleep и последующего вызова resume,  sleep продолжал отсчитывать время. В этой же реализации наш метод stop сбрасывал все блокирующие задержки, переставал вызывать нашу функцию и усыплял поток до необходимости. Метод start же работал как следует, даже если сразу вызывается после stop, независимо от того, сколько времени уже прошло. Такое поведение невозможно получить при использовании стандартного sleep потока.



unit StopwatcherLib;
  
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,DateUtils;
 
  type
 
    TStopwatcher = Class(TThread)
    private
      startTick : int64;
      stopTick : int64;
      frequency : int64;
      logStr : string;
 
      hEvent: Cardinal;
      totalTime : TDateTime;      
      status : Integer;
 
    FTickEvent:TNotifyEvent ;
 
    protected
      procedure Execute; override;
      procedure log(line: string);
      procedure calcTime;
    public
      constructor Create; overload;
      procedure start;
      procedure stop;
      procedure pause;
      procedure resume;
      function getTimespan : string;
      function getStatus : string;
      function getLog: string;
    published
      property OnTick: TNotifyEvent read FTickEvent write FTickEvent;
    end;
    const
      STOPED = 0;
      RUNNING = 1;
      PAUSED  = 2;
 
      TICK_TIME = 60000;
 
implementation
 
constructor TStopwatcher.Create;
begin
  QueryPerformanceFrequency(frequency);
  status := STOPED;
  hEvent:=CreateEvent(nil,true,false,'super_event');
  inherited Create(false);
  FreeOnTerminate:=true;
end;
 
function TStopwatcher.getStatus : string;
begin
  Case status of
    STOPED: Result := 'STOPED';
    RUNNING: Result := 'RUNNING';
    PAUSED: Result := 'PAUSED';
  end;
end;
 
procedure TStopwatcher.start();
begin
  if status <> STOPED then stop();
 
  log('start logged');
 
  totalTime := 0;  
 
  QueryPerformanceCounter(startTick);
 
 
  status := RUNNING;
  SetEvent(hEvent);
end;
 
procedure TStopwatcher.pause();
begin
  if status <> RUNNING then
    begin
      log('Pause no sense');
      Exit;
    end;
    status := PAUSED;
    calcTime();
    log(getTimespan()+'  #pause logged');
end;
 
procedure TStopwatcher.resume();
begin
  if status <> PAUSED then
    begin
      log('Resume no sense ');
      Exit;
    end;
    QueryPerformanceCounter(startTick);
    status := RUNNING;
    log(getTimespan()+'  #resume logged ');
end;
 
procedure TStopwatcher.stop();
var
  TimeInSeconds:double;
begin
  if status = RUNNING then pause();
    if status = PAUSED then
      begin
        SetEvent(hEvent);
        status := STOPED;
        log(getTimespan()+'  #stop logged ');
      end
    else log('Stop no sense');
end;
 
function TStopwatcher.getTimespan: string;
begin
  Result := TimeToStr(IncSecond(0,Trunc(totalTime))) + ':' +  Format('%.3d', [Trunc(totalTime*1000) mod 1000]);
end;
 
procedure TStopwatcher.calcTime;
var TimeInSeconds:double;
begin
    QueryPerformanceCounter(stopTick);
    TimeInSeconds := (stopTick - startTick) / frequency;
    startTick := stopTick;
    totalTime := totalTime + TimeInSeconds;
end;
 
procedure TStopwatcher.Execute;
var dwWaitResult:word;
begin
  while true do
    begin
      dwWaitResult := WaitForSingleObject(hEvent, TICK_TIME);
      if dwWaitResult <> WAIT_OBJECT_0 then
      begin
        if status = RUNNING then
            begin
              if Assigned(FTickEvent) then
              begin
                calcTime();
                FTickEvent(Self);
              end;
            end;
        end
      else
        begin
          ResetEvent(hEvent);
        end;
    end;
end;
 
procedure TStopwatcher.log( line: string) ;
begin
  logStr := logStr + #13#10 + line;
end;
 
function TStopwatcher.getLog: string;
begin
  Result := logStr;
end;
end.



Comments