Membuat Kalender Sederhana Dengan Variasi Tulisan

Contoh Program dibawah ini merupakan program sederhana membuat calender dengan perpaduan membuat animasi tulisan  .
berikut Kodingnya :

Option Explicit

Dim Transparan As Integer
Dim mulai As Boolean

Private Sub Form_Activate()
If lblnumber.Caption = "6" Then
MsgBox "heee"
lblultah.Caption = "Happy Birtsday Mas Japik, Semoga Panjang Umur"
ElseIf lblnumber.Caption = "15" Then
lblultah.Caption = "Happy Birtsday Mas Jefri, Semoga Panjang Umur"
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If lblnumber.Caption = "6" Then
lblultah.Caption = "Happy Birtsday Mas Japik, Semoga Panjang Umur"
ElseIf lblnumber.Caption = "15" Then
lblultah.Caption = "Happy Birtsday Mas Jefri, Semoga Panjang Umur"
End If
End Sub

Private Sub Form_Load()

    Call FungsiTanggal
  mulai = True
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Cancel = True: mulai = False
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If mulai Then
  Transparan = Transparan + 5
  If Transparan > 255 Then Transparan = 255: Timer1.Enabled = False
Else
  Transparan = Transparan - 5
  If Transparan < 0 Then Transparan = 0: End
End If
SetTransparan frmcalender.hwnd, Transparan
End Sub



Private Sub Image1_Click()
 Shell "EXPLORER.EXE " & "http://ujexs09.blogspot.com/"

End Sub

Private Sub Label1_Click()
 Shell "EXPLORER.EXE " & "http://ujexs09.blogspot.com/"
End Sub

Private Sub Timer4_Timer()
Dim Today As Variant
Today = Now
'lblday.Caption = Format(Today, "dddd")
'lblmonth.Caption = Format(Today, "mmmm")
lblyear.Caption = Format(Today, "yyyy")
lblnumber.Caption = Format(Today, "d")
lbltime.Caption = Format(Today, "h:mm:ss ampm")

End Sub
Sub FungsiTanggal()
    'untuk menampilkan hari kedalam bhs indonesia
    Dim KHari, Hari, KBulan, Bulan As String
        KHari = Weekday(Now, vbSunday)
        Select Case KHari
        Case 1
            Hari = "\M\I\G\G\G\U =="
        Case 2
            Hari = "\S\E\N\I\N =="
        Case 3
            Hari = "\S\E\L\A\S\A =="
        Case 4
            Hari = "\R\A\B\U =="
        Case 5
            Hari = "\K\A\M\I\S =="
        Case 6
            Hari = "\J\U\M\A\T =="
        Case 7
            Hari = "\S\A\B\T\U =="
        End Select
       
        ' mengganti nama kedalam bhs indonesia
        KBulan = Month(Now)
        Select Case KBulan
        Case 1
            Bulan = "\J\a\n\u\a\r\i"
        Case 2
            Bulan = "\F\e\b\r\u\a\r\i"
        Case 3
            Bulan = "\M\a\r\e\t"
        Case 4
            Bulan = "\A\P\R\I\L"
        Case 5
            Bulan = "\M\e\i"
        Case 6
            Bulan = "\J\u\n\i"
        Case 7
            Bulan = "\J\u\l\i"
        Case 8
            Bulan = "\A\g\u\s\t\u\s"
        Case 9
            Bulan = "\S\e\p\t\e\m\b\e\r"
        Case 10
            Bulan = "\O\k\t\o\b\e\r"
        Case 11
            Bulan = "\N\o\v\e\m\b\e\r"
        Case 12
            Bulan = "\D\e\s\e\m\b\e\r"
        End Select
    lblday.Caption = Format(Now, Hari) '& Bulan & " yyyy ")
    lblmonth.Caption = Format(Now, Bulan)

End Sub


    'memanggil fungsi tanggal saat form aktif


Private Sub Timer2_Timer()
lblday.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)

End Sub

Private Sub Timer3_Timer()
lblnumber.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
lblultah.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)

End Sub

Layout Setelah Program di jalan-kan :


Silahkan download project vbnya , agar bisa dipelajari dan dikembangkan.


== VBMANDIRI PROJECT DOWNLOAD ==

PASSWORD UNTUK MEMBUKA WINRAR yaitu : ujexsvbmandiri ( di copy saja )