Option Compare Database
Private Type periode
begin As Variant
end As Variant
End Type
Private Const C_DAY_IN_SEC As Long = 86400
'
Public Function getNightHours(ByVal iBegin As Date, ByVal iEnd As Date) As String
getNightHours = convertSecoundsToTimeString(getNightHoursInSec(iBegin, iEnd))
End Function
Public Function getNightHoursInSec(ByVal iBegin As Date, ByVal iEnd As Date) As Variant
'Nacht definieren
Const C_NIGHT_BEGIN = "00:00:00"
Const C_NIGHT_END = "06:00:00"
Dim night As periode
Dim shift As periode
Dim secounds As Long
night = createPerode(C_NIGHT_BEGIN, C_NIGHT_END)
shift = createPerode(iBegin, iEnd)
getNightHoursInSec = min(night.end, shift.end) - max(night.begin, shift.begin)
If Sgn(getNightHoursInSec) = -1 Then getNightHoursInSec = 0
End Function
'/**
' * Erstellt eine Zeit-Periode
' * @param Date Startzeit Time(hh:nn:ss)
' * @param Date Endzeit Time(hh:nn:ss)
' * @return periode
' */
Private Function createPerode(ByVal iBegin As Date, ByVal iEnd As Date) As periode
With createPerode
.begin = convertTimeToSecounds(iBegin)
.end = convertTimeToSecounds(iEnd)
'Falls die Startzeit hinter der Endzeit liegt, den Wert degieren (Periode geht über Mitternacht)
If iBegin > iEnd Then .begin = .begin - C_DAY_IN_SEC
End With
End Function
'/**
' * Konvertiert Time (hh:nn:ss) in Sekunden
' * @param Date Time(hh:nn:ss)
' * @return Long Anzahl Sekunden
' */
Public Function convertTimeToSecounds(ByVal iTime As Date) As Variant
convertTimeToSecounds = DateDiff("s", CDate("00:00:00"), iTime)
End Function
'/**
' * Konvertiert Sekunden in Time (hh:nn:ss)
' * @param Date Anzahl Sekunden
' * @return Long Time(hh:nn:ss)
' */
Public Function convertSecoundsToTimeString(ByVal iSecounds As Variant) As String
Dim time As Date
Dim dateInHours As Variant
time = Format(iSecounds / C_DAY_IN_SEC, "dd.mm.yyyy hh:nn:ss")
dateInHours = Fix(iSecounds / C_DAY_IN_SEC)
convertSecoundsToTimeString = dateInHours + Hour(time) & ":" & Format(time, "nn:ss")
End Function
'/**
' * Gibt den Höheren von 2 Werten zurück
' * @param Variant Wert 1
' * @param Variant Wert 2
' * @return Variant der Grössere Wert
' */
Private Function max(ByVal iValue1 As Variant, ByVal iValue2 As Variant) As Variant
If iValue1 > iValue2 Then
max = iValue1
Else
max = iValue2
End If
End Function
'/**
' * Gibt den Tieferen von 2 Werten zurück
' * @param Variant Wert 1
' * @param Variant Wert 2
' * @return Variant der Kleinere Wert
' */
Private Function min(ByVal iValue1 As Variant, ByVal iValue2 As Variant) As Variant
If iValue1 < iValue2 Then
min = iValue1
Else
min = iValue2
End If
End Function