Gambar Program Aplikasi Horoskop |
Beberapa hari yang lalu ada seorang teman cew dari kampus yang terkemuka juga di kota medan ini, dia bertanya soal pada saya gimana cara buat Program ramalan Zodiak dari Visual Basic 6.0
Sebenarnyasih dikampus q sama sekali gak pernah buatnya, cuma karena saya juga penasaran dengan program Zodiaknya langsung aja saya sanggupi untuk membuatlanya.
setalh berpikir logika programnya sebentar selanjutnya saya mulai membuat formnya. dan membuat programnya.
nah beginilah listing program yang saya buat mungkin akan terlihat sangat kacau listing programnya tapi tenang aja, dibawah saya sudah menyediakan file aslinya supaya bisa teman-teman edit kembali :
nah beginilah listing program yang saya buat mungkin akan terlihat sangat kacau listing programnya tapi tenang aja, dibawah saya sudah menyediakan file aslinya supaya bisa teman-teman edit kembali :
Private Sub Form_Load()
LblHari.Visible = False
LblUmur.Visible = False
LblZodiak.Visible = False
LblKeterangan.Visible = False
hari.Visible = False
umur.Visible = False
zodiak.Visible = False
keterangan.Visible = False
tahun.Visible = False
CmbKelamin.Text = "Pilih..!!"
With CmbKelamin
.AddItem "Laki-Laki"
.AddItem "Perempuan"
End With
End Sub
Private Sub Command1_Click()
Dim Bulan As Integer
Dim Tanggal As Integer
Tanggal = Format(DTPicker.Value, "dd")
Bulan = Format(DTPicker.Value, "MM")
If TxtNama.Text = "" Then
MsgBox "Isi Dahulu Nama Anda", vbInformation, "Informasi"
TxtNama.SetFocus
Exit Sub
End If
If CmbKelamin.Text = "" Or CmbKelamin.Text = "Pilih..!!" Then
MsgBox "Pilih Dahulu Jenis Kelamin Anda", vbInformation, "Informasi"
CmbKelamin.SetFocus
Exit Sub
End If
'Menentkan Umur
LblUmur.Caption = DateDiff("yyyy", DTPicker.Value, Date)
'Menentukan Hari
KodeHari = Weekday(DTPicker.Value)
Select Case KodeHari
Case 1: hari = "Minggu"
Case 2: hari = "Senin"
Case 3: hari = "Selasa"
Case 4: hari = "Rabu"
Case 5: hari = "Kamis"
Case 6: hari = "Jumat"
Case 7: hari = "Sabtu"
End Select
LblHari.Caption = hari
'Menentukan Zodiak
If Bulan = 1 Then
LblZodiak.Caption = IIf(Tanggal <= 19, "Capricorn", "Aquarius")
ElseIf Bulan = 2 Then
LblZodiak.Caption = IIf(Tanggal <= 19, "Aquarius", "Pisces")
ElseIf Bulan = 3 Then
LblZodiak.Caption = IIf(Tanggal <= 20, "Pisces", "Aries")
ElseIf Bulan = 4 Then
LblZodiak.Caption = IIf(Tanggal <= 20, "Aries", "Taurus")
ElseIf Bulan = 5 Then
LblZodiak.Caption = IIf(Tanggal <= 21, "Taurus", "Gemini")
ElseIf Bulan = 6 Then
LblZodiak.Caption = IIf(Tanggal <= 21, "Gemini", "Cancer")
ElseIf Bulan = 7 Then
LblZodiak.Caption = IIf(Tanggal <= 21, "Cancer", "Leo")
ElseIf Bulan = 8 Then
LblZodiak.Caption = IIf(Tanggal <= 21, "Leo", "Virgo")
ElseIf Bulan = 9 Then
LblZodiak.Caption = IIf(Tanggal <= 22, "Virgo", "Libra")
ElseIf Bulan = 10 Then
LblZodiak.Caption = IIf(Tanggal <= 23, " Libra", "Scorpio")
ElseIf Bulan = 11 Then
LblZodiak.Caption = IIf(Tanggal <= 22, "Scorpio", "Sagitarius")
Else
LblZodiak.Caption = IIf(Tanggal <= 22, "Sagitarius", "Capricorn")
End If
'Mengisi Label keterangan
If LblZodiak.Caption = "Capricorn" Then
LblKeterangan.Caption = "Penuh energi, Penuh intuisi, mampu berinspirasi, dapat meramal, berperikemanusiaan, dapat menerangkan sesuatu"
ElseIf LblZodiak.Caption = "Aquarius" Then
LblKeterangan.Caption = "Berbakat artistik, bisa berimajinasi, berinspirasi, berkemampuan bicara, serba bisa, optimis, suka kesenangan, nasib baik, cemerlang, mampu meramal dengan cepat"
ElseIf LblZodiak.Caption = "Pisces" Then
LblKeterangan.Caption = "Penuh energi, serba bisa, banyak akal, cepat bertindak, cinta kebebasan dan perubahan, bisa menjamu dan menghibur, seksualitas, mampu berpikir cepat"
ElseIf LblZodiak.Caption = "Aries" Then
LblKeterangan.Caption = "Penuh energi, serba bisa, banyak akal, cepat bertindak, cinta kebebasan dan perubahan, bisa menjamu dan menghibur, seksualitas, mampu berpikir cepat"
ElseIf LblZodiak.Caption = "Taurus" Then
LblKeterangan.Caption = "Ulet, gigih, Memiliki otoritas, berkemampuan eksekutif, senang melakukan supervisi, mempertimbangkan efisiensi, penilai, meterialis, bisa dipercaya"
ElseIf LblZodiak.Caption = "Gemini" Then
LblKeterangan.Caption = "Berani, Penuh inisiatif, mempunyai daya cipta, Individualitas, mempnyai gagasan2 creatif dan inventif, memiliki kemampuan eksekutif, berkemauan keras, gigih, mandiri, mampu bertindak, penuh perjuangan"
ElseIf LblZodiak.Caption = "Cancer" Then
LblKeterangan.Caption = "Mempunyai perdamaian, dapat bekerja sama, berjiwa kemitraan, diplomasi, penengah, suka berunding, mudah beradaptasi, rendah hati, luwes, memiliki pengaruh spiritual"
ElseIf LblZodiak.Caption = "Leo" Then
LblKeterangan.Caption = "Berbakat artistik, bisa berimajinasi, berinspirasi, berkemampuan bicara, serba bisa, optimis, suka kesenangan, nasib baik, cemerlang, mampu meramal dengan cepat"
ElseIf LblZodiak.Caption = "Virgo" Then
LblKeterangan.Caption = "Berbakat artistik, bisa berimajinasi, berinspirasi, berkemampuan bicara, serba bisa, optimis, suka kesenangan, nasib baik, cemerlang, mampu meramal dengan cepat"
ElseIf LblZodiak.Caption = "Libra" Then
LblKeterangan.Caption = "Konstruktif, sistematis, tertib, praktis, relistis, teguh, tenang, efisien, pembangun, serius, berpikir ilmiah, tekun, bertanggung jawab, rajin, jujur, setia, keras hari"
ElseIf LblZodiak.Caption = "Scorpio" Then
LblKeterangan.Caption = "Tidak mementingkan diri sendiri, pemaaf, iba hati, bisa toleran, lapang dada, dermawan, ahli agama, suka akan hal spiritual"
Else
LblKeterangan.Caption = "Berbakat artistik, bisa berimajinasi, berinspirasi, berkemampuan bicara, serba bisa, optimis, suka kesenangan, nasib baik, cemerlang, mampu meramal dengan cepat"
End If
LblHari.Visible = True
LblUmur.Visible = True
LblZodiak.Visible = True
LblKeterangan.Visible = True
hari.Visible = True
umur.Visible = True
zodiak.Visible = True
keterangan.Visible = True
tahun.Visible = True
End Sub
Private Sub Command2_Click()
End
End Sub
'Membuat tulisan blog berwarna
Private Sub Timer1_Timer()
blog.ForeColor = RGB(255, 255, 255) * Rnd
End Sub
'Membuat Nama zodiak berganti2 warna
Private Sub Timer3_Timer()
LblZodiak.ForeColor = RGB(255, 255, 255) * Rnd
End Sub
Download File :
Download : Zodiak
Password : fahri
Ukuran : 701 kb
2 Komentar:
erorr broo..sintaxnya mungkin da yg salah
iya bro erorr,,,
waktu compile filenya menjadi file execute saya lupa. ada beberapa yang tidak saya ceklis.
tapi sintaksnyaitu sudah OK ko.
coba aja compile ulang programnya di vb 6.0
Posting Komentar