unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TimeFunctions, MMSystem, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    txtSystemWorkTime: TEdit;
    Timer1: TTimer;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    txtTimeMinPeriod: TEdit;
    Label3: TLabel;
    txtTimeMaxPeriod: TEdit;
    cmbTimeGo: TButton;
    Label4: TLabel;
    txtTimeMaxVal: TEdit;
    Label5: TLabel;
    txtTimeResult: TEdit;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    txtHWFreq: TEdit;
    Label7: TLabel;
    txtHWPeriod: TEdit;
    txtHWCurCount: TEdit;
    Label8: TLabel;
    txtHWSystemWorkTime: TEdit;
    Label9: TLabel;
    GroupBox4: TGroupBox;
    Label10: TLabel;
    txtTimeInterval: TEdit;
    cmbTimeStart: TButton;
    lstTimes: TListBox;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmbTimeGoClick(Sender: TObject);
    procedure cmbTimeStartClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}
var
  timerID: UINT; //Идентификатор таймера (мультимедиа-таймера)

//Функция обратного вызова. Вызывается при истечении промедутка времени,
//заданного в текстовом поле "Интервал(мс)"
procedure TimerProc(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
begin
  //Добавляем текущее значение времени в список (для того, чтобы была
  //видна разница между моментами вызова этой процедуры)
  Form1.lstTimes.Items.Add(IntToStr(timeGetTime()));
end;

procedure TForm1.cmbTimeStartClick(Sender: TObject);
begin
  if cmbTimeStart.Caption = 'Запуск' then
  begin
    txtTimeInterval.Enabled := False;
    cmbTimeStart.Caption := 'Стоп';
    lstTimes.Clear;
    //Запускаем таймер
    timerID := timeSetEvent(StrToInt(txtTimeInterval.Text),
                            timeGetMinPeriod(),
                            TimerProc, 0,
                            TIME_CALLBACK_FUNCTION or TIME_PERIODIC)
  end
  else
  begin
    txtTimeInterval.Enabled := True;
    cmbTimeStart.Caption := 'Запуск';
    //Останавливаем таймер
    timeKillEvent(timerID);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  counter: Int64;
begin
  //Обновляем показания старта времени системы
  txtSystemWorkTime.Text := GetSystemWorkTime();
  //Обновляем показания аппаратного таймера
  counter := hwTimerGetCounter();
  txtHWCurCount.Text := IntToStr(counter);
  txtHWSystemWorkTime.Text := hwCounterToTimeStr(counter);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Определяем характеристики мультимедийного таймера
  txtTimeMinPeriod.Text := IntToStr(timeGetMinPeriod());
  txtTimeMaxPeriod.Text := IntToStr(timeGetMaxPeriod());
  //Определяем характеристики аппаратного таймера
  txtHWFreq.Text := IntToStr(hwTimerGetFreq());
  txtHWPeriod.Text := FloatToStr(1000 / hwTimerGetFreq());
end;

procedure TForm1.cmbTimeGoClick(Sender: TObject);
var
  summ, arg, maxVal: Int64;
  startTime, endTime: Cardinal;
begin
  txtTimeResult.Text := 'Измерение...';
  Refresh;
  maxVal := StrToInt(txtTimeMaxVal.Text);

  //Устанавливаем маскимальную точность таймера
  timeSetTimerPeriod(timeGetMinPeriod());
  startTime := timeGetTime(); //Начальный момент времени

  summ := 0;
  arg := 1;
  while (arg <= maxVal) do
  begin
    Inc(summ, arg);
    Inc(arg);
  end;

  endTime := timeGetTime(); //Конечный момент времени
  //Восстанавливаем период таймера
  timeRestoreTimerPeriod();

  //Время выполнения операций
  txtTimeResult.Text := IntToStr(endTime - startTime);
end;

end.



