Страницы: 1
RSS
Вопрос по временной задержке в макросе
 
Для управления скоростью шагового двигателя через LPT порт использую вот такую временную задержку между импульсами. Помимо того что такой выбор функции задержки по времени между импульсами останавливается в полночь (00.00.00) интуиция мне подсказывает, что инструмент временной задержки нужно использовать какойто другой.... Подскажите..
Код
' Работа ШД каретки ' 
 For W = 1 To V 
 DlPortWritePortUchar &H378, 0 
 DlPortWritePortUchar &H378, 33 

 PauseTime = O 
 Start = Timer 

 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 34 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 36 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 40 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 Next W
 
artclonic, посмотрите по ссылке
http://www.planetaexcel.ru/forum/?PAGE_NAME=message&FID=8&TID=17782&MID=154749#message154749
Там в конце обсуждения
"Для того, чтобы приостановить выполнение макроса на определённое время, достаточно использовать метод Wait об'екта Application. Далее следуют пять примеров, которые могут остановить выполнение макроса на десять секунд"
Код
Application.Wait Time:=DateAdd("s", 10, Now)
Application.Wait Time:=Now + #12:00:10 AM#
Application.Wait Time:=Now + 10 / 86400
Application.Wait Time:=Now + TimeSerial(0, 0, 10)
Application.Wait Time:=Now + TimeValue("0:00:10" ;) 
 
10 секунд в моем случае - это вечность.... Задержка между импульсами от 0,1 до 0,001 (а может и меньше), какой из 5-ти вариантов приемлен в этом случае...и какой в использовании "легче" для процессора....?
 
А Вы по приведенной ссылке ходили? Там есть и другой пример:
Это от Hugo
Ну и для полноты:
Код
Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long) 

Sub tt() 
    MsgBox 1 
    Sleep 3000 
    MsgBox 2 
End Sub
 
Использование Application.OnTime с задержкой меньше секунды:

Код
Sub ЗапускМакросаСНебольшойЗадержкой() ' по мотивам макроса ZVI_Timer
   ЗадержкаВСекундах = 0.3    ' в секундах
   НазваниеМакроса$ = "test"    ' этот макрос будет запущен через 0.3 сек.
   ЗадержкаВЧасах$ = Replace(Format(CDbl(TimeSerial(0, 0, 1)) * ЗадержкаВСекундах, "0.000000000"), ",", ".")
    macro = "ON.TIME(NOW()+" & ЗадержкаВЧасах$ & ", """ & НазваниеМакроса$ & """)" ' формируем команду запуска
   ExecuteExcel4Macro macro ' macro = ON.TIME(NOW()+0.000003472, "test")
End Sub


Цитата
Задержка между импульсами от 0,1 до 0,001 (а может и меньше)
Excel для такого вам не подойдёт
(он для вычислений создан, а отслеживать тысячные доли секунды - вряд ли сможет)
0,1 сек - ещё ладно, можно сделать (и то, не совсем точно будет), а вот для работы с миллисекундами - это совсем другую программу надо, не на VBA
 
artclonic, функция Timer и API функция GetTickCount обновляется примерно 100 раз в секунду.
Вам нужна другая функция - почитайте http://www.google.ru/search?q=QueryPerformanceCounter+vba
Функция QueryPerformanceCounter обновляется с частотой около 3,5 МГц, причем само значение частоты тоже известно с высокой точностью с помощью функции QueryPerformanceFrequency.
Изменено: Казанский - 04.03.2013 00:20:11
 
Добрый вечер, функция QueryPerformanceCounter  пока  очень сложна для моих познаний в VB...
Попробую использовать в своей программе TimeGetTime, думаю ее осилю с некоторыми подсказками..

Между импульсами примерно так должно выглядеть?

DlPortWritePortUchar &H378, 36

timeGetTime("В")

DlPortWritePortUchar &H378, 40

а "В" - значение в милисекундах
 
Функция timeGetTime не имеет преимуществ в плане разрешающей способности по сравнению с функциями Timer и GetTickCount. Они все обновляются 100 раз в секунду. Вот тестовая программа:
Код
Declare Function timeGetTime Lib "winmm.dll" () As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long

Sub dd()
Dim endTime!, cLoops&
Dim cTimer&, oldTimer!, newTimer!
Dim cTick&, oldTick&, newTick&
Dim cGT&, oldGT&, newGT&
Dim cPC&, oldPC@, newPC@

endTime = Timer + 1
While Timer < endTime
    newTimer = Timer
    If newTimer > oldTimer Then oldTimer = newTimer: cTimer = cTimer + 1
    newTick = GetTickCount
    If newTick > oldTick Then oldTick = newTick: cTick = cTick + 1
    newGT = timeGetTime
    If newGT > oldGT Then oldGT = newGT: cGT = cGT + 1
    QueryPerformanceCounter newPC
    If newPC > oldPC Then oldPC = newPC: cPC = cPC + 1
    cLoops = cLoops + 1
Wend
Debug.Print "Число циклов", cLoops
Debug.Print "Timer", cTimer
Debug.Print "GetTickCount", cTick
Debug.Print "timeGetTime", cGT
Debug.Print "QueryPerf.", cPC

End Sub

Здесь подсчитывается, сколько раз в течение 1 секунды изменилось число, возвращаемое разными функциями для измерения времени.
Мой результат (P3-500, Win2k)
Код
Число циклов   127719 
Timer          100 
GetTickCount   100 
timeGetTime    100 
QueryPerf.     127719

На более быстром компьютере первое и последнее число увеличатся, а остальные останутся прежними (если, конечно, в Win7 или 8 не увеличили разрешающую способность этих таймеров).
Значение QueryPerformanceCounter меняется на самом деле гораздо чаще, данная методика измерений просто не может отследить каждое изменение этой функции.
 
Попробовал в WinXP (Core 2 Duo 1.6 ГГц) - результаты другие!
Код
Число циклов   362059 
Timer          64 
GetTickCount   64 
timeGetTime    997 
QueryPerf.     362059
Получается, что в WinXP timeGetTime "тикает" каждую миллисекунду и эту функцию можно использовать для задания задержки в несколько мс.
А вот Timer и GetTickCount "тикают" реже, чем в Win2k.

Прошу тех, кто имеет Win7 и Win8, прогнать этот код и выложить результат!
Изменено: Казанский - 05.03.2013 13:37:33
 
Win7(32), AMD II X2 245 2.9 ГГц
Код
Число циклов   1534403 
Timer          256 
GetTickCount   65 
timeGetTime    998 
QueryPerf.     1534403
Изменено: RAN - 05.03.2013 14:32:03
 
WinXP P4 2.80GHz, XL2003

Код
Число циклов 530485 
Timer 64 
GetTickCount 64 
timeGetTime 65 
QueryPerf. 530485


timeGetTime хоть и выигрывает - но не много, да и не всегда  :(
Изменено: Hugo - 05.03.2013 14:43:08
 
Да все функции которые обнавляются 100 раз в сек дают одинаковую (ограничительную) скорость вращения моего шагового двигателя...сейчас крутил... а мне надо побыстрее....
Придется грызть QueryPerformanceCounter (может ктото хоть пример откроет поближе к моему случаю)
 
Попробовал в WinXP (Core 2 Duo E8400 3.0 ГГц)
Код
Число циклов   1791993 
Timer          64 
GetTickCount   65 
timeGetTime    989 
QueryPerf.     1791993 
 
RAN, Hugo, спасибо! Неожиданные результаты! Может, это от железа (чипсета) зависит?

artclonic, вот простейший пример задержки с помощью QueryPerformanceCounter:
Код
Sub test1()
Dim pc0@, pc1@, pf@, d#
    'в начале программы, один раз
QueryPerformanceFrequency pf 'получить значение частоты (/10000)
                             'каждую секунду значение счетчика увеличивается на это число
d = 0.5 'задержка в секундах

'начало задержки
QueryPerformanceCounter pc0  'получить начальное значение счетчика
pc1 = pc0 + pf * d           'значение счетчика в конце интервала
Do
    QueryPerformanceCounter pc0
Loop While pc0 < pc1         'цикл, пока значение счетчика не достигнет заданного
'конец задержки
End Sub
Страницы: 1
Наверх