Untuk mendownload source code program ini dapat di download di bawah ini .
Download Link : http://www.easy-share.com/1913045301/prog_zodiak_hitungumur.rar
Coding di Form :
Public Class lsthasil
Function getzodiak(ByVal tgllahir As Date) As String
Dim tanggal, bulan, zodiak As String
tanggal = tgllahir.Day
bulan = tgllahir.Month
Select Case tgllahir.Month
Case 1
If tanggal >= 20 Then
zodiak = "Aquarius"
Else
zodiak = "Capricorn"
Case 2
If tanggal >= 19 Then
zodiak = "Pisces"
Else
zodiak = "Aquarius"
End If
Case 3
If tanggal >= 21 Then
zodiak = "Aries"
Else
zodiak = "Pisces"
End If
Case 4
If tanggal >= 21 Then
zodiak = "Taurus"
Else
zodiak = "Aries"
End If
Case 5
If tanggal >= 21 Then
zodiak = "Gemini"
Else
zodiak = "Taurus"
End If
Case 6
If tanggal >= 21 Then
zodiak = "Cancer"
Else
zodiak = "Gemini"
End If
Case 7
If tanggal >= 21 Then
zodiak = "Leo"
Else
zodiak = "Cancer"
End If
Case 8
If tanggal >= 22 Then
zodiak = "Virgo"
Else
zodiak = "Leo"
End If
Case 9
If tanggal >= 23 Then
zodiak = "Libra"
Else
zodiak = "Virgo"
End If
Case 10
If tanggal >= 24 Then
zodiak = "Scropio"
Else
zodiak = "Libra"
End If
Case 11
If tanggal >= 23 Then
zodiak = "Sagitarius"
Else
zodiak = "Scorpio"
End If
Case 12
If tanggal >= 21 Then
zodiak = "Capricorn"
Else
zodiak = "Sagitarius"
End If
End Select
Return zodiak
End Function
Function getumur(ByVal tgllahir As Date) As String
Dim year, month, day As Integer
year = Now.Year - tgllahir.Year
month = Now.Month - tgllahir.Month
day = Now.Day - tgllahir.Day
If Math.Sign(day) = -1 Then
day = 30 - Math.Abs(day)
month -= 1
End If
If Math.Sign(month) = -1 Then
month = 12 - Math.Abs(month)
year -= 1
End If
Return year & " tahun, " & month & " bulan, " & day & " hari."
End Function
Sub clearinputoutput()
Txtnama.Text = ""
dtptanggalLahir.Value = Format(Now, "MM/dd/yyyy")
Lsbhasil.Items.Clear()
End Sub
Function validateinput(ByVal tgllahir As Date) As Boolean
Dim flag As Boolean
If dtptanggallahir.Value >= Now Then
flag = False
MessageBox.Show("Cek Kembali tanggal lahir anda")
Else
flag = True
End If
Return flag
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
dtptanggallahir.Value = Now
End Sub
Private Sub btnHitung_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnHitung.Click
Dim zodiak, umur As String
If Len(Trim(txtnama.Text)) = 0 Then
MessageBox.Show("Tolong isi Nama Anda.")
Exit Sub
End If
If validateinput(dtptanggallahir.Value) = False Then
Exit Sub
End If
zodiak = getzodiak(dtptanggallahir.Value)
umur = getumur(dtptanggallahir.Value)
lsbhasil.Items.Clear()
lsbhasil.Items.Add("Hi , " & txtnama.Text)
lsbhasil.Items.Add("Zodiak Anda Adalah : " & zodiak)
lsbhasil.Items.Add("Umur Anda Sekarang : " & umur)
End Sub
Private Sub btnReset_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnReset.Click
clearinputoutput()
End Sub
End Class
0 comments:
Post a Comment