Delphi World - Класс-оболочка для объекта синхронизации WaitableTimer
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Класс-оболочка для объекта синхронизации WaitableTimer

Автор: Алексей Вуколов
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Класс-оболочка для объекта синхронизации WaitableTimer.

Класс представляет собой оболочку для объекта синхронизации WaitableTimer,
существующего в операционных системах, основанных на ядре WinNT.

Методы.
--------------
Start - запуск таймера.

Stop - остановка таймера.

Wait - ожидает срабатывания таймера заданное количество миллисекунд и
возвращает результат ожидания.

Свойства.
--------------
Time : TDateTime - дата/время когда должен сработать таймер.

Period : integer - Период срабатывания таймера. Если значение равно 0, то
таймер срабатывает один раз, если же значение отлично от нуля, таймер будет
срабатывать периодически с заданным интервалом, первое срабытывание произойдет
в момент, заданный свойством Time.

LongTime : int64 - альтернативный способ задания времени срабатывания. Время
задается в формате UTC.

Handle : THandle (только чтение) - хендл обекта синхронизации.

LastError : integer (только чтение) - В случае если метод Wait возвращает
wrError, это свойство содержит значение, возвращаемое функцией GetLastError.

Зависимости: Windows, SysUtils, SyncObjs
Автор:       vuk
Copyright:   Алексей Вуколов
Дата:        25 апреля 2002 г.
***************************************************** }

unit wtimer;

interface

uses
  Windows, SysUtils, SyncObjs;

type

  TWaitableTimer = class(TSynchroObject)
  protected
    FHandle: THandle;
    FPeriod: longint;
    FDueTime: TDateTime;
    FLastError: Integer;
    FLongTime: int64;
  public

    constructor Create(ManualReset: boolean;
      TimerAttributes: PSecurityAttributes; const Name: string);
    destructor Destroy; override;

    procedure Start;
    procedure Stop;
    function Wait(Timeout: longint): TWaitResult;

    property Handle: THandle read FHandle;
    property LastError: integer read FLastError;
    property Period: integer read FPeriod write FPeriod;
    property Time: TDateTime read FDueTime write FDueTime;
    property LongTime: int64 read FLongTime write FLongTime;

  end;

implementation

{ TWaitableTimer }

constructor TWaitableTimer.Create(ManualReset: boolean;
  TimerAttributes: PSecurityAttributes; const Name: string);
var
  pName: PChar;
begin
  inherited Create;
  if Name = '' then
    pName := nil
  else
    pName := PChar(Name);
  FHandle := CreateWaitableTimer(TimerAttributes, ManualReset, pName);
end;

destructor TWaitableTimer.Destroy;
begin
  CloseHandle(FHandle);
  inherited Destroy;
end;

procedure TWaitableTimer.Start;
var
  SysTime: TSystemTime;
  LocalTime, UTCTime: FileTime;
  Value: int64 absolute UTCTime;

begin
  if FLongTime = 0 then
  begin
    DateTimeToSystemTime(FDueTime, SysTime);
    SystemTimeToFileTime(SysTime, LocalTime);
    LocalFileTimeToFileTime(LocalTime, UTCTime);
  end
  else
    Value := FLongTime;
  SetWaitableTimer(FHandle, Value, FPeriod, nil, nil, false);
end;

procedure TWaitableTimer.Stop;
begin
  CancelWaitableTimer(FHandle);
end;

function TWaitableTimer.Wait(Timeout: Integer): TWaitResult;
begin
  case WaitForSingleObjectEx(Handle, Timeout, BOOL(1)) of
    WAIT_ABANDONED: Result := wrAbandoned;
    WAIT_OBJECT_0: Result := wrSignaled;
    WAIT_TIMEOUT: Result := wrTimeout;
    WAIT_FAILED:
      begin
        Result := wrError;
        FLastError := GetLastError;
      end;
  else
    Result := wrError;
  end;
end;

end.

Пример использования:

// Пример создания таймера, который срабатывает по алгоритму "завтра в это же
// время и далее с интервалом в одну минуту".

var
  Timer: TWaitableTimer;
begin
  Timer := TWaitableTimer.Create(false, nil, '');
  Timer.Time := Now + 1; //завтра в это же время
  Timer.Period := 60 * 1000; //Интервал в 1 минуту
  Timer.Start; //запуск таймера
end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования