Pascal zodiak

PROGRAM ZODIAK;
USES CRT, DOS;

TYPE TANGGAL = RECORD
    DD, MM, YY:INTEGER;
END;

VAR I, J, X, Y:INTEGER;
    TOMBOL, HURUF:CHAR;
    STANGGAL:STRING;
    NAMA:STRING;
    SALAH:INTEGER;
    MYTANGGAL:TANGGAL;
    IDX:CHAR;
    SJK:STRING;

(*
  FUNGSI UNTUK MENGKONVERSI NILAI LONGINT
  MENJADI STRING (TEKS)
*)

FUNCTION INTTOSTR(I: LONGINT): STRING;
VAR
        S: STRING[11];

BEGIN
    STR(I, S);
    INTTOSTR := S;
END;

(*
  FUNGSI UNTUK MENENTUKAN NAMA HARI DAN BULAN
  MENURUT TANGGAL PADA SISTEM
*)

FUNCTION HARI_INI:STRING;
CONST
    DAYS : ARRAY [0..6] OF STRING[9] =
          ('MINGGU','SENIN','SELASA',
          'RABU','KAMIS','JUMAT',
          'SABTU');
    MONTHS : ARRAY [1..12] OF STRING [10] =
        ('JANUARI','PEBRUARI','MARET','APRIL',
        'MEI','JUNI','JULI','AGUSTUS','SEPTEMBER',
        'OKTOBER','NOPEMBER','DESEMBER');
VAR
    Y, M, D, DOW : Word;

BEGIN
  GETDATE(Y,M,D,DOW);

  HARI_INI := 'HARI INI : ' + DAYS[DOW] + ', ' +
          INTTOSTR(d) +  ' ' + MONTHS[M] + ' ' + INTTOSTR(y);
END;

(*
  PROSEDUR UNTUK MENULISKAN TEKS
  PADA POSISI TERTENTU
*)

PROCEDURE TULIS(KIRI, ATAS, PILIH:INTEGER;
                TEKS:STRING);
VAR PANJANG:INTEGER;

BEGIN
  PANJANG := LENGTH(TEKS);
  IF PILIH = 1 THEN
        GOTOXY(KIRI, ATAS)
  ELSE IF PILIH = 2 THEN
        (* AGAR POSISI KURSOR DITENGAH-TENGAH LAYAR *)
        GOTOXY((80 - PANJANG) DIV 2, ATAS)
  ELSE IF PILIH = 3 THEN
        GOTOXY((80 - PANJANG), ATAS);
  WRITE(TEKS);
END;

(*
  PROSEDUR UNTUK MEMBUAT KOTAK/WINDOW
*)
PROCEDURE WINDOW(KIRI, ATAS, LEBAR, TINGGI,
                WARNA1, WARNA2:INTEGER;
                ARSIR:BYTE);

BEGIN
    TEXTATTR:=WARNA1;
    TEXTATTR:=WARNA2;

    TULIS(KIRI, ATAS, 1, CHAR(201));
    TULIS(KIRI, ATAS+TINGGI, 1, CHAR(200));
    TULIS(KIRI+LEBAR, ATAS, 1, CHAR(187));
    TULIS(KIRI+LEBAR, ATAS+TINGGI, 1, CHAR(188));

    FOR I:= KIRI+1 TO KIRI+LEBAR-1 DO
    BEGIN
        TULIS(I, ATAS, 1, 'Í');
        TULIS(I, ATAS+TINGGI, 1, 'Í');
    END;

    FOR I:= ATAS+1 TO TINGGI+ATAS-1 DO
    BEGIN
        TULIS(KIRI, I, 1,CHAR(186));
        TULIS(KIRI + LEBAR, I, 1,CHAR(186));
    END;

    IF ARSIR = 1 THEN
    BEGIN
        FOR I:= ATAS + 1 TO TINGGI + ATAS - 1 DO
        FOR J:= KIRI + 1 TO KIRI + LEBAR - 1 DO
        TULIS(J, I, 1, CHAR(176));
    END
    ELSE
    BEGIN
        FOR I:= ATAS + 1 TO TINGGI + ATAS - 1 DO
        FOR J:= KIRI + 1 TO KIRI + LEBAR - 1 DO
    TULIS(J, I, 1, ' ');
    END;

    TEXTATTR:=WARNA2;
END;

(*
  PROSEDUR UNTUK MENENTUKAN NAMA ZODIAK
  MENURUT NILAI DARI VARIABEL IDX
*)

PROCEDURE KETERANGAN;

BEGIN
    CLRSCR;
    WINDOW(1,1,79,23,$4A,$5B,0);

    IF (SJK) = 'L' THEN
        TULIS(3,3,1,'MAS ' + NAMA)
    ELSE
        TULIS(3,3,1,'MBA ' + NAMA);

    TULIS (3,4,1, 'TERNYATA ZODIAK ANDA ADALAH ...');

    WINDOW((80-14) dIV 2,6,14,2,$21,$1C,0);
    WINDOW(2,10,77,13,$21,$1C,0);

    TEXTCOLOR(YELLOW);
    TULIS(3,11,1,'SIFAT :');
    TULIS(3,18,1,'CIRI KHAS :');

    TEXTCOLOR(GREEN);

    CASE IDX OF
    '1' : BEGIN
              TULIS(1,7,2,'CAPRICORNUS')
              {TULIS(3,19,1,'')}
          END;
    '2': BEGIN
              TULIS(1,7,2,'AQUARIUS')
              {TULIS(3,19,1,'')}
        END;
    '3' : BEGIN
              TULIS(1,7,2,'PISCES')
              {TULIS(3,19,1,'')}
          END;
    '4': BEGIN
              TULIS(1,7,2,'ARIES')
              {TULIS(3,19,1,'')}
        END;
    '5' : BEGIN
              TULIS(1,7,2,'TAURUS')
              {TULIS(3,19,1,'')}
          END;
    '6': BEGIN
              TULIS(1,7,2,'GEMINI')
              {TULIS(3,19,1,'')}
        END;
    '7' : BEGIN
              TULIS(1,7,2,'CANCER')
              {TULIS(3,19,1,'')}
          END;
    '8': BEGIN
              TULIS(1,7,2,'LEO')
              {TULIS(3,19,1,'')}
        END;
    '9' : BEGIN
              TULIS(1,7,2,'VIRGO')
              {TULIS(3,19,1,'')}
          END;
    'A': BEGIN
              TULIS(1,7,2,'LIBRA')
              {TULIS(3,19,1,'')}
        END;
    'B' : BEGIN
              TULIS(1,7,2,'SCORPIO')
              {TULIS(3,19,1,'')}
          END;
    'C': BEGIN
              TULIS(1,7,2,'SAGITARIUS')
              {TULIS(3,19,1,'')}
        END;
    END;
END;

(*
  PROSEDUR UNTUK MENENTUKAN IDX BERDASARKAN TANGGAL DAN BULAN
  YANG DIINPUTKAN
*)

PROCEDURE CEK_ZODIAK(TANGGAL, BULAN:WORD);
VAR NAMA_ZODIAK:STRING;

BEGIN
    CLRSCR;

    IF BULAN = 1 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '2'
          ELSE
              IDX := '1'
        END
    ELSE IF BULAN = 2 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '3'
          ELSE
              IDX := '2'
        END
    ELSE IF BULAN = 3 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '4'
          ELSE
              IDX := '3'
        END
    ELSE IF BULAN = 4 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '5'
          ELSE
              IDX := '4'
        END

    ELSE IF BULAN = 5 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '6'
          ELSE
              IDX := '5'
        END
    ELSE IF BULAN = 6 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '7'
          ELSE
              IDX := '6'
        END
    ELSE IF BULAN = 7 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '8'
          ELSE
              IDX := '7'
        END
    ELSE IF BULAN = 8 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '9'
          ELSE
              IDX := '8'
        END
    ELSE IF BULAN = 9 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := 'A'
          ELSE
              IDX := '9'
        END
    ELSE IF BULAN = 10 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := 'B'
          ELSE
              IDX := 'A'
        END
    ELSE IF BULAN = 11 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := 'C'
          ELSE
              IDX := 'B'
        END
    ELSE IF BULAN = 12 THEN
        BEGIN
          IF (TANGGAL) >= 23 THEN
              IDX := '1'
          ELSE
              IDX := 'C'
        END;

  KETERANGAN;
END;

(*
  PROSEDUR UNTUK MENGINPUTKAN TANGGAL
*)
PROCEDURE INPUT_TANGGAL;
BEGIN
    TULIS(39,7,1,'  /  /  ');
    GOTOXY(39,7);
    I:=34; J:=7;
    STANGGAL := '';
    HURUF := #0;

    WHILE (HURUF <> #13) AND (LENGTH(STANGGAL) < 8) DO
    BEGIN
          REPEAT
            HURUF:=READKEY;

            (*  PEMBATASAN AGAR TOMBOL KEYBOARD YG BERFUNGSI
              HARUSLAH TOMBOL ANGKA DAN ENTER SAJA *)

          UNTIL HURUF IN ['1','2','3','4','5',
          '6','7','8','9','0',#13];
          IF HURUF <> #13 THEN
          BEGIN
                STANGGAL := STANGGAL + HURUF;
                WRITE(HURUF);
              
                IF (LENGTH(STANGGAL)=2) OR
                (LENGTH(STANGGAL)=5) THEN
                BEGIN
                    STANGGAL := STANGGAL + '/';
                    WRITE('/');
                END;
          END;
    END;

        TULIS(39,7, 1, STANGGAL);

        (* MENGISI NILAI-NILAI VARIABEL (TANGGAL,
          BULAN DAN TAHUN) BERDASARKAN STRING
          YANG DIINPUTKAN *)

        VAL(COPY(STANGGAL,1,2),MYTANGGAL.DD,SALAH);
        VAL(COPY(STANGGAL,4,2),MYTANGGAL.MM,SALAH);
        VAL(COPY(STANGGAL,7,2),MYTANGGAL.YY,SALAH);
END;

(* PROGRAM UTAMA *)
BEGIN
    CLRSCR;

    (* MEMPERCANTIK TAMPILAN *)
    WINDOW(1,1,79,23,$4A,$5B,1);
    WINDOW(20,2,41,3,$1A,15,0);

    TULIS(0,3,2,'SELAMAT DATANG');
    TULIS(0,4,2,'DI RAMALAN ZODIAK INOCHIS' +
    CHAR(147)  + 'ftware');

    WINDOW(18,8,45,4,$3B,$6F,0);
    TULIS (0, 9, 2, 'DIBUAT OLEH : KI AGUNG NOVIAN');
    TULIS (0, 10, 2, 'TEAM PROGRAMMER');
    TULIS (0, 11, 2, 'INOCHI COMPUTER CIREBON');
    TEXTATTR:=$1F;
    TULIS (0, 15, 2, HARI_INI);

    TEXTATTR:=$8F;
    TULIS (0, 17, 2, 'INOCHIS' + CHAR(147) + 'ftware');
    TULIS (0, 18, 2,
    'Jl. P. Drajat Gg. Jepun No. 48 '
    + 'Telp. (0231) 210178 Cirebon');

    WINDOW(19,21,43,2,$1A,15,0);
    TULIS(0,22,2,'TEKAN SEMBARANG TOMBOL UNTUK MELANJUTKAN');
    READKEY;

    CLRSCR;
    WINDOW(1,1,79,23,$1D,$7F,1);
    WINDOW(15,3,50,8,$2A,$6B,0);

    TULIS (20,5,1,'NAMA ANDA        : ');
    GOTOXY(39,5);READLN(NAMA);
    TULIS (20,7,1,'TANGGAL LAHIR    : ');

    INPUT_TANGGAL;

    TULIS (20,9,1,'J. KELAMIN (L/K) : ');

    WHILE (HURUF <> #13) AND (LENGTH(SJK) < 2) DO
    BEGIN
        REPEAT
            HURUF := READKEY;
        UNTIL HURUF IN ['L', 'l', 'p', 'P', #13];
        IF HURUF <> #13 THEN
        BEGIN
          SJK := SJK + HURUF;
          WRITE (HURUF);
        END;
    END;

    (* PEMANGGILAN PROSEDUR *)
    CEK_ZODIAK(MYTANGGAL.DD, MYTANGGAL.MM);

    READLN;
END.