Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Здравствуйте!
как сделать таймер в delphi, точнее скорость изменения времени с милисекундами. реализация должна быть через функцию decode time

Вопрос задал: yan yan (статус: Посетитель) Вопрос отправлен: 12 октября 2007, 17:27 Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, yan yan!
Может данная статья Вам чем-то поможет...

Компонент timer (таймер) служит для отсчета интервалов реального времени. Его свойство interval определяет интервал временив миллисекундах , который должен пройти от включения таймера до наступления события ontimer. Таймер включается при установке значения true в его свойство enabled. Единожды включенный таймер все время будет возбуждать события ontimer до тех пор, пока его свойство enabled не примет значения false.
Следует учесть, что в силу специфики реализации стандартного аппаратного таймера ibm-совместимого компьютера минимальный реально достижимый интервал отсчета времени не может быть меньше 55 мс (этот интервал называется тиком), более того, любой интервал времени, отсчитываемый с помощью таймера, всегда кратен 55 мс. Чтобы убедиться в этом, проведите эксперимент, в котором подсчитывается среднее время между двумя срабатываниями таймера (timer.dpr):
Начните новый проект с пустой формой и положите на нее компонент ttimer.
Установите в свойство enabled таймера значение false.
Приложение 1.
Необходимость нескольких (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) иллюстрируется использование мультимедийного таймера Приложение 2.

Ответ отправил: Feniks (статус: Бакалавр) Время отправки: 12 октября 2007, 19:08

Ответ #2. Отвечает эксперт: min@y™

Функция DecodeTime() не имеет отношения к отсчёту времени, она лишь преобразует время из типа TDateTime (с плавающей точкой) в часы, минуты, секкунды и миллисекунды. А вот сделать таймер с точностью 1 мс возможно, сам пробовал. Я воспользовался вот этой статьёй из сброника советов Валентина Озерова:

//Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :
//--------------------------------------------------------------------------------
procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD); stdcall;
begin
  // Тело процедуры.
end;  
 
//а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру
//--------------------------------------------------------------------------------
uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);  
 
//Подробности смотри в Help. Hу и в конце убиваешь таймер
//--------------------------------------------------------------------------------
timeKillEvent(uTimerID);  
 
//И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.
//Обратите внимание на то, что все CALLBACK-функции, вызываемые Windows, должны использовать соглашение о вызовах
stdcall.

Ответ отправил: min@y™ (статус: Доктор наук) Время отправки: 15 октября 2007, 08:27

Мини-форум вопроса

Вадим К (статус: Академик), 12 октября 2007, 17:31 [#1]: можно сделать мультимедийный таймер, но точности сильно не добавит. >>реализация должна быть через функцию decode time Это как? Может сформулируем точнее, что хотим? И не забываем, что Windows не среда реального времени Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 17:40 [#2]: необходимо создать таймер реального времени (настоящее время) с милисекундами, я его сделала. реальное время с милисекундами реализовала с помощью функции decode time. необходим еще и таймер виртуального времени, где я сама смогу изменять скорость времени - ускорять или замедлять, тоже с милисекундами

Вадим К (статус: Академик), 12 октября 2007, 17:52 [#3]: Сформулируйте поточнее. я не понимаю. что понимается под ускорением времени? хотя может вам поможет просто банальное умножение на коэффициент? тоесть. запоминаем начальное время (переменная starttime), и текщее "виртуальное" равно (now-starttime)*coeff Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 18:03 [#4]: при вводе определенного числа виртуальное время должно отличаться от реального времени на это число, в секундах

Вадим К (статус: Академик), 12 октября 2007, 18:26 [#5]: а разве скорость и разница это одного типа величины? подключите в uses юнит DateUtils есть функция function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64 = 1): TDateTime; которое к заданному времени AValue добавит указанное кол-во милисекунд и возратит новое время Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 18:38 [#6]: у меня есть пример работы таймера, подобие которого мне надо создать, с функцией IncMilliSecond, но без милисекунд.

yan yan (статус: Посетитель), 12 октября 2007, 18:40 [#7]: как мне в этом коде исправить функцию IncMilliSecond, чтоб были и секунды unit Timer; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TFTimerGo = class(TForm) RTimer: TTimer; VTimer: TTimer; Label2: TLabel; Sist: TEdit; Virt: TEdit; Change: TEdit; TrackBar1: TTrackBar; RadioGroup1: TRadioGroup; Pause: TRadioButton; Stop: TRadioButton; Start: TRadioButton; Fast: TButton; Slow: TButton; Label1: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; procedure RTimerTimer(Sender: TObject); procedure VTimerTimer(Sender: TObject); procedure SlowClick(Sender: TObject); procedure PauseClick(Sender: TObject); procedure StopClick(Sender: TObject); procedure StartClick(Sender: TObject); procedure FastClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBar1Change(Sender: TObject); private { Private declarations } public { Public declarations } x,tx : TDateTime; p,s : real; vt,dob : integer; end; var FTimerGo: TFTimerGo; x,tx,n : TDateTime; p,s : real; vt,dob : integer; r:single; implementation {$R *.dfm} uses DateUtils; procedure TFTimerGo.RTimerTimer(Sender: TObject); begin tx:=IncMilliSecond(tx,1000); Sist.Text:=timetostr(tx); RTimer.Enabled:=True; RTimer.Interval:=1000; end; procedure TFTimerGo.VTimerTimer(Sender: TObject); begin x:= IncMilliSecond(x,dob); //Прибавление по dob секунд к х с частотой vt Virt.Text:=timetostr(x); end; procedure TFTimerGo.PauseClick(Sender: TObject); begin VTimer.Enabled := False; RTimer.Enabled := False; tx:=StrToTime(Sist.Text); end; procedure TFTimerGo.StopClick(Sender: TObject); begin VTimer.Enabled:=False; RTimer.Enabled:=False; Sist.Text:=''; Virt.Text:=''; p:=1; Change.Text:=FloatToStr(p); end; procedure TFTimerGo.StartClick(Sender: TObject); var a:String; begin a:=Trim(Change.Text); if a='' Then begin //Проверка на ввод текста ShowMessage('Введите ненулевое значение'); Exit; end; if TryStrToFloat(a,r) Then begin a:=FloatToStr(r); end else begin ShowMessage('Введите числовое значение'); Exit; end; if a[1]='-' Then begin //Проверка знака Delete(a,1,1); p := StrToFloat(a); dob:=-1000; end else begin p := StrToFloat(a); dob := 1000; end; if StrToFloat(Trim(Change.Text))=0 Then begin ShowMessage('Введите ненулевое значение'); VTimer.Enabled := False; RTimer.Enabled := False; tx:=StrToTime(Sist.Text); Exit; end; if (p>200) or (p<-200) Then begin ShowMessage('Введимое значение должно быть от -200 до 200'); Exit; end; if p=0 Then begin ShowMessage('Введите ненулевое значение'); VTimer.Enabled := False; RTimer.Enabled := False; tx:=StrToTime(Sist.Text); exit; end; s := 1000/p; vt := trunc(s); //Интервал виртуального таймера VTimer.Enabled := true; VTimer.Interval:=vt; RTimer.Enabled := true; RTimer.Interval:=1000; end; procedure TFTimerGo.FormCreate(Sender: TObject); begin VTimer.Enabled:=True; RTimer.Enabled:=True; TrackBar1.Position := 1; x := now(); tx := now(); dob := 1000; Rtimer.Interval := 1000; Vtimer.Interval := 1000; Change.Text := FloatTostr(TrackBar1.Position); p:=1; end; procedure TFTimerGo.TrackBar1Change(Sender: TObject); begin Change.Text := FloatTostr(TrackBar1.Position); end; procedure TFTimerGo.FastClick(Sender: TObject); var a:String; begin a:=Trim(Change.Text); if TryStrToFloat(a,r) Then begin a:=FloatToStr(r); end else begin ShowMessage('Введите числовое значение'); Exit; end; p := StrToFloat(a); p:=p*2; if (p>200) or (p<-200) Then begin ShowMessage('Вы достигли наибольшего прибавления к виртуальному таймеру'); Exit; end; if p=0 Then begin ShowMessage('Введите ненулевое значение'); VTimer.Enabled := False; RTimer.Enabled := False; tx:=StrToTime(Sist.Text); exit; end; Change.Text:=FloatToStr(p); if p>0 Then begin dob:=1000; end else begin dob:=-1000; end; s:=1000/p; vt:=trunc(s); VTimer.Enabled := true; VTimer.Interval:=vt; RTimer.Enabled := true; RTimer.Interval:=1000; end; procedure TFTimerGo.SlowClick(Sender: TObject); var a:String; begin a:=Trim(Change.Text); if TryStrToFloat(a,r) Then begin a:=FloatToStr(r); end else begin ShowMessage('Введите числовое значение'); Exit; end; p := StrToFloat(a); p:=p/2; if p>1 Then begin dob:=1000; end else begin dob:=-1000; end; if p=0 Then begin ShowMessage('Введите ненулевое значение'); exit; end; s:=1000/p; vt:=trunc(s); VTimer.Enabled := true; VTimer.Interval:=vt; RTimer.Enabled := true; RTimer.Interval:=1000; end; end.

Вадим К (статус: Академик), 12 октября 2007, 18:57 [#8]: во-первых, этот "таймер" будет работать плохо. дело в том, что таймер построен на базе системного таймера Windows и управляется сообщением WM_TIMER. А это сообщение может пропускаться. И это чётко описано в хелпе и мсдн. тоесть, при более-менее нагруженной системе таймер будет отставать. во-вторых. Вот эти строки в обработчике таймера навели меня на грусть... RTimer.Enabled:=True; RTimer.Interval:=1000; смысл сего действия для меня остаётся загадкой. Если таймер сработал, то он уже запущен! но даже если эти строки используются для запуска таймера с другой процедуры, то я бы поменял бы их местами. подумайте, почему. в третих. строка if p=0 Then это плохое сравнения. вещественные числа нельзя сравнивать на "равно" но с другой стороны я могу ввести 0,00001 (кол-во нулей подобрать надо) и будет вам "счастя" в виде большого s. но можно и переполнение сгенерировать дальше if TryStrToFloat(a,r) Then .... a:=FloatToStr(r); .... if a[1]='-' Then Это где такое учят??? не проще ли if r<0 then ---------------- но какие то секунды, то миллисекунды вы ищите, я не понимаю Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 19:10 [#9]: у меня запускается реальное время, например, 19:23:12. ввожу скорость изменения времени, к примеру 2, и виртуальное время становится 19:23:14 и продолжает "убегать" от реального времени на 2секунды. к этому всему мне необходимо добавить еще и милисекунды

Вадим К (статус: Академик), 12 октября 2007, 19:15 [#10]: сделать "отображение" миллисекунд? Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 19:26 [#11]: да

Вадим К (статус: Академик), 12 октября 2007, 19:33 [#12]: так надо было сначала об этом сказать. у вас есть два пути. первый - "разложить" время на составляющие - процедура procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); использовать где то так var y,m,d, h, n, s, ms:word; begin DecodeDateTime(Now,y,m,d, h, n, s, ms); Caption := format('%2d:%2d:%2d.%3d'[h, n, s, ms]); или функцией FormatDateTime Галочка "подтверждения прочтения" - вселенское зло.

yan yan (статус: Посетитель), 12 октября 2007, 19:41 [#13]: я это сделала для реального времени, а с ускорением (изменением) времени возникла проблема

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.