Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

потоки и таймер

AKMTT © (2006-01-08 23:07:00)
Доброго времени суток. Мне нужно сделать следующее: после запуска программы проходит некоторое время, к примеру 1 секунда, выполняется некторое действие. Делаю так:
type TGameRead=class(TThread) protected procedure Execute;override; procedure Tic; end; procedure TGameRead.execute; begin repeat synchronize(Tic); until Terminated end;procedure TGameRead.Tic; begin ..... Beep; end; ... T1:=TGameRead.Create(false); T1.Priority:=tpLowest;
Код взят из одной статьи.
Но 1ых, он работает не сразу после запуска, а через некоторый промежуток времени, и как проследить что прошла 1а секунда?
Проще говоря мне нужно заменить обычный таймер, чем-нибудь другим, не используя VCL

begin...end (2006-01-09 09:26:00) [1]
CreateWaitableTimer

Piter (2006-01-08 23:41:00) [2]
Я честно говоря не понял.

Автору нужно отсчитать сколько прошло времени? Тогда GetTickCount.

Или нужно сделать свой таймер средствами WinApi? Тогда вот:

Вопрос: как создать таймер средствами Win32Api

Ответ: нужно воспользоваться функцией SetTimer, описанной в Windows.pas следующим образом:

function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT; lpTimerFunc: TFNTimerProc): UINT; stdcall;

hWnd- указатель на окно, куда будут посылаться сообщения WM_TIMER при очередной итерации таймера
nIDEvent- задает идентификатор таймера, не должен быть ноль. Игнорируется системой, если hWnd равно нулю
uElapse- время в миллисекундах между итерациями таймера
lpTimerFunc- указатель на процедеру TimepProc, которая должна являться callback функцией и которая будет вызываться системой при каждой итерации таймера

Видно, что существую два пути задания таймера - или задать окно hWnd, куда будут посылаться сообщения WM_TIMERкаждые uElapseмиллисекунд, или задать указатель на процедуру lpTimerFunc, которая будет вызываться системой каждые uElapseмиллисекунд.

1) Рассмотрим первый вариант:

procedure TForm1.Button1Click(Sender: TObject); begin if SetTimer(Handle, 1, 1000, nil)=0 then ShowMessage('Не удалось создать таймер!'); end;

При успешном создании таймера, функция SetTimerвернет индентификатор таймера, который мы сами и задали - 1.
Если таймер создать не удалось - функция вернет ноль.
Если таймер создан, то экземпляру TForm1 каждые 1000 миллисекунд (1 секунду) будет посылаться сообщение WM_TIMER. Естественно, нужно это сообщение обрабатывать. У TForm1объявить метод:

TForm1 = class(TForm) ... procedure WMTImer(var Msg: TMessage); message WM_TIMER; ...

И реализовать:

procedure TForm1.WMTImer(var Msg: TMessage); begin beep; end;

Каждую секунду будем издавать звуковой сигнал.

Чтобы удалить таймер, нужно вызвать функцию KillTimer, передав ей Handleокна и идентификатор таймера (которые указывали при создании таймера) .

KillTimer(Handle, 1);

Стоит заметить, что если в очереди потока стоит хотя бы одно необработанное сообщение от таймера - то новое сообщение от таймера в очередь помещаться не будет. Мicrosoft, наверное, это сделал специально, чтобы исключить забиение очереди необработанными сообщениями какого-то не в меру шустрого таймера по отношению к обработчикам остальных сообщений

2) теперь рассмотрим второй варинт, на основе процедуры TimerProc. Вызов будет такой:

idTimer := SetTimer(0, 0, 1000, @TimerProc); if idTimer=0 then ShowMessage('Не удалось создать таймер!');

В качестве указателя на окно пишем ноль, во второй параметр пишем что хотим (все равно игнорируется), третий - время итераций, четвертый - указатель на процедуру TimerProc, которая будет вызываться системой каждые 1000 миллисекунд. Где-то должна быть объявлена и реализована эта процедура TimerProc(получается, что это callback процедура, значит соглашение о вызове должно быть stdcall, не забывайте):

procedure TimerProc(wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; begin beep; end;

Где wnd- указатель на окно, которое передали функции SetTimer(в нашем случае ноль); Msg- номер сообщения (оно будет равно WM_TIMER); idEvent- идентификатор таймера (тоже значение, которое вернет SetTimerи которое записано в idTimer); Time- время в миллисекундах, которое прошло с момента загрузки Windows на момент генерации этого события таймера (данное значение эквивалентно тому, что возвращает функция GetTickCount).

Делает этот код тоже самое, что и первый пример - издает сигнал каждую секунду. При этом никакие передаваемые аргументы я не анализирую. Хотя, например, можно создать два таймера и назначить им одинаковую TimerProc. А различать вызовы от одного и другого таймеров по значению idEvent.

Значение, возвращаемое функцией SetTimerсохраняется в какую-нибудь переменную idTimer: UINT. Это нужно, чтобы потом можно было удалить таймер, так как во втором примере id таймера назначется системой.

Стоит отметить, что функция TimerProcвызывается системой в контексте того потока, который вызвал функцию SetTimerдля установки таймера. Причем вызов TimerProcпроисходит неявно при вызове приложением функции DispatchMessage, поэтому если приложение не делает выборки и диспетчеризации сообщений - то вызова SetTimerне будет.

Чтобы удалить таймер, надо просто вызвать функию KillTimer, передав ей Handle окна (который указывали при создании таймера) и идентификатор таймера (которое вернула система).

KillTimer(0, idTimer);

3) Есть еще и третий вариант - не указывать ни handle окна, ни процедуру TimerProc:

idTimer := SetTimer(0, 0, 1000, nil);

Тогда система просто будет посылать сообщение WM_Timerв очередь потока, который вызвал SetTimer.
В главном потоке отловить такое сообщение можно назначив обработку Application.OnMessage:

... Application.OnMessage := OnAppMessage; ... procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean); begin if Msg.message = WM_TIMER then begin beep; Handled := True; end; end;

При этом какой бы цикл выборки сообщений в потоке не был - нельзя допускать вызова DispatchMessage, так как ведь у этого сообщения Handle=0, а значит оно не будет диспетчеризировано. Поэтому до Application.OnMessageэто сообщение "доходит", а вот до Application.DefaultHandlerне дойдет.

Файл проекта с данными примерами можно загрузить ЗДЕСЬ

Отвечали: Piter, Ihor Osov'yak

AKMTT (2006-01-08 23:30:00) [3]
Ладно, всем спасибо, на GetTickCount остановился, ничего лучшего не нашел :(

EvS (2006-01-08 23:27:00) [4]
http://www.cracklab.ru/pro/delphi/Winapifa.php#00086D

AKMTT (2006-01-08 23:19:00) [5]
ClockRate := QW.QuadPart;
Вот в этой строчке возникает ошибка:Record, object or class type required

VirEx (2006-01-08 23:14:00) [6]
{

Имя файла: HRTimer.PAS V1.00
Создан: Апр 17 1997, 06:40, автор John Mertus
Обновлен #6: Окт 12 1997, 10:56 John Mertus

Оболочка для таймера высокой точности при создании приложений под
Win95/WinNT

Var
HRT : THRTimer

HRT := THRTimer.Create;
HRT.StartTimer; Сброс таймера в ноль
HRT.ReadTimer; Возвращает отсчитанное время в миллисекундах
начиная со времени старта

HRT.Free;

Список изменений
Версия 1.00 - Первый выпуск
}

{-----------------Модуль HRTimer-------------------John Mertus Апрель 97---}

Unit HRTimer;

{-------------------Объявления-------------------------------}

interface

Uses Windows;

Type

THRTimer = Class(TObject)
Constructor Create;
Function StartTimer : Boolean;
Function ReadTimer : Double;

private
StartTime : Double;
ClockRate : Double;

public
Exists : Boolean;

End;

{--------------------------Реализация-----------------------------------}

implementation

{------------------Create-------------------------John Mertus----Мар 97-}

Constructor THRTimer.Create;

{ Получаем точное системное время и сохраняем его для дальнейшего }
{ использования. }
{ }
{***********************************************************************}
Var

QW : TLargeInteger;

BEGIN

Inherited Create;
Exists := QueryPerformanceFrequency(QW);
ClockRate := QW.QuadPart;
END;

{------------------StartTimer---------------------John Mertus----Мар 97-}

Function THRTimer.StartTimer : Boolean;

{ Получаем точное системное время и сохраняем его для дальнейшего }
{ использования. }
{ }
{***********************************************************************}
Var

QW : TLargeInteger;

BEGIN

Result := QueryPerformanceCounter(QW);
StartTime := QW.QuadPart;
END;

{-------------------ReadTimer---------------------John Mertus----Мар 97---}

Function THRTimer.ReadTimer : Double;

{ Получаем точное системное время и сохраняем его для дальнейшего }
{ использования. }
{ }
{***********************************************************************}
Var

ET : TLargeInteger;

BEGIN

QueryPerformanceCounter(ET);
Result := 1000.0*(ET.QuadPart - StartTime)/ClockRate;
END;

end.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »