Пауза при выполнениии кода

[Alexey-VB]

Требуется временная задержка выполнения кода.
Тоесть код должен в одном месте сделать паузу, но при этом должны выполняться и другие функции.
Пробовал вот так:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

..........
DoEvents
Sleep (5000)
....................

Но в момент паузы вся прога останавливается, а мне нужно что бы только функция была в паузе.

Использование Timer отпадает, так как это будет громоздко. Потому как у меня много таких пауз и в разных функциях.

Плиз хелп.

[alibek]

Тем не менее, либо таймер, либо второй поток.

[Neonikus]

Да лучше всего Таймером

[keks-n]

Народ, не мудрите... Таймеры, потоки... Неужели так сложно сделать это:

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



Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub Wait(dwMilliseconds As Long)
Dim cnt As Long, LTime As Long
LTime = GetTickCount
Do While cnt < dwMilliseconds
DoEvents
cnt = cnt + GetTickCount - LTime
LTime = GetTickCount
Loop
End Sub

[hCORe]

Несложно то несложно, но вот загрузка ЦП 100%. А так все ничего...

[AlexBlack]

тогда так:

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


Do
  Sleep( t_dis )
  t = t + t_dis
  If ( t > t_max ) Then Exit Do
Loop


[tyomitch]

тогда так:

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

Do
  Sleep( t_dis )
  t = t + t_dis
  If ( t > t_max ) Then Exit Do
Loop


И в чём тогда отличие от одного большого слипа?

[keks-n]

hCORe
В результате копипаста и последовавшей очистки от табов и пробелов слип потерялся

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

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub Wait(dwMilliseconds As Long)
Dim cnt As Long, LTime As Long
LTime = GetTickCount
Do While cnt < dwMilliseconds
DoEvents
Sleep 1
cnt = cnt + GetTickCount - LTime
LTime = GetTickCount
Loop
End Sub

[hCORe]

Вот-вот, теперь гораздо лучше. Хотя мне все равно больше нравится таймер

[AntonGV]

Я делал так:

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

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Delay(MilliSeconds As Long)
Dim old As Single
old = Timer
Do While (Timer - old) < MilliSeconds / 1000
   DoEvents
   Sleep 1
Loop
End Sub

зы. Чуть проще чем у keks-n

[JohnK]

А если замутить что-то с флагом?
Тоесть в функции где нужна пауза:

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

...
if Delay_Flag then exit sub (function)
...


А потом, смотря по какому условию у тебя идет пауза:

1) можно по таймеру

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

Sub Timer1() ' Интервал 1000
nCount=nCount+1
if nCount>60 then
  nCount=0
  Delay_Flag= not Delay_Flag
end if
....


2) Вручную

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

Sub Command_Click ' Кнопка Пауза
  Delay_Flag= not Delay_Flag
...