vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Datum/Zeit und Timer · Datums- und Zeitfunktionen   |   VB-Versionen: VB4, VB5, VB610.08.05
Julianisches Datum

Umrechnungen von greg.- und jul Datum in julianischen Tag und zurück

Autor:   Thomas KrohBewertung:     [ Jetzt bewerten ]Views:  13.761 
www.astronomieseite.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Dieser Algorithmus wurde mit Hilfe der entsprechenden Wikipedia - Seite erstellt. Mir war wichtig, dass alle Zwischenergebnisse sichtbar gemacht werden. Auch evtl Korrekturen werden in extra - Labels angezeigt. Viel Spaß damit.

Folgende Steuerelemente werden benötigt:

  1. Command1(0) - Command1(3)
  2. lblJul(0) - lblJul(3)
  3. lblGreg(0) - lblGreg(3)
  4. Combo1(0) - Combo1(5)
  5. Text1 (0)
  6. Text1 (1)
  7. Label1(0) - Label1(3)
  8. Label2(0)
  9. Label2(1)
  10. lblWT(0)
  11. lblWT(1)

Den gesamten Code kopieren und in eine leere Form einfügen. Alle Steuerelemente auf eine Form ziehen. Beschriftung, Größe und Anordnung übernimmt der Code.

Option Explicit
 
Dim Start As Boolean
Private Sub Form_Load()
  ' alle Steuerelemente positionieren
  Dim i As Integer
 
  Start = True
 
  Me.Height = 9930
  Me.Width = 6320
  Me.Caption = "Kalenderberechnungen"
 
  For i = 0 To 2
    Combo1(i).Top = 720
  Next i
 
  For i = 3 To 5
    Combo1(i).Top = 5400
  Next i
 
  For i = 0 To 3
    With Label1(i)
      .Width = 3495
      .Height = 255
      .Left = 240
      .ForeColor = vbBlue
    End With
  Next i
 
  Label1(0).Top = 120
  Label1(0).Caption = "Julianisch -> Julianisches Datum  (JD)"
  Label1(1).Top = 2640
  Label1(1).Caption = "Julianisches Datum -> Julianischer Kalender"
  Label1(2).Top = 4800
  Label1(2).Caption = "Gregorianisch -> Julianisches Datum  (JD)"
  Label1(3).Top = 7320
  Label1(3).Caption = "Julianisches Datum -> Gregorianischer Kalender"
 
  With Combo1(0)
    For i = 1 To 31
      .AddItem Format$(i, "00")
    Next i
    .Width = 615
    .Left = 240
    .Text = "01"
  End With
 
  With Combo1(1)
    For i = 1 To 12
      .AddItem Format$(i, "00")
    Next i
    .Width = 615
    .Left = 1080
    .Text = "01"
  End With
 
  With Combo1(2)
    For i = 1 To 1582
      .AddItem i
    Next i
    .Width = 975
    .Left = 1920
    .Text = 1582
  End With
 
  With Combo1(3)
    For i = 1 To 31
      .AddItem Format$(i, "00")
    Next i
    .Width = 615
    .Left = 240
    .Text = "01"
  End With
 
  With Combo1(4)
    For i = 1 To 12
      .AddItem Format$(i, "00")
    Next i
    .Width = 615
    .Left = 1080
    .Text = "01"
  End With
 
  With Combo1(5)
    For i = 1582 To 2100
      .AddItem i
    Next i
    .Width = 975
    .Left = 1920
    .Text = Right(Date, 4)
  End With
 
  For i = 0 To 1
    Text1(i).Width = 1815
    Text1(i).Height = 285
    Text1(i).Left = 3120
  Next i
 
  Text1(0).Top = 720
  Text1(1).Top = 5400
  Text1(0).Text = ""
  Text1(1).Text = ""
 
  For i = 0 To 1
    lblWT(i).Width = 1335
    lblWT(i).Height = 255
    lblWT(i).Left = 4440
    lblWT(i).Caption = "Wochentag"
  Next i
 
  lblWT(0).Top = 120
  lblWT(1).Top = 4800
 
  For i = 0 To 1
    Label2(i).Height = 255
    Label2(i).Width = 4695
    Label2(i).Left = 240
    Label2(i).Caption = "Tag             Monat        " & _
      "Jahr                    Jul. Datum  (JD)"
  Next i
 
  Label2(0).Top = 480
  Label2(1).Top = 5160
 
  For i = 0 To 3
    With lblJul(i)
      .Height = 614
      .Width = 5655
      .Left = 240
    End With
  Next i
  lblJul(0).Caption = "Zwischenergebnisse"
  lblJul(2).Caption = "Zwischenergebnisse"
  lblJul(1).Caption = "Zwischenergebnisse korrigiert"
  lblJul(3).Caption = "Zwischenergebnisse korrigiert"
 
  lblJul(0).Top = 1200
  lblJul(1).Top = 1920
  lblJul(2).Top = 3000
  lblJul(3).Top = 3720
 
  For i = 0 To 3
    With lblGreg(i)
      .Height = 614
      .Width = 5655
      .Left = 240
    End With
  Next i
  lblGreg(0).Caption = "Zwischenergebnisse"
  lblGreg(2).Caption = "Zwischenergebnisse"
  lblGreg(1).Caption = "Zwischenergebnisse korrigiert"
  lblGreg(3).Caption = "Zwischenergebnisse korrigiert"
 
  lblGreg(0).Top = 5880
  lblGreg(1).Top = 6600
  lblGreg(2).Top = 7680
  lblGreg(3).Top = 8400
 
  For i = 0 To 3
    Command1(i).Height = 255
    Command1(i).Width = 615
    Command1(i).Left = 5280
    Command1(i).Caption = "Start"
  Next i
 
  Command1(0).Top = 720
  Command1(1).Top = 2640
  Command1(2).Top = 5400
  Command1(3).Top = 7320
 
  Start = False
End Sub
Private Sub Combo1_Change(Index As Integer)
  If Start = False Then
    If Combo1(2) <> "-" Then
      If Combo1(2) = 0 Then
        MsgBox "Das Jahr 0 gibt es nicht", vbExclamation, "Kalender"
        Combo1(2) = 1
        Exit Sub
      End If
    End If
  End If
  If Index = 2 Or Index = 5 Then Combo1(Index).ToolTipText = ""
End Sub
Private Sub Combo1_Click(Index As Integer)
  If Combo1(2) <> "-" Then
    If Combo1(2) = 0 Then
      MsgBox "Das Jahr 0 gibt es nicht", vbExclamation, "Kalender"
      Combo1(2) = 1
      Exit Sub
    End If
  End If
  If Index = 2 Or Index = 5 Then Combo1(Index).ToolTipText = ""
End Sub
Private Sub Command1_Click(Index As Integer)
  Dim M    ' Monat
  Dim T    ' Tag
  Dim J    ' Jahr
  Dim MK   ' Monatskorrektur
  Dim SK   ' Schaltjahreskorrektur
  Dim LT   ' Laufender Tag
  Dim LJ   ' Laufendes Jahr
  Dim N4   ' Anzahl der vollen 4-Jahres-Zyklen (N4) seit dem Startjahr
  Dim N1   ' Anzahl der vollen Jahre (N1) im letzten, unvollständigen 4-Jahres-Zyklus
  Dim JD   ' Julianisches Datum nach Joseph Justus Scaliger (1540 - 1609)
  Dim R4   ' Anzahl Tage  des letzten, unvollständigen 4-Jahres-Zyklus berechnet
 
  Dim N400 ' Anzahl der vollen 4-Jahres-Zyklen  seit Startjahr
  Dim R400 ' Anzahl Tage des letzten, unvollständigen 400-Jahres-Zyklus
  Dim N100 ' Anzahl der vollen 100-Jahres-Zyklen des letzten 400-Jahres-Zyklus
  Dim R100 ' Anzahl der vollen Jahre im letzten, unvollständigen 100-Jahres-Zyklus
  Dim JD0  ' Das Julianische Datum des ertsen Januar des Jahres 1 ist JD0 = 1721426
 
  Dim M1
  Dim T1
 
  Select Case Index
    Case 0
      Combo1(2).ToolTipText = ""
      lblJul(0) = ""
      lblJul(1) = ""
 
      ' Das Julianische Datum zählt die Tage seit dem 1. Januar 4713 v. Chr.
      ' (JD = 0) -> 3267 n. Chr. durch
      ' = 7980 Jahre
 
      ' In dieser Rechnung wird das Startjahr des Julianischen Datums
      ' auf 4716 v. Chr. vorverlegt, da die Schaltjahre dann am Ende eines
      ' 4-Jahres-Zyklus liegen und sich sich die Rechnung vereinfacht. Als
      ' laufendes Jahr (LJ) wird die Anzahl Jahre ab diesem Startjahr bezeichnet.
      ' Für 4716 v. Chr. ist LJ=0, für 4715 v. Chr. ist LJ=1 usw.
 
      T = Combo1(0)
      M = Combo1(1)
      J = Combo1(2)
 
      ' Schaltjahr ermitteln
      If IstSchaltjahrJul(Combo1(2)) Then Combo1(2).ToolTipText = "Schaltjahr"
 
      ' Korrekturwert Schaltjahr ermitteln
      If IstSchaltjahrJul(Combo1(2)) And M > 2 Then
        SK = 1
      Else
        SK = 0
      End If
 
      ' Laufendes Jahr ermitteln
      If Combo1(2) < 0 Then
        LJ = 4716 + J   ' (für vorchristliche Jahre)
      Else
        LJ = 4715 + J   ' (für nachchristliche Jahre)
      End If
 
      N4 = Int(LJ / 4)    ' (ganzzahlig)
      N1 = LJ Mod 4       ' Rest dieser Division
 
      ' Monatskorrektur ermitteln
      MK = Monatskorrektur(M)
 
      ' Laufender Tag
      LT = T + 30 * (M - 1) + (SK + MK)
 
      ' Die Umkehrung (Ermittlung des Datums bei gegebenem LT) ist:
      M1 = Int((LT + 1) / 30 + 1) ' (ganzzahlig)
      T1 = LT - 30 * (M1 - 1) - (SK + MK)
 
      ' Julianisches Datum errechnen
      ' (1461 ist die Länge eines 4-Jahres-Zyklus, 365 die Länge eines
      ' Normaljahres.
      ' Die 3 wird von N1 abgezogen, um die Vorverlegung des Startjahres
      ' auszugleichen)
      ' siehe oben in dieser Prozedur
      JD = 1461 * N4 + 365 * (N1 - 3) + LT
 
      ' Zwischenergebnisse eintragen
 
      ' Bei einigen Werten von LT ergibt die Formel für M einen um 1 zu großen Wert.
      ' Das macht sich durch M=13 oder T<1 bemerkbar. In diesen Fällen müssen
      ' die Werte für M und T korrigiert werden.
      ' Falls (M>12) oder (T<1): vermindere M um 1 und berechne T erneut
      If M1 > 12 Or T1 < 1 Then
        lblJul(1).Caption = "M1 = " & M1 & "   T1 = " & T1
        M1 = M1 - 1
        T1 = LT - 30 * (M1 - 1) - (SK + MK)
      End If
 
      lblJul(0) = "T = " & T & "    M = " & M & _
        "    J = " & J & "    SK = " & SK & _
        "    MK = " & MK & "    LT = " & LT & _
        "    LJ = " & LJ & "    (  M = " & M1 & _
        "    T = " & T1 & "  )    N4 = " & N4 & _
        "    N1 = " & N1 & _
        "    ( Probe: N4 x 4 = " & N4 * 4 & " ) "
 
        Text1(0) = JD
        lblWT(0).Caption = Wochentag(Int((JD + 1.5)) Mod 7)
        lblWT(0).ToolTipText = Int((JD + 1.5)) Mod 7
 
      Case 1
        If IsNumeric(Text1(0)) = False Then
          MsgBox "Das Julianische Datum fehlt", vbExclamation, "Kalender"
          Exit Sub
        End If
 
        lblJul(2) = ""
        lblJul(3) = ""
 
        JD = Text1(0)
 
        ' Um ein Datum des Julianischen Kalenders bei gegebenem Julianischen Datum
        ' zu berechnen, werden zunächst die Anzahl der vollen 4-Jahres-Zyklen (N4)
        ' seit dem Startjahr und die Anzahl Tage (R4) des letzten, unvollständigen
        ' 4-Jahres-Zyklus berechnet:
 
        N4 = Int((JD + 1095) / 1461)    ' (ganzzahlig)
        R4 = (JD + 1095) Mod 1461       ' Rest obiger Division
 
        ' (Durch Addition von 1095 (3*365) wird das Startjahr um drei Jahre vorverlegt.)
 
        ' Als nächstes wird die Anzahl der vollen Jahre (N1) des unvollständigen
        ' 4-Jahres-Zyklus berechnet, sowie der laufende Tag (LT) im letzten Jahr:
 
        N1 = Int(R4 / 365) ' (ganzzahlig)
        LT = R4 Mod 365
 
        ' N1 kann zwischen 0 und 3 liegen. Am letzten Tag des Zyklus ergibt die
        ' Rechnung N1=4 und LT=0. In diesem Fall müssen die Werte korrigiert werden:
 
        ' falls (N1=4) setze N1=3 und LT=365
        If N1 = 4 Then
          ' Zwischenergebnis festhalten
          lblJul(3).Caption = "N1 = " & N1
          N1 = 3 And LT = 365
        End If
 
        ' Das laufende Jahr LJ ergibt sich zu:
        LJ = 4 * N4 + N1
 
        ' Die Berechnung der Jahreszahl (J) aus LJ ergibt sich durch:
        If LJ <= 4715 Then J = (4716 - LJ) * -1     ' v. Chr. (für LJ <= 4715)
        If LJ > 4715 Then J = LJ - 4715             ' n. Chr. (für LJ > 4715)
 
        ' Monat ermitteln bei gegebenem LT
        M = Int((LT + 1) / 30 + 1) ' (ganzzahlig)
 
        ' Monatskorrektur ermitteln
        MK = Monatskorrektur(M)
 
        ' Korrekturwert Schaltjahr ermitteln
        If IstSchaltjahrJul(J) And M > 2 Then
          SK = 1
        Else
          SK = 0
        End If
 
        T = LT - 30 * (M - 1) - (SK + MK)
 
        If MK = "" Then MK = "?"
 
        ' Bei einigen Werten von LT ergibt die Formel für M einen um 1 zu großen Wert.
        ' Das macht sich durch M=13 oder T<1 bemerkbar. In diesen Fällen müssen
        ' die Werte für M und T korrigiert werden:
 
        '  falls (M>12) oder (T<1): vermindere M um 1 und berechne T erneut
        If M > 12 Or T < 1 Then
          lblJul(3).Caption = lblJul(3).Caption & "  M = " & M & "   T = " & T
          M = M - 1
          MK = Monatskorrektur(M)
 
          ' Korrekturwert Schaltjahr ermitteln
          If IstSchaltjahrJul(J) And M > 2 Then
            SK = 1
          Else
            SK = 0
          End If
          T = LT - 30 * (M - 1) - (SK + MK)
        End If
 
        lblJul(2).Caption = "N4 = " & N4 & "    R4 = " & R4 & _
          "    N1 = " & N1 & "    LT = " & LT & _
          "    LJ = " & LJ & _
          "    SK = " & SK & "    MK = " & MK & _
          "    J = " & J & "   (  M = " & M & _
          "    T = " & T & "  )   " & T & "." & M & "." & J
 
      Case 2
        Combo1(5).ToolTipText = ""
 
        ' Schaltjahr ermitteln
        If IstSchaltjahrGreg(Combo1(5)) Then Combo1(5).ToolTipText = "Schaltjahr"
        lblGreg(0).Caption = ""
        lblGreg(1).Caption = ""
 
        JD0 = 1721426
 
        T = Combo1(3)
        M = Combo1(4)
        J = Combo1(5)
 
        ' Laufender Tag ermitteln
        ' In dieser Rechnung wird die Tageszählung seit Jahresanfang,
        ' beginnend mit 0, laufender Tag (LT) genannt. Für den 1. Januar
        ' ist LT = 0, für den 31. Dezember LT=365 (Normaljahr) bzw. '
        ' LT=366 (Schaltjahr).
 
        ' Korrekturwert Schaltjahr ermitteln
        If IstSchaltjahrGreg(Combo1(5)) And M > 2 Then
          SK = 1
        Else
          SK = 0
        End If
 
        ' Monatskorrektur ermitteln
        MK = Monatskorrektur(M)
 
        ' Laufender Tag
        LT = T + 30 * (M - 1) + (SK + MK)
 
        ' Die Umkehrung (Ermittlung des Datums bei gegebenem LT) ist:
        M1 = Int((LT + 1) / 30 + 1) ' (ganzzahlig)
        T1 = LT - 30 * (M1 - 1) - (SK + MK)
 
        ' Laufendes Jahr
        ' In dieser Rechnung wird der Anfang des Gregorianischen Kalenders
        ' auf den 1. Januar des Jahres 1 vorverlegt. Dadurch beginnt der
        ' Kalender am Anfang eines 400-Jahres-Zyklus und die Rechnung
        ' vereinfacht sich. Als laufendes Jahr (LJ) wird die Anzahl Jahre ab
        ' diesem Startjahr bezeichnet. Für das Jahr 1 ist LJ=0, für das
        ' Jahr 2 ist LJ=1 usw. Das Julianische Datum dieses Tages ist
        ' JD0 = 1721426.
        LJ = J - 1
 
        ' Zur Berechnung des Julianischen Datums wird die Anzahl der vollen
        ' 400-Jahres-Zyklen (N400) seit dem Startjahr, sowie die Anzahl der
        ' vollen Jahre (R400) im letzten, unvollständigen 400-Jahres-Zyklus
        ' berechnet:
        N400 = Int(LJ / 400)    ' (ganzzahlig)
        R400 = LJ Mod 400
 
        ' Aus R400 wird die Anzahl der vollen 100-Jahres-Zyklen (N100) des
        ' letzten 400-Jahres-Zyklus, sowie die Anzahl der vollen Jahre (R100)
        ' im letzten, unvollständigen 100-Jahres-Zyklus berechnet:
        N100 = Int(R400 / 100)  ' (ganzzahlig)
        R100 = R400 Mod 100
 
        ' Dann wird aus R100 die Anzahl der vollen 4-Jahres-Zyklen (N4) des
        ' letzten 100-Jahres-Zyklus, sowie die Anzahl der vollen Jahre (N1)
        ' im letzten, unvollständigen 4-Jahres-Zyklus berechnet:
        N4 = Int(R100 / 4)      ' (ganzzahlig)
        N1 = R100 Mod 4
 
        ' Das Julianische Datum berechnet sich dann zu:
        JD = JD0 + N400 * 146097 + N100 * 36524 + N4 * 1461 + N1 * 365 + LT
 
        ' Die Zahlen sind die Länge der Zyklen in Tagen. 1461 (3*365+366) für
        ' den 4-Jahres-Zyklus, 36524 (24*1461 + 1460) für den 100-Jahres-Zyklus
        ' und 146097 (3*36524 + 36525) für den 400-Jahres-Zyklus.
        Text1(1) = JD
 
        ' Bei einigen Werten von LT ergibt die Formel für M einen um 1 zu
        ' großen Wert. Das macht sich durch M=13 oder T<1 bemerkbar. In diesen
        ' Fällen müssen die Werte für M und T korrigiert werden
        ' falls (M>12) oder (T<1): vermindere M um 1 und berechne T erneut
        If M1 > 12 Or T1 < 1 Then
          lblGreg(1) = "M1 = " & M1 & "   T1 = " & T1
          M1 = M1 - 1
          T1 = LT - 30 * (M1 - 1) - (SK + MK)
        End If
 
        lblGreg(0).Caption = "T = " & T & "   M = " & M & _
          "    J = " & J & "    SK = " & SK & _
          "    MK = " & MK & "    LT = " & LT & _
          "    LJ = " & LJ & _
          "    N400 = " & N400 & "    R400 = " & R400 & _
          "    N100 = " & N100 & _
          "    N4 = " & N4 & "    N1 = " & N1 & _
          "   ( M = " & M1 & "    T = " & T1 & " )"
 
        lblWT(1).Caption = Wochentag(Int((JD + 1.5)) Mod 7)
        lblWT(1).ToolTipText = Int((JD + 1.5)) Mod 7
 
      Case 3
        If IsNumeric(Text1(1)) = False Then
          MsgBox "Das Julianische Datum fehlt", vbExclamation, "Kalender"
          Exit Sub
        End If
 
        lblGreg(2).Caption = ""
        lblGreg(3).Caption = ""
 
        JD = Text1(1)
        JD0 = 1721426
 
        ' Um ein Datum des Gregorianischen Kalenders bei gegebenem
        ' Julianischen Datum zu berechnen, werden zunächst die Anzahl der
        ' vollen 4-Jahres-Zyklen (N400) seit dem Startjahr und die Anzahl Tage
        ' (R400) des letzten, unvollständigen 400-Jahres-Zyklus berechnet:
        N400 = Int((JD - JD0) / 146097) ' (ganzzahlig)
        R400 = (JD - JD0) Mod 146097
 
        ' Als nächstes wird die Anzahl der vollen 100-Jahres-Zyklen (N100)
        ' des unvollständigen 400-Jahres-Zyklus berechnet, sowie die Anzahl Tage
        ' (R100) des letzten, unvollständigen 100-Jahres-Zyklus:
        N100 = Int(R400 / 36524)        ' (ganzzahlig)
        R100 = R400 Mod 36524
 
        ' Am letzten Tag des Zyklus ergibt die Rechnung N100=4 und R100=0.
        ' In diesem Fall müssen die Werte korrigiert werden:
        If N100 = 4 Then
          ' Zwischenergebnis sichern
          lblGreg(3) = "N100 = " & N100
          N100 = 3 And R100 = 36524
        End If
 
        ' Dann wird die Anzahl der vollen 4-Jahres-Zyklen (N4) des unvollständigen
        ' 100-Jahres-Zyklus berechnet, sowie die Anzahl Tage (R4) des letzten,
        ' unvollständigen 4-Jahres-Zyklus:
        N4 = Int(R100 / 1461)           ' (ganzzahlig)
        R4 = R100 Mod 1461
 
        ' Schließlich wird die Anzahl der vollen Jahre (N1) des unvollständigen
        ' 4-Jahres-Zyklus berechnet, sowie der laufende Tag (LT) im letzten Jahr:
        N1 = Int(R4 / 365)              ' (ganzzahlig)
        LT = R4 Mod 365
 
        ' Am letzten Tag des Zyklus ergibt die Rechnung N1=4 und LT=0.
        ' In diesem Fall müssen die Werte korrigiert werden:
        If N1 = 4 Then
          ' Zwischenergebnis sichern
          lblGreg(3) = lblGreg(3) & "   N1 = " & N1
          N1 = 3 And LT = 365
        End If
 
        ' Das laufende Jahr LJ ergibt sich zu:
        LJ = 400 * N400 + 100 * N100 + 4 * N4 + N1
 
        ' Die Berechnung der Jahreszahl (J) aus LJ ergibt sich durch:
        J = LJ + 1
        lblGreg(2).Caption = lblGreg(2).Caption & "    LJ = " & LJ & "    J = " & J
 
        ' Monat ermitteln bei gegebenem LT
        M = Int((LT + 1) / 30 + 1) ' (ganzzahlig)
 
        ' Monatskorrektur ermitteln
        MK = Monatskorrektur(M)
 
       ' Korrekturwert Schaltjahr ermitteln
       If IstSchaltjahrGreg(J) And M > 2 Then
         SK = 1
       Else
         SK = 0
       End If
 
       T = LT - 30 * (M - 1) - (SK + MK)
 
       If MK = "" Then MK = "?"
 
       ' Bei einigen Werten von LT ergibt die Formel für M einen um 1 zu
       ' großen Wert. Das macht sich durch M=13 oder T<1 bemerkbar. In diesen
       ' Fällen müssen die Werte für M und T korrigiert werden:
 
       ' falls (M>12) oder (T<1): vermindere M um 1 und berechne T erneut
       If M > 12 Or T < 1 Then
         lblGreg(3) = lblGreg(3) & "  M = " & M & "   T = " & T
         M = M - 1
         ' Monatskorrektur ermitteln
         MK = Monatskorrektur(M)
 
         ' Korrekturwert Schaltjahr ermitteln
         If IstSchaltjahrGreg(J) And M > 2 Then
           SK = 1
         Else
           SK = 0
         End If
         T = LT - 30 * (M - 1) - (SK + MK)
       End If
 
       lblGreg(2).Caption = "N400 = " & N400 & "    R400 = " & R400 & _
         "    N100 = " & N100 & "    R100 = " & R100 & _
         "    N4 = " & N4 & "    R4 = " & R4 & "    N1 = " & N1 & _
         "    LT = " & LT & "    LJ = " & LJ & "    J = " & J & _
         "    MK = " & MK & "  (  T = " & T & "    M = " & M & ")" & _
         "   " & T & "." & M & "." & J
  End Select
End Sub
Function IstSchaltjahrGreg(ByVal Jahreszahl As Double) As Boolean
  IstSchaltjahrGreg = (Jahreszahl Mod 4 = 0 And _
    (Jahreszahl Mod 100 <> 0 Or Jahreszahl Mod 400 = 0))
End Function
Function IstSchaltjahrJul(ByVal Jahreszahl As Double) As Boolean
  If Jahreszahl < 0 Then
    ' Vorchristliche Jahre
    IstSchaltjahrJul = (Jahreszahl Mod -4 = -1)
  Else
    ' Nachchristliche Jahre
    IstSchaltjahrJul = (Jahreszahl Mod 4 = 0)
  End If
End Function
Private Function Monatskorrektur(ByVal M As Integer) As Integer
  ' Monatskorrektur ermitteln
  Select Case M
    Case 1, 4, 5
      Monatskorrektur = -1
    Case 2, 6, 7
      Monatskorrektur = 0
    Case 3
      Monatskorrektur = -2
    Case 8
      Monatskorrektur = 1
    Case 9, 10
      Monatskorrektur = 2
    Case 11, 12
      Monatskorrektur = 3
  End Select
End Function
Private Function Wochentag(ByVal n As Integer) As String
  ' Wochentag
  Select Case n
    Case 0
      Wochentag = "Sonntag"
    Case 1
      Wochentag = "Montag"
    Case 2
      Wochentag = "Dienstag"
    Case 3
      Wochentag = "Mittwoch"
    Case 4
      Wochentag = "Donnerstag"
    Case 5
      Wochentag = "Freitag"
    Case 6
      Wochentag = "Samstag"
  End Select
End Function

Dieser Tipp wurde bereits 13.761 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel