Aplikasi Waktu Beranimasi

Pada kali ini saya akan membuat sebuah aplikasi waktu (Jam dan Tanggal) dimana saat form tampil (load) dan keluar (unload) bisa beranimasi. Mari kita langsung saja ke TKP.

Buatlah Projek Baru (New project, standar exe)

Pada form tambahkan control/object sbb:

1. 2 buah label dengan nama masing-masing lblWaktu dan lblTanggal. Lalu hapus properti caption-nya (kosongkan).

2. CommandButton dengan nama 'cmdFormat' , Caption = "12"

3. Tambahkan sebuah timer pada form.

Aturlah ukuran dan tampilannya sesuai selera, serta tambahkan label judul atau yang lainnya.

Setelah selesai, copas code dibawah ini dan letakkan pada halaman kode (untuk menampilkan halaman kode, klik 2 kali pada form).

Option Explicit

'Dibuat oleh Yosa Cahya

'Email: yosa.cahya@gmail.com

'Blog : tutorialvb6.blogspot.com

Dim wkt As String, Tanggal As Variant

Dim TimeFormat As Byte

Dim hijri As Boolean

Const AW_CENTER = &H10

Const AW_HIDE = &H10000

Const AW_BLEND = &H80000

Private Declare Function AnimateWindow Lib "user32" _

    (ByVal hwnd As Long, _

    ByVal dwTime As Long, _

    ByVal dwFlags As Long) As Boolean

Private Sub Form_Load()

 Me.AutoRedraw = True

 Animasikan Me.hwnd, 1000, AW_CENTER

 Me.Show

 Me.Refresh

 TimeFormat = 1

 Timer1.Interval = 1000

 lblWaktu.Caption = Format(Time, "h:mm:ss")

 lblWaktu.Refresh

 lblTanggal.Caption = Hari(Date) & ", " & Format(Date, "dd mmmm yyyy")

 lblTanggal.Refresh

End Sub

Private Sub Form_Unload(Cancel As Integer)

 Animasikan Me.hwnd, 1000, AW_BLEND Or AW_HIDE

End Sub

Private Sub cmdFormat_Click()

If cmdFormat.Caption = "12" Then

  cmdFormat.Caption = "24"

  TimeFormat = 0

   Else

  cmdFormat.Caption = "12"

  TimeFormat = 1

End If

End Sub

Private Sub lblTanggal_Click()

If hijri = False Then

 Calendar = vbCalHijri

 hijri = True

 Else

 Calendar = vbCalGreg

 hijri = False

 End If

End Sub

Private Sub lblTanggal_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

 lblTanggal.ToolTipText = "Klik pada tanggal ini untuk merubah Kalender"

End Sub

Private Sub lblWaktu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

 lblWaktu.ToolTipText = "Klik tombol disamping kanan untuk merubah format jam"

End Sub

Private Sub Timer1_Timer()

 wkt = Time

 Tanggal = Date

 If TimeFormat = 0 Then

    wkt = Format(Time, "HH:mm:ss AMPM")

    wkt = Replace(wkt, "AM", "am")

    wkt = Replace(wkt, "PM", "pm")

 Else

    wkt = Format(Time, "h:mm:ss")

 End If

 lblWaktu.Caption = wkt

 lblWaktu.Refresh

 If hijri = False Then

 lblTanggal.Caption = Hari(Tanggal) & ", " & Format(Tanggal, "dd mmmm yyyy")

 Else

 lblTanggal.Caption = Hari(Tanggal) & ", " & FormatDateTime(Tanggal, vbShortDate) & " Hij"

End If

End Sub

Function Hari(ByVal tgl As Variant) As String

Dim poe As Byte

 poe = Weekday(tgl, vbSunday)

 Select Case poe

  Case 1: Hari = "Minggu"

  Case 2: Hari = "Senin"

  Case 3: Hari = "Selasa"

  Case 4: Hari = "Rabu"

  Case 5: Hari = "Kamis"

  Case 6: Hari = "Jum'at"

  Case 7: Hari = "Sabtu"

 End Select

End Function

Function Animasikan(Win_hWnd As Long, AnimationTime As Long, flag As Long)

  AnimateWindow Win_hWnd, AnimationTime, flag

End Function

Jalankan program dengan menekan F5 dan lihat hasilnya.

Bagi anda yang ingin melihat contoh aplikasi yang sudah jadi dari artikel ini, silahkan download disini, dijamin direct link alias tanpa iklan.

Selamat mencoba, Semoga bermanfa'at.

Artikel yang berkaitan: