Thursday, January 21, 2010

Source kode

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: