title image


Smiley Zeitumwandlung jetzt auch für Millisekunden!
Hallo!



Das Millisekunden-Problem hat mich gereizt, ich habe geforscht und festgestellt, daß die Fließkommazahlen, die Zeitwerte repräsentieren, durchaus fähig sind, auch Millisekunden darzustellen; es fehlt bloß an Umwandlungs- und Anzeige- Funktionen.

Habe also ein paar Funktionen geschrieben, die ähnlich funktionieren (sollen) wie die herkömmlichen Zeitumwandlungsfunktionen:



MTimeserial() analog zu Timeserial()

MTimeFormat() analog zu Format()

MSecond() analog zu Second()

und Millisecond()



Damit sind Aufrufe möglich wie:

Label=MTimeFormat(TimeValue,"hh:mm:ss:§§§"),



wobei '§' der Platzhalter für eine Ziffer der Millisekunden ist. Nebeneffekt: Nur ein '§' stellt Zehntelsekunden dar.



Oder:

Time2 = Time1 + MTimeserial(Hour, Minute, Second, Millisecond)



Habe auch ein totschickes Formular zum Testen gebastelt, kann ich auch vermailen: eckardahlers_at_freenet.de, wobei _at_ natürlich für @ steht.

MTimeFormat(Value,FormatString) funktioniert übrigens nur, wenn man den FormatString ziemlich einfach hält, wenn das jemand verbessern möchte, bitte postet oder mailt es mir wieder.



Also hier mein heutiges Tagewerk:





Option Explicit

Const SekCalcFaktor = 86400                     '       Anzahl der Sek im Tag

Const MSekCalcFaktor = SekCalcFaktor * 1000 '       Anzahl der Millisekunden im Tag



'-----------------------------------------------------------------------------------------------------'

'----------verhält sich wie Timeserial(), erwartet jedoch zusätzlich ein Argument für Millisekunden



Function MTimeserial(ByVal Hour%, ByVal Minute%, ByVal Second%, ByVal MSecond%) As Date

MTimeserial = TimeSerial(Hour, Minute, Second) + MSecond / MSekCalcFaktor

End Function





'-----------------------------------------------------------------------------------------------------'

'--------verhält sich weitgehend wie Format(), interpretiert jedoch zusätzlich das Zeichen '§' _

        als Platzhalter einer Ziffer der Millisekunden eines Zeitwertes. Ist simpel programmiert, _

        interpretiert daher nur das erste Vorkommnis von '§§' (und hat noch andere Bugs).--------



Function MTimeFormat$(ByVal Value, sFormat$, Optional FirstDayOfWeek As VbDayOfWeek = vbSunday, _

                Optional FirstWeekOfYear As VbFirstWeekOfYear = vbFirstJan1)

Dim flTime2#, flMSec#, sStandartTime$, sMSec$, I&, I2&

Dim sFormat3$, sFormat4$, sFormat5$, Ch$

sStandartTime = CDate(Value)

flTime2 = CDate(sStandartTime)          'CDate rundet auf ganze Sekunden

flMSec = Value - flTime2                'Millisekunden ermitteln:

If flMSec < 0 Then                      'falls CDate die ganzen Sekunden aufgerundet hat, ergeben _

                                            sich negative Werte für die Millisekunden

    Value = Value - 1 / SekCalcFaktor       'dann den Sekunden 1 s abziehen

    flMSec = flMSec + 1 / SekCalcFaktor     'und den Millisekunden 1 s zuzählen

End If

MTimeFormat = Format(Value, sFormat, FirstDayOfWeek, FirstWeekOfYear)      'normale Formatfunktion; _

                                                                '§' wird weder gelöscht noch ersetzt

I2 = InStr(MTimeFormat, "§")

If I2 = 0 Then Exit Function

sFormat5 = "."                                                 'bilde mein Sonderformat sFormat5:

For I = 1 To Len(sFormat)                          'für jedes '§' in sFormat wird sFormat5 um '0' _

                                verlängert, sodaß ich ein Format wie ".000" erhalte. '0' ist der _

                                Platzhalter für eine Ziffer hinter dem Komma. Auf diese Weise kann _

                                ich meine Millisekunden durch Format() runden lassen

    If Mid(sFormat, I, 1) = "§" Then

        sFormat5 = sFormat5 & "0"

    End If

Next

sMSec = Format(flMSec * SekCalcFaktor, sFormat5)         'Ich erhalte die Millisekunden im _

                                                            Nachkommastellen-Format, also gerundet

Mid(MTimeFormat, I2) = Mid(sMSec, 2)             ' dieses Ergebnis an die Stelle der '§§' setzen,

'                                                     aber ohne Dezimalpunkt

End Function



'-----------------------------------------------------------------------------------------------------'

Function Millisecond(ByVal Value)

Dim flTime2#, sStandartTime$

sStandartTime = CDate(Value)

flTime2 = CDate(sStandartTime)          'CDate rundet auf ganze Sekunden

Millisecond = Value - flTime2                'Millisekunden ermitteln:

If Millisecond < 0 Then                      'falls CDate die ganzen Sekunden aufgerundet hat, ergeben _

                                            sich negative Werte für die Millisekunden

    Millisecond = Millisecond + 1 / SekCalcFaktor     'dann den Millisekunden 1 s zuzählen

End If

Millisecond = CInt(Millisecond * MSekCalcFaktor)

End Function



'-----------------------------------------------------------------------------------------------------'

'--------Berücksichtigt man in seiner Zeitangabe Millisekunden, so darf die Sekundenangabe nicht _

        mehr aufgerundet werden. Daher muß man die Funktion Second() ersetzen durch MSecond()



Function MSecond(ByVal Value)

Dim flTime2#, sStandartTime$

sStandartTime = CDate(Value)

flTime2 = CDate(sStandartTime)          'CDate rundet auf ganze Sekunden

MSecond = Value - flTime2                'Millisekunden ermitteln:

If MSecond < 0 Then                      'falls CDate die ganzen Sekunden aufgerundet hat, ergeben _

                                            sich negative Werte für die Millisekunden

    Value = Value - 1 / SekCalcFaktor       'dann den Sekunden 1 s abziehen

End If

MSecond = Second(Value)

End Function













 Code eingefügt mit Syntaxhighlighter 1.16





Hoffnung trügt.

(eigentlich dürfte man im Spotlight-VB-Forum keine Fragen stellen, wenn man nicht vorher auf ActiveVB geguckt hat)




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: