Option Explicit
 
Private Type msg
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    ptX As Long 'Pointapi.X
    ptY As Long 'Pointapi.Y
End Type
 
Private Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" ( _
     ByRef lpMsg As msg, _
     ByVal hwnd As Long, _
     ByVal wMsgFilterMin As Long, _
     ByVal wMsgFilterMax As Long) As Long
 
Private Declare Function TranslateMessage Lib "user32.dll" ( _
     ByRef lpMsg As msg) As Long
 
Private Declare Function DispatchMessage Lib "user32.dll" Alias _
  "DispatchMessageA" ( _
     ByRef lpMsg As msg) As Long
 
Private Declare Function PostQuitMessage Lib "user32.dll" ( _
     ByVal nReturnCode As Long) As Long
 
Private Declare Function CreateTimerQueue Lib "kernel32.dll" () As Long
 
Private Declare Function CreateTimerQueueTimer Lib "kernel32.dll" ( _
    ByRef hTimerQ As Long, _
    ByVal hQueue As Long, _
    ByVal pCallBack As Long, _
    ByVal lParam As Long, _
    ByVal nDuration As Long, _
    ByVal nPeriote As Long, _
    ByVal nFlags As Long) As Long
 
Private Declare Function DeleteTimerQueue Lib "kernel32.dll" ( _
     ByVal TimerQueue As Long) As Long
 
Private Declare Function DeleteTimerQueueTimer Lib "kernel32.dll" ( _
     ByVal TimerQueue As Long, _
     ByVal Timer As Long, _
     ByVal CompletionEvent As Long) As Long
 
 
Private hQueue As Long
Private hTimerQ As Long
Private mes As msg
 
Private Function GetFooAddress(pFunctionpointer As Long) As Long
    'Result des AddressOf Operator
    GetFooAddress = pFunctionpointer
End Function
 
Private Function WaitForTimer(lParam As Long, ByVal nWhat As Long) As Long
    DeleteTimerQueueTimer hQueue, hTimerQ
    DeleteTimerQueue hQueue
 
    '-> Funktion die GetMessage killt ... fehlt
End Function
 
 
Public Sub WaitforMyTime(ByVal nMilliseconds As Long)
 
    hQueue = CreateTimerQueue
    CreateTimerQueueTimer hTimerQ, hQueue, GetFooAddress(AddressOf _
      WaitForTimer), 0, nMilliseconds, 0, 0
 
    Do While GetMessage(mes, 0, 0, 0)
       TranslateMessage mes
       DispatchMessage mes
    Loop
 
End Sub