purebasic.info

PureBasic forum
Текущее время: Пн дек 10, 2018 6:35 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 10 ] 
Автор Сообщение
 Заголовок сообщения: Секундомер
СообщениеДобавлено: Чт дек 06, 2018 3:05 pm 
Не в сети
доцент

Зарегистрирован: Пн мар 30, 2015 5:48 pm
Сообщений: 53
Благодарил (а): 37 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Всем привет!
Сделал секундомер, вот только есть проблема. Он неверно отмеряет время, ошибается процентов на 8 (за минуту отстает примерно на 5 секунд).
В чем может быть причина?

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Global Xwin.w=-1,Ywin.w=-1  ;координаты главного окна
Global mSek.a=0            
Global Sek.a=0              
Global StartSecundomer=0    ;индикатор запуска секундомера
 
Enumeration
  #Window_0
  #TimerSekundomer
  #TextEnumerator
  #ButtonStop
  #ButtonStart
  #ButtonReset
EndEnumeration
 
 
Procedure Secundomer()
  mSek=mSek+1
  If mSek=10
    mSek=0
    Sek=Sek+1
  EndIf
  SetGadgetText(#TextEnumerator, FormatDate("%ii:%ss", Sek) + "." + Str(mSek))
EndProcedure
 
 
Procedure Open_Window_0()                                                  
  winflag=#PB_Window_SystemMenu
  winflag|#PB_Window_MinimizeGadget
  If Xwin<0 Or Ywin<0
    winflag|#PB_Window_ScreenCentered                                      
  EndIf
 
  If OpenWindow(#Window_0, Xwin, Ywin, 150, 100,"Секундомер", winflag)                
    TextGadget(#TextEnumerator, 50, 10, 50, 20, "00:00.0", #PB_Text_Center|#PB_Text_Border)
    ButtonGadget(#ButtonStop, 50,40, 50,25, "Стоп")
      HideGadget(#ButtonStop,1)
    ButtonGadget(#ButtonStart, 50,40, 50,25, "Старт")
    ButtonGadget(#ButtonReset, 50,70, 50,25, "Сброс")
  EndIf
EndProcedure
 
 
Open_Window_0()
 
Repeat                                                ;главный цикл
  Event=WaitWindowEvent()
  Select Event
  ;события гаджетов  
    Case #PB_Event_Gadget                                            
      Select EventGadget()
        Case #ButtonStart                           ;кнопка запуска секундомера "старт"
          StartSecundomer=SetTimer_(#Window_0, #TimerSekundomer, 100, @Secundomer())    ;запуск таймера (10 Гц)          
          HideGadget(#ButtonStart,1)
          HideGadget(#ButtonStop,0)
        Case #ButtonStop                            ;кнопка паузы секундомера "стоп"
          KillTimer_(#Window_0, StartSecundomer)
          StartSecundomer=0                         ;обнуляем индикатор запуска таймера
          HideGadget(#ButtonStop,1)
          HideGadget(#ButtonStart,0)    
        Case #ButtonReset                           ;кнопка сброса секундомера "сброс"
          If StartSecundomer                        ;если секундомер запущен, то
            KillTimer_(#Window_0, StartSecundomer)  ;выключаем таймер
          EndIf
          StartSecundomer=0                         ;обнуляем индикатор запуска таймера
          mSek =0
          Sek  =0                                   ;обнуляем секундомер
          SetGadgetText(#TextEnumerator, "00:00.0")
          HideGadget(#ButtonStop,1)
          HideGadget(#ButtonStart,0)
      EndSelect  
  EndSelect
Until Event = #PB_Event_CloseWindow
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Чт дек 06, 2018 3:37 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11335
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
У таймера кратность шага 15.625 миллисекунд, насколько помню. Из-за этого процедура вызывается не каждые 100 миллисекунд, а через другие промежутки времени.
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
Global Time
 
Procedure Secundomer()
  mSek=mSek+1
  If mSek=10
    mSek=0
    Sek=Sek+1
  EndIf
  SetGadgetText(#TextEnumerator, FormatDate("%ii:%ss", Sek) + "." + Str(mSek))
  x=ElapsedMilliseconds()
  Debug x-Time
  Time=x
EndProcedure


_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Чт дек 06, 2018 4:12 pm 
В сети
профессор

Зарегистрирован: Пт фев 20, 2009 12:57 pm
Сообщений: 1717
Откуда: Алматы
Благодарил (а): 16 раз.
Поблагодарили: 47 раз.
Пункты репутации: 5
и по идее еще зависит от загруженности компьютера. если например писать видео и запустить таймер - то этот таймер тоже по идее будет врать. у меня так если в винампе музыку слушать и в гугель хроме лазить - музыка заикается.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Чт дек 06, 2018 5:18 pm 
Не в сети
доцент

Зарегистрирован: Пн мар 30, 2015 5:48 pm
Сообщений: 53
Благодарил (а): 37 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Спасибо! Подкорректирую код.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 4:25 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 336
Благодарил (а): 1 раз.
Поблагодарили: 10 раз.
Пункты репутации: 0
Цитата:
У таймера кратность шага 15.625 миллисекунд,
Нет Петр, он точно считает.
А почемуже эта зараза чегото постоянно врет, а все очень просто.
Если какойто процесс занял для себя время работы и там например приоритет или запрет на прерывание, то вот тебе и недосчет какихто тиков, вот и получили тик од така.
есть какието другие методики для таймера, один человек целую страницу в инете написал для этого.

вот код мож поможет, но тут нет прерывания
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
maxfreq.q: a.q: b.q
QueryPerformanceFrequency_(@maxfreq)
maxfreq / 1000
 
time$ = ""
QueryPerformanceCounter_(@a.q)
 
;...прога которую проверяем
Delay(1000)
 
QueryPerformanceCounter_(@b.q)
time$ + RSet(StrD((b - a) / maxfreq, 3), 8) + " - прошло времени" + #LF$
Debug time$


Delay всегда грешит, но ближе к секунде и более точнее.

ЕсчЁ, сделай на прерываний так, сделай проверку времени по системном таймеру:ElapsedMilliseconds(), да и учти у него гдето есть переход через ноль.
тем таймером вызывай прерывание, а результат высчитывай этим ElapsedMilliseconds().

Вобщем не нашел, и ссылки нет, чегото у меня неверно прописано, вот и все.

А во чегото нашел, но не на пурике, ну думаю тут не сложно переделать вместе.
Там розборы всех недостатков обычного таймера и чем заменить.
"Мысль о хорошем таймере давно волнует умы программистов. Сразу оговорюсь, что речь не идет о прецизионном, "высокочастотном" иструменте отсчета интервалов времени..."
" Здесь же будет построен просто НАДЕЖНЫЙ ТАЙМЕР общего назначения, который "ТИКНЕТ" ВОВРЕМЯ, ВО ЧТО БЫ ТО НИ СТАЛО."
delphikingdom.com/asp/viewitem.asp?catalogid=434

Но гдето было еще чтото, никак не найду.

_________________
искатель истины


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 4:27 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 336
Благодарил (а): 1 раз.
Поблагодарили: 10 раз.
Пункты репутации: 0
SereZa
Цитата:
если например писать видео и запустить таймер - то этот таймер тоже по идее будет врать.
не просто врать, а ... ну ты и так понял.
в звуке и видео используются предназначеные для этого средства.

_________________
искатель истины


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 4:37 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 336
Благодарил (а): 1 раз.
Поблагодарили: 10 раз.
Пункты репутации: 0
Вот нашел чегото, если нужно сделать задержку высокоточную, менее 1 милисек.

У меня результат:
Цикл сработал(18) раз за 0.0000312889 сек.
без дебугера 23 цикла делает.

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Procedure.s MiniDelay(msek.d) 
  Ctr1.LARGE_INTEGER
  Ctr2.LARGE_INTEGER
  Freq.LARGE_INTEGER
  Overhead.LARGE_INTEGER
  A.l
  i.l
  If QueryPerformanceFrequency_(Freq)
    QueryPerformanceCounter_(Ctr1)
    QueryPerformanceCounter_(Ctr2)
    Overhead\lowpart = Ctr2\lowpart - Ctr1\lowpart  ; determine API overhead
    QueryPerformanceCounter_(Ctr1)                  ; start time loop
    ;Delay(xNum)
    While C.d < msek ; выход из цикла будет только если пройдёт указанное кол-во времени
    a+1
    QueryPerformanceCounter_(Ctr2) ; end time loop
    C.d=(Ctr2\lowpart - Ctr1\lowpart - Overhead\lowpart) / Freq\lowpart
    Wend                ;  
    TimerInfo$ = "Цикл сработал(" + Str(a) + ") раз за " + StrF((Ctr2\lowpart - Ctr1\lowpart - Overhead\lowpart) / Freq\lowpart) + " сек."
    result$ = TimerInfo$
  Else
    result$ = "Error occured"
  EndIf
  ProcedureReturn result$
EndProcedure
 
;- Пример использования - задержка на 0.00003 секунды
 
Debug MiniDelay(0.00003)
MessageRequester("MiniDelay", MiniDelay(0.00003))


А а а, понял тут все тот пример с таймером проца.

_________________
искатель истины


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 4:42 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11335
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
balex1978 писал(а):
он точно считает.
https://stackoverrun.com/ru/q/861809
http://qaru.site/questions/11985578/sle ... k-properly

Delay судя по всему использует timeBeginPeriod и timeEndPeriod. Замени ее на Sleep_(994) и посмотри что получится.

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 4:46 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 336
Благодарил (а): 1 раз.
Поблагодарили: 10 раз.
Пункты репутации: 0
Да Sleep_(4) поточнее считает задержку, но вычислять точно време смещение это непоможет, нужно то что я давал, но это нужно схрестит

_________________
искатель истины


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Секундомер
СообщениеДобавлено: Пт дек 07, 2018 7:55 pm 
Не в сети
профессор

Зарегистрирован: Вс июл 05, 2009 5:55 pm
Сообщений: 336
Благодарил (а): 1 раз.
Поблагодарили: 10 раз.
Пункты репутации: 0
вот держи.
за две минуты у меня твой код показал 1:48, а мой точно.
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
 
Global Xwin.w=-1,Ywin.w=-1  ;координаты главного окна
Global mSek.a=0            
Global Sek.a=0              
Global StartSecundomer=0    ;индикатор запуска секундомера
Global t=0
 
Enumeration
  #Window_0
  #TimerSekundomer
  #TextEnumerator
  #TextEnumerator2
  #ButtonStop
  #ButtonStart
  #ButtonReset
EndEnumeration
 
 
Procedure Secundomer()
  mSek=mSek+1
  If mSek=10
    mSek=0
    Sek=Sek+1
  EndIf
  SetGadgetText(#TextEnumerator, FormatDate("%ii:%ss", Sek) + "." + Str(mSek))
  t2=(ElapsedMilliseconds()-t)
  t3.f=t2/1000
  SetGadgetText(#TextEnumerator2, FormatDate("%ii:%ss", t3)+ "." + Mid(StrF(t3-Int(t3),2) ,3 ,2 ) )
  Debug FormatDate("%ii:%ss", (ElapsedMilliseconds()-t)/1000)
  Debug t3
  Debug t3-Int(t3)
 
EndProcedure
 
 
Procedure Open_Window_0()                                                  
  winflag=#PB_Window_SystemMenu
  winflag|#PB_Window_MinimizeGadget
  If Xwin<0 Or Ywin<0
    winflag|#PB_Window_ScreenCentered                                      
  EndIf
 
  If OpenWindow(#Window_0, Xwin, Ywin, 170, 100,"Секундомер", winflag)                
      TextGadget(#TextEnumerator, 20, 10, 50, 20, "00:00.0", #PB_Text_Center|#PB_Text_Border)
      TextGadget(#TextEnumerator2, 90, 10, 70, 20, "00:00.0", #PB_Text_Center|#PB_Text_Border)
    ButtonGadget(#ButtonStop, 50,40, 50,25, "Стоп")
      HideGadget(#ButtonStop,1)
    ButtonGadget(#ButtonStart, 50,40, 50,25, "Старт")
    ButtonGadget(#ButtonReset, 50,70, 50,25, "Сброс")
  EndIf
EndProcedure
 
 
Open_Window_0()
 
Repeat                                                ;главный цикл
  Event=WaitWindowEvent()
  Select Event
  ;события гаджетов  
    Case #PB_Event_Gadget                                            
      Select EventGadget()
        Case #ButtonStart                           ;кнопка запуска секундомера "старт"
          StartSecundomer=SetTimer_(#Window_0, #TimerSekundomer, 100, @Secundomer())    ;запуск таймера (10 Гц)          
          t=ElapsedMilliseconds()
          HideGadget(#ButtonStart,1)
          HideGadget(#ButtonStop,0)
        Case #ButtonStop                            ;кнопка паузы секундомера "стоп"
          KillTimer_(#Window_0, StartSecundomer)
          StartSecundomer=0                         ;обнуляем индикатор запуска таймера
          HideGadget(#ButtonStop,1)
          HideGadget(#ButtonStart,0)    
        Case #ButtonReset                           ;кнопка сброса секундомера "сброс"
          If StartSecundomer                        ;если секундомер запущен, то
            KillTimer_(#Window_0, StartSecundomer)  ;выключаем таймер
          EndIf
          StartSecundomer=0                         ;обнуляем индикатор запуска таймера
          mSek =0
          Sek  =0                                   ;обнуляем секундомер
          SetGadgetText(#TextEnumerator, "00:00.0")
          HideGadget(#ButtonStop,1)
          HideGadget(#ButtonStart,0)
      EndSelect  
  EndSelect
Until Event = #PB_Event_CloseWindow
 


Правда тебе нужно учесть, что мой кусок обнуляется после остановки, поэтому додумай как доделать

_________________
искатель истины


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 10 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 18


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB