Kata Baru

Tentang Pikiran, Perkataan, dan Perbuatan

Menghitung Hari Libur Keagamaan (Islam) dengan VB Classic


Pembaca, kali ini giliran menghitung hari libur Islam, setelah hari libur agama lainnya sudah dibahas di artikel-artikel terdahulu (Kristen, Hindu, Buddha, dan China).

Seperti telah disampaikan sebelumnya, perumusan menghitung hari libur Islam berbeda dengan cara menghitung hari libur lainnya. Untuk menghitung hari libur keagamaan lainnya dapat dilakukan dengan langsung menentukan tanggal Masehi berdasarkan tahun tertentu. Berbeda dengan menghitung hari libur Islam yaitu harus mengkonversi tanggal Masehi menjadi tanggal Hijriyah.


Adakalanya perhitungan konversi dari Masehi ke Hijriyah tidak menghasilkan tanggal yang akurat, oleh karenanya dilakukan metoda penyesuaian lainnya, misal mengkonversi dari tanggal Hijriyah ke Masehi terlebih dulu.

Baiklah, langsung ke prakteknya saja, buatlah sebuah module baru pada IDE VB6 Anda, kemudian ketikkan kode di bawah ini:

Option Explicit

Public IdulFitri As Date
Public IdulFitri2 As Date
Public IdulAdha As Date
Public MaulidNabi As Date
Public TahunBaruHijri As Date
Public IsraMiraj As Date

Public TahunIdulFitri As Long
Public TahunHijriyah As Long
Public TahunIdulAdha As Long
Public TahunMaulid As Long
Public TahunIsraMiraj As Long

Private Function intPart(floatNum)
    Dim lngReturn As Long

    If floatNum < -0.0000001 Then
        intPart = (floatNum - 0.0000001)
    End If

    intPart = Fix(floatNum + 0.0000001)
End Function

Private Function RoundDown(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundDown = CDbl(Left(CStr(dblValue), myDec))
Else
    RoundDown = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Down"
End Function

Private Function RoundUp(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundUp = CDbl(Left(CStr(dblValue), myDec)) + 1
Else
    RoundUp = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Up"
End Function

Private Function Trunc(dblValue As Double) As Long
On Error Resume Next
    Dim strValue As String

    If dblValue = 0 Then
        Trunc = 0
        Exit Function
    End If

    Dim myDec As Integer
    Dim Pisah() As String

    myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)

    If myDec <> 0 Then
        Pisah = Split(CStr(dblValue), ".")
        strValue = Pisah(0)
    Else
        strValue = dblValue
    End If

    Trunc = CLng(strValue)
End Function

Public Function Masehi2Hijri(datMasehi As Date) As Date
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Const intAW As Long = 227016

    Dim intMonth As Integer
    Dim intYear As Integer

    Dim TA(0 To 12) As Integer
    Dim JH(0 To 12) As Integer
    Dim KA(0 To 12) As Integer

    Dim intAM1 As Long
    Dim intAM As Long
    Dim intAH As Long
    Dim intB As Integer
    Dim intThH1 As Integer
    Dim intDayCount As Integer
    Dim intAddYear As Integer
    Dim intTHM2 As Integer
    Dim intSisa As Integer
    Dim intModDay1 As Integer
    Dim intModDay2 As Integer
    Dim intBulan1 As Integer
    Dim x As Integer

    Dim intJmlHari As Integer
    Dim intSisaHari As Integer

    Dim dHijri As Integer
    Dim mHijri As Integer
    Dim yHijri As Integer
    Dim intODay As Integer

    Dim datResult As Date

    dDay = Day(datMasehi)
    dMonth = Month(datMasehi)
    dYear = Year(datMasehi)

    TA(0) = 29:    TA(1) = 30
    TA(2) = 29:    TA(3) = 30
    TA(4) = 29:    TA(5) = 30
    TA(6) = 29:    TA(7) = 30
    TA(8) = 29:    TA(9) = 30
    TA(10) = 29:    TA(11) = 30
    TA(12) = 29

    KA(0) = 0:    KA(1) = 2
    KA(2) = 5:    KA(3) = 7
    KA(4) = 10:    KA(5) = 13
    KA(6) = 16:    KA(7) = 18
    KA(8) = 21:    KA(9) = 24
    KA(10) = 26:    KA(11) = 29
    KA(12) = 32

    JH(0) = 0:    JH(1) = 30
    JH(2) = 59:    JH(3) = 89
    JH(4) = 118:    JH(5) = 148
    JH(6) = 177:    JH(7) = 207
    JH(8) = 236:    JH(9) = 266
    JH(10) = 295:    JH(11) = 325
    JH(12) = 354

    intMonth = IIf(dMonth < 3, dMonth + 12, dMonth)
    intYear = IIf(dMonth < 3, dYear - 1, dYear)

    intAM1 = Int(365.25 * intYear) + _
    Int(30.60001 * (intMonth + 1)) + dDay - 428
    intB = IIf(intAM1 < 577748, 0, 2 - _
    Int(intYear / 100) + Int(Int(intYear / 100) / 4))

    intAM = Int(365.25 * intYear) + _
    Int(30.60001 * (intMonth + 1)) + dDay + intB - 428

    intAH = intAM - intAW
    intThH1 = Int(intAH / 354.3671)

    intModDay1 = Round(intAH - 354.3671 * Int(intAH / 354.3671), 0.5)
    intModDay2 = RoundUp(intAH - 354.3671 * Int(intAH / 354.3671))

    intDayCount = IIf(intAH < 0, intModDay1, intModDay2)
    intAddYear = Int(intDayCount / 365)

    intTHM2 = intThH1 + intAddYear + 1
    intSisa = intDayCount Mod 365

    For x = 1 To 12
        If intSisa >= JH(x - 1) And intSisa <= JH(x) Then
            intBulan1 = x - 1
            Exit For
        End If
    Next

    intJmlHari = JH(intBulan1)
    intSisaHari = intSisa - intJmlHari

    dHijri = IIf(intSisaHari = 0, TA(intBulan1), intSisaHari)
    mHijri = IIf(intSisaHari = 0, intBulan1, _
    IIf((intBulan1 + 1) Mod 12 = 0, 12, (intBulan1 + 1) Mod 12))

    yHijri = intTHM2

    datResult = DateSerial(yHijri, mHijri, dHijri)
    Masehi2Hijri = datResult
End Function

Public Function Hijri2Masehi(datHijri As Date) As Date
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Dim datResult As Date

    Const intAW As Long = 227016

    dDay = Day(datHijri)
    dMonth = Month(datHijri)
    dYear = Year(datHijri)

    Dim intAH As Long
    Dim intAM As Long

    intAH = Trunc((11 * dYear) / 30) + _
            Trunc(354 * dYear) + _
            Trunc(30 * dMonth) - _
            Trunc((dMonth - 1) / 2) + dDay - 384

    intAM = intAH + intAW

    Dim intTHM1 As Long
    Dim intDayCount As Integer
    Dim intAddYear As Integer
    Dim intTHM2 As Long
    Dim intA As Integer
    Dim intB As Integer
    Dim intSisa As Integer

    intTHM1 = Int(intAM / 1461) * 4
    intDayCount = intAM Mod 1461
    intAddYear = Int(intDayCount / 365)

    intTHM2 = intTHM1 + intAddYear + 1
    intA = intDayCount Mod 365
    intB = IIf(intAM < 577748, 0, 2 - Int(intTHM2 / 100) + _
    Int(Int(intTHM2 / 100) / 4))

    intSisa = intA - intB

    Dim JH(0 To 12) As Integer
    Dim JLH(0 To 12) As Integer

    Dim intBulan1 As Integer
    Dim intMatch As Integer
    Dim x As Integer

    JH(0) = 31
    JH(1) = 31
    JH(2) = IIf((((intTHM2 Mod 4) = 0 Or (intTHM2 Mod 100) = 0) _
    Or (intTHM2 Mod 400) = 0), 29, 28)

    JH(3) = 31
    JH(4) = 30
    JH(5) = 31
    JH(6) = 30
    JH(7) = 31
    JH(8) = 31
    JH(9) = 30
    JH(10) = 31
    JH(11) = 30
    JH(12) = 31

    JLH(0) = 0
    JLH(1) = 31

    For x = 2 To 12
       JLH(x) = JLH(x - 1) + JH(x)
    Next

    For x = 1 To 12
        If intSisa >= JLH(x - 1) And intSisa <= JLH(x) Then
            intMatch = x - 1
            Exit For
        End If
    Next

    intBulan1 = IIf(intSisa < 31, 0, intMatch)

    Dim intJmlHari As Integer
    Dim intSisaHari As Integer

    intJmlHari = JLH(intBulan1)
    intSisaHari = intSisa - intJmlHari

    Dim dMasehi As Integer
    Dim mMasehi As Integer
    Dim yMasehi As Long

    dMasehi = IIf(intSisaHari = 0, JH(intBulan1), intSisaHari)
    mMasehi = IIf(intJmlHari = 0, intBulan1, _
    IIf((intBulan1 + 1) Mod 12 = 0, 12, (intBulan1 + 1) Mod 12))
    yMasehi = intTHM2

    datResult = DateSerial(yMasehi, mMasehi, dMasehi)
    Hijri2Masehi = datResult
End Function

Public Function Masehi2Hijri2(ByVal dDate As Date) As Date
    Dim j, k, l, n, jd
    Dim monthName As String
    Dim intDay As Integer, intMonth As Integer, intYear As Integer

    Dim arrFormat() As String
    Dim sSplit As String
    Dim strResult As String
    Dim sDay As String
    Dim sMonth As String
    Dim sYear As String

    intDay = Day(dDate)
    intMonth = Month(dDate)
    intYear = Year(dDate)

    If ((intYear > 1582) Or ((intYear = 1582) And (intMonth > 10)) _
        Or ((intYear = 1582) And (intMonth = 10) And (intDay > 14))) Then
        jd = intPart((1461 * (intYear + 4800 + _
        intPart((intMonth - 14) / 12))) / 4) + _
             intPart((367 * (intMonth - 2 - 12 * _
             (intPart((intMonth - 14) / 12)))) / 12) - _
             intPart((3 * (intPart((intYear + 4900 + _
             intPart((intMonth - 14) / 12)) / 100))) / 4) + intDay - 32075
    Else
        jd = 367 * intYear - intPart((7 * _
        (intYear + 5001 + intPart((intMonth - 9) / 7))) / 4) + _
        intPart((275 * intMonth) / 9) + intDay + 1729777
    End If

    l = jd - 1948440 + 10632
    n = intPart((l - 1) / 10631)
    l = l - 10631 * n + 354

    j = (intPart((10985 - l) / 5316)) * (intPart((50 * l) / 17719)) + _
    (intPart(l / 5670)) * (intPart((43 * l) / 15238))

    l = l - (intPart((30 - j) / 15)) * (intPart((17719 * j) / 50)) - _
    (intPart(j / 16)) * (intPart((15238 * j) / 43)) + 29

    intMonth = intPart((24 * l) / 709)
    intDay = l - intPart((709 * intMonth) / 24)
    intYear = 30 * n + j - 30

    Masehi2Hijri2 = DateSerial(intYear, intMonth, intDay)
End Function

Public Function Hijri2Pasaran(datHijri As Date) As String
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Dim intAH As Long
    Dim intAM As Long
    Dim datResult As Date
    Dim PA(5) As String

    Const intAW As Long = 227016

    dDay = Day(datHijri)
    dMonth = Month(datHijri)
    dYear = Year(datHijri)

    intAH = Trunc((11 * dYear) / 30) + _
            Trunc(354 * dYear) + _
            Trunc(30 * dMonth) - _
            Trunc((dMonth - 1) / 2) + dDay - 384

    intAM = intAH + intAW

    PA(0) = "Wage"
    PA(1) = "Kliwon"
    PA(2) = "Legi"
    PA(3) = "Pahing"
    PA(4) = "Pon"

    Dim intMod As Integer

    intMod = intAM Mod 5
    Hijri2Pasaran = PA(intMod)
End Function

Public Sub Islam(intTahun As Integer)
On Error Resume Next
    Dim x As Integer
    Dim dDate As Date
    Dim datResult As Date
    Dim datHijri(1 To 366) As Date
    Dim datMasehi(1 To 366) As Date

    For x = 0 To 366
        dDate = DateAdd("d", x, DateSerial(intTahun, 1, 1))
        datMasehi(x) = dDate
        datHijri(x) = Masehi2Hijri(dDate)

        If Hijri2Masehi(datHijri(x)) <> datMasehi(x) Then
            datHijri(x) = Masehi2Hijri2(dDate)
            'If Hijri2Masehi(datHijri(x)) <> datMasehi(x) Then
                'datHijri(x) = DateAdd("d", -1, Masehi2Hijri(dDate))
            'End If
        End If

        Select Case Month(datHijri(x))
        Case 1
            If Day(datHijri(x)) = 1 Then
                TahunBaruHijri = datMasehi(x)
            End If
            TahunHijriyah = Year(datHijri(x))
        Case 3
            If Day(datHijri(x)) = 12 Then
                MaulidNabi = datMasehi(x)
            End If
            TahunMaulid = Year(datHijri(x))
        Case 7
            If Day(datHijri(x)) = 27 Then
                IsraMiraj = datMasehi(x)
            End If
            TahunIsraMiraj = Year(datHijri(x))
        Case 10
            If Day(datHijri(x)) = 1 Then
                IdulFitri = datMasehi(x)
            End If
            If Day(datHijri(x)) = 2 Then
                IdulFitri2 = datMasehi(x)
            End If
            TahunIdulFitri = Year(datHijri(x))
        Case 12
            If Day(datHijri(x)) = 10 Then
                IdulAdha = datMasehi(x)
            End If
            TahunIdulAdha = Year(datHijri(x))
        End Select
    Next
End Sub

Baiklah, simpan saja lebih dulu module-module yang sudah Anda buat mulai dari tulisan terdahulu hingga tulisan yang sekarang. Tulisan berikutnya saya akan memaparkan teknik pembuatan kalender dan penggunaan perumusan yang sudah dibahas.

2 responses to “Menghitung Hari Libur Keagamaan (Islam) dengan VB Classic

  1. Mbok Ijah Unyu 30 Januari 2012 14:44 pukul 14:44

    di blog motor ko ada kalender,kripik pisang,nya sih?

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: