Perbolehkan saya untuk berbagi script untuk mnghitung umu di VB6 gan.
ini ScreenShotnya gan....
Silahkan di coba, tolong feedBacknya ya.....
Inilah dia....
Jeng jeng jeng...
Function ExactAge(BirthDate As Variant) As String
Dim yer As Integer, mon As Integer, d As Integer
Dim dt As Date
Dim sAns As String
If Not IsDate(BirthDate) Then Exit Function
dt = CDate(BirthDate)
If dt > Now Then Exit Function
yer = Year(dt)
mon = Month(dt)
d = Day(dt)
yer = Year(Date) - yer
mon = Month(Date) - mon
d = Day(Date) - d
If Sgn(d) = -1 Then
d = 30 - Abs(d)
mon = mon - 1
End If
If Sgn(mon) = -1 Then
mon = 12 - Abs(mon)
yer = yer - 1
End If
sAns = yer & " Tahun " & mon & " Bulan " & d & " Hari"
ExactAge = sAns
End Function
Dim yer As Integer, mon As Integer, d As Integer
Dim dt As Date
Dim sAns As String
If Not IsDate(BirthDate) Then Exit Function
dt = CDate(BirthDate)
If dt > Now Then Exit Function
yer = Year(dt)
mon = Month(dt)
d = Day(dt)
yer = Year(Date) - yer
mon = Month(Date) - mon
d = Day(Date) - d
If Sgn(d) = -1 Then
d = 30 - Abs(d)
mon = mon - 1
End If
If Sgn(mon) = -1 Then
mon = 12 - Abs(mon)
yer = yer - 1
End If
sAns = yer & " Tahun " & mon & " Bulan " & d & " Hari"
ExactAge = sAns
End Function
klo kode d atas untuk menghitung umur. Tehniknya mengurangi Date sekarang dengan Date yg d tentukan....
Private Sub txtlahir_Change()
txtumur.Caption = ExactAge(txtlahir.Text)
End Sub
kode di atas berfungsi untuk membuat caption txtumur sebuah umur dari perbandingan tanggal sekarang dengan waktu yang ada di txtlahir.texttxtumur.Caption = ExactAge(txtlahir.Text)
End Sub
Private Sub txtlahir_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not (KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Or KeyAscii = vbKeyBack ) Then
If KeyAscii = 13 Then
CEK
Else
Dim a
Beep
a = MsgBox("Hanya Bisa Diisi Angka", vbInformation, "Peringatan")
KeyAscii = 0
End If
End If
End Sub
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not (KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Or KeyAscii = vbKeyBack ) Then
If KeyAscii = 13 Then
CEK
Else
Dim a
Beep
a = MsgBox("Hanya Bisa Diisi Angka", vbInformation, "Peringatan")
KeyAscii = 0
End If
End If
End Sub
-untuk baris pertama ane masih belum tahu fungsinya
-untuk baris kedua berfungsi menyeleksi apabila yg diketik adalah angka dan tombol backspace maka program akan lanjut ke bawah. Dan apabila seleksi salah maka akan langsung ke baris 6
-untuk baris ketiga berfungsi menyeleksi apakah yg d ketik tombol ENTER, apabila ya, program lanjut. Apabila tidak, Program akan menuggu.....
-untuk baris keempat memanggil Sub CEK
Sub CEK()
If Not IsDate(txtlahir.Text) Then
Beep
MsgBox "Tanggal Tidak Valid!", vbCritical, "Tidak Valid"
txtlahir.SetFocus
Else
txtumur.Caption = ExactAge(txtlahir.Text)
txtstatus.Enabled = True
txtstatus.SetFocus
End If
End Sub
Terima Kasih banyak gan....
Telah Berkenan mampir di mari....
Lain waktu mampir lagi ya.....
0 comments:
Post a Comment
Tolong diisi se-objektif mungkin ya....
Terima kasih...