Как написать свой таймер

← →
Колян (2003-05-15 13:43) [0]

Может кто сталкивался

← →
Axis_of_Evil © (2003-05-15 13:45) [1]

TimeSetEvent
SetTimer
и поехали ...

← →
Mystic © (2003-05-15 13:51) [2]

А зачем? Чем тебя не удовлетворяет стандартный? Может есть другое решение?

← →
AlexRush © (2003-05-15 14:20) [3]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
bt_CreateTimer: TButton;
bt_KillTimer: TButton;
procedure bt_CreateTimerClick(Sender: TObject);
procedure bt_KillTimerClick(Sender: TObject);
private
{ Private declarations }
public
procedure MTP1(const TimerID,TickCount:DWORD);
end;

var
Form1: TForm1;

implementation

TYPE TMyTimerProc = procedure(const TimerID,TickCount:DWORD)of object;

TMyTimerStruct = record
dwTimerID :DWORD;
dwInterval :DWORD;
TimerProc :TMyTimerProc;
dwTickCount :DWORD;
end;
PMyTimerStruct = ^TMyTimerStruct;

TMyTimerInternalStruct = record
Timer :TMyTimerStruct;
hThread :DWORD;
ThreadID :DWORD;
end;
TMyTimerInternalStructArray =array of TMyTimerInternalStruct;

VAR _InternalMyTimerArray : TMyTimerInternalStructArray;
VAR _InternalMyTimerArrayCount:DWORD=0;//ObjectPascal 6

procedure TimerThreadProc(timer:PMyTimerStruct);stdcall;
begin
while true
do begin
timer.TimerProc(timer.dwTimerID,timer.dwTickCount);
Sleep(timer.dwInterval);
inc(timer.dwTickCount);
end;
end;

function MyTimerCreate(dwInterval:DWORD; TimerProc:TMyTimerProc):DWORD;
begin
result:=0;
if (dwInterval=0)or(not assigned(TimerProc))
then exit;
inc(_InternalMyTimerArrayCount);
SetLength(_InternalMyTimerArray,_InternalMyTimerArrayCount);

_InternalMyTimerArray[_InternalMyTimerArrayCount-1].Timer.dwTimerID
:=_InternalMyTimerArrayCount;
_InternalMyTimerArray[_InternalMyTimerArrayCount-1].Timer.dwInterval:=dwInterval;
_InternalMyTimerArray[_InternalMyTimerArrayCount-1].Timer.TimerProc:=TimerProc;
_InternalMyTimerArray[_InternalMyTimerArrayCount-1].hThread
:=CreateThread(nil,
0,
@TimerThreadProc,
@_InternalMyTimerArray[_InternalMyTimerArrayCount-1].Timer,
0,
_InternalMyTimerArray[_InternalMyTimerArrayCount-1].ThreadID);
if _InternalMyTimerArray[_InternalMyTimerArrayCount-1].hThread=0
then begin
dec(_InternalMyTimerArrayCount);
SetLength(_InternalMyTimerArray,_InternalMyTimerArrayCount);
exit;
end
else result:=_InternalMyTimerArrayCount;//TimerID
end;

function MyTimerKill(TimerID:DWORD):boolean;
var i:integer;
begin
result:=false;
if TimerID>length(_InternalMyTimerArray)
then begin
Windows.SetLastError(ERROR_INVALID_PARAMETER);
exit;
end;
result:=TerminateThread(_InternalMyTimerArray[TimerID-1].hThread,0);
if not result
then exit;
for i:=TimerID-1 to _InternalMyTimerArrayCount-2
do begin
_InternalMyTimerArray[i]:=_InternalMyTimerArray[i+1];
end;
dec(_InternalMyTimerArrayCount);
SetLength(_InternalMyTimerArray,_InternalMyTimerArrayCount);
end;
{$R *.dfm}

{ TForm1 }

procedure TForm1.MTP1(const TimerID, TickCount: DWORD);
begin
MessageBoxA(0,PChar("TimerID = "+IntToStr(TimerID)+#13"TickCount = "+IntToStr(TickCount)),"Timer:",0);
end;

procedure TForm1.bt_CreateTimerClick(Sender: TObject);
begin
MyTimerCreate(2000,Self.MTP1);
end;

procedure TForm1.bt_KillTimerClick(Sender: TObject);
begin
MyTimerKill(_InternalMyTimerArrayCount);
end;

end.
//**********************************
// P.S. Но дейтвительно, зачем ?!

← →
Слесарь Матерящийся © (2003-05-15 15:23) [4]

Делаем наследника от TTimer - получаем свой таймер. Но зачем?

← →
Колян (2003-05-16 07:27) [5]

AlexRush, спасибо, но слишком мудрено

← →
Колян (2003-05-16 07:30) [6]

Вот зачем.
Для потока (класс TThread) TTimer не подходит. А мне просто необходим таймер, работающий в потоке.

Как думаете вариант Axis_of_Evil подойдет?

← →
Digitman © (2003-05-16 08:09) [7]

> Для потока (класс TThread) TTimer не подходит

Ничего подобного. TTimer прекрасно работает в любом кодовом потоке. Если же окно для приема нотификаций таймера к код.потоке создавать нежелательно, то простое использование ф-ций SetTimer/KillTimer заменяют его

← →
Verg © (2003-05-16 11:06) [8]

> TTimer прекрасно работает в любом кодовом потоке.

Да, но только если этот кодовый поток выполняет peekmessage/dispatchmessage

По-моему в данном случае ближе всего подходит функции time**** из
модуля MMSystem

← →
Digitman © (2003-05-16 11:12) [9]

> Verg

а что мешает это сделать ? никаких же ограничений на эту тему в оригинальной постановке вопроса нет !

← →
Колян (2003-05-16 11:41) [10]

Тут таймер нужен довольно точный, с точностью до микросекунд. Насколько я знаю TTimer только миллисек поддерживает.

Если нужны микросекунды, то надо тупо ждать в цикле наступления нужного времени по QueryPerformanceCounter. Или комбинировать таймер (грубое ожидание с точностью 10-20 мс) + QueryPerformanceCounter. Но что-то подсказывает мне, что ты что-то делаешь не так. Может быть ты ошибся с выбором OS (если тебе нужен real-time). То ли средством программирования (возможно нужно писать драйвер). То ли ошибка архитектурно (не обязательно выжидать столь точные промежутки времени).

← →
Колян (2003-05-16 11:56) [12]

Mystic,
Дело в том что нужны точные расчеты.
Неужели функции API не поддерживают микросек.

← →
ai (2003-05-16 11:58) [13]

Почитай http://www.asutp.ru/?p=600438
раздел "Чем недостаточно хороша Windows?"

> Колян (16.05.03 11:56)

Если нужны микросекунды, то надо тупо ждать в цикле наступления нужного времени по QueryPerformanceCounter. Или комбинировать таймер (грубое ожидание с точностью 10-20 мс) + QueryPerformanceCounter. Но что-то подсказывает мне, что ты что-то делаешь не так. Может быть ты ошибся с выбором OS (если тебе нужен real-time). То ли средством программирования (возможно нужно писать драйвер). То ли ошибка архитектурно (не обязательно выжидать столь точные промежутки времени).

Как написать свой таймер Найти похожие ветки