XProfan

Français

je hoffe la fois, il y a encore aucun entsprechende Include

cette Minuteur verspricht une höhere Genauigkeit, comme qui Profaneigene, bzw. qui normalle API-Minuteur. qui Include selber nécessaire un Callback avec 5 Parametern, sowie un Callback avec 0 Parametern wird je Minuteur nécessaire. il y a zur Zeit alors max. 5 Minuteur possible, qui Source berücksichtigt mais bereits alle 16

avant qui ersten Verwendung qui Funktionen ist toujours TimerInit() aufzurufen, quelle 1 im Erfolgsfalle zurückgibt. Zum aufräumen ist am Ende TimerEnd aufzurufen, qui aussi alle Minuteur killt.

HighResTimer.inc
Kompilieren Marque Séparation

Autor: TS-Soft (Thomas Schulz)
basiert auf C-Source von Danilo Krahn
Unterliegt der LGPL
Def timeGetDevCaps(2) !winmm.dll, timeGetDevCaps
Def timeEndPeriod(1) !winmm.dll, timeEndPeriod
Def timeKillEvent(1) !winmm.dll, timeKillEvent
Def timeSetEvent(5) !winmm.dll, timeSetEvent
Struct TIMECAPS = wPeriodMin&, wPeriodMax&
Declare TimerResolution#
Dim TimerResolution#, TIMECAPS
Declare TimerHandles&[15]
Declare TimerProc&[15]

Proc TimerInit

    Declare Result&
    Result& = timeGetDevCaps(TimerResolution#, SizeOf(TimerResolution#))

    If Result& <> 0

        Return 0  Initialisierung fehlgeschlagen

    Else

        Return 1

    EndIf

EndProc

Proc TimerEnd

    Declare ID%
    timeEndPeriod(TimerResolution#.wPeriodMin&)

    WhileLoop 0, 15

        ID% = &Loop

        If TimerHandles&[ID%] > 0

            timeKillEvent(TimerHandles&[ID%])

        EndIf

    Wend

    Dispose TimerResolution#

EndProc

Proc TimerCallBack

    parameters TimerHwnd&, Message&, TimerID&, wParam&, lParam&

    If TimerProc&[TimerID&] <> 0

        Call(TimerProc&[TimerID&])

    EndIf

EndProc

Proc TimerStart

    parameters TimerID&, Delay&, ProcAddr&

    If TimerID& < 0 Or TimerID& > 15

        Return 0

    Else

        If TimerHandles&[TimerID&] <> 0

            timeKillEvent(TimerHandles&[TimerID&])

        EndIf

        TimerProc&[TimerID&] = ProcAddr&
        TimerHandles&[TimerID&] = timeSetEvent(Delay&, 0, ProcAddr(TimerCallBack, 5), TimerID&, 1)
        Return TimerHandles&[TimerID&]

    EndIf

EndProc

Proc TimerStop

    parameters TimerID&

    If TimerID& < 0 Or TimerID& > 15

        Return 0

    Else

        If TimerHandles&[TimerID&] <> 0

            timeKillEvent(TimerHandles&[TimerID&])
            Return 1

        EndIf

        Return 0

    EndIf

EndProc

Proc TimerGetMinResolution

    Return TimerResolution#.wPeriodMin&

EndProc

Proc TimerGetMaxResolution

    ENDPROC

et maintenant encore une simplen Testcode:
Kompilieren Marque Séparation

 $I HighResTimer.inc

Si TimerInit() = 0  initialisation fehlgeschlagen

    Fin

EndIf

Déclarer Anzahl&
Cls
Imprimer Minimale Minuteur Auflösung:  + Str$(TimerGetMinResolution()),
Imprimer - : - Maximale Minuteur Auflösung:  + Str$(TimerGetMaxResolution())
TimerStart 0, 500, ProcAddr(WieOft, 0)
WaitKey
TimerEnd

Proc WieOft

    Inc Anzahl&
    Imprimer je wurde bereits  + Str$(Anzahl&) +  la fois aufgerufen

ENDPROC