Листинг 5

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;

type
TfmExample = class(TForm)
Panel1: TPanel;
bbRun: TBitBtn;
bbClose: TBitBtn;
edInput: TEdit;
lbOutput: TLabel;
mmOutput: TMemo;
procedure bbRunClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmExample: TfmExample;

implementation

{$R *.DFM}
// Объявление экспортируемых функций:

function timeSetEvent(uDelay, uReolution: UINT; lpTimeProc: Pointer;
dwUser: DWORD; fuEvent: UINT): Integer; stdcall; external 'winmm';

function timeKillEvent(uID: UINT): Integer; stdcall; external 'winmm';

// Объявление глобальных переменных
var
uEventID: UINT; // Идентификатор события таймера
BegTime: TDateTime; // Засекаем время<
Counter: Integer; // Счетчик повторений
Delay: Word; // Период срабатывания

procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;
// Реакция на срабатывание таймера (процедура обратного вызова)
var
h, m, s, ms: Word; // Переменные для декодирования времени
const
MaxCount = 55; // Количество повторений
begin
timeKillEvent(uEventID); // Останавливаем таймер
Counter := Counter+1; // Наращиваем счетчик
if Counter=MaxCount then // Конец цикла?
begin // - Да: декодируем время
DecodeTime((Time-BegTime)/MaxCount, h, m, s, ms);
fmExample.mmOutput.Lines.Add( // Сообщаем результат
Format('Задано %s ms. Получено %d ms',
[fmExample.edInput.Text,ms]));
fmExample.edInput.Text := ''; // Готовим повторение
fmExample.edInput.SetFocus
end else // - Нет: вновь пускаем таймер
uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);
end;

procedure TfmExample.bbRunClick(Sender: TObject);
// Запускает таймер. edInput содержит требуемый период.
begin
// Проверяем задание периода
if edInput.Text='' then Exit;
try
Delay := StrToInt(edInput.Text)
except
ShowMessage('Ошибка ввода числа');
edInput.SelectAll;
edInput.SetFocus;
Exit
end;
Counter := 0; // Сбрасываем счетчик
BegTime := Time; // Засекаем время
// Запускаем таймер:
uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);
if uEventID=0 then
ShowMessage('Ошибка запуска таймера')
end;

procedure TfmExample.FormActivate(Sender: TObject);
begin
edInput.SetFocus
end;

end.