Fungsi-Fungsi Tanggal Visual Basic Tambahan

• Bagaimana menentukan apakah suatu tahun adalah kabisat?
• Bagaimana kita menentukan apakah sekarang sudah akhir bulan, sehingga kita bisa mengingatkan user untuk tutup buku?
• Bagaimana menghitung umur customer, sehingga kita dapat memberi hadiah yang tepat?

'//*******************************************************
'// File Name   : DATE.BAS
'// Module Name : modDate.Bas
'// Description : Contents date functions
'//               that not suported by Visual Basic.
'// Author      : Agus Suhartono(agussmg@n2software.com)
'//               http://agus.cjb.net
'// Date        : 29 June 1998 - 05 May 1999
'//
'// License:
'//    Permission is given without restriction to use and
'//    distribute the program provided that it is not
'//    modified in any way without the author 's permission.
'//
'// Disclaimer:
'//    The author disclaims all liability for its use or
'//    for problems, data corruption, data loss, or other
'//    loss that may result from the use of this program.
'//
'//*******************//

Option Explicit

'// Menentukan apakah suatu tanggal adalah tahun kabisat.
Public Function DateIsLeap(rvDate As Variant) As Boolean
 Dim lYear As Long
  
  '// Cek tipe data parameter.
  If IsDate(rvDate) Then
    lYear = Year(rvDate)
  ElseIf IsNumeric(rvDate) Then
    lYear = CLng(rvDate)
  Else
    Err.Raise 12
    Exit Function
  End If
    
  If ((lYear Mod 4) = 0) And _
                 ((lYear Mod 100) <> 0) Then
     DateIsLeap = True
  ElseIf ((lYear Mod 100) = 0) And _
                  ((lYear Mod 400) = 0) Then
     DateIsLeap = True
  Else
     DateIsLeap = False
  End If
  
End Function

'//  Meng-konversi tanggal ke tanggal terakhir dengan
'//  bulan dan tahun tetep sama. Biasanya digunakan untuk
'//  konfirmasi apakah akan tutup bulan atau tidak ketika
'//  pada akkhir bulan.
Public Function DateToLast(rdtDate As Date) As Date
   DateToLast = DateAdd("d", _
                (DayPerMonth(rdtDate) - Day(rdtDate)), _
                rdtDate)
End Function

'// Meng-konversi tanggal ke tanggal 1 dengan
'// bulan dan tahun tetep sama.
Public Function DateToFirst(rdtDate As Date) As Date
    DateToFirst = DateAdd("d", ((-1 * Day(rdtDate)) - 1), _
                          rdtDate)
End Function

'// Menghitung jumlah hari per bulan.
Public Function DayPerMonth(rdtDate As Date) As Integer
 Dim iMonth As Integer
 Dim iDayPerMonth As Integer
   
   iMonth = Month(rdtDate)
   
   '// Jumlah hari per bulan tergantung
   '   bulan yang bersangkutan.
   Select Case iMonth
     Case 4, 6, 9, 11
        '// Month: 4, 6, 9, 11 = 30 days
        iDayPerMonth = 30
     Case 2
        '// Bulan February  :
        If DateIsLeap(rdtDate) Then
          '// leap = 29 days
          iDayPerMonth = 29
        Else
          '// non leap = 28 days
          iDayPerMonth = 28
        End If
     Case Else
        '// other month= 31 days.
        iDayPerMonth = 31
   End Select
   DayPerMonth = iDayPerMonth
   
End Function

'// Menentukan apakah suatu tanggal berada di akhir bulan.
Public Function IsLastDay(rdtDate As Date) As Boolean
   IsLastDay = (Day(rdtDate) = DayPerMonth(rdtDate))
End Function

'// Menentukan nama bulan dari nomor bulan.
Public Function NumToStrMonth(riMonth As Integer)
 Dim sFormat As String
    NumToStrMonth = _
         Trim( Format(DateSerial(1990, riMonth, 1), _
               "MMMM") _
             )
End Function

'// Konversi Nama bulan ke Angka bulan
Public Function StrMonthToNum(rstrMonth As String) As Integer
 Dim iMonth As String
 Dim i As Integer
    iMonth = 0
    For i = 1 To 12
        If Trim(rstrMonth) = NumToStrMonth(i) Then
          iMonth = i
          Exit For
        End If
    Next
    StrMonthToNum = iMonth
End Function

'// Konversi VB date Type ke SQL date type.
'// Biasanya digunakan untuk membuat SQL dengan parameter
'//  ditentukan oleh user dari textbox.
Public Function DateToSQL(rdtDate As Date) As String
    DateToSQL = "#" & Format(rdtDate, "m/d/yy") & "#"
End Function

'// Konversi Angka bulan ke Angka Romawi.
'// Biasanya digunakan untuk membuat nomor transaksi
'//  yang mengandung bulan. Mis: 01/XI/AGUS/99
Public Function MonthToRoma(Optional rvDate As Variant)
 Dim iMonth As Integer

   If IsMissing(rvDate) Then
      iMonth = Month(Date)
   Else
      Select Case VarType(rvDate)
         Case vbDate
            iMonth = Month(rvDate)
         Case vbInteger
            iMonth = rvDate
      End Select
   End If
       
   Select Case iMonth
       Case 1
          MonthToRoma = "I"
       Case 2
          MonthToRoma = "II"
       Case 3
          MonthToRoma = "III"
       Case 4
          MonthToRoma = "IV"
       Case 5
          MonthToRoma = "VI"
       Case 6
          MonthToRoma = "VII"
       Case 7
          MonthToRoma = "VIII"
       Case 8
          MonthToRoma = "IX"
       Case 10
          MonthToRoma = "X"
       Case 11
          MonthToRoma = "XI"
       Case 12
          MonthToRoma = "XII"
       Case Else
          MonthToRoma = ""
   End Select
   
End Function

'// Konversi VB date type ke Crystal Report date type.
Public Function DateToCrystal(rdtDate As Date) As String
    DateToCrystal = "Date(" & Trim(Str(Year(rdtDate))) & _
                    "," & _
                    Trim(Str(Month(rdtDate))) & _
                    "," & _
                    Trim(Str(Day(rdtDate))) & ")"
End Function

'// Menghitung umur saat ini dari tanggal(lahir) yang 
'//   ditentukan.
Public Function DateToAge(rdtDate As Date) As Integer
 Dim iYear1 As Integer, iMonth1 As Integer, iDay1 As Integer
 Dim iYear2 As Integer, iMonth2 As Integer, iDay2 As Integer
 Dim iAge As Integer

   iYear1 = Year(rdtDate)
   iMonth1 = Month(rdtDate)
   iDay1 = Day(rdtDate)

   iYear2 = Year(Date)
   iMonth2 = Month(Date)
   iDay2 = Day(Date)
   
   iAge = iYear2 - iYear1
   
   If iMonth2 < iMonth1 Then
      iAge = iAge - 1
   ElseIf iMonth2 = iMonth1 Then
      If iDay2 < iDay1 Then
           iAge = iAge - 1
      End If
   End If
   
   DateToAge = iAge
   
End Function