Идентификатор события таймера BegTime: TDateTime;
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);
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.
