XProfan

English

I hope time, there's yet no suitable Include

this Timer promising a höhere accuracy, as the Profaneigene, or. the normalle API-Timer. The Include yourself needed one Callback with 5 Parameters, as well as one Callback with 0 Parameters becomes apiece Timer needed. there are to Time means max. 5 Timer possible, the Source berücksichtigt but already any 16

to the first Using the functions is always TimerInit() aufzurufen, which 1 in the Erfolgsfalle zurückgibt. to that straighten up is end TimerEnd aufzurufen, the too any Timer killt.

HighResTimer.inc
Compile Mark Separation

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

and yet a simple Testcode:
Compile Mark Separation

 $I HighResTimer.inc

If TimerInit() = 0  Initialisierung fehlgeschlagen

    End

EndIf

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

Proc WieOft

    Inc Anzahl&
    Print I watts already  + Str $(Anzahl&) +  time called

ENDPROC