Kata Baru

Tentang Pikiran, Perkataan, dan Perbuatan

Membuat Aplikasi Kalender dengan VB6 (Visual Basic Classic)


Pembaca, setelah pada tulisan sebelumnya saya sudah mengulas semua rumus penghitungan hari libur, kini saatnya kita mencoba memanfaatkannya untuk membuat sebuah aplikasi seperti yang bisa Anda lihat di sini: Kalender Indonesia.

Setelah pada tulisan sebelumnya untuk mencoba menerapkan rumus pada suatu form, sekarang mari kita olah kembali form tersebut. Hapus CommandButton yang ada pada form, hapus juga kode sumber pada form yang sudah ada sebelumnya.


Kembali ke desain form, tambahkan 2 (dua) buah Label, 2 (dua) ComboBox, 2 (dua) buah ListBox, dan sebuah PictureBox.

Desain Form Calender

Desain Form Calender

Kemudian ubah properti-propertinya seperti tabel di bawah ini, dan atur-posisinya seperti pada gambar.

No Control Properti Perubahan
1 Label Caption &Bulan
2 ComboBox Name cboBulan
Style 2-Dropdown List
3 Label Caption &Tahun
4 ComboBox Name cboTahun
Style 2-Dropdown List
5 PictureBox Name picDate
Appearance 0-Flat
AutoRedraw True
Index 0
52 ListBox Name lstTemp
Sorted True
53 ListBox Name lstCuti
Sorted True

Klik kanan pada picDate (no. 5) pilih Copy, lalu klik kanan pada form dan klik Paste. Pindahkan posisi PictureBox yang tersalin seperti no. 6 pada gambar. Klik kanan lagi pada form kemudian klik Paste, posisikan seperti no. 7. Lakukan cara ini berulang-ulang hingga pada form terpenuhi kontrol PictureBox dari no. 6 sampai no. 47.

Tambahkan 2 (dua) buah kontrol ListView pada form. Jika pada toolbox IDE VB6 Anda belum terdapat ikon ListView, klik menu Project, kemudian Components…

Pada kotak dialog yang ditampilkan, pilih Microsoft Windows Common Control 6.0 (SP6)

Pemilihan Komponen

Pemilihan Komponen

Posisikan ListView seperti pada no. 48 dan no. 51. Lalu ubah propertinya.

No Control Properti Perubahan
48 ListView Name lvwInfo
View 3-lvwReport
FullRowSelect True
GridLines True
HideColumnHeaders True
51 ListView Name lvwTemp
View 3-lvwReport
FullRowSelect True
GridLines True
HideColumnHeaders True

Tambahkan sebuah Label dan sebuah TextBox, posisikan seperti no. 49 dan no. 50.

No Control Properti Perubahan
49 Label Caption Jumlah hari cuti bersama
50 TextBox Name txtCuti

Terakhir, tambahkan 7 (tujuh) buah Label lagi, ubah Caption-nya sebagai nama-nama hari, posisikan seperti pada gambar.

Sekarang beralih ke bagian kode, bukalah jendela kode dari frmCalender, lalu ketik kode di bawah ini:

Option Explicit

Public intMonth As Integer
Public intYear As Integer
Dim intAwalMinggu As Integer
Dim myList As ListViewItem

Dim myList1 As ListViewItem
Dim myList2 As ListViewItem

Dim intCuti As Integer
Dim intTglCuti(1 To 10) As Integer

Function SetWarna(d As Integer, m As Integer, y As Integer) As OLE_COLOR
    Dim dDate As Date
    Dim oWarna As OLE_COLOR
    
    oWarna = vbBlack
    
    dDate = DateSerial(y, m, d)
    
    If Weekday(dDate, vbMonday) = 7 Then oWarna = vbRed
    If Weekday(dDate, vbMonday) = 5 Then oWarna = RGB(0, 200, 0)
    
    If dDate = Proklamasi Then oWarna = vbRed
    
    If dDate = TahunBaru Then oWarna = vbRed
    If dDate = WafatIsa Then oWarna = vbRed
    If dDate = KenaikanIsa Then oWarna = vbRed
    If dDate = Natal Then oWarna = vbRed
    
    If dDate = IdulFitri Then oWarna = vbRed
    If dDate = IdulFitri2 Then oWarna = vbRed
    If dDate = IdulAdha Then oWarna = vbRed
    If dDate = MaulidNabi Then oWarna = vbRed
    If dDate = TahunBaruHijri Then oWarna = vbRed
    If dDate = IsraMiraj Then oWarna = vbRed

    If dDate = Nyepi Then oWarna = vbRed
    
    If dDate = Waisak Then oWarna = vbRed
    
    If dDate = Imlek Then oWarna = vbRed
    
    
    SetWarna = oWarna
End Function

Function TulisLibur(m As Integer, y As Integer, dDate As Date, strText As String)
    If Month(dDate) = m And Year(dDate) = y Then
        Set myList = Me.lvwInfo.ListItems.Add
        myList.Text = Day(dDate)
        myList.SubItems(1) = strText
    End If
End Function

Function SetLibur(m As Integer, y As Integer)
    On Error Resume Next
    With Me.lvwInfo
        With .ColumnHeaders
            .Clear
            .Add , , , 300
            .Add , , , Me.lvwInfo.Width - 350
        End With
        
        .ListItems.Clear
        
        TulisLibur m, y, Natal, "Hari Raya Natal"
        TulisLibur m, y, Proklamasi, "HUT RI ke-" & CStr(Int(y) - 1945)
        TulisLibur m, y, TahunBaru, "Tahun Baru Masehi"
        
        TulisLibur m, y, MaulidNabi, "Maulid Nabi Muhammad SAW (12 Robi'ul Awwal " & _
        TahunMaulid & "H)"
        
        TulisLibur m, y, TahunBaruHijri, "Tahun Baru Hijriyah (1 Muharrom " & _
        TahunHijriyah & "H)"
        
        TulisLibur m, y, IsraMiraj, "Isro' Mi'roj Nabi Muhammad SAW (27 Rojab " & _
        TahunIsraMiraj & "H)"
        
        TulisLibur m, y, IdulFitri, "Idul Fitri (1 Syawwal " & TahunIdulFitri & "H)"
        TulisLibur m, y, IdulFitri2, "Idul Fitri (2 Syawwal " & TahunIdulFitri & "H)"
        TulisLibur m, y, IdulAdha, "Idul Adha (10 Dzul Hijjah " & TahunIdulAdha & "H)"
        
        TulisLibur m, y, WafatIsa, "Wafat Isa Al-Masih"
        TulisLibur m, y, KenaikanIsa, "Kenaikan Isa Al-Masih"
        
        TulisLibur m, y, Nyepi, "Hari Raya Nyepi Tahun Baru Saka " & CStr(Int(y - 78))
        TulisLibur m, y, Waisak, "Hari Raya Waisak " & CStr(Int(y + 554))
        TulisLibur m, y, Imlek, "Tahun Baru Imlek " & CStr(Int(y + 551)) & " (" & Shio & ")"
    End With
End Function

Sub SetCutiBersama(m As Integer, y As Integer)
    '
    Dim intWProklamasi As Integer
    Dim intWTahunBaru As Integer
    Dim intWWafatIsa As Integer
    Dim intWKenaikanIsa As Integer
    Dim intWNatal As Integer
    Dim intWIdulFitri As Integer
    Dim intWIdulFitri2 As Integer
    Dim intWIdulAdha As Integer
    Dim intWMaulidNabi As Integer
    Dim intWTahunBaruHijri As Integer
    Dim intWIsraMiraj As Integer
    Dim intWNyepi As Integer
    Dim intWWaisak As Integer
    Dim intWImlek As Integer
    
    Dim i As Integer
    'Senin = 1
    'Selasa = 2
    'Rabu = 3
    'Kamis = 4
    'Jumat = 5
    'Sabtu = 6
    intWProklamasi = Weekday(Proklamasi, vbMonday)
    intWTahunBaru = Weekday(TahunBaru, vbMonday)
    intWWafatIsa = Weekday(WafatIsa, vbMonday)
    intWKenaikanIsa = Weekday(KenaikanIsa, vbMonday)
    intWNatal = Weekday(Natal, vbMonday)
    intWIdulFitri = Weekday(IdulFitri, vbMonday)
    intWIdulFitri2 = Weekday(IdulFitri2, vbMonday)
    intWIdulAdha = Weekday(IdulAdha, vbMonday)
    intWMaulidNabi = Weekday(MaulidNabi, vbMonday)
    intWTahunBaruHijri = Weekday(TahunBaruHijri, vbMonday)
    intWIsraMiraj = Weekday(IsraMiraj, vbMonday)
    intWNyepi = Weekday(Nyepi, vbMonday)
    intWWaisak = Weekday(Waisak, vbMonday)
    intWImlek = Weekday(Imlek, vbMonday)
    
    Me.lstCuti.Clear
    
    Me.lstCuti.AddItem intWProklamasi & ":" & NamaHari(intWProklamasi)
    
    If intWIdulFitri2 = 1 Then
        TulisCuti m, y, IdulFitri2 + 1, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 + 2, "Idul Fitri"
    End If
    If intWIdulFitri2 = 2 Then
        TulisCuti m, y, IdulFitri2 + 1, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 + 2, "Idul Fitri"
    End If
    If intWIdulFitri2 = 3 Then
        TulisCuti m, y, IdulFitri2 - 2, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 + 1, "Idul Fitri"
    End If
    If intWIdulFitri2 = 4 Then
        TulisCuti m, y, IdulFitri2 + 1, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 - 2, "Idul Fitri"
        If intCuti < 5 Then
            TulisCuti m, y, IdulFitri2 - 3, "Idul Fitri"
        End If
    End If
    If intWIdulFitri2 = 5 Then
        TulisCuti m, y, IdulFitri2 - 2, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 - 3, "Idul Fitri"
    End If
    If intWIdulFitri2 = 6 Then
        TulisCuti m, y, IdulFitri2 - 2, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 + 2, "Idul Fitri"
    End If
    If intWIdulFitri2 = 7 Then
        TulisCuti m, y, IdulFitri2 + 1, "Idul Fitri"
        TulisCuti m, y, IdulFitri2 + 2, "Idul Fitri"
    End If
    If intWIdulAdha = 4 Then
        TulisCuti m, y, IdulAdha + 1, "Idul Adha"
    End If
    If intWIdulAdha = 2 Then
        TulisCuti m, y, IdulAdha - 1, "Idul Adha"
    End If
    If intWKenaikanIsa = 4 Then
        TulisCuti m, y, KenaikanIsa + 1, "Kenaikan Isa Al-Masih"
    End If
    If intWKenaikanIsa = 2 Then
        TulisCuti m, y, KenaikanIsa - 1, "Kenaikan Isa Al-Masih"
    End If
    If intWNatal = 4 Then
        TulisCuti m, y, Natal + 1, "Natal"
    End If
    If intWNatal = 2 Then
        TulisCuti m, y, Natal - 1, "Natal"
    End If
    If intWNyepi = 4 Then
        TulisCuti m, y, Nyepi + 1, "Natal"
    End If
    If intWNyepi = 2 Then
        TulisCuti m, y, Nyepi - 1, "Nyepi"
    End If
    If intWWaisak = 4 Then
        TulisCuti m, y, Waisak + 1, "Waisak"
    End If
    If intWWaisak = 2 Then
        TulisCuti m, y, Waisak - 1, "Waisak"
    End If
    If intWImlek = 4 Then
        TulisCuti m, y, Imlek + 1, "Imlek"
    End If
    If intWImlek = 2 Then
        TulisCuti m, y, Imlek - 1, "Imlek"
    End If
    If intCuti < 6 Then
        If Month(TahunBaruHijri) <> 1 Then
            If intWTahunBaruHijri = 4 Then
                TulisCuti m, y, TahunBaruHijri + 1, "Tahun Baru Hijriyah"
            End If
            If intWTahunBaruHijri = 2 Then
                TulisCuti m, y, TahunBaruHijri - 1, "Tahun Baru Hijriyah"
            End If
        End If
        If Month(MaulidNabi) <> 1 Then
            If intWMaulidNabi = 4 Then
                TulisCuti m, y, MaulidNabi + 1, "Maulid Nabi"
            End If
            If intWMaulidNabi = 2 Then
                TulisCuti m, y, MaulidNabi - 1, "Maulid Nabi"
            End If
        End If
        If Month(intWIsraMiraj) <> 1 Then
            If intWIsraMiraj = 4 Then
                TulisCuti m, y, IsraMiraj + 1, "Isra Miraj"
            End If
            If intWIsraMiraj = 2 Then
                TulisCuti m, y, IsraMiraj - 1, "Isra Miraj"
            End If
        End If
    End If
    'If intWTahunBaru = 2 Then
    '    TulisCuti m, y, TahunBaru - 1
    'End If
    If intCuti < 7 Then
        If intWTahunBaru = 4 Then
            TulisCuti m, y, TahunBaru + 1
        End If
        If intWProklamasi = 4 Then
            TulisCuti m, y, Proklamasi + 1, "HUT RI"
        End If
        If intWProklamasi = 2 Then
            TulisCuti m, y, Proklamasi - 1, "HUT RI"
        End If
    End If
        
    Me.txtCuti.Text = intCuti
End Sub

Sub TulisCuti(m As Integer, y As Integer, dDate As Date, Optional strTeks As String)
On Error Resume Next
    Dim i As Integer
    
    TulisLibur m, y, dDate, "Cuti Bersama " & strTeks
    intTglCuti(intCuti) = Day(dDate)
    
    If m = Month(dDate) Then
        For i = 1 To Me.picDate.Count - 1
            With Me.picDate(i)
                If .Tag = CStr(intTglCuti(intCuti)) Then
                    .FillStyle = 0
                    .FillColor = vbRed
                    .DrawWidth = 2
                    Me.picDate(i).Circle ((.ScaleWidth - 120) / 2 + 60, _
                    .ScaleHeight - 100), 80, 0
                    Exit For
                End If
            End With
        Next
    End If
    intCuti = intCuti + 1
End Sub

Sub SetTahun()
    Call Hindu(intYear)
    Call Kristen(intYear)
    Call Islam(intYear)
    Call Buddha(intYear)
    Call China(intYear)
    Call Nasional(intYear)
End Sub

Private Sub cboBulan_Click()
    intMonth = Me.cboBulan.ListIndex + 1
    Call GambarKalender
End Sub

Private Sub cboTahun_Click()
    intYear = cboTahun.Text
    Call SetTahun
    Call GambarKalender
End Sub

Sub GambarKalender()
'On Error Resume Next
    Dim intSelisih
    Dim intJumlahHari As Integer
    Dim x As Integer
    Dim h As Integer
    
    intCuti = 0
    
    intAwalMinggu = Weekday(DateSerial(intYear, intMonth, 1), vbMonday)
    intJumlahHari = DateSerial(intYear, intMonth + 1, 1) - _
    DateSerial(intYear, intMonth, 1)
    
    For x = 1 To 42
        Me.picDate(x).Cls
        Me.picDate(x).ForeColor = vbBlack
        Me.picDate(x).Font.Size = 24
        Me.picDate(x).ScaleLeft = 0
        Me.picDate(x).Tag = ""
    Next
    
    For x = intAwalMinggu To intJumlahHari + (intAwalMinggu - 1)
        h = x - (intAwalMinggu - 1)
        With Me.picDate(x)
            .ForeColor = SetWarna(h, intMonth, intYear)
            .CurrentX = (.ScaleWidth - .TextWidth(h)) \ 2 - 100
            .CurrentY = (.ScaleHeight - .TextHeight(h)) \ 2
            Me.picDate(x).Print h
            
            If DateSerial(intYear, intMonth, h) = Date Then
                Me.picDate(x).DrawWidth = 4
                Me.picDate(x).Line (0, 0)-(.Width - 30, .Height - 30), vbRed, B
            End If
            .Tag = h
        End With
    Next
    
    SetLibur intMonth, intYear
    SetCutiBersama intMonth, intYear
    SortList
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim intBatas As Integer
    
    intBatas = 50
    
    With Me.lvwTemp
        With .ColumnHeaders
            .Clear
            .Add , , , 300
            .Add , , , Me.lvwInfo.Width - 350
        End With
    End With
    
    For i = 1 To 12
        With Me.cboBulan
            .AddItem NamaBulanMasehi(i)
        End With
    Next
    
    For i = intBatas To 1 Step -1
        With Me.cboTahun
            .AddItem Year(Date) + i
        End With
    Next
    
    For i = 0 To intBatas
        With Me.cboTahun
            .AddItem Year(Date) - i
        End With
    Next
    
    Me.cboBulan.ListIndex = Month(Date) - 1
    Me.cboTahun.Text = Year(Date)
    
End Sub

Sub SortList()
    Dim i As Long
    Dim j As Long
    Dim strFind As String
    Dim Pisah() As String
    
    Me.lvwTemp.ListItems.Clear
    Me.lstTemp.Clear
    
    If Me.lvwInfo.ListItems.Count <> 0 Then
        For j = 1 To Me.lvwInfo.ListItems.Count
            Set myList1 = Me.lvwInfo.ListItems(j)
            Set myList2 = Me.lvwTemp.ListItems.Add
            myList2.Text = Format(myList1.Text, "00")
            myList2.SubItems(1) = myList1.SubItems(1)
            
            Me.lstTemp.AddItem Format(myList1.Text, "00") & _
            " | " & myList1.SubItems(1)
        Next
        
        Me.lvwInfo.ListItems.Clear
        
        For j = 0 To Me.lstTemp.ListCount - 1
            Pisah() = Split(lstTemp.List(j), " | ")
            Set myList2 = Me.lvwInfo.ListItems.Add
            myList2.Text = Pisah(0)
            myList2.SubItems(1) = Pisah(1)
        Next
    End If
End Sub

Selesai, silakan jalankan program Anda!

About these ads

2 responses to “Membuat Aplikasi Kalender dengan VB6 (Visual Basic Classic)

  1. agussynyster 3 Februari 2012 10:04 pukul 10:04

    di posting do artikel yng seputar pemerintahannya..

Tinggalkan Balasan

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

WordPress.com Logo

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

Twitter picture

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

Facebook photo

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

Google+ photo

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

Connecting to %s

Ikuti

Get every new post delivered to your Inbox.

Bergabunglah dengan 161 pengikut lainnya.

%d bloggers like this: