Таймер и задержки выполнения (Delay)

Использование команды RDTSC процессора Pentium для работы с малыми временными интервалам

2013-09-16T14:38:14+07:00

Автор: Шевченко В.В.

Приветствую Вас, жители королевства!

В одной толстой книге нашел интересное использование команды RDTSC процессора Pentium для работы с малыми временными интервалами. Я думаю, что эта функция может найти широкое применение (в таймерах, управлении внешними устройствами, научных исследованиях).

Этот счетчик увеличивается на 1 на каждом такте CPU.

Он стартует при включении компьютера или при нажатии кнопки RESET.

Обычно функцию RDTSC используют при определении тактовой частоты процессора.

Применяя программные ухищрения можно добиться измерения очень малых временных величин в реальном масштабе времени или применять для калибровки таймеров (предварительно определив при помощи этой же функции тактовую частоту процессора).

Готовые примеры определения тактовой частоты при помощи функции RDTSC есть в интернете, например, на сайте Мастера Delphi" : "Скорость работы процессора, точный таймер"

Code:

function RDTSC: comp;

var

TimeStamp: record

case byte of

1: (Whole: comp);

2: (Lo, Hi: Longint);

end;

begin

asm

db $0F; db $31;

{$ifdef Cpu386}

mov [TimeStamp.Lo], eax

mov [TimeStamp.Hi], edx

{$else}

db D32

mov word ptr TimeStamp.Lo, AX

db D32

mov word ptr TimeStamp.Hi, DX

{$endif}

end;

Result := TimeStamp.Whole;

end;

©Drkb::00686

https://delphiworld.narod

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

2013-09-16T14:22:30+07:00

Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :

Code:

procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD);stdcall;

begin

// Тело процедуры.

end;

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру

Code:

uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);

Подробности смотри в Help.Hу и в конце убиваешь таймер:

Code:

timeKillEvent(uTimerID);

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Автор: Leonid Tserling

Как реализовать сверхточный таймер?

2013-08-22T20:50:28+07:00

Windows is not a real time operating system so it is not really able to reliably achieve high accuracy timing without using a device driver. The best I have been able to get is a few nanoseconds using QueryPerformanceCounter. This is the procedure I use:

Code:

var

WaitCal: Int64;

procedure Wait(ns: Integer);

var

Counter, Freq, WaitUntil: Int64;

begin

if QueryPerformanceCounter(Counter) then

begin

QueryPerformanceFrequency(Freq);

WaitUntil := Counter + WaitCal + (ns * (Freq div1000000));

while Counter < WaitUntil do

QueryPerformanceCounter(Counter);

end

else

Sleep(ns div1000);

end;

To get improved accuracy do this a little while before using Wait()

Code:

var

Start, Finish: Int64;

Application.ProcessMessages;

Sleep(10);

QueryPerformanceCounter(Start);

Wait(0);

QueryPerformanceCounter(Finish);

WaitCal := Start - Finish;

A trick I have found to increase the reliability of this on my computer is to call Wait like this:

Code:

Application.ProcessMessages;

Sleep(0);

DoSomething;

Wait(10);

DoSomethingElse;

Взято из https://www.lmc-mediaagentur

Code:

Unit Counter; (* Written by Jin *)

{$O-,F-,S-,N-,R-,Q-}

Interface

Type

tTimerValue = record

Micro: Word; { Счётчик 8253/8254 }

Counter: Longint { Счётчик BIOS }

End;

Const

MicroFreq = 1193181{ $1234DD }; { Частота обновления счётчика Micro (1/сек) }

CounterFreq = MicroFreq / 65536; { Частота обновления счётчика Counter (1/сек) }

MicroInterval = 1 / MicroFreq; { Интервал обновления счётчика Micro (сек) }

CounterInterval = 1 / CounterFreq; { Интервал обновления счётчика Counter (сек) }

Var

BIOSCounter: Longint absolute$0040:$006C;

{ Системный счётчик (обновляется CounterFreq раз/сек, }

{ то есть каждые CounterInterval секунд) }

Procedure InitTimer;

{ Инициализировать таймер (перевести в нужный режим работы). }

{ Эту процедуру необходимо выполнять перед использованием функций }

{ и процедур для получения значения таймера (или счётчика), если }

{ Вы в своей программе изменили режим работы таймера. В противном }

{ случае эта процедура Вам не понадобится, так как она выполняется }

{ в секции инициализации модуля (сразу после запуска программы) ! }

Procedure GetTimerValue(var Timer: tTimerValue);

{ Записать значение таймера в переменную Timer }

Function GetTimerSec: Real;

{ Получить значение таймера в секундах (с точностью до 1 мкс) }

Function GetTimerMillisec: Longint;

{ Получить значение таймера в миллисекундах }

Procedure GetTimerDifference(var Older, Newer, Result: tTimerValue);

{ Записать разницу значений Newer и Older в переменную Result }

Function GetTimerDifSec(var Older, Newer: tTimerValue): Real;

{ Получить разницу значений Newer и Older в секундах }

Function GetTimerDifMillisec(var Older, Newer: tTimerValue): Longint;

{ Получить разницу значений Newer и Older в миллисекундах }

Function ConvTimer2Sec(var Timer: tTimerValue): Real;

{ Получить количество секунд по значению переменной Timer }

Function ConvTimer2Millisec(var Timer: tTimerValue): Longint;

{ Получить количество миллисекунд по значению переменной Timer }

Procedure ConvSec2Timer(Sec: Real; var Timer: tTimerValue);

{ Преобразовать значение секунд Sec типа Real в тип tTimerValue }

Procedure ConvMillisec2Timer(Millisec: Longint; var Timer: tTimerValue);

{ Преобразовать значение миллисекунд Millisec типа Longint в тип tTimerValue }

Procedure ResetCounter;

{ Сбросить счётчик (то есть принять текущее значение таймера за ноль для }

{ процедуры GetCounterValue и функции GetCounterSec) }

Procedure GetCounterValue(var Timer: tTimerValue);

{ Записать значение счётчика в переменную Timer }

Function GetCounterSec: Real;

{ Получить значение секунд счётчика }

Function GetCounterMillisec: Longint;

{ Получить значение миллисекунд счётчика }

Procedure Delay(MS: Word);

{ Задержка MS миллисекунд (1 сек = 1000 мс) }

Procedure DelaySec(Sec: Real);

{ Задержка Sec секунд }

Procedure MDelay(N: Longint);

{ Задержка N * MicroInterval секунд (приближённо N * 0.838095813 мкс). }

{ Если Вам нужны наиболее точные короткие задержки, лучше использовать }

{ эту процедуру, так как она даёт наименьшую погрешность по сравнению }

{ с двумя предыдущими процедурами. }

Implementation

Var Now: tTimerValue;

Var Zero: tTimerValue;

Procedure InitTimer; assembler;

Asm

mov al,34h { Режим 2 таймера 0 }

out 43h,al

xor al,al { 65536 циклов до IRQ }

out 40h,al

End

Procedure GetTimerValue; assembler;

Asm

cld

xor ax,ax

mov es,ax

mov bx,46Ch { DS:BX = 0000h:046Ch = Таймер BIOS }

cli

mov dx,es:[bx]

mov cx,es:[bx+2]{ CX:DX = Первое значение таймера BIOS }

sti

out 43h,al { Замораживаем таймер 8253/8254 }

cli

mov si,es:[bx]

mov di,es:[bx+2]{ DI:SI = Второе значение таймера BIOS }

in al,40h

mov ah,al

in al,40h

sti

xchg ah,al { AX = Таймер 8253/8254 }

not ax { Обратный отсчёт -> Прямой отсчёт }

cmp dx,si { Первое значение таймера BIOS равно второму значению ? }

je @Ok { Да! Оставляем как есть (CX:DX), иначе... }

or ax,ax { Таймер BIOS изменился после заморозки таймера 8253/8254 (между OUT и CLI) ? }

js @Ok { Да! Оставляем как есть (CX:DX), иначе... }

mov dx,si

mov cx,di { CX:DX = DI:SI, если таймер BIOS изменился между STI и OUT }

@Ok:

les di,Timer

stosw { Low Word }

xchg ax,dx

stosw { Middle Word }

xchg ax,cx

stosw { High Word - Записаны из CX:DX:AX }

End

Function GetTimerSec;

Begin

GetTimerValue(Now);

GetTimerSec := ConvTimer2Sec(Now)

End;

Function GetTimerMillisec;

Begin

GetTimerMillisec := Trunc(GetTimerSec*1000)

End;

Procedure GetTimerDifference; assembler;

Asm

cld

push ds

lds si,Newer

lodsw { Low Word }

xchg cx,ax

lodsw { Middle Word }

xchg dx,ax

lodsw { High Word }

xchg cx,ax { Прочитаны в CX:DX:AX }

lds si,Older

sub ax,[si]

sbb dx,[si+2]

sbb cx,[si+4] { Вычитаем Older из Newer }

les di,Result

stosw { Low Word }

xchg ax,dx

stosw { Middle Word }

xchg ax,cx

stosw { High Word - Записано из CX:DX:AX }

pop ds

End

Function GetTimerDifSec;

Begin

GetTimerDifference(Older, Newer, Now);

GetTimerDifSec := ConvTimer2Sec(Now)

End;

Function GetTimerDifMillisec;

Begin

GetTimerDifMillisec := Trunc(GetTimerDifSec(Older, Newer)*1000)

End;

Function ConvTimer2Sec;

Begin

ConvTimer2Sec := (Timer.Counter*65536 + Timer.Micro) / MicroFreq

End;

Function ConvTimer2Millisec;

Begin

ConvTimer2Millisec := Trunc(ConvTimer2Sec(Timer)*1000)

End;

Procedure ConvSec2Timer;

Begin

Timer.Counter := Trunc(Sec * CounterFreq);

Timer.Micro := Trunc(Sec * MicroFreq) mod65536

End;

Procedure ConvMillisec2Timer;

Begin

Timer.Counter := Trunc(Millisec/1000 * CounterFreq);

Timer.Micro := Trunc(Millisec/1000 * MicroFreq) mod65536

End;

Procedure ResetCounter;

Begin

GetTimerValue(Zero)

End;

Procedure GetCounterValue;

Begin

GetTimerValue(Timer);

GetTimerDifference(Zero, Timer, Timer)

End;

Function GetCounterSec;

Begin

GetTimerValue(Now);

GetTimerDifference(Zero, Now, Now);

GetCounterSec := ConvTimer2Sec(Now)

End;

Function GetCounterMillisec;

Begin

GetCounterMillisec := Trunc(GetCounterSec*1000)

End;

Procedure Delay;

Var Zero: Longint;

Begin

If MS <= 0then Exit;

Zero := GetTimerMillisec;

Repeat

Until GetTimerMillisec-Zero >= MS

End;

Procedure DelaySec;

Var Zero: Real;

Begin

If Sec <= 0then Exit;

Zero := GetTimerSec;

Repeat

Until GetTimerSec-Zero >= Sec

End;

Procedure MDelay;

Label Check;

Var Zero: tTimerValue;

Begin

If N <= 0then Exit;

GetTimerValue(Zero);

Check:

GetTimerValue(Now);

GetTimerDifference(Zero, Now, Now);

Asm

mov ax,word ptr Now

mov dx,word ptr Now+2{ DX:AX - Прошедшее время }

{ mov cx,word ptr Now+4

or cx,cx

jnz @Exit}

cmp dx,word ptr N+2{ Проверяем старшие слова }

jb Check

cmp ax,word ptr N { Проверяем младшие слова }

jb Check

@Exit:

EndEnd;

Begin

InitTimer

End.

Ивотещёпрограмма-тестер:

Code:

Uses Counter;

Var

Ans: Char;

i: Longint;

Sec: Real;

Begin

Asm

mov ah,0Dh

int 21h { Сбрасываем кэш }

mov ax,1681h

int 2Fh { Запрещаем Windows Task Switch }

End

Write('Без задержки...');

ResetCounter;

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('1000 раз холостой цикл...');

ResetCounter;

For i := 1to1000do ;

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('1000 раз по 0 сек...');

ResetCounter;

For i := 1to1000do

DelaySec(0);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

WriteLn('-------------------------------------------------');

Write('1 раз 1 сек...');

ResetCounter;

DelaySec(1);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('1000 раз по 0.001 сек...');

ResetCounter;

For i := 1to1000do

DelaySec(0.001);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('10000 раз по 0.0001 сек...');

ResetCounter;

For i := 1to10000do

DelaySec(0.0001);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('100000 раз по 0.00001 сек...');

ResetCounter;

For i := 1to100000do

DelaySec(0.00001);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('119318 раз по 1/119318.1 сек...');

ResetCounter;

For i := 1to119318do

MDelay(10);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

WriteLn('-------------------------------------------------');

Write('Запускать тесты по микросекундам (м.б. очень долгими) [Y/N] ? : ');

Asm

@Repeat:

xor ah,ah

int 16h

or al,20h

cmp al,'y'

je @Ok

cmp al,'n'

jne @Repeat

@Ok:

mov Ans,al

End

WriteLn(Ans);

If Ans = 'y'then

Begin

Write('1000000 раз по 0.000001 сек...');

ResetCounter;

For i := 1to1000000do

DelaySec(0.000001);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек');

Write('1193181 раз по 1/1193181 сек...');

ResetCounter;

For i := 1to1193181do

MDelay(1);

Sec := GetCounterSec;

WriteLn(#8#8#8': прошло ', Sec: 0: 6, ' сек')

End;

Asm

mov ax,1682h

int 2Fh { Разрешаем Windows Task Switch }

EndEnd.

Незабывайте, чтопогрешности, которыебудетвыдаватьпрограмма-тестербудутиз-затого, чтокакое-товремятратитьсянавызовпроцедуры, циклыит.д. (т.к. тамиспользуютсяпроцедурыDelaySec, MDelay).... НоесливызватьResetCounter, ачерезнекотороевремяGetCounterSec, торезультатбудетточным (собственно, именнотакздесьиизмеряютсяпогрешности)! Иможновызыватьего (GetCounterSec) ещёхоть 10000 раз! ;D
Кстати, запускайтетестертольковполноэкранномрежиме, т.к. программаотключаетмногозадачность Windows, инаэкраневыничегонеувидите (будетвпечатление, чтопрогаповисла).

Автор: 7jin

Взято из https://forum.sources

Авотещёодинспособ (работаеттолькона Pentium иливыше)....

Code:

Unit TSCDelay; (* Работает только на Pentium (и то не всегда ;) *)

{$O-,F-,G+,S-,R-}

Interface

Var

CPUClock: Longint; { Тактовая частота процессора (гц) }

Procedure CalcCPUClock;

{ Вычислить тактовую частоту процессора и записать в переменную CPUClock. }

Procedure MDelay(N: Longint);

{ Производит задержку в N микросекунд. Задержки более 4294967296/CPUClock }

{ (на 300-м ~ 14) секунд будут работать неправильно из-за переполнения!!! }

{ Перед использованием это процедуры необходимо установить правильное }

{ значение переменной CPUClock. Это можно сделать либо вручную, либо }

{ выполнив процедуру CalcCPUClock. }

Procedure TDelay(N: Longint);

{ Производит задержку в N тактов процессора }

Implementation

Uses Dos;

Var

SaveInt08: Pointer;

Stage: Byte;

Procedure SpeedCounter; far; assembler; { Наш IRQ 0 }

Asm

push ax

push ds

mov ax,seg @Data

mov ds,ax

inc Stage { Прибавляем к Stage единицу }

mov al,20h

out 20h,al { Посылаем сигнал "конец IRQ" }

pop ds

pop ax

iret { Выходим }

End

Procedure CalcCPUClock;

Begin

Asm

mov ah,0Dh

int 21h { Сбрасываем кэш }

mov ax,1681h

int 2Fh { Отключаем Windows Task Switch }

in al,0A1h { Маски IRQ 8-15 }

mov ah,al

in al,21h { Маски IRQ 0-7 }

push ax { Сохраняем маски }

mov al,0FEh

out 21h,al { Запрещаем IRQ 1-7 (нулевой нам нужен) }

inc ax

out 0A1h,al { Запрещаем IRQ 8-15 }

mov al,36h

out 43h,al { Устанавливаем нормальный режим работы таймера }

xor al,al

out 40h,al

out 40h,al { 65536 циклов до IRQ 0 }

mov Stage,0{ Готовимся к началу отсчёта }

End

GetIntVec(8, SaveInt08); { Сохраняем старый IRQ 0 }

SetIntVec(8, @SpeedCounter); { Устанавливаем свой IRQ 0 }

Asm

@1:cmp Stage,1

jne @1{ Цикл до первого IRQ 0 }

db 0Fh,31h { RDTSC }

db 66h; xchg cx,ax { Запоминаем значение счётчика }

@2:cmp Stage,2

jne @2{ Цикл до второго IRQ 0 }

db 0Fh,31h { RDTSC }

db 66h; sub ax,cx { Вычитаем из текущего значение счётчика запомненное }

db 66h,0B9h; dd 1234DDh { mov ecx,1234DDh }

db 66h; mul cx { Умножаем значение на 1193181 }

db 66h,0Fh,0ACh,0D0h,10h { shrd eax,edx,16 - делим на 65536 }

db 66h; mov word ptr CPUClock,ax { Записываем результат в CPUClock }

pop ax

out 21h,al { Восстанавливаем маску IRQ 0-7 }

mov al,ah

out 0A1h,al { Восстанавливаем маску IRQ 8-15 }

End

SetIntVec(8, SaveInt08); { Восстанавливаем старый IRQ 0 }

Asm

mov ax,1682h

int 2Fh { Включаем Windows Task Switch }

EndEnd;

Procedure MDelay; assembler;

Asm

db 0Fh,31h { RDTSC }

db 66h; push ax

db 66h; push dx { Сохраняем счётчик в стеке }

db 66h; mov ax,word ptr N

db 66h; mov cx,word ptr CPUClock

db 66h; mul cx { Умножаем N на CPUClock }

db 66h,0B9h; dd 1000000{ mov ecx,1000000 }

db 66h; div cx { Затем делим на 1000000 }

db 66h; xchg si,ax { Сохраняем значение в ESI }

db 66h; pop cx

db 66h; pop bx { Восстанавливаем значение счётчика в ECX:EBX }

@:db 0Fh,31h { RDTSC }

db 66h; sub ax,bx

db 66h; sbb dx,cx { Вычитаем из текущего счётчика ECX:EBX }

db 66h; or dx,dx { Старшая часть разницы д.б. всегда 0, проверяем это }

jnz @Exit { Нет - выходим! }

db 66h; cmp ax,si { Проверяем - прошло ли столько, сколько нам надо }

jb @ { Нет - ждём ещё }

@Exit:

End

Procedure TDelay; assembler;

Asm

db 0Fh,31h { RDTSC }

db 66h; mov bx,ax

db 66h; mov cx,dx { Сохраняем счётчик в ECX:EBX }

@:db 0Fh,31h { RDTSC }

db 66h; sub ax,bx

db 66h; sbb dx,cx { Вычитаем из текущего счётчика ECX:EBX }

db 66h; or dx,dx { Старшая часть разницы д.б. всегда 0, проверяем это }

jnz @Exit { Нет - выходим! }

db 66h; cmp ax,word ptr N { Проверяем - прошло ли столько, сколько нам надо }

jb @ { Нет - ждём ещё }

@Exit:

End

End.

Ипрограмма-тестер:

Code:

Uses TSCDelay;

Var N: Longint;

Begin

CalcCPUClock;

WriteLn('Тактовая частота процессора: ', CPUClock/1000000: 0: 3,' МГц');

Write('Введите количество микросекунд (не более ', 4294967296.0/CPUClock: 0: 3, ' млн): ');

ReadLn(N);

Write('Задержка...');

MDelay(N);

WriteLn(' всё!')

End.

Автор: 7jin

Класс-оболочка для объекта синхронизации WaitableTimer

2013-09-16T14:29:00+07:00

Code:

{ **** UBPFD *********** by kladovka ****

>> Класс-оболочка для объекта синхронизации 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

********************************************** }

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; constName : 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; constName: string);

var

pName : PChar;

begin

inherited Create;

ifName = ''then pName := nilelse

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 = 0then

begin

DateTimeToSystemTime( FDueTime, SysTime );

SystemTimeToFileTime( SysTime, LocalTime );

LocalFileTimeToFileTime( LocalTime, UTCTime );

endelse

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.

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

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

время и далее с интервалом в одну минуту".

Code:

var

Timer : TWaitableTimer;

....

begin

Timer := TWaitableTimer.Create(false, nil, '');

Timer.Time := Now + 1; //завтра в это же время

Timer.Period := 60 * 1000; //Интервал в 1 минуту

Timer.Start; //запуск таймера

....

О таймере

2013-09-16T14:36:53+07:00

Компонент timer (таймер) служит для отсчета интервалов реального времени. Его свойство interval определяет интервал временив миллисекундах , который должен пройти от включения таймера до наступления события ontimer. Таймер включается при установке значения true в его свойство enabled. Единожды включенный таймер все время будет возбуждать события ontimer до тех пор, пока его свойство enabled не примет значения false.

Следует учесть, что в силу специфики реализации стандартного аппаратного таймера ibm-совместимого компьютера минимальный реально достижимый интервал отсчета времени не может быть меньше 55 мс (этот интервал называется тиком), более того, любой интервал времени, отсчитываемый с помощью таймера, всегда кратен 55 мс. Чтобы убедиться в этом, проведите эксперимент, в котором подсчитывается среднее время между двумя срабатываниями таймера (timer.dpr):

Начните новый проект с пустой формой и положите на нее компонент ttimer.
Установите в свойство enabled таймера значение false.
Напишите такой модуль главной формы (листинг 4):
Листинг 4

Code:

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;

timer1: ttimer;

procedure bbrunclick(sender: tobject);

procedure timer1timer(sender: tobject);

procedure formactivate(sender: tobject);

private

begtime: tdatetime; // Начальное время цикла

counter: integer; // Счетчик цикла

end;

var fmexample: tfmexample;

implementation

{$r *.dfm}

procedure tfmexample.bbrunclick(sender: tobject);

// Запускает таймер. edinput содержит период его срабатывания.

var delay: word;

begin

// Проверяем задание интервала

if edinput.text=''then exit;

try

delay := strtoint(edinput.text);

except

showmessage('Ошибка в записи числа');

edinput.selectall;

edinput.setfocus;

exit

end;

counter := 0; // Сбрасываем счетчик

timer1.interval := delay; // Устанавливаем интервал

begtime := time; // Засекаем время

timer1.enabled := true; // Пускаем таймер

screen.cursor := crhourglass

end;

procedure tfmexample.timer1timer(sender: tobject);

var h, m, s, ms: word; // Переменные для декодирования времени

const maxcount = 55; // Количество срабатываний таймера

begin

counter := counter + 1; // Наращиваем счетчик срабатываний

if counter=maxcount then// Конец цикла?

begin// - Да

timer1.enabled := false; // Останавливаем таймер

// Находим среднее время срабатывания:

decodetime((time-begtime)/maxcount, h, m, s, ms);

mmoutput.lines.add( // Выводим результат

format('Задано %s ms. Получено %d ms.', [edinput.text, ms]));

edinput.text := ''; // Готовим следующий запуск

edinput.setfocus;

screen.cursor := crdefault

end;

procedure tfmexample.formactivate(sender: tobject);

begin

edinput.setfocus

end;

end.

Необходимость нескольких (maxcount) срабатываний для точного усреднения результата связана с тем, что системные часы обновляются каждые 55 мс. После запуска программы и ввода 1 как требуемого периода срабатывания в редакторе mmoutput вы увидите строку

Задано 1 ms. Получено 55 ms.

в которой указывается, какое реальное время разделяет два соседних события ontimer. Если вы установите период таймера в диапазоне от 56 до 110 мс, в строке будет указано 110 ms и т.д. (в силу дискретности обновления системных часов результаты могут несколько отличаться в ту или иную сторону).

В ряде практически важных областей применения (при разработке игр, в системах реального времени для управления внешними устройствам и т.п.) интервал 55 мс может оказаться слишком велик. Современный ПК имеет мультимедийный таймер, период срабатывания которого может быть от 1 мс и выше, однако этот таймер не имеет компонентного воплощения, поэтому для доступа к нему приходится использовать функции api.

Общая схема его использования такова. Сначала готовится процедура обратного вызова (call back) с заголовком:

Code:

procedure timeproc(uid, umsg: uint; dwuser, dw1, dw2: dword); stdcall;

Здесь uid — идентификатор события таймера (см. об этом ниже); umsg — не используется; dwuser — произвольное число, передаваемое процедуре в момент срабатывания таймера; dw1, dw2 — не используются.

Запуск таймера реализуется функцией:

Code:

function timesetevent(udelay, uresolution: uint; lptimeproc: pointer; dwuser: dword; fuevent: uint): uint; stdcall; external'winmm.dll';

Здесь udelay — необходимый период срабатывания таймера (в мс); uresolution — разрешение таймера (значение 0 означает, что события срабатывания таймера будут возникать с максимально возможной частотой; в целях снижения нагрузки на систему вы можете увеличить это значение); lptimeproc — адрес процедуры обратного вызова; dwuser — произвольное число, которое передается процедуре обратного вызова и которым программист может распоряжаться по своему усмотрению; fuevent — параметр, управляющий периодичностью возникновения события таймера: time_oneshot (0) — событие возникает только один раз через udelay миллисекунд; time_periodic (1) — события возникают периодически каждые udelay мс. При успешном обращении функция возвращает идентификатор события таймера и 0, если обращение было ошибочным.

Таймер останавливается, и связанные с ним системные ресурсы освобождаются функцией:

Code:

function timekillevent(uid: uint): uint; stdcall; external'winmm.dll';

Здесь uid — идентификатор события таймера, полученный с помощью timesetevent.

В следующем примере (timer.dpr) иллюстрируется использование мультимедийного таймера (листинг 5).

Code:

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=0then

showmessage('Ошибка запуска таймера')

end;

procedure tfmexample.formactivate(sender: tobject);

begin

edinput.setfocus

end;

end.

Источник: https://www.delphi.h5

Реализация функции Delay

2013-09-16T14:41:05+07:00

Code:

procedure Delay(dwMilliseconds: Longint);

var

iStart, iStop: DWORD;

begin

iStart := GetTickCount;

repeat

iStop := GetTickCount;

Application.ProcessMessages;

until (iStop - iStart) >= dwMilliseconds;

end;

Взято с сайта: https://www.swissdelphicenter

Примечание от Vit: функция будет "безбожно" жрать процессорное время. Если ожидаемые интервалы задержек достаточно велики, то очень желательно её дополнить следующим образом:

Code:

procedure Delay(dwMilliseconds: Longint);

®Vit (Vitaly Nevzorov) - nevzorov}

var

iStart, iStop: DWORD;

begin

iStart := GetTickCount;

repeat

iStop := GetTickCount;

sleep(10);

Application.ProcessMessages;

until (iStop - iStart) >= dwMilliseconds;

end;

Команда Sleep будет отдавать время другим приложением, но точность отмеряемого интервала пострадает на 0.01 секунды, что сопоставимо с общей погрешностью предложенного метода.

Code:

procedure Delay(msecs: Longint);

var

targettime: Longint;

Msg: TMsg;

begin

targettime := GetTickCount + msecs;

while targettime > GetTickCount do

if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

begin

If Msg.message = WM_QUIT Then

begin

PostQuitMessage(msg.wparam);

Break;

end;

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

{

Note:

The elapsed time is stored as a DWORD value.

Therefore, the time will wrap around to zero if the system is

run continuously for 49.7 days.

}

Взято с сайта: https://www.swissdelphicenter.ch

Code:

{

The Sleep function suspends the execution of the current

thread for a specified interval.

}

Sleep(dwMilliseconds: Word);

Взято с сайта: https://www.swissdelphicenter

Примечание от Vit: эта функция страдает многими недостатками, во-первых ни о какой точности речь и не идёт, погрешности среднепотолочные, во-вторых при количестве милисекунд большем 100 функция будет создавать эффект "подвисания" приложения, так как во время её работы приложение не будет отвечать на внешние воздействия. Собственно сама по себе функция sleep вовсе не для отсчёта времени и не для задержки на определённый интервал, её назначение в другом - отдать процессорное время в течение заданного интервала другим процессам. Код можно подправить примерно таким образом:

Code:

Procedure Delay (IntervalinSeconds:integer);

var i:integer;

®Vit (Vitaly Nevzorov) - nevzorov}

begin

For i:=0to IntervalinSeconds*100do

begin

sleep(10);

Application.ProcessMessages;

end;

Это "поправит" подвисание, но не улучшит точность. Эта функция хороша для задержек на период от секунд до несколько минут когда точность не важна.

Можно так же помудрив сделать и возможность прерывания ожидания по нажатию кнопки, примерно так:

Code:

var Canceled:boolean; // должна быть объявлена как глобальная переменная модуля

.....

Function Delay (IntervalinSeconds:integer):boolean; //возвращает true если отработала не прерываясь

(Vitaly Nevzorov) - nevzorov@yahoo.com}var i:integer;

begin

Canceled:=false;

For i:=0to IntervalinSeconds*100do

begin

sleep(10);

Application.ProcessMessages;

if Canceled then break;

end;

Result:=not Canceled;

end;

........

Procedure TForm1.onButton1Click(Sender:TObject);

begin

Canceled:=true;

end;

Code:

{

Including the Sleep in the loop prevents the app from hogging

100% of the CPU for doing practically nothing but running around the loop.

}

procedure PauseFunc(delay: DWORD);

var

lTicks: DWORD;

begin

lTicks := GetTickCount + delay;

repeat

Sleep(100);

Application.ProcessMessages;

until (lTicks <= GetTickCount) or Application.Terminated;

end;

Взято с сайта: https://www.swissdelphicenter.ch

Code:

procedure Delay(Milliseconds: Integer);

{by Hagen Reddmann}

var

Tick: DWord;

Event: THandle;

begin

Event := CreateEvent(nil, False, False, nil);

try

Tick := GetTickCount + DWord(Milliseconds);

while (Milliseconds > 0) and

(MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do

begin

Application.ProcessMessages;

Milliseconds := Tick - GetTickcount;

end;

finally

CloseHandle(Event);

end;

Взято с сайта: https://www.swissdelphicenter

Скорость работы процессора, точный таймер

2013-08-22T20:42:50+07:00

Данная тема уже обсуждалась, но у меня есть своя реализация сабжа. Начиная с Pentium MMX, Intel ввели в процессор счетчик тактов на 64 бита (Присутствует точно и в К6). Для того чтобы посмотреть на его содержание, была введена команда "rdtsc" (подробное описание в интеловской мануале). Эту возможность можно использовать для реализации сабжа.

Поскольку Дельфи не в курсе насчет rdtsc, то пришлось юзать опкод (0F31).

Привожу простенький примерчик юзания, Вы уж извините - немножко кривоват получился, да и ошибка компилятора какая-то вылезла :( (V4 Bld5.104 Upd 2). Кому интересно, поделитесь своими соображениями по этому поводу. Особенно интересует работа в режиме когда меняется частота процессора (Duty Cycle, Standby).

Code:

unit Unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms,Dialogs, StdCtrls, Buttons, ExtCtrls;

type TForm1 = class(TForm)

Label1: TLabel;

Timer1: TTimer;

Label2: TLabel;

Label3: TLabel;

Button1: TButton;

Button2: TButton;

Label4: TLabel;

procedure Timer1Timer(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Counter:integer;

//Счетчик срабатывания таймера

Start:int64;

//Начало роботы

Previous:int64;

//Предыдущее значение

PStart,PStop:int64;

//Для примера выч. времени

CurRate:integer;

//Текущая частота проца

function GetCPUClick:int64;

function GetTime(Start,Stop:int64):double;

end;

var Form1: TForm1;implementation{$R *.DFM}

// Функция работает на пнях ММХ или выше а

// также проверялась на К6

function TForm1.GetCPUClick:int64;

begin

asm db 0fh,31h

// Опкод для команды rdtsc mov dword ptr result,eax mov dword ptr result[4],edx

end;

// Не смешно :(. Без ?той штуки

// Компайлер выдает Internal error C1079

Result:=Result;

end;

// Время в секундах между старт и стоп

function TForm1.GetTime(Start,Stop:int64):double;

begin

try result:=(Stop-Start)/CurRate except result:=0;

end;

// Обработчик таймера считает текущую частоту, выводит ее, а также

// усредненную частоту, текущий такт с момента старта процессора.

// При постоянной частоте процессора желательно интервал братьпобольше

// 1-5с для точного прощета частоты процессора.

procedure TForm1.Timer1Timer(Sender: TObject);

var i:int64;

begin

i:=GetCPUClick;

if Counter=0then Start:=i else

begin

Label2.Caption:=Format('Частота общая:%2f',[(i-Start)/(Counter*Timer1.Interval*1000)]);

Label3.Caption:=Format('Частота текущая:%2f',[(i-Previous)/(Timer1.Interval*1000)]);

CurRate:=Round(((i-Previous)*1000)/(Timer1.Interval));

end;

Label1.Cap примера

procedure TForm1.Button1Click(Sender: TObject);

begin

PStart:=GetCPUClick;

end;

// Останавливаем отсчет времени и показуем соко

// прошло секунд

procedure TForm1.Button2Click(Sender: TObject);

begin

PStop:=GetCPUClick;

Label4.Caption:=Format!

('Время между нажатиями:%gсек',[GetTime(PStart,PStop)])

end;

end.