home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / calculat / date_vb.zip / DATE.BAS next >
BASIC Source File  |  1993-09-10  |  3KB  |  90 lines
  1. Option Explicit
  2.  
  3. ' Function ConvertDate (Original As Long) As String
  4. '   Returns a string containing the converted date in Original re-converted into date format.
  5.  
  6. ' Function ConvertDay (Original As Long) As Integer
  7. '   Returns an integer containing the day portion of the converted date in Original.
  8.  
  9. ' Function ConvertDays (MM As Integer, DD As Integer, YY As Integer) As Long
  10. '   Returns a long integer containing a converted date derived from MM, DD, and YY.
  11.  
  12. ' Function ConvertMonth (Original As Long) As Integer
  13. '   Returns an integer containing the month portion of the converted date in Original.
  14.  
  15. ' Function ConvertYear (Original As Long) As Integer
  16. '   Returns an integer containing the year portion of the converted date in Original.
  17.  
  18. Function ConvertDate (Original As Long) As String
  19.     Dim DummyString
  20.     DummyString = ""
  21.     DummyString = DummyString & LTrim$(Str$(ConvertMonth(Original))) & "-"
  22.     DummyString = DummyString & LTrim$(Str$(ConvertDay(Original))) & "-"
  23.     DummyString = DummyString & LTrim$(Str$(ConvertYear(Original)))
  24.     ConvertDate = DummyString
  25. End Function
  26.  
  27. Function ConvertDay (Original As Long) As Integer
  28.     ConvertDay = Original - ConvertDays(ConvertMonth(Original), 0, ConvertYear(Original))
  29. End Function
  30.  
  31. Function ConvertDays (MM As Integer, DD As Integer, YY As Integer) As Long
  32.     Dim AssumedDays As Long, LastYear As Long
  33.     LastYear = (YY - 1)
  34.     AssumedDays = LastYear * 365
  35.     AssumedDays = AssumedDays + LastYear / 4 - LastYear / 100
  36.     AssumedDays = AssumedDays + LastYear / 1000 + (MM - 1) * 28 + DD
  37.     AssumedDays = AssumedDays + ((MM > 2) And (((YY Mod 4 = 0) And (YY Mod 100 <> 0)) Or (YY Mod 1000 = 0)))
  38.     Select Case MM
  39.     Case 1
  40.         AssumedDays = AssumedDays + 0
  41.     Case 2
  42.         AssumedDays = AssumedDays + 3
  43.     Case 3
  44.         AssumedDays = AssumedDays + 3
  45.     Case 4
  46.         AssumedDays = AssumedDays + 6
  47.     Case 5
  48.         AssumedDays = AssumedDays + 8
  49.     Case 6
  50.         AssumedDays = AssumedDays + 11
  51.     Case 7
  52.         AssumedDays = AssumedDays + 13
  53.     Case 8
  54.         AssumedDays = AssumedDays + 16
  55.     Case 9
  56.         AssumedDays = AssumedDays + 19
  57.     Case 10
  58.         AssumedDays = AssumedDays + 21
  59.     Case 11
  60.         AssumedDays = AssumedDays + 24
  61.     Case 12
  62.         AssumedDays = AssumedDays + 26
  63.     End Select
  64.     ConvertDays = AssumedDays
  65. End Function
  66.  
  67. Function ConvertMonth (Original As Long) As Integer
  68.     Dim CounterMonth As Integer, AssumedMonth As Integer, ComputedYear As Integer
  69.     AssumedMonth = 12
  70.     ComputedYear = ConvertYear(Original)
  71.     For CounterMonth = 1 To 11
  72.     If Original < ConvertDays(CounterMonth + 1, 0, ComputedYear) And AssumedMonth = 12 Then
  73.         AssumedMonth = CounterMonth
  74.     End If
  75.     Next
  76.     ConvertMonth = AssumedMonth
  77. End Function
  78.  
  79. Function ConvertYear (Original As Long) As Integer
  80.     Dim CounterYear As Integer, AssumedYear As Integer
  81.     AssumedYear = 2050
  82.     For CounterYear = 1990 To 2049
  83.     If Original < ConvertDays(1, 0, CounterYear) And AssumedYear = 2050 Then
  84.         AssumedYear = CounterYear - 1
  85.     End If
  86.     Next
  87.     ConvertYear = AssumedYear
  88. End Function
  89.  
  90.