VBA Tipp: Sexagesimale Berechnungen

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Es sollen Winkel im Bogenmaß, Stundenwinkel und Zeitintervalle in ihre entsprechenden sexagesimalen Einheiten hin- und zurückkonvertiert werden. Optional soll der Sekundenanteil flexibel auf Vor- und Nachkommaanteile skaliert werden können.

Lösung

Verwende folgenden Code in einem allgemeinen VBA-Modul:

'Quelle: http://www.dbwiki.net/
 
Option Explicit
 
'2 * Pi (Kreiszahl)
Private Const D2PI   As Double = 6.28318530717959
 
'Sekunden zu Bogenmaß
Private Const DS2R   As Double = 7.27220521664304E-05
 
'Bogensekunden zu Bogenma0
Private Const DAS2R  As Double = 4.84813681109536E-06
 
'Sekunden je Tag
Private Const DAYSEC As Double = 86400#
 
 
'Zerlegen von Bogenmaß in Stunden, Minuten, Sekunden, Bruchteil
Public Sub Angle2HMSF(ByVal ndp As Long, _
                      ByVal angle As Double, _
                      ByRef sign As String, _
                      ByRef hmsf() As Long)
 
   'Eingabe:
   'ndp     Long     Auflösung (number of decimal places)
   'angle   Double   Winkel im Bogenmaß
 
   'Rückgabe:
   'Rückgabe:
   'sign    String   "+" oder "-"
   'HMSF    Long()   Stunden, Minuten, Sekunden, Bruchteil
 
   'Das Argument ndp wird wie folgt interpretiert:
   ' ndp resolution
   '  :      ...0000 00 00
   ' -7         1000 00 00
   ' -6          100 00 00
   ' -5           10 00 00
   ' -4            1 00 00
   ' -3            0 10 00
   ' -2            0 01 00
   ' -1            0 00 10
   '  0            0 00 01
   '  1            0 00 00.1
   '  2            0 00 00.01
   '  3            0 00 00.001
   '  :            0 00 00.000...
 
   'Der größte sinnvolle Wert für ndp wird durch die Größe des Winkels, das
   'Format von Double auf der Zielplattform und das Risiko des Überlaufens von
   'HMSF(3) bestimmt.  Auf einer typischen Plattform gilt für angle <= 2*Pi,
   'dass die verfügbare Gleitkommapräzision ndp = 12 betragen kann.  Die prak-
   'tische Grenze ist jedoch typischerweise ndp = 9, bedingt durch die Kapazi-
   'tät eines Long Integer.
 
   'Der absolute Wert von angle kann 2*Pi überschreiten.  In Fällen, in denen
   'dies nicht der Fall ist, ist es Sache des Anwenders, den Fall zu prüfen
   'und zu behandeln, in dem angle sehr nahe bei 2*Pi liegt und bis zu 24 Stun-
   'den beträgt, indem er HMSF(0) auf 24 überprüft und durch Setzen von
   'HMSF(0-3) auf Null eine Korrektur durchführt.
 
   'Skalieren und Methode Days2HMSF() verwenden
   Days2HMSF ndp, angle / D2PI, sign, hmsf
 
End Sub
 
 
'Stunden, Minuten, Sekunden in Bogenmaß umrechnen
Public Function HMSF2Angle(ByVal sign As String, _
                           ByVal hr As Long, _
                           ByVal min As Long, _
                           ByVal sec As Double, _
                           ByRef rad As Double) As Long
 
   'Eingabe:
   'sign    String   Vorzeichen:  "-" = negativ, sonst positive
   'hr      Long     Stunden
   'min     Long     Minuten
   'sec     Double   Sekunden
 
   'Rückgabe:
   'rad     Double   Winkel im Bogenmaß
   'Funktionswert    Status
   '                 0 = OK
   '                 1 = hr außßerhalb von 0..23
   '                 2 = min außerhalb von 0..59
   '                 3 = sec außerhalb von 0..59,999...
 
   'Das Ergebnis wird auch dann berechnet, wenn eine der Bereichsprüfungen
   'fehlschlägt.
 
   'Negative hr, min und/oder sec Werte bewirken einen Warnstatus. Bei der
   'Konvertierung wird jedoch der Absolutwert verwendet.
 
   'Bei mehreren Fehlern spiegelt der Statuswert nur den ersten Fehler wider,
   'der kleinste Fehler hat also Vorrang.
 
   'Intervall in Sekunden bestimmen
   rad = IIf(sign = "-", -1#, 1#) * _
         (60# * (60# * Abs(hr) + _
                 Abs(min)) + _
                 Abs(sec)) * DS2R
 
   ' Argumente und Rückgabestatus validieren
   If hr < 0 Or hr > 23 Then
      HMSF2Angle = 1
   ElseIf min < 0 Or min > 59 Then
      HMSF2Angle = 2
   ElseIf sec < 0# Or sec >= 60# Then
      HMSF2Angle = 3
      'Else  'standard
      '   HMSF2Angle = 0
   End If
 
End Function
 
 
'Zerlegen von Bogenmaß in Grad, Bogenminuten, Bogensekunden, Bruchteil
Public Sub Angle2DMSF(ByVal ndp As Long, _
                      ByVal angle As Double, _
                      ByRef sign As String, _
                      ByRef dmsf() As Long)
 
   'Eingabe:
   'ndp     Long     Auflösung (number of decimal places)
   'angle   Double   Winkel im Bogenmaß
 
   'Rückgabe:
   'Rückgabe:
   'sign    String   "+" oder "-"
   'DMSF    Long()   Grad, Bogenminuten, Bogensekunden, Bruchteil
 
   'Das Argument ndp wird wie folgt interpretiert:
   ' ndp resolution
   '  :      ...0000 00 00
   ' -7         1000 00 00
   ' -6          100 00 00
   ' -5           10 00 00
   ' -4            1 00 00
   ' -3            0 10 00
   ' -2            0 01 00
   ' -1            0 00 10
   '  0            0 00 01
   '  1            0 00 00.1
   '  2            0 00 00.01
   '  3            0 00 00.001
   '  :            0 00 00.000...
 
   'Der größte sinnvolle Wert für ndp wird durch die Größe des Winkels, das
   'Format von Double auf der Zielplattform und das Risiko des Überlaufens von
   'HMSF(3) bestimmt.  Auf einer typischen Plattform gilt für angle <= 2*Pi,
   'dass die verfügbare Gleitkommapräzision ndp = 12 betragen kann.  Die prak-
   'tische Grenze ist jedoch typischerweise ndp = 9, bedingt durch die Kapazi-
   'tät eines Long Integer.
 
   'Der absolute Wert von angle kann 2*Pi überschreiten.  In Fällen, in denen
   'dies nicht der Fall ist, ist es Sache des Anwenders, den Fall zu prüfen
   'und zu behandeln, in dem angle sehr nahe bei 2*Pi liegt und bis zu 360
   'Grad beträgt, indem er HMSF(0) auf 360 überprüft und durch Setzen von
   'HMSF(0-3) auf Null eine Korrektur durchführt.
 
   'Stunden in Grad * Bogenmaß in Umdrehungen
   Const FACTOR As Double = 15# / D2PI
 
   'Skalieren und Methode Days2HMSF() verwenden
   Days2HMSF ndp, angle * FACTOR, sign, dmsf
 
End Sub
 
'Grad, Bogenminuten, Bogensekunden in Bogenmaß umrechnen
Public Function DMSF2Angle(ByVal sign As String, _
                           ByVal deg As Long, _
                           ByVal amin As Long, _
                           ByVal asec As Double, _
                           ByRef rad As Double) As Long
 
   'Eingabe:
   'sign    String   Vorzeichen:  "-" = negativ, sonst positive
   'deg     Long     Grad
   'amin    Long     Bogenminuten
   'asec    Double   Bogensekunden
 
   'Rückgabe:
   'rad     Double   Winkel im Bogenmaß
   'Funktionswert    Status
   '                 0 = OK
   '                 1 = deg außßerhalb von 0..359
   '                 2 = amin außerhalb von 0..59
   '                 3 = asec außerhalb von 0..59,999...
 
   'Das Ergebnis wird auch dann berechnet, wenn eine der Bereichsprüfungen
   'fehlschlägt.
 
   'Negative deg, amin und/oder asec Werte bewirken einen Warnstatus. Bei der
   'Konvertierung wird jedoch der Absolutwert verwendet.
 
   'Bei mehreren Fehlern spiegelt der Statuswert nur den ersten Fehler wider,
   'der kleinste Fehler hat also Vorrang.
 
   'Berechne das Intervall
   rad = IIf(sign = "-", -1#, 1#) * _
         (60# * (60# * Abs(deg) + _
                 Abs(amin)) + _
                 Abs(asec)) * DAS2R
 
   ' Argumente und Rückgabestatus validieren
   If deg < 0 Or deg > 359 Then
      DMSF2Angle = 1
   ElseIf amin < 0 Or amin > 59 Then
      DMSF2Angle = 2
   ElseIf asec < 0# Or asec >= 60# Then
      DMSF2Angle = 3
   'Else  'standard
   '   DMSF2Angle = 0
   End If
End Function
 
 
'Zerlegen von Tagen in Stunden, Minuten, Sekunden, Bruchteil
Public Sub Days2HMSF(ByVal ndp As Long, _
                     ByVal days As Double, _
                     ByRef sign As String, _
                     ByRef hmsf() As Long)
 
   'Eingabe:
   'ndp     Long     Auflösung (number of decimal places)
   'days    Double   Intervall in Tagen
 
   'Rückgabe:
   'sign    String   "+" oder "-"
   'HMSF    Long()   Stunden, Minuten, Sekunden, Bruchteil
 
   'Das Argument ndp wird wie folgt interpretiert:
   ' ndp resolution
   '  :      ...0000 00 00
   ' -7         1000 00 00
   ' -6          100 00 00
   ' -5           10 00 00
   ' -4            1 00 00
   ' -3            0 10 00
   ' -2            0 01 00
   ' -1            0 00 10
   '  0            0 00 01
   '  1            0 00 00.1
   '  2            0 00 00.01
   '  3            0 00 00.001
   '  :            0 00 00.000...
 
   'Der größte sinnvolle Wert für ndp wird durch die Größe der Tage, das Format
   'von Double auf der Zielplattform und das Risiko des Überlaufens von HMSF(3)
   'bestimmt.  Auf einer typischen Plattform gilt für days <= 1, dass die ver-
   'fügbare Gleitkommapräzision ndp = 12 betragen kann.  Die praktische Grenze
   'ist jedoch typischerweise ndp = 9, bedingt durch die Kapazität eines Long
   'Integer.
 
   'Der absolute Wert der Tage kann 1,0 überschreiten.  In Fällen, in denen
   'dies nicht der Fall ist, ist es Sache des Anwenders, den Fall zu prüfen und
   'und zu behandeln, in dem days sehr nahe bei 1,0 liegt und bis zu 24 Stunden
   'dauern kann, indem er auf HMSF(0) = 24 testet und dann HMSF(0-3) auf Null
   'setzt.
 
   Dim i     As Long
   Dim nrs   As Long
   Dim a     As Double
   Dim w     As Double
   Dim ahr   As Double
   Dim amin  As Double
   Dim asec  As Double
   Dim afrac As Double
   Dim rhr   As Double
   Dim rmin  As Double
   Dim rsec  As Double
 
   'vorzeichen bestimmen
   sign = IIf(days > 0#, "+", "-")
 
   'Intervall in Sekunden bestimmen
   a = DAYSEC * Abs(days)
 
   'Vorrunden, falls die Auflösung gröber als 1 Sekunde ist. (nrs = 1 vorgeben)
   If ndp < 0 Then
      nrs = 1
      For i = 1 To -ndp: nrs = nrs * IIf(i = 2 Or i = 4, 6, 10): Next
      rsec = nrs
      w = a / rsec
      a = rsec * Int(w)
   End If
 
   'Die Einheit jedes Feldes in der Einheit der Auflösung ausdrücken
   nrs = 1
   For i = 1 To ndp: nrs = nrs * 10: Next
   rsec = nrs
   rmin = rsec * 60#
   rhr = rmin * 60#
 
   'Das Intervall runden und in der Einheit der Auflösung ausdrücken
   a = Int(rsec * a)
 
   'In Felder aufbrechen
   ahr = a / rhr
   ahr = Int(ahr)
   a = a - ahr * rhr
   amin = a / rmin
   amin = Int(amin)
   a = a - amin * rmin
   asec = a / rsec
   asec = Int(asec)
   afrac = a - asec * rsec
 
   'Ergebnis zurückgeben
   ReDim hmsf(3)
   hmsf(0) = ahr
   hmsf(1) = amin
   hmsf(2) = asec
   hmsf(3) = afrac
End Sub
 
'Konvertiert Stunden, Minuten, Sekunden in Tage
Public Function HMSF2Days(ByVal sign As String, _
                          ByVal hr As Long, _
                          ByVal min As Long, _
                          ByVal sec As Double, _
                          ByRef days As Double) As Long
 
   'Eingabe:
   'sign    String   Vorzeichen:  "-" = negativ, sonst positive
   'hr      Long     Stunden
   'min     Long     Minuten
   'sec     Double   Sekunden
 
   'Rückgabe:
   'days    Double   Intervall in Tagen
   'Funktionswert    Status
   '                 0 = OK
   '                 1 = hr außßerhalb von 0..23
   '                 2 = min außerhalb von 0..59
   '                 3 = sec außerhalb von 0..59,999...
 
   'Das Ergebnis wird auch dann berechnet, wenn eine der Bereichsprüfungen
   'fehlschlägt.
 
   'Negative hr, min und/oder sec Werte bewirken einen Warnstatus. Bei der
   'Konvertierung wird jedoch der Absolutwert verwendet.
 
   'Bei mehreren Fehlern spiegelt der Statuswert nur den ersten Fehler wider,
   'der kleinste Fehler hat also Vorrang.
 
   'Berechne Intervall
   days = IIf(sign = "-", -1#, 1#) * _
          (60# * (60# * Abs(hr) + _
                  Abs(min)) + _
                  Abs(sec)) / DAYSEC
 
   ' Argumente und Rückgabestatus validieren
   If hr < 0 Or hr > 23 Then
      HMSF2Days = 1
   ElseIf min < 0 Or min > 59 Then
      HMSF2Days = 2
   ElseIf sec < 0# Or sec >= 60# Then
      HMSF2Days = 3
   'Else  'standard
   '   HMSF2Days = 0
   End If
End Function

Beispiel

Sub Beispiel()
   Dim j      As Long
   Dim a      As Double
   Dim d      As Double
   Dim s      As String
   Dim hmsf() As Long
   Dim dmsf() As Long
 
   'Winkel im Bogenmaß in Stundenwinkel umrechnen
   Angle2HMSF 4, -3.01234, s, hmsf
   Debug.Print hmsf(0), hmsf(1), hmsf(2), hmsf(3)
   '==>            11       30       22     6484
   Debug.Print s; Format$(hmsf(0), "0:"); _
                  Format$(hmsf(1), "00:"); _
                  Format$(hmsf(2), "00\,"); _
                  Format$(hmsf(3), String$(4, "0"))          '==> -11:30:22,6484
 
 
   'Stundenwinkel in Bogenmaß umrechnen
   j = HMSF2Angle("+", 4, 58, 20.2, a)
   Debug.Print j, a
   '==>        0  1,30173927818954
 
 
   'Winkel im Bogenmaß in Grad, Minuten, Sekunden umrechnen
   Angle2DMSF 4, 2.345, s, dmsf
   Debug.Print s, dmsf(0), dmsf(1), dmsf(2), dmsf(3)
   '==>        +     134       21       30     9706
   Debug.Print s; Format$(dmsf(0), "0°"); _
                  Format$(dmsf(1), "00'"); _
                  Format$(dmsf(2), "00\,"); _
                  Format$(dmsf(3), String$(4, "0") & "\""")  '==> +134°21'30,9706"
 
 
   'Grad, Minuten, Sekunden in Bogenmaß umrechnen
   j = DMSF2Angle("-", 45, 13, 27.2, a)
   Debug.Print a  '-0,789311579431365
 
 
   'Zeitintervall in Stunden, Minuten, Sekunden umrechnen
   Days2HMSF 4, -0.987654321, s, hmsf
   Debug.Print s, hmsf(0), hmsf(1), hmsf(2), hmsf(3)
   '==>        -      23       42       13     3333
   Debug.Print s; Format$(hmsf(0), "00h "); _
                  Format$(hmsf(1), "00m "); _
                  Format$(hmsf(2), "00\,"); _
                  Format$(hmsf(3), String$(4, "0") & "s")    '==> -23h 42m 13,3333s
 
 
   'Zeitintervall in Stunden, Minuten, Sekunden umrechnen (ohne Sekunden)
   Days2HMSF -2, -0.987654321, s, hmsf
   Debug.Print s, hmsf(0), hmsf(1), hmsf(2), hmsf(3)
   '==>        -      23       42        0        0
   Debug.Print s; Format$(hmsf(0), "00h "); _
                  Format$(hmsf(1), "00m "); _
                  Format$(hmsf(2), "00s")                    '==> -23h 42m 00s
 
   'Zeitintervall in Stunden, Minuten, Sekunden umrechnen (ohne einzelne Minuten)
   Days2HMSF -3, -0.987654321, s, hmsf
   Debug.Print s, hmsf(0), hmsf(1), hmsf(2), hmsf(3)
   '==>        -      23       40        0        0
   Debug.Print s; Format$(hmsf(0), "00h "); _
                  Format$(hmsf(1), "00m "); _
                  Format$(hmsf(2), "00s")                    '==> -23h 40m 00s
 
 
  'Stunden, Minuten, Sekunden in Zeitintervall umrechnen
   j = HMSF2Days("+", 23, 55, 10.9, d)
   Debug.Print j, d
   '==>        0  0,996653935185185
 
End Sub