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
