Menghitung Hari Libur Keagamaan
1 Februari 2012 4 Komentar
Jika sebelumnya saya telah membagikan sebuah aplikasi Kalender Indonesia yang dilengkapi dengan hari-hari libur nasional dan keagamaan, dan prakiraan cuti bersama. Nah kali ini saya akan membahasa perumusan untuk menghitung hari libur nasional dan keagamaan yang berlaku di Indonesia.
Ayo, langsung saja ke prakteknya. Jalankan IDE VB6 Anda, buat sebuah project baru, kemudian tambahkan beberapa module pada project Anda, diantaranya:
– basIslam
– basKristen
– basHindu
– basBuddha
– basChina
– basNasional
Oke, tinggal menyalin kode yang berikut ini:
– basIslam
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
– basKristen
Option Explicit
Public Paskah As Date
Public WafatIsa As Date
Public KenaikanIsa As Date
Public Natal As Date
Public TahunBaru As Date
Sub Kristen(intTahun As Integer)
Dim intA As Integer
Dim intB As Integer
Dim intC As Integer
Dim intD As Integer
Dim intE As Integer
Dim intF As Integer
Dim intG As Integer
Dim intH As Integer
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intL As Integer
Dim intM As Integer
Dim intN As Integer
Dim intO As Integer
intA = intTahun Mod 19
intB = intTahun Mod 4
intC = intTahun Mod 7
intH = IIf((intTahun >= 1900 And intTahun <= 2099), 5, 0)
intI = IIf((intTahun >= 2100 And intTahun <= 2199), 6, 0)
intJ = IIf((intTahun >= 2200 And intTahun <= 2299), 0, 0)
intK = intH + intI + intJ
intL = IIf((intTahun >= 1900 And intTahun <= 2099), 24, 0)
intM = IIf((intTahun >= 2100 And intTahun <= 2199), 24, 0)
intN = IIf((intTahun >= 2200 And intTahun <= 2299), 25, 0)
intO = intL + intM + intN
intD = ((19 * intA) + intO) Mod 30
intE = ((2 * intB) + (4 * intC) + (6 * intD) + intK) Mod 7
intF = IIf(intD + intE < 10, 3, 4)
intG = IIf(intD + intE < 10, intD + intE + 22, intD + intE - 9)
Paskah = DateSerial(intTahun, intF, intG)
WafatIsa = DateAdd("d", -2, Paskah)
KenaikanIsa = DateAdd("d", 39, Paskah)
TahunBaru = DateSerial(intTahun, 1, 1)
Natal = DateSerial(intTahun, 12, 25)
End Sub
– basHindu
Option Explicit
Public Nyepi As Date
Public Sub Hindu(iTahun As Integer)
Dim TA(1 To 33) As Integer
Const cTanggal As Integer = 28
Const cBulan As Integer = 3
Dim intBulan As Integer
Dim intTahun As Integer
Dim intAM1 As Long
Dim intKoreksiGr As Long
Dim intH As Long
Dim intN As Long
Dim intI As Integer
Dim Ma As Integer
Dim Mb As Integer
Dim MbMin As Integer
Dim cDateFull As Date
Dim Ya As Integer
Dim Yb As Integer
Dim x As Integer
Dim datMa As Date
Dim datMb As Date
Dim datA1 As Date
Dim datA2 As Date
Dim lngMa As Long
Dim lngMb As Long
Dim intResult As Long
Dim datResult As Date
TA(1) = 0: TA(2) = 30
TA(3) = 60: TA(4) = 89
TA(5) = 119: TA(6) = 148
TA(7) = 178: TA(8) = 207
TA(9) = 237: TA(10) = 266
TA(11) = 296: TA(12) = 325
TA(13) = 355: TA(14) = 384
TA(15) = 414: TA(16) = 443
TA(17) = 473: TA(18) = 502
TA(19) = 532: TA(20) = 562
TA(21) = 591: TA(22) = 621
TA(23) = 650: TA(24) = 680
TA(25) = 709: TA(26) = 739
TA(27) = 768: TA(28) = 798
TA(29) = 827: TA(30) = 857
TA(31) = 886: TA(32) = 916
TA(33) = 945
If cBulan < 3 Then
intBulan = cBulan + 12
Else
intBulan = cBulan
End If
If intBulan < 3 Then
intTahun = iTahun - 1
Else
intTahun = iTahun
End If
intAM1 = Int(365.25 * intTahun) + _
Int(30.60001 * (intBulan + 1)) + cTanggal - 428
If intAM1 < 577748 Then
intKoreksiGr = 0
Else
intKoreksiGr = 2 - Int(intTahun / 100) + _
Int(Int(intTahun / 100) / 4)
End If
intH = Int(365.25 * intTahun) + _
Int(30.60001 * (intBulan + 1)) + cTanggal + _
intKoreksiGr - 428
intN = intH Mod 945
If intN < 351 Then
intI = (intN + 945) - 351
Else
intI = intN - 351
End If
For x = 1 To 33
If TA(x) >= intI Then
Ya = TA(x)
Yb = TA(x - 1)
Exit For
End If
Next
datA1 = DateSerial(iTahun, 3, 31)
datA2 = DateSerial(iTahun, 3, 2)
Ma = Ya - intI + 1
Mb = intI - Yb - 1
MbMin = Mb + 1
cDateFull = DateSerial(intTahun, intBulan, cTanggal)
datMa = DateAdd("d", Ma - 1, cDateFull)
datMb = DateAdd("d", -MbMin, cDateFull)
lngMa = IIf(datMa >= datA1, 0, CLng(datMa))
lngMb = IIf(datMb >= datA2, CLng(datMb), 0)
intResult = lngMa + lngMb
datResult = CDate(intResult)
Nyepi = datResult
End Sub
– basBuddha
Option Explicit
Public Waisak As Date
Private Function iMod(dblValue1, dblValue2) As Double
On Error Resume Next
iMod = dblValue1 - dblValue2 * Int(dblValue1 / dblValue2)
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 Sub Buddha(iTahun As Integer)
Dim intIJST(1 To 2) As Integer
Dim intTanggal(1 To 2) As Integer
Dim intBulan(1 To 2) As Integer
Dim intTahun(1 To 2) As Integer
Dim intTa1(1 To 2) As Integer
Dim intTa2(1 To 2) As Integer
Dim intTa3(1 To 2) As Integer
Const PI As Double = 3.141592654
Dim dblKN(1 To 2) As Double
Dim dblKB(1 To 2) As Double
Dim dblT(1 To 2) As Double
Dim dblK1(1 To 2) As Double
Dim dblK2(1 To 2) As Double
Dim dblK3(1 To 2) As Double
Dim dblK4(1 To 2) As Double
Dim dblK5(1 To 2) As Double
Dim dblK6(1 To 2) As Double
Dim dblK7(1 To 2) As Double
Dim dblM(1 To 2) As Double
Dim dblM1(1 To 2) As Double
Dim dblM2(1 To 2) As Double
Dim dblM3(1 To 2) As Double
Dim dblMA(1 To 2) As Double
Dim dblMA1(1 To 2) As Double
Dim dblMA2(1 To 2) As Double
Dim dblMA3(1 To 2) As Double
Dim dblF(1 To 2) As Double
Dim dblF1(1 To 2) As Double
Dim dblF2(1 To 2) As Double
Dim dblF3(1 To 2) As Double
Dim dblKRA1(1 To 2) As Double
Dim dblKRA2(1 To 2) As Double
Dim dblKRA3(1 To 2) As Double
Dim dblKRA4(1 To 2) As Double
Dim dblKRA5(1 To 2) As Double
Dim dblKRA6(1 To 2) As Double
Dim dblKORA(1 To 2) As Double
Dim dblKRB1(1 To 2) As Double
Dim dblKRB2(1 To 2) As Double
Dim dblKRB3(1 To 2) As Double
Dim dblKRB4(1 To 2) As Double
Dim dblKRB5(1 To 2) As Double
Dim dblKORB(1 To 2) As Double
Dim dblKORB1(1 To 2) As Double
Dim dblKC1(1 To 2) As Double
Dim dblKC2(1 To 2) As Double
Dim dblKC3(1 To 2) As Double
Dim dblKORC(1 To 2) As Double
Dim dblKORC1(1 To 2) As Double
Dim dblKoreksi(1 To 2) As Double
Dim dblJdA1(1 To 2) As Double
Dim dblJdA2(1 To 2) As Double
Dim dblJdA3(1 To 2) As Double
Dim dblJdB1(1 To 2) As Double
Dim dblJdB2(1 To 2) As Double
Dim dblJdB3(1 To 2) As Double
Dim dblJdC1(1 To 2) As Double
Dim dblJdC2(1 To 2) As Double
Dim dblJdC3(1 To 2) As Double
Dim dblJD(1 To 2) As Double
Dim dblZJd(1 To 2) As Double
Dim dblEFJd(1 To 2) As Double
Dim dblAPJd(1 To 2) As Double
Dim dblAJd(1 To 2) As Double
Dim dblBJd(1 To 2) As Double
Dim dblCJd(1 To 2) As Double
Dim dblDJd(1 To 2) As Double
Dim dblEJd(1 To 2) As Double
Dim dblHasilJam(1 To 2) As Double
Dim dblHasilBulan(1 To 2) As Integer
Dim dblHasilTahun(1 To 2) As Integer
Dim dblHasilHari(1 To 2) As Integer
Dim dblHasilPasaran(1 To 2) As Integer
Dim dblTgl1(1 To 2) As Double
Dim dblTgl2(1 To 2) As Double
Dim dblTgl3(1 To 2) As Double
Dim dblTgl4(1 To 2) As Double
Dim dblTgl5(1 To 2) As Double
Dim dblTglM(1 To 2) As Double
Dim dblKT(1 To 2) As Double
Dim dblET1(1 To 2) As Double
Dim dblET2(1 To 2) As Double
Dim dblKET(1 To 2) As Double
Dim dblJDH(1 To 2) As Double
Dim datFull(1 To 2) As Date
Dim datHasil(1 To 2) As Date
intIJST(1) = 0
intTanggal(1) = 5
intBulan(1) = 5
intTahun(1) = iTahun
datFull(1) = DateSerial(intTahun(1), intBulan(1), intTanggal(1))
intTa1(1) = IIf((intTahun(1) Mod 4) = 0, 1, 0)
intTa2(1) = IIf((intTahun(1) Mod 100) = 0, 1, 0)
intTa3(1) = intTa1(1) + intTa2(1)
dblKB(1) = IIf(intTa3(1) > 0, 1, 2)
dblK1(1) = Trunc((275 * intBulan(1)) / 9)
dblK2(1) = Trunc((intBulan(1) + 9) / 12) * dblKB(1)
dblK3(1) = (dblK1(1) - dblK2(1) + intTanggal(1) - 30)
dblK4(1) = (dblK3(1) / 365.25) + (intTahun(1) - 1900)
dblK5(1) = (dblK4(1) * 12.3685)
dblK6(1) = (dblK5(1) - Trunc(dblK5(1)))
dblK7(1) = IIf(dblK6(1) > 0.5, Trunc(dblK5(1) + 1), Trunc(dblK5(1) + 0))
dblKN(1) = IIf(intIJST(1) = 1, (dblK7(1) - 0), (dblK7(1) - 0.5))
dblT(1) = (dblKN(1) / 1236.85)
dblM1(1) = 29.10535608 * dblKN(1)
dblM2(1) = -0.000033 * dblT(1) * dblT(1)
dblM3(1) = -0.00000347 * dblT(1) * dblT(1) * dblT(1)
dblM(1) = iMod(359.2242 + dblM1(1) + dblM2(1) + dblM3(1), 360)
dblMA1(1) = 385.81691806 * dblKN(1)
dblMA2(1) = 0.0107306 * dblT(1) * dblT(1)
dblMA3(1) = 0.00001236 * dblT(1) * dblT(1) * dblT(1)
dblMA(1) = iMod(306.0253 + dblMA1(1) + dblMA2(1) + dblMA3(1), 360)
dblF1(1) = 390.67050646 * dblKN(1)
dblF2(1) = -0.0016528 * dblT(1) * dblT(1)
dblF3(1) = -0.00000239 * dblT(1) * dblT(1) * dblT(1)
dblF(1) = iMod(21.2964 + dblF1(1) + dblF2(1) + dblF3(1), 360)
dblKRA1(1) = 0.1734 - (0.000393 * dblT(1))
dblKRA2(1) = (dblKRA1(1) * Sin(dblM(1) * PI / 180))
dblKRA3(1) = -0.4068 * Sin(dblMA(1) * PI / 180)
dblKRA4(1) = 0.0021 * Sin(2 * dblM(1) * PI / 180)
dblKRA5(1) = 0.0161 * Sin(2 * dblMA(1) * PI / 180)
dblKRA6(1) = -0.0004 * Sin(3 * dblMA(1) * PI / 180)
dblKORA(1) = (dblKRA2(1) + dblKRA3(1) + dblKRA4(1) + dblKRA5(1) + dblKRA6(1))
dblKRB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180)
dblKRB2(1) = -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180)
dblKRB3(1) = 0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180)
dblKRB4(1) = -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180)
dblKRB5(1) = 0.0104 * Sin(2 * dblF(1) * PI / 180)
dblKORB(1) = (dblKRB1(1) + dblKRB2(1) + dblKRB3(1) + dblKRB4(1) + dblKRB5(1))
dblKORB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180) + _
-0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180) + _
0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180) + _
-0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180) + _
0.0104 * Sin(2 * dblF(1) * PI / 180)
dblKC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180)
dblKC2(1) = 0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180)
dblKC3(1) = 0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
dblKORC(1) = (dblKC1(1) + dblKC2(1) + dblKC3(1))
dblKORC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180) + _
0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180) + _
0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
dblKoreksi(1) = (dblKORA(1) + dblKORB(1) + dblKORC(1))
dblJdA1(1) = 29.53058868 * dblKN(1)
dblJdA2(1) = 0.0001178 * dblT(1) * dblT(1) * dblT(1)
dblJdA3(1) = -0.000000155 * dblT(1) * dblT(1) * dblT(1)
dblJdB1(1) = 132.87 * dblT(1)
dblJdB2(1) = 0.009173 * dblT(1) * dblT(1)
dblJdB3(1) = 166.56 + dblJdB1(1) - dblJdB2(1)
dblJdC1(1) = 0.00033 * Sin(dblJdB3(1) * PI / 180)
dblJdC2(1) = (dblJdA1(1) + dblJdA2(1) + dblJdA3(1) + dblJdC1(1))
dblJdC3(1) = 2415020.75933 + dblJdC2(1)
dblJD(1) = (dblJdC3(1) + 0.5 + dblKoreksi(1))
dblZJd(1) = Trunc(dblJD(1))
dblEFJd(1) = (dblJD(1) - dblZJd(1))
dblAPJd(1) = Trunc((dblZJd(1) - 1867216.25) / 36524.25)
dblAJd(1) = IIf(dblZJd(1) < 2299161, dblZJd(1), dblZJd(1) + 1 + dblAPJd(1) - Trunc(dblAPJd(1) / 4))
dblBJd(1) = (dblAJd(1) + 1524)
dblCJd(1) = Trunc((dblBJd(1) - 122.1) / 365.25)
dblDJd(1) = Trunc(365.25 * dblCJd(1))
dblEJd(1) = Trunc((dblBJd(1) - dblDJd(1)) / 30.6001)
dblTgl1(1) = (dblBJd(1) - dblDJd(1) - Trunc(30.6001 * dblEJd(1)) + dblEFJd(1))
dblTgl2(1) = Trunc(dblTgl1(1))
dblTgl3(1) = (dblTgl1(1) - dblTgl2(1))
dblTgl4(1) = (dblTgl3(1) * 24)
dblTgl5(1) = (dblTgl4(1) + 7)
dblTglM(1) = IIf(dblTgl5(1) <= 24, dblTgl2(1), dblTgl2(1) + 1)
dblKT(1) = (dblK4(1) - 100) / 100
dblET1(1) = 123.5 * dblKT(1)
dblET2(1) = 32.5 * dblKT(1) * dblKT(1)
dblKET(1) = (102.3 + dblET1(1) + dblET2(1)) / 3600
dblJDH(1) = IIf(dblTgl5(1) <= 24, (dblZJd(1) + 2), dblZJd(1) + 3)
dblHasilBulan(1) = IIf(dblEJd(1) < 13.5, dblEJd(1) - 1, dblEJd(1) - 13)
dblHasilTahun(1) = IIf(dblHasilBulan(1) < 2.5, Trunc(dblCJd(1) - 4715), Trunc(dblCJd(1) - 4716))
dblHasilHari(1) = (dblJDH(1) - Trunc(dblJDH(1) / 7) * 7)
dblHasilPasaran(1) = (dblJDH(1) - Trunc(dblJDH(1) / 5) * 5)
dblHasilJam(1) = IIf(dblTgl5(1) > 24, (dblTgl5(1) - 24), dblTgl5(1))
'Tabel 2
datHasil(1) = DateSerial(dblHasilTahun(1), dblHasilBulan(1), dblTglM(1))
datFull(2) = IIf(datHasil(1) > datFull(1), datHasil(1), datHasil(1) + 29)
intIJST(2) = 0
intTanggal(2) = Day(datFull(2))
intBulan(2) = Month(datFull(2))
intTahun(2) = Year(datFull(2))
intTa1(2) = IIf((intTahun(2) Mod 4) = 0, 1, 0)
intTa2(2) = IIf((intTahun(2) Mod 100) = 0, 1, 0)
intTa3(2) = intTa1(2) + intTa2(2)
dblKB(2) = IIf(intTa3(2) > 0, 1, 2)
'===========================================================================
dblK1(2) = Trunc((275 * intBulan(2)) / 9)
dblK2(2) = Trunc((intBulan(2) + 9) / 12) * dblKB(2)
dblK3(2) = (dblK1(2) - dblK2(2) + intTanggal(2) - 30)
dblK4(2) = (dblK3(2) / 365.25) + (intTahun(2) - 1900)
dblK5(2) = (dblK4(2) * 12.3685)
dblK6(2) = (dblK5(2) - Trunc(dblK5(2)))
dblK7(2) = IIf(dblK6(2) > 0.5, Trunc(dblK5(2) + 1), Trunc(dblK5(2) + 0))
dblKN(2) = IIf(intIJST(2) = 1, (dblK7(2) - 0), (dblK7(2) - 0.5))
dblT(2) = (dblKN(2) / 1236.85)
dblM1(2) = 29.10535608 * dblKN(2)
dblM2(2) = -0.000033 * dblT(2) * dblT(2)
dblM3(2) = -0.00000347 * dblT(2) * dblT(2) * dblT(2)
dblM(2) = iMod(359.2242 + dblM1(2) + dblM2(2) + dblM3(2), 360)
dblMA1(2) = 385.81691806 * dblKN(2)
dblMA2(2) = 0.0107306 * dblT(2) * dblT(2)
dblMA3(2) = 0.00001236 * dblT(2) * dblT(2) * dblT(2)
dblMA(2) = iMod(306.0253 + dblMA1(2) + dblMA2(2) + dblMA3(2), 360)
dblF1(2) = 390.67050646 * dblKN(2)
dblF2(2) = -0.0016528 * dblT(2) * dblT(2)
dblF3(2) = -0.00000239 * dblT(2) * dblT(2) * dblT(2)
dblF(2) = iMod(21.2964 + dblF1(2) + dblF2(2) + dblF3(2), 360)
dblKRA1(2) = 0.1734 - (0.000393 * dblT(2))
dblKRA2(2) = (dblKRA1(2) * Sin(dblM(2) * PI / 180))
dblKRA3(2) = -0.4068 * Sin(dblMA(2) * PI / 180)
dblKRA4(2) = 0.0021 * Sin(2 * dblM(2) * PI / 180)
dblKRA5(2) = 0.0161 * Sin(2 * dblMA(2) * PI / 180)
dblKRA6(2) = -0.0004 * Sin(3 * dblMA(2) * PI / 180)
dblKORA(2) = (dblKRA2(2) + dblKRA3(2) + dblKRA4(2) + dblKRA5(2) + dblKRA6(2))
dblKRB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180)
dblKRB2(2) = -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180)
dblKRB3(2) = 0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180)
dblKRB4(2) = -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180)
dblKRB5(2) = 0.0104 * Sin(2 * dblF(2) * PI / 180)
dblKORB(2) = (dblKRB1(2) + dblKRB2(2) + dblKRB3(2) + dblKRB4(2) + dblKRB5(2))
dblKORB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180) + _
-0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180) + _
0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180) + _
-0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180) + _
0.0104 * Sin(2 * dblF(2) * PI / 180)
dblKC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180)
dblKC2(2) = 0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180)
dblKC3(2) = 0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
dblKORC(2) = (dblKC1(2) + dblKC2(2) + dblKC3(2))
dblKORC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180) + _
0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180) + _
0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
dblKoreksi(2) = (dblKORA(2) + dblKORB(2) + dblKORC(2))
dblJdA1(2) = 29.53058868 * dblKN(2)
dblJdA2(2) = 0.0001178 * dblT(2) * dblT(2) * dblT(2)
dblJdA3(2) = -0.000000155 * dblT(2) * dblT(2) * dblT(2)
dblJdB1(2) = 132.87 * dblT(2)
dblJdB2(2) = 0.009173 * dblT(2) * dblT(2)
dblJdB3(2) = 166.56 + dblJdB1(2) - dblJdB2(2)
dblJdC1(2) = 0.00033 * Sin(dblJdB3(2) * PI / 180)
dblJdC2(2) = (dblJdA1(2) + dblJdA2(2) + dblJdA3(2) + dblJdC1(2))
dblJdC3(2) = 2415020.75933 + dblJdC2(2)
dblJD(2) = (dblJdC3(2) + 0.5 + dblKoreksi(2))
dblZJd(2) = Trunc(dblJD(2))
dblEFJd(2) = (dblJD(2) - dblZJd(2))
dblAPJd(2) = Trunc((dblZJd(2) - 1867216.25) / 36524.25)
dblAJd(2) = IIf(dblZJd(2) < 2299161, dblZJd(2), dblZJd(2) + 1 + dblAPJd(2) - Trunc(dblAPJd(2) / 4))
dblBJd(2) = (dblAJd(2) + 1524)
dblCJd(2) = Trunc((dblBJd(2) - 122.1) / 365.25)
dblDJd(2) = Trunc(365.25 * dblCJd(2))
dblEJd(2) = Trunc((dblBJd(2) - dblDJd(2)) / 30.6001)
dblTgl1(2) = (dblBJd(2) - dblDJd(2) - Trunc(30.6001 * dblEJd(2)) + dblEFJd(2))
dblTgl2(2) = Trunc(dblTgl1(2))
dblTgl3(2) = (dblTgl1(2) - dblTgl2(2))
dblTgl4(2) = (dblTgl3(2) * 24)
dblTgl5(2) = (dblTgl4(2) + 7)
dblTglM(2) = IIf(dblTgl5(2) <= 24, dblTgl2(2), dblTgl2(2) + 1)
dblKT(2) = (dblK4(2) - 100) / 100
dblET1(2) = 123.5 * dblKT(2)
dblET2(2) = 32.5 * dblKT(2) * dblKT(2)
dblKET(2) = (102.3 + dblET1(2) + dblET2(2)) / 3600
dblJDH(2) = IIf(dblTgl5(2) <= 24, (dblZJd(2) + 2), dblZJd(2) + 3)
dblHasilBulan(2) = IIf(dblEJd(2) < 13.5, dblEJd(2) - 1, dblEJd(2) - 13)
dblHasilTahun(2) = IIf(dblHasilBulan(2) < 2.5, Trunc(dblCJd(2) - 4715), Trunc(dblCJd(2) - 4716))
dblHasilHari(2) = (dblJDH(2) - Trunc(dblJDH(2) / 7) * 7)
dblHasilPasaran(2) = (dblJDH(2) - Trunc(dblJDH(2) / 5) * 5)
dblHasilJam(2) = IIf(dblTgl5(2) > 24, (dblTgl5(2) - 24), dblTgl5(2))
datHasil(2) = DateSerial(dblHasilTahun(2), dblHasilBulan(2), dblTglM(2))
Waisak = datHasil(2)
End Sub
– basChina
Option Explicit
Public Imlek As Date
Public Shio As String
Private Function iMod(dblValue1, dblValue2) As Double
On Error Resume Next
iMod = dblValue1 - dblValue2 * Int(dblValue1 / dblValue2)
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 Sub China(iTahun As Integer)
Dim intIJST(1 To 2) As Integer
Dim intTanggal(1 To 2) As Integer
Dim intBulan(1 To 2) As Integer
Dim intTahun(1 To 2) As Integer
Dim intTa1(1 To 2) As Integer
Dim intTa2(1 To 2) As Integer
Dim intTa3(1 To 2) As Integer
Const PI As Double = 3.141592654
Dim dblKN(1 To 2) As Double
Dim dblKB(1 To 2) As Double
Dim dblT(1 To 2) As Double
Dim dblK1(1 To 2) As Double
Dim dblK2(1 To 2) As Double
Dim dblK3(1 To 2) As Double
Dim dblK4(1 To 2) As Double
Dim dblK5(1 To 2) As Double
Dim dblK6(1 To 2) As Double
Dim dblK7(1 To 2) As Double
Dim dblM(1 To 2) As Double
Dim dblM1(1 To 2) As Double
Dim dblM2(1 To 2) As Double
Dim dblM3(1 To 2) As Double
Dim dblMA(1 To 2) As Double
Dim dblMA1(1 To 2) As Double
Dim dblMA2(1 To 2) As Double
Dim dblMA3(1 To 2) As Double
Dim dblF(1 To 2) As Double
Dim dblF1(1 To 2) As Double
Dim dblF2(1 To 2) As Double
Dim dblF3(1 To 2) As Double
Dim dblKRA1(1 To 2) As Double
Dim dblKRA2(1 To 2) As Double
Dim dblKRA3(1 To 2) As Double
Dim dblKRA4(1 To 2) As Double
Dim dblKRA5(1 To 2) As Double
Dim dblKRA6(1 To 2) As Double
Dim dblKORA(1 To 2) As Double
Dim dblKRB1(1 To 2) As Double
Dim dblKRB2(1 To 2) As Double
Dim dblKRB3(1 To 2) As Double
Dim dblKRB4(1 To 2) As Double
Dim dblKRB5(1 To 2) As Double
Dim dblKORB(1 To 2) As Double
Dim dblKORB1(1 To 2) As Double
Dim dblKC1(1 To 2) As Double
Dim dblKC2(1 To 2) As Double
Dim dblKC3(1 To 2) As Double
Dim dblKORC(1 To 2) As Double
Dim dblKORC1(1 To 2) As Double
Dim dblKoreksi(1 To 2) As Double
Dim dblJdA1(1 To 2) As Double
Dim dblJdA2(1 To 2) As Double
Dim dblJdA3(1 To 2) As Double
Dim dblJdB1(1 To 2) As Double
Dim dblJdB2(1 To 2) As Double
Dim dblJdB3(1 To 2) As Double
Dim dblJdC1(1 To 2) As Double
Dim dblJdC2(1 To 2) As Double
Dim dblJdC3(1 To 2) As Double
Dim dblJD(1 To 2) As Double
Dim dblZJd(1 To 2) As Double
Dim dblEFJd(1 To 2) As Double
Dim dblAPJd(1 To 2) As Double
Dim dblAJd(1 To 2) As Double
Dim dblBJd(1 To 2) As Double
Dim dblCJd(1 To 2) As Double
Dim dblDJd(1 To 2) As Double
Dim dblEJd(1 To 2) As Double
Dim dblHasilJam(1 To 2) As Double
Dim dblHasilBulan(1 To 2) As Integer
Dim dblHasilTahun(1 To 2) As Integer
Dim dblHasilHari(1 To 2) As Integer
Dim dblHasilPasaran(1 To 2) As Integer
Dim dblTgl1(1 To 2) As Double
Dim dblTgl2(1 To 2) As Double
Dim dblTgl3(1 To 2) As Double
Dim dblTgl4(1 To 2) As Double
Dim dblTgl5(1 To 2) As Double
Dim dblTglM(1 To 2) As Double
Dim dblKT(1 To 2) As Double
Dim dblET1(1 To 2) As Double
Dim dblET2(1 To 2) As Double
Dim dblKET(1 To 2) As Double
Dim dblJDH(1 To 2) As Double
Dim datFull(1 To 2) As Date
Dim datHasil(1 To 2) As Date
intIJST(1) = 1
intTanggal(1) = 22
intBulan(1) = 12
intTahun(1) = iTahun - 1
datFull(1) = DateSerial(intTahun(1), intBulan(1), intTanggal(1))
intTa1(1) = IIf((intTahun(1) Mod 4) = 0, 1, 0)
intTa2(1) = IIf((intTahun(1) Mod 100) = 0, 1, 0)
intTa3(1) = intTa1(1) + intTa2(1)
dblKB(1) = IIf(intTa3(1) > 0, 1, 2)
dblK1(1) = Trunc((275 * intBulan(1)) / 9)
dblK2(1) = Trunc((intBulan(1) + 9) / 12) * dblKB(1)
dblK3(1) = (dblK1(1) - dblK2(1) + intTanggal(1) - 30)
dblK4(1) = (dblK3(1) / 365.25) + (intTahun(1) - 1900)
dblK5(1) = (dblK4(1) * 12.3685)
dblK6(1) = (dblK5(1) - Trunc(dblK5(1)))
dblK7(1) = IIf(dblK6(1) > 0.5, Trunc(dblK5(1) + 1), Trunc(dblK5(1) + 0))
dblKN(1) = IIf(intIJST(1) = 1, (dblK7(1) - 0), (dblK7(1) - 0.5))
dblT(1) = (dblKN(1) / 1236.85)
dblM1(1) = 29.10535608 * dblKN(1)
dblM2(1) = -0.000033 * dblT(1) * dblT(1)
dblM3(1) = -0.00000347 * dblT(1) * dblT(1) * dblT(1)
dblM(1) = iMod(359.2242 + dblM1(1) + dblM2(1) + dblM3(1), 360)
dblMA1(1) = 385.81691806 * dblKN(1)
dblMA2(1) = 0.0107306 * dblT(1) * dblT(1)
dblMA3(1) = 0.00001236 * dblT(1) * dblT(1) * dblT(1)
dblMA(1) = iMod(306.0253 + dblMA1(1) + dblMA2(1) + dblMA3(1), 360)
dblF1(1) = 390.67050646 * dblKN(1)
dblF2(1) = -0.0016528 * dblT(1) * dblT(1)
dblF3(1) = -0.00000239 * dblT(1) * dblT(1) * dblT(1)
dblF(1) = iMod(21.2964 + dblF1(1) + dblF2(1) + dblF3(1), 360)
dblKRA1(1) = 0.1734 - (0.000393 * dblT(1))
dblKRA2(1) = (dblKRA1(1) * Sin(dblM(1) * PI / 180))
dblKRA3(1) = -0.4068 * Sin(dblMA(1) * PI / 180)
dblKRA4(1) = 0.0021 * Sin(2 * dblM(1) * PI / 180)
dblKRA5(1) = 0.0161 * Sin(2 * dblMA(1) * PI / 180)
dblKRA6(1) = -0.0004 * Sin(3 * dblMA(1) * PI / 180)
dblKORA(1) = (dblKRA2(1) + dblKRA3(1) + dblKRA4(1) + dblKRA5(1) + dblKRA6(1))
dblKRB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180)
dblKRB2(1) = -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180)
dblKRB3(1) = 0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180)
dblKRB4(1) = -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180)
dblKRB5(1) = 0.0104 * Sin(2 * dblF(1) * PI / 180)
dblKORB(1) = (dblKRB1(1) + dblKRB2(1) + dblKRB3(1) + dblKRB4(1) + dblKRB5(1))
dblKORB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180) + _
-0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180) + _
0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180) + _
-0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180) + _
0.0104 * Sin(2 * dblF(1) * PI / 180)
dblKC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180)
dblKC2(1) = 0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180)
dblKC3(1) = 0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
dblKORC(1) = (dblKC1(1) + dblKC2(1) + dblKC3(1))
dblKORC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180) + _
0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180) + _
0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
dblKoreksi(1) = (dblKORA(1) + dblKORB(1) + dblKORC(1))
dblJdA1(1) = 29.53058868 * dblKN(1)
dblJdA2(1) = 0.0001178 * dblT(1) * dblT(1) * dblT(1)
dblJdA3(1) = -0.000000155 * dblT(1) * dblT(1) * dblT(1)
dblJdB1(1) = 132.87 * dblT(1)
dblJdB2(1) = 0.009173 * dblT(1) * dblT(1)
dblJdB3(1) = 166.56 + dblJdB1(1) - dblJdB2(1)
dblJdC1(1) = 0.00033 * Sin(dblJdB3(1) * PI / 180)
dblJdC2(1) = (dblJdA1(1) + dblJdA2(1) + dblJdA3(1) + dblJdC1(1))
dblJdC3(1) = 2415020.75933 + dblJdC2(1)
dblJD(1) = (dblJdC3(1) + 0.5 + dblKoreksi(1))
dblZJd(1) = Trunc(dblJD(1))
dblEFJd(1) = (dblJD(1) - dblZJd(1))
dblAPJd(1) = Trunc((dblZJd(1) - 1867216.25) / 36524.25)
dblAJd(1) = IIf(dblZJd(1) < 2299161, dblZJd(1), _
dblZJd(1) + 1 + dblAPJd(1) - Trunc(dblAPJd(1) / 4))
dblBJd(1) = (dblAJd(1) + 1524)
dblCJd(1) = Trunc((dblBJd(1) - 122.1) / 365.25)
dblDJd(1) = Trunc(365.25 * dblCJd(1))
dblEJd(1) = Trunc((dblBJd(1) - dblDJd(1)) / 30.6001)
dblTgl1(1) = (dblBJd(1) - dblDJd(1) - Trunc(30.6001 * dblEJd(1)) + dblEFJd(1))
dblTgl2(1) = Trunc(dblTgl1(1))
dblTgl3(1) = (dblTgl1(1) - dblTgl2(1))
dblTgl4(1) = (dblTgl3(1) * 24)
dblTgl5(1) = (dblTgl4(1) + 7)
dblTglM(1) = IIf(dblTgl5(1) <= 24, dblTgl2(1), dblTgl2(1) + 1)
dblKT(1) = (dblK4(1) - 100) / 100
dblET1(1) = 123.5 * dblKT(1)
dblET2(1) = 32.5 * dblKT(1) * dblKT(1)
dblKET(1) = (102.3 + dblET1(1) + dblET2(1)) / 3600
dblJDH(1) = IIf(dblTgl5(1) <= 24, (dblZJd(1) + 2), dblZJd(1) + 3)
dblHasilBulan(1) = IIf(dblEJd(1) < 13.5, dblEJd(1) - 1, dblEJd(1) - 13)
dblHasilTahun(1) = IIf(dblHasilBulan(1) < 2.5, _
Trunc(dblCJd(1) - 4715), Trunc(dblCJd(1) - 4716))
dblHasilHari(1) = (dblJDH(1) - Trunc(dblJDH(1) / 7) * 7)
dblHasilPasaran(1) = (dblJDH(1) - Trunc(dblJDH(1) / 5) * 5)
dblHasilJam(1) = IIf(dblTgl5(1) > 24, (dblTgl5(1) - 24), dblTgl5(1))
'Tabel 2
datHasil(1) = DateSerial(dblHasilTahun(1), dblHasilBulan(1), dblTglM(1))
datFull(2) = IIf(datHasil(1) > datFull(1), datHasil(1) + 29, datHasil(1) + (29 * 2))
'
intIJST(2) = 1
intTanggal(2) = Day(datFull(2))
intBulan(2) = Month(datFull(2))
intTahun(2) = Year(datFull(2))
intTa1(2) = IIf((intTahun(2) Mod 4) = 0, 1, 0)
intTa2(2) = IIf((intTahun(2) Mod 100) = 0, 1, 0)
intTa3(2) = intTa1(2) + intTa2(2)
dblKB(2) = IIf(intTa3(2) > 0, 1, 2)
'===========================================================================
dblK1(2) = Trunc((275 * intBulan(2)) / 9)
dblK2(2) = Trunc((intBulan(2) + 9) / 12) * dblKB(2)
dblK3(2) = (dblK1(2) - dblK2(2) + intTanggal(2) - 30)
dblK4(2) = (dblK3(2) / 365.25) + (intTahun(2) - 1900)
dblK5(2) = (dblK4(2) * 12.3685)
dblK6(2) = (dblK5(2) - Trunc(dblK5(2)))
dblK7(2) = IIf(dblK6(2) > 0.5, Trunc(dblK5(2) + 1), Trunc(dblK5(2) + 0))
dblKN(2) = IIf(intIJST(2) = 1, (dblK7(2) - 0), (dblK7(2) - 0.5))
dblT(2) = (dblKN(2) / 1236.85)
dblM1(2) = 29.10535608 * dblKN(2)
dblM2(2) = -0.000033 * dblT(2) * dblT(2)
dblM3(2) = -0.00000347 * dblT(2) * dblT(2) * dblT(2)
dblM(2) = iMod(359.2242 + dblM1(2) + dblM2(2) + dblM3(2), 360)
dblMA1(2) = 385.81691806 * dblKN(2)
dblMA2(2) = 0.0107306 * dblT(2) * dblT(2)
dblMA3(2) = 0.00001236 * dblT(2) * dblT(2) * dblT(2)
dblMA(2) = iMod(306.0253 + dblMA1(2) + dblMA2(2) + dblMA3(2), 360)
dblF1(2) = 390.67050646 * dblKN(2)
dblF2(2) = -0.0016528 * dblT(2) * dblT(2)
dblF3(2) = -0.00000239 * dblT(2) * dblT(2) * dblT(2)
dblF(2) = iMod(21.2964 + dblF1(2) + dblF2(2) + dblF3(2), 360)
dblKRA1(2) = 0.1734 - (0.000393 * dblT(2))
dblKRA2(2) = (dblKRA1(2) * Sin(dblM(2) * PI / 180))
dblKRA3(2) = -0.4068 * Sin(dblMA(2) * PI / 180)
dblKRA4(2) = 0.0021 * Sin(2 * dblM(2) * PI / 180)
dblKRA5(2) = 0.0161 * Sin(2 * dblMA(2) * PI / 180)
dblKRA6(2) = -0.0004 * Sin(3 * dblMA(2) * PI / 180)
dblKORA(2) = (dblKRA2(2) + dblKRA3(2) + dblKRA4(2) + dblKRA5(2) + dblKRA6(2))
dblKRB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180)
dblKRB2(2) = -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180)
dblKRB3(2) = 0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180)
dblKRB4(2) = -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180)
dblKRB5(2) = 0.0104 * Sin(2 * dblF(2) * PI / 180)
dblKORB(2) = (dblKRB1(2) + dblKRB2(2) + dblKRB3(2) + dblKRB4(2) + dblKRB5(2))
dblKORB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180) + _
-0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180) + _
0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180) + _
-0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180) + _
0.0104 * Sin(2 * dblF(2) * PI / 180)
dblKC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180)
dblKC2(2) = 0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180)
dblKC3(2) = 0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
dblKORC(2) = (dblKC1(2) + dblKC2(2) + dblKC3(2))
dblKORC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180) + _
0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180) + _
0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
dblKoreksi(2) = (dblKORA(2) + dblKORB(2) + dblKORC(2))
dblJdA1(2) = 29.53058868 * dblKN(2)
dblJdA2(2) = 0.0001178 * dblT(2) * dblT(2) * dblT(2)
dblJdA3(2) = -0.000000155 * dblT(2) * dblT(2) * dblT(2)
dblJdB1(2) = 132.87 * dblT(2)
dblJdB2(2) = 0.009173 * dblT(2) * dblT(2)
dblJdB3(2) = 166.56 + dblJdB1(2) - dblJdB2(2)
dblJdC1(2) = 0.00033 * Sin(dblJdB3(2) * PI / 180)
dblJdC2(2) = (dblJdA1(2) + dblJdA2(2) + dblJdA3(2) + dblJdC1(2))
dblJdC3(2) = 2415020.75933 + dblJdC2(2)
dblJD(2) = (dblJdC3(2) + 0.5 + dblKoreksi(2))
dblZJd(2) = Trunc(dblJD(2))
dblEFJd(2) = (dblJD(2) - dblZJd(2))
dblAPJd(2) = Trunc((dblZJd(2) - 1867216.25) / 36524.25)
dblAJd(2) = IIf(dblZJd(2) < 2299161, dblZJd(2), _
dblZJd(2) + 1 + dblAPJd(2) - Trunc(dblAPJd(2) / 4))
dblBJd(2) = (dblAJd(2) + 1524)
dblCJd(2) = Trunc((dblBJd(2) - 122.1) / 365.25)
dblDJd(2) = Trunc(365.25 * dblCJd(2))
dblEJd(2) = Trunc((dblBJd(2) - dblDJd(2)) / 30.6001)
dblTgl1(2) = (dblBJd(2) - dblDJd(2) - Trunc(30.6001 * dblEJd(2)) + dblEFJd(2))
dblTgl2(2) = Trunc(dblTgl1(2))
dblTgl3(2) = (dblTgl1(2) - dblTgl2(2))
dblTgl4(2) = (dblTgl3(2) * 24)
dblTgl5(2) = (dblTgl4(2) + 7)
dblTglM(2) = IIf(dblTgl5(2) <= 24, dblTgl2(2), dblTgl2(2) + 1)
dblKT(2) = (dblK4(2) - 100) / 100
dblET1(2) = 123.5 * dblKT(2)
dblET2(2) = 32.5 * dblKT(2) * dblKT(2)
dblKET(2) = (102.3 + dblET1(2) + dblET2(2)) / 3600
dblJDH(2) = IIf(dblTgl5(2) <= 24, (dblZJd(2) + 2), dblZJd(2) + 3)
dblHasilBulan(2) = IIf(dblEJd(2) < 13.5, dblEJd(2) - 1, dblEJd(2) - 13)
dblHasilTahun(2) = IIf(dblHasilBulan(2) < 2.5, _
Trunc(dblCJd(2) - 4715), Trunc(dblCJd(2) - 4716))
dblHasilHari(2) = (dblJDH(2) - Trunc(dblJDH(2) / 7) * 7)
dblHasilPasaran(2) = (dblJDH(2) - Trunc(dblJDH(2) / 5) * 5)
dblHasilJam(2) = IIf(dblTgl5(2) > 24, (dblTgl5(2) - 24), dblTgl5(2))
datHasil(2) = DateSerial(dblHasilTahun(2), dblHasilBulan(2), dblTglM(2))
Imlek = datHasil(2)
Dim strShio(0 To 11) As String
Dim intShio As Integer
strShio(0) = "Ayam"
strShio(1) = "Anjing"
strShio(2) = "Babi"
strShio(3) = "Tikus"
strShio(4) = "Kerbau"
strShio(5) = "Harimau"
strShio(6) = "Kelinci"
strShio(7) = "Naga"
strShio(8) = "Ular"
strShio(9) = "Kuda"
strShio(10) = "Kambing"
strShio(11) = "Monyet"
intShio = (iTahun + 551) Mod 12
Shio = strShio(intShio)
End Sub
– basNasional
Option Explicit
Public Proklamasi As Date
Sub Nasional(intTahun As Integer)
Proklamasi = DateSerial(intTahun, 8, 17)
End Sub
Bagaimana cara pengujiannya? Gampang, pada Form1, tambahkan sebuah CommandButton, lalu ketik kode di bawah ini:
Option Explicit
Private Sub Command1_Click()
Dim intYear As Integer
intYear = Year(Date)
Call Kristen(intYear)
Call Hindu(intYear)
Call Buddha(intYear)
Call China(intYear)
Call Islam(intYear)
Dim strPesan As String
strPesan = "Tahun: " & intYear & vbCrLf
strPesan = strPesan & String(25, "=") & vbCrLf & vbCrLf
strPesan = strPesan & "Maulid Nabi Muhammad: " & _
Format(MaulidNabi, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Isra' Mi'raj Nabi Muhammad: " & _
Format(IsraMiraj, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Idul Fitri: " & _
Format(IdulFitri, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Idul Adha: " & _
Format(IdulAdha, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Tahun Baru Hijriyah: " & _
Format(TahunBaruHijri, "d MMM yyyy") & vbCrLf & vbCrLf
strPesan = strPesan & "Wafat Isa Al Masih: " & _
Format(WafatIsa, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Kenaikan Isa Al Masih: " & _
Format(KenaikanIsa, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Natal: " & _
Format(Natal, "d MMM yyyy") & vbCrLf
strPesan = strPesan & "Tahun Baru: " & _
Format(TahunBaru, "d MMM yyyy") & vbCrLf & vbCrLf
strPesan = strPesan & "Nyepi: " & _
Format(Nyepi, "d MMM yyyy") & vbCrLf & vbCrLf
strPesan = strPesan & "Waisak: " & _
Format(Waisak, "d MMM yyyy") & vbCrLf & vbCrLf
strPesan = strPesan & "Imlek: " & _
Format(Imlek, "d MMM yyyy") & _
" (" & Shio & ")" & vbCrLf & vbCrLf
MsgBox strPesan, vbInformation, "Kalender"
End Sub
Nah, selanjutnya tinggal mendayagunakan kemampuan Anda untuk menjadikan aplikasi lain sesuai kebutuhan Anda.
Perhatian:
Kode sumber di atas hanya boleh digunakan untuk keperluan non profit (untuk keperluan ini, harus menyertakan alamat blog http://www.pujanggavb.wordpress.com sebagai sumber referensi). Untuk keperluan komersial, harus menghubungi saya melalui email ke: pujanggabageur@yahoo.com.
Ampiran Visual Basic 6 
Komentar Terbaru