Задержка?

[_Vasya]

Нужно создать задержку на указаное количество миллисукунд, типа Delay() в Delphi???
Ел. упр. Timer плохо работает с интервалом в 1 миллисекунду а функция Timer возвращает только сотые секунды???
Может кто знает как это зделать???

Заранее благодарен.

[alibek]

GetTickCount или использовать мультимедийный таймер.

[Konst_One]

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

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

Public Sub Idle(Optional msec As Long = 0)
Dim EndTime As Long
  EndTime = GetTickCount() + msec
  Do
    DoEvents
    Sleep 1
  Loop While GetTickCount() < EndTime
End Sub



[_Vasya]

Спасибо
Иду пробовать

[_Vasya]

А

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

Sleep 1

там зачем?

[Konst_One]

Это собственно и есть задержка в выполнении проги на 1 мс

[_Vasya]

А это

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

Loop While GetTickCount() < EndTime

тогда зачем?, там все и без Sleep задерживает.

Но обидно то, что Sleep 1 в самом деле задерживает на 15-16 мс.

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

        t1 = GetTickCount
        Sleep 1
        MsgBox  GetTickCount - t1

выдаёт 15

Что делать

[alibek]

Вот для того и надо, чтобы точнее задерживать.

[_Vasya]

Да, без sleep 1 точнее.

Но вопрос уже в том как сделать задержку именно на 1 мс. При задании sleep 1 задерживает на 10-16, (на другом компе на 10)

Как зделать именно на 1 мс., так чтобы было точно на каждом компе???

[alibek]

Дубль: используй мультимедийный таймер.

[_Vasya]

Мультимедийный таймер это какой???

[_Vasya]

Т. е. я хотел сказать как им пользоваться?
Может кто знает, помогите!

[alibek]

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

'API-Guide
'This project requires a Form and a Module
'On the form, there should be one command button (Command1)
'and one Timer (Timer1)

'In the form:
Option Explicit
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Command1.Caption = "Start"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Stop the timers if they're still counting
    timeKillEvent hMMTimer
    Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
    'increment VBTimer
    VBTimer = VBTimer + 1
End Sub
Private Sub Command1_Click()
    If Command1.Caption = "Start" Then
        'Start both timers
        Timer1.Interval = 1
        Timer1.Enabled = True
        hMMTimer = timeSetEvent(1, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        Command1.Caption = "Stop"
    Else
        'Stop both timers
        timeKillEvent hMMTimer
        Timer1.Enabled = False
        Command1.Caption = "Start"
        'Show result
        MsgBox "Timer1_Timer was called " & VBTimer & " times;" & vbNewLine & "TimerProc was called " & MMTimer & " times."
        VBTimer = 0
        MMTimer = 0
    End If
End Sub
'In a module
Option Explicit
Public Const TIME_ONESHOT = 0  'Event occurs once, after uDelay milliseconds.
Public Const TIME_PERIODIC = 1  'Event occurs every uDelay milliseconds.
Public Const TIME_CALLBACK_EVENT_PULSE = &H20  'When the timer expires, Windows calls thePulseEvent function to pulse the event pointed to by the lpTimeProc parameter. The dwUser parameter is ignored.
Public Const TIME_CALLBACK_EVENT_SET = &H10  'When the timer expires, Windows calls theSetEvent function to set the event pointed to by the lpTimeProc parameter. The dwUser parameter is ignored.
Public Const TIME_CALLBACK_FUNCTION = &H0   'When the timer expires, Windows calls the function pointed to by the lpTimeProc parameter. This is the default.
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public VBTimer As Long, MMTimer As Long
Public hMMTimer As Long
Sub TimerProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    'Increment MMTimer
    MMTimer = MMTimer + 1
End Sub


[_Vasya]

Примного благодарен