Program ini
memakai bahasa pemograman basiq, program ini saya buat untuk kelengkapan tugas
akhir mata kuliah algoritma dan pemograman I..bahasa program basic adalah
bahasa pemograman tingkat tinggi seperti halnya bahasa program pascal, dll.
Berikut gambar
hasil program dan kode programnya;
DECLARE SUB
DialogKeluar (x1!, y1!, x2!, y2!, WarnaDepan!, WarnaBelakang!)
DECLARE SUB
KotakAnimasi (x1!, y1!, x2!, y2!, WarnaDepan!, WarnaBelakang!)
DECLARE SUB
BuatKotak (x1!, y1!, x2!, y2!, WarnaDepan!, WarnaBelakang!, Judul$)
CONST ESC = 27
CONST Terang = 8,
KelapKelip = 16
CONST Biru = 1,
hijau = 2, Cyan = 3, merah = 4, magenta = 5
CONST Putih = 7,
Abu = 8, Hitam = 0, Kuning = 6
DIM Tgl$, NBln$
DIM j$(10)
CLS
CALL BuatKotak(1,
2, 21, 75, 6, 6, "ANDI...")
FOR k = 1 TO 9
NEXT
TanyaBintang:
DIM JUL(1 TO 12)
JUL(1) = 0: JUL(2) = 31: JUL(3) = 59: JUL(4)
= 90
JUL(5) = 120: JUL(6) = 151: JUL(7) = 181:
JUL(8) = 212
JUL(9) = 243: JUL(10) = 273: JUL(11) = 304:
JUL(12) = 334
hh = 0: bb = 0: tt = 0: BintangNya$ =
"": Jkel$ = "": Nama$ = ""
COLOR 7, 7
LOCATE 15, 45: PRINT " "
CALL BuatKotak(8, 16, 16, 62, 6, 6,
"ISI DATA")
COLOR 0, 7
LOCATE 11, 20: PRINT "Nama : "
LOCATE 12, 20: PRINT "Jenis Kelamin
(L/P) : "
LOCATE 13, 20: PRINT "Tgl Lahir
(hhbbtt) : "
UlangIsiNama:
LOCATE 11, 42: INPUT "", Nama$
IF Nama$ = "" OR LEN(Nama$) < 3
THEN
BEEP
LOCATE 11, 42: PRINT UCASE$(Nama$)
END IF
LOCATE 12, 42: INPUT "", Jkel$
IF UCASE$(Jkel$) = "L" OR
UCASE$(Jkel$) = "LAKI-LAKI" THEN
LOCATE 12, 42: PRINT
"Laki-laki"
ELSEIF UCASE$(Jkel$) = "P" OR
UCASE$(Jkel$) = "PEREMPUAN" THEN
LOCATE 12, 42: PRINT
"Perempuan"
ELSE
BEEP
COLOR 24, 7
LOCATE 15, 32: PRINT "Tekan
tombol..."
COLOR 0, 7
LOCATE 12, 42: PRINT " "
LOCATE 15, 32: PRINT " "
END IF
UlangIsiTgl:
LOCATE 13, 42: INPUT "", Tgl$
hh = VAL(LEFT$(Tgl$, 2))
IF hh <= 0 OR hh > 31 THEN
BEEP
LOCATE 13, 42: PRINT " "
GOTO UlangIsiTgl
END IF
bb = VAL(MID$(Tgl$, 3, 2))
Juldate = JUL(bb) + hh
IF tt / 4 = INT(tt / 4) AND bb > 2 THEN
Juldate = Juldate + 1
Julian = Juldate
IF Julian >= 20 AND Julian <= 49 THEN
Bintang$ = "Aquarius"
IF Julian >= 50 AND Julian <= 79 THEN
Bintang$ = "Pisces"
IF Julian >= 80 AND Julian <= 110
THEN Bintang$ = "Aries"
IF Julian >= 111 AND Julian <= 141
THEN Bintang$ = "Taurus"
IF Julian >= 142 AND Julian <= 171
THEN Bintang$ = "Gemini"
IF Julian >= 172 AND Julian <= 203
THEN Bintang$ = "Cancer"
IF Julian >= 204 AND Julian <= 234
THEN Bintang$ = "Leo"
IF Julian >= 235 AND Julian <= 265
THEN Bintang$ = "Virgo"
IF Julian >= 266 AND Julian <= 296
THEN Bintang$ = "Libra"
IF Julian >= 297 AND Julian <= 326
THEN Bintang$ = "Scorpio"
IF Julian >= 327 AND Julian <= 355
THEN Bintang$ = "Sagitarius"
IF Julian >= 356 OR Julian <= 19 THEN
Bintang$ = "Capricornus"
Tgl$ =
MID$(DATE$, 4, 2)
bln$ =
MID$(DATE$, 1, 2)
Thn$ = MID$(DATE$,
7, 4)
NamaBulan:
SELECT CASE bln$
CASE IS = "01"
NBln$ = "Januari"
CASE IS = "02"
NBln$ = "Februari"
CASE IS = "03"
NBln$ = "Maret"
CASE IS = "04"
NBln$ = "April"
CASE IS = "05"
NBln$ = "Mei"
CASE IS = "06"
NBln$ = "Juni"
CASE IS = "07"
NBln$ = "Juli"
CASE IS = "08"
NBln$ = "Agustus"
CASE IS = "09"
NBln$ = "September"
CASE IS = "10"
NBln$ = "Oktober"
CASE IS = "11"
NBln$ = "Nopember"
CASE IS = "12"
NBln$ = "Desember"
END SELECT
CLS
CALL BuatKotak(3,
2, 18, 74, 6, 6, "RAMALAN BINTANG")
Brs = 5: kol = 5
'---------
keterangan bintang -------
KetBintang:
SELECT CASE UCASE$(Bintang$)
CASE "AQUARIUS"
Arti$ = "Penuang Air"
Simbol$ = "Dua garis
gelombang"
Jodoh$ = "Gemini, Cancer,
Sagitarius"
CASE "PISCES"
Arti$ = "Ikan"
Simbol$ = "Dua ikan"
Jodoh$ = "Cancer, Scorpio,
Leo"
CASE "ARIES"
Arti$ = "Domba"
Simbol$ = "Tanduk domba"
Jodoh$ = "Leo, Capricornus,
Gemini"
CASE "TAURUS"
Arti$ = "Sapi"
Simbol$ = "Sapi jantan"
Jodoh$ = "Libra, Leo,
Capricornus"
CASE "GEMINI"
Arti$ = "Kembar"
Simbol$ = "Orang kembar"
Jodoh$ = "Aries, Taurus,
Scorpio"
CASE "CANCER"
Arti$ = "Kepiting"
Simbol$ = "Jepit Kepiting"
Jodoh$ = "Scorpio, Pisces,
Aries"
CASE "LEO"
Arti$ = "Singa"
Simbol$ = "Singa jantan"
Jodoh$ = "Aries, Aquarius,
Virgo"
CASE "VIRGO"
Arti$ = "Perawan"
Simbol$ = "Wanita"
Jodoh$ = "Capricornus, Taurus,
Leo"
CASE "LIBRA"
Arti$ = "Seimbang"
Simbol$ = "Timbangan"
Jodoh$ = "Gemini, Pisces,
Virgo"
CASE "SCORPIO"
Arti$ = "Kalajengking"
Simbol$ = "Kalajengking"
Jodoh$ = "Gemini, Pisces,
Scorpio"
CASE "SAGITARIUS"
Arti$ = "Panah"
Simbol$ = "Pemanah"
Jodoh$ = "Leo, Libra, Taurus"
CASE "CAPRICORNUS"
Arti$ = "Makara"
Simbol$ = "Kambing"
Jodoh$ = "Virgo, Taurus,
Gemini"
CASE ELSE
END SELECT
COLOR 0, 7
LOCATE Brs, kol:
PRINT Sebut$; " SAHABAT "; UCASE$(Nama$); " ANDA
BERZODIAK..."
COLOR 15, 7
LOCATE Brs + 2,
kol: PRINT UCASE$(Bintang$); "..."
COLOR 0, 7
LOCATE Brs + 3,
kol: PRINT "Arti : "; Arti$
LOCATE Brs + 4,
kol: PRINT "Simbol : "; Simbol$
LOCATE Brs + 5,
kol: PRINT "Jodoh : "; Jodoh$
LOCATE Brs + 8,
kol + 49: PRINT "Enter KELUAR"
END
RETURN
SUB BuatKotak
(x1, y1, x2, y2, WarnaDepan, WarnaBelakang, Judul$)
COLOR WarnaDepan, WarnaBelakang
LOCATE x1, y1: PRINT "Ú";
LOCATE x1, y1 + 1: PRINT STRING$(y2 - y1,
196); "¿"
LOCATE x2 + 1, y1 + 1: PRINT STRING$(y2 -
y1, 196);
LOCATE x2 + 1, y1: PRINT "À"
LOCATE x2 + 1, y2 + 1: PRINT "Ù"
FOR t = x1 + 1 TO x2
LOCATE t, y1: PRINT "³"
LOCATE t, y2 + 1: PRINT "³"
NEXT t
COLOR 8 + WarnaDepan, 0
LOCATE x1, y1 + 5: PRINT " ";
Judul$; " "
COLOR 7, 0
'bayangan
COLOR 0, 0
LOCATE x2 + 2, y1 + 2: PRINT STRING$(y2 -
y1 + 2, 219)
FOR nt = x1 + 1 TO x2 + 1
LOCATE nt, y2 + 2: PRINT "ÛÛ"
NEXT nt
'isi kotak dengan karakter kosong
FOR nn = x1 + 1 TO x2
FOR j = y1 + 1 TO y2
COLOR 7, 1
LOCATE nn, j: PRINT CHR$(219);
NEXT j
NEXT nn
'efek 3 dimensi
COLOR 15, 7: LOCATE x1 + 1, y1 + 2: PRINT
STRING$((y2 - y1) - 2, 196)
COLOR 0, 7: LOCATE x2, y1 + 2: PRINT
STRING$((y2 - y1) - 2, 196)
END SUB
SUB DialogKeluar
(x1, y1, x2, y2, WarnaDepan, WarnaBelakang)
CALL KotakAnimasi(x1, y1, x2, y2,
WarnaDepan, WarnaBelakang)
COLOR Putih + Terang + KelapKelip,
WarnaBelakang
LOCATE y1 + 1, x1 + (x2 - x1) / 2 + 2
PRINT "KELUAR ? (Y/T) "
Resp$ = INPUT$(1)
IF LEFT$(UCASE$(Resp$), 1) = "Y"
THEN
CALL BuatKotak(2, 16, 21, 63, 6, 6,
"WASSALAM...")
COLOR WarnaDepan, WarnaBelakang
LOCATE 4, 17: PRINT " Terima kasih telah memilih program ini.. "
LOCATE 5, 17: PRINT " Medan - Sumatera Utara 21 JULI 1999 "
LOCATE 6, 17: PRINT " "
COLOR 0, 7
LOCATE 7, 17: PRINT "
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ "
COLOR 15, 0
LOCATE 8, 18: PRINT " Ir. Hartoto "
COLOR 7, 0
LOCATE 9, 18: PRINT "
"
LOCATE 10, 18: PRINT " http://www.xbasicpro.com "
LOCATE 11, 18: PRINT "
"
LOCATE 12, 18: PRINT " "
LOCATE 13, 18: PRINT "
"
LOCATE 14, 18: PRINT "
"
LOCATE 15, 18: PRINT " "
LOCATE 16, 18: PRINT "
"
LOCATE 17, 18: PRINT "
"
LOCATE 18, 18: PRINT " "
LOCATE 19, 18: PRINT "
"
LOCATE 20, 18: PRINT "
"
COLOR 7, 0
PRINT
tahan$ = INPUT$(1)
END
ELSE
EXIT SUB
END IF
END SUB
SUB KotakAnimasi
(x1, y1, x2, y2, WarnaDepan, WarnaBelakang)
COLOR WarnaDepan, WarnaBelakang
FOR a = x1 TO (x2 - x1) / 2
FOR tunda = 1 TO 9000
NEXT tunda
'\**jalan ke kanan
LOCATE y1, (x2 - ((x2 - x1) / 2)) + a:
PRINT STRING$((x2 - x1) / 4, 196); "¿"
LOCATE y1 + 1, (x2 - ((x2 - x1) / 2)) +
a: PRINT STRING$((x2 - x1) / 4, " "); "³"
LOCATE y1 + 2, (x1 + ((x2 - x1) / 2)) +
a: PRINT STRING$((x2 - x1) / 4, 196); "Ù"
'\**jalan ke kiri
LOCATE y1, x1 + (x2 - ((x2 - x1) / 2))
- a + 1: PRINT "Ú"; STRING$((x2 - x1) / 4, 196)
LOCATE y1 + 1, x1 + (x2 - ((x2 - x1) /
2)) - a + 1: PRINT ; "³"; STRING$((x2 - x1) / 4, " ")
LOCATE y1 + 2, x1 + (x2 - ((x2 - x1) /
2)) - a + 1: PRINT ; "À"; STRING$((x2 - x1) / 4, 196)
NEXT a
END SUB
Tidak ada komentar:
Posting Komentar