VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form Hitung Umur"
ClientHeight = 2295
ClientLeft = 45
ClientTop = 330
ClientWidth = 4590
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2295
ScaleWidth = 4590
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame2
Height = 780
Left = 135
TabIndex = 4
Top = 1395
Width = 4290
Begin VB.CommandButton cmdKeluar
Caption = "Keluar"
Height = 375
Left = 2745
TabIndex = 6
Top = 225
Width = 1410
End
Begin VB.CommandButton cmdHitung
Caption = "Hitung Umur"
Height = 375
Left = 135
TabIndex = 5
Top = 225
Width = 1410
End
End
Begin VB.Frame Frame1
Height = 1185
Left = 135
TabIndex = 0
Top = 180
Width = 4290
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 285
Left = 2520
TabIndex = 2
Text = "19-03-1980"
Top = 270
Width = 915
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
Height = 285
Left = 180
TabIndex = 1
Top = 630
Width = 3975
End
Begin VB.Label Label1
Caption = "Masukkan Tanggal Lahir Anda"
Height = 195
Left = 180
TabIndex = 3
Top = 315
Width = 2220
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ExactAgenow As String
Public 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 = "Umur anda saat ini adalah : " & yer & " Tahun " & mon & " Bulan " & d _
& " Hari"
ExactAgenow = sAns
End Function
Private Sub cmdHitung_Click()
ExactAge Text1.Text
Text2.Text = ExactAgenow
End Sub
Private Sub cmdKeluar_Click()
Unload Me
End Sub

No comments:
Post a Comment