IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Секундомер и delay, от чего зависит задержка?
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 178
Пол: Мужской

Репутация: -  0  +


Есть секундомер
Но что-то он сильно быстро бегает.
В чём может быть проблема?
Код
uses crt;

function Zero (i: integer): string;
var
     s: string[2];
begin
     str (i, s);
     if i < 10 then
          s := '0' + s;
     Zero := s;
end;

procedure ShowTime (t: word);
var
     mm, ss: word;
begin
     mm := t div 60;  { целое кол-во при делении на 60 секунд }
     ss   := t mod 60; {остаток от деления на 60 секунд }
    
     write (mm:2, ':', Zero(ss): 2);
end;

var
     elapsed: word; {истёкшее время}
    
begin
     elapsed := 0;
     while Not Keypressed do
     begin
          inc (elapsed);
          delay (1000); {1 sec = 1000 msec}
          clrscr;
          ShowTime (elapsed);
     end;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(cooler @ 2.05.2009 17:57) *
что-то он сильно быстро бегает.
В чём может быть проблема?
Проблема в том, что delay из TP/BP работает некорректно. Обсуждение этого давно перестало быть актуальным (поищи в FAQе).

Для подобных целей рекомендую использовать GetTime/GetDate. Реализуй свою функцию наподобие такой (раскопал специально для тебя из старых запасов)):
function Timer:LongInt;  {время в сотых долях секунды}
var
m,d,h,mi,s,s1:word;
l:LongInt;
begin
GetDate(h,m,d,mi);GetTime(h,mi,s,s1);l:=d;
Timer:=(((l*24+h)*60+mi)*60+s)*100+s1
end;

И тогда вместо Delay(1000) ставь, например, цикл:
t0:=Timer;
while Timer-t0<100 do;

Хотя, конечно, такой стиль работы - непростительная трата ресурсов..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






cooler, возможно вот такое решение проблемы (только для TP !!!):
{$M $1000,0,0}
Uses Crt,Dos;
Var
OldVect: pointer;
TimerVect: Procedure;
hr, min, sec, hund: word;
second_call: boolean;

Function Beauty(n: Word): String;
var s: string;
begin
str(n, s);
while length(s) < 2 do s := '0' + s;
Beauty := s;
end;
Procedure PrintTime;
begin
clreol;
write(#13,Beauty(hr),':',Beauty(min),':',Beauty(sec));
End;
{$F+}
Procedure MyTimer; interrupt;
begin
if second_call then begin
inc(hund, 11);
if hund >= 100 then begin
dec(hund, 100); inc(sec);
if sec >= 60 then begin
dec(sec, 60); inc(min);
if min >= 60 then begin
dec(min, 60); inc(hr);
if hr >= 24 then dec(hr, 24);
end;
end;
printtime;
end;
end;
Inline ($9C);
TimerVect;
second_call := not second_call;
end;
{$F-}
begin
{ GetTime(hr, min, sec, hund); }
hr := 0; min := 0; sec := 0; hund := 0;
second_call := false;
GetIntVec ($8, @TimerVect);
GetIntVec ($8, OldVect);
SetIntVec ($8, Addr (myTimer));

repeat delay(10); until keypressed;
while keypressed do readkey;

SetIntVec ($8, OldVect);
end.
(вкратце - пишешь свой обработчик прерывания таймера, который вызывается раз в 55 миллисекунд, поэтому если обрабатывать каждый второй тик, то время увеличивается на 11 сотых секунды, а потом уже проверяешь, если больше 100 сотых, то увеличиваешь секунды, потом - минуты, потом - часы)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 178
Пол: Мужской

Репутация: -  0  +


Спасибо, прояснили ситуацию ;)

Сообщение отредактировано: cooler -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 31.10.2020 16:01
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name