Delay - странный эффект

[visualman]

Код:

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public ExitDelay As Boolean 'Флаг, отвечающий за выход из Delay

Public AutoCheckRun As Boolean 'Флаг сообщает, работает ли автотест
Public ExitAutoCheck As Boolean 'Флаг сообщает, нужно ли закончить автотест

Public Sub Delay(ByVal DelayInSeconds As Long)
Dim StartTimeMark As Long
Dim EndTimeMark As Long

StartTimeMark = GetTickCount
Do While EndTimeMark - StartTimeMark < DelayInSeconds * 60000
If ExitDelay = True Then Exit Sub
DoEvents
EndTimeMark = GetTickCount
Loop
End Sub


Процедура вызова:

Private Sub AutoCheck()
AutoCheckRun = True

Do While ExitAutoCheck = False
Delay 10 'Задержка в 10 минут
MsgBox "трам-пам-пам"
Loop

AutoCheckRun = False
End Sub

Код выводит мессадж каждые 10 минут, до тех пор пока ExitAutoCheck не = True


странный эффект: При вызове AutoCheck и соответственно Delay из неё, проц уходит в 100% загрузки.

Замена на простой таймер не катит, т.к. требуются задержки до нескольких дней.

Подскажите решение, чтобы проц не грузило или альтернативу моему Delay, но с возможностью установки задержки в несколько минут/часов

[Денис]

Замена на простой таймер не катит

Катит - катит
попробуй

Код: Выделить всё

if Variable = #20/01/2008 12:30:00# then 'продолжаем работу

может лучше так?
Эту проверку в таймер, к таймеру флаг, разрешающий остальным процедурам работать и вперед...

P.S. Формат записи даты и времени уточни. Я не уверен, что правильно написал.

[visualman]

может

Код: Выделить всё

if Variable = #20/01/2008 12:30:00# then 'продолжаем работу

лучше так?

P.S. Формат записи даты и времени уточни. Я не уверен, что правильно написал.

бррррр

Или я чего - то не понял.
Никакой привязки ко времени или к чему то ещё не допускается. Считать надо только от StartTimeMark

Код нужно выполнять не в определённое время, а через заданный промежуток, когда бы код не запустили.

[Денис]

тогда

Код: Выделить всё

if Variable = {StartTimeMark + время в часах минутах секундах}  then 'продолжаем работу

[visualman]

Уважаемый Денис, вот описание функции GetTickCount, взятое из API Guide:
The GetTickCount function retrieves the number of milliseconds that have elapsed since Windows was started.

Предложенный Вами подход...... ну ни как не катит ))))

[visualman]

И мне не столько интересно решение, сколько объяснение, почему проц уходит в 100%

[visualman]

Дядюшка Томич, ты самый умный! подскажи!

[BV]

странный эффект: При вызове AutoCheck и соответственно Delay из неё, проц уходит в 100% загрузки.

Не странный, а закономерный.

Замена на простой таймер не катит, т.к. требуются задержки до нескольких дней.

И в чем же проблема? Инкрементируй глобальную или статическую переменную.

[Денис]

visualman
Проц грузится из-за частых вызовов DoEvents. На форуме уже обсуждалось. В поиск.

и, да. Вместо GetTickCount используй Now и все прокатит сразу. Неужели так сложно сообразить? Берем дату и время "сейчас" прибавляем количество часов минут и секунд и ждем назначенного времени. Вы жэ пытаетесь пользоваться инструментами, которые обычно используют для измерения миллисекунд.

Подскажите решение, чтобы проц не грузило или альтернативу моему Delay, но с возможностью установки задержки в несколько минут/часов

[CodeName33]

Он и должен уходить с 100% загруз - DoEvents не даёт ему отдохнуть, она просто проверяет сообщения. Нужно вставить в цикл Sleep хотябы на 10 мс и ничего не будет загружаться:

Код: Выделить всё

Do While EndTimeMark - StartTimeMark < DelayInSeconds * 60000
If ExitDelay = True Then Exit Sub
Sleep 10 '!!!!!
DoEvents
EndTimeMark = GetTickCount
Loop

P.S. Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

[visualman]

Он и должен уходить с 100% загруз - DoEvents не даёт ему отдохнуть, она просто проверяет сообщения. Нужно вставить в цикл Sleep хотябы на 10 мс и ничего не будет загружаться:

Код: Выделить всё

Do While EndTimeMark - StartTimeMark < DelayInSeconds * 60000
If ExitDelay = True Then Exit Sub
Sleep 10 '!!!!!
DoEvents
EndTimeMark = GetTickCount
Loop

P.S. Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

Большое спасибо. Я sleep делал, но с секундной задержкой )) прога зависала и я подумал что sleep не покатит. с 10 ms всё круто работает.