XProfan

Italia

Ich hoffe mal, es gibt noch keine entsprechende Include

Dieser Timer verspricht eine höhere Genauigkeit, als der Profaneigene, bzw. der normalle API-Timer. Die Include selber necessario ein Callback mit 5 Parametern, sowie ein Callback mit 0 Parametern wird je Timer necessario. Es sind zur Zeit also max. 5 Timer possibile, der Source berücksichtigt aber bereits alle 16

Vor der ersten Verwendung der Funktionen ist immer TimerInit() aufzurufen, welche 1 im Erfolgsfalle zurückgibt. Zum aufräumen ist am Ende TimerEnd aufzurufen, der auch alle Timer killt.

HighResTimer.inc
Kompilieren Markieren Separieren

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

Und jetzt noch einen simplen Testcode:
Kompilieren Markieren Separieren

 $I HighResTimer.inc

If TimerInit() = 0  Initialisierung fehlgeschlagen

    End

EndIf

Declare Anzahl&
Cls
Print Minimale Timer Auflösung:  + Str$(TimerGetMinResolution()),
Print - : - Maximale Timer Auflösung:  + Str$(TimerGetMaxResolution())
TimerStart 0, 500, ProcAddr(WieOft, 0)
WaitKey
TimerEnd

Proc WieOft

    Inc Anzahl&
    Print Ich wurde bereits  + Str$(Anzahl&) +  mal aufgerufen

EndProc