2012-01-30 14 views

Odpowiedz

13

W rzeczywistości funkcja timera daje sekund z milisekund. Integer część zwracanej wartości jest liczba sekund od północy i część frakcji można przekształcić w milisekundach - wystarczy pomnożyć przez 1000.

t = Timer 

' Int() behaves exacly like Floor() function, ie. it returns the biggest integer lower than function's argument 
temp = Int(t) 

Miliseconds = Int((t-temp) * 1000) 

Seconds = temp mod 60 
temp = Int(temp/60) 
Minutes = temp mod 60 
Hours = Int(temp/60) 

WScript.Echo Hours, Minutes, Seconds, Miliseconds 

' Let's format it 
strTime =   String(2 - Len(Hours), "0") & Hours & ":" 
strTime = strTime & String(2 - Len(Minutes), "0") & Minutes & ":" 
strTime = strTime & String(2 - Len(Seconds), "0") & Seconds & "." 
strTime = strTime & String(4 - Len(Miliseconds), "0") & Miliseconds 

WScript.Echo strTime 
1

Opierając odpowiedź MBU, oto jest Sub wersja. Spryskuj połączenia z tym kodem wokół wiadomości w bezpośrednim oknie, aby zobaczyć, gdzie opóźnienia występują.

' *** Debug.Print the time with milliseconds, and a message of your choice 
Private Sub DebugPrintTime(strWhereFrom As String) 
On Error GoTo ErrHandler 

    Dim sglTimer As Single 
    Dim sglWholeSecs As Single 
    Dim Millisecs As Variant ' as a variant, Len() will give the length of string representation of this value 
    Dim Seconds As Variant 
    Dim Minutes As Variant 
    Dim Hours As Variant 
    Dim strTime As String 

    sglTimer = timer 
    sglWholeSecs = Int(sglTimer) 
    Millisecs = Int((sglTimer - sglWholeSecs) * 1000) 
    Seconds = sglWholeSecs Mod 60 
    sglWholeSecs = Int(sglWholeSecs/60) 
    Minutes = sglWholeSecs Mod 60 
    Hours = Int(sglWholeSecs/60) 

    strTime = String(2 - Len(Hours), "0") & Hours & ":" 
    strTime = strTime & String(2 - Len(Minutes), "0") & Minutes & ":" 
    strTime = strTime & String(2 - Len(Seconds), "0") & Seconds & "." 
    strTime = strTime & String(3 - Len(Millisecs), "0") & Millisecs 
    Debug.Print strTime, strWhereFrom 

    Exit Sub 
ErrHandler: 
    MsgBox "Error in Sub DebugPrintTime" & vbCrLf & Err.Description & vbCrLf & strWhereFrom 
    Err.Clear 
End Sub 
Powiązane problemy