Program Zodiac dengan Pascal

Topik sebelumnya Topik selanjutnya Go down

Program Zodiac dengan Pascal

Post by PujanggaBageur on Sun Oct 19, 2008 2:29 pm

Membangun program untuk menentukan zodiac memang terlalu lazim dan mudah, di semua jenis bahasa pemogramman. Banyak sekolah-sekolah computer atau kursus-kursur yang mengambil program zodiac sebagai bahan latihan awal. Tapi pembahasan mengenai program zodiac dengan Pascal kali ini mungkin akan lebih spesial. Karena di sini diterapkan trik-trik menarik dan penggunaan prosedur dan fungsi.

Desain Program

Program untuk menentukan zodiac melatih penggunaan beberapa struktur pengambilan keputusan dalam bahasa pemograman yaitu: struktur IF bersarang (If … Then … Else), dan strukstur seleksi (Case Of). Karena kedua buah struktur ini boleh dikata merupakan ‘jantung’ dari bahasa pemograman. Baiklah, langsung saja kita ke pembahasan.

Pada program ini diterapkan beberapa prosedur dan fungsi, diantaranya:

Prosedur

Nama Prosedur Kegunaan
TulisMenuliskan teks pada posisi tertentu. Prosedur ini juga disertai 3 (tiga) pilihan perataan teks (terhadap layar monitor) yaitu: rata kiri, rata, rata tengah, dan rata kanan.
Window Membuat window (kotak) dengan ukuran tertentu dan pada lokasi tertentu, window ini dilengkapi dengan bingkai dan dapat diarsir (diisi bagian dalamnya), juga dapat ditentukan warna huruf dan warna latarnya.
KeteranganMenentukan nama zodiac berdasarkan nilai yang diterima, kemudian menampilkannya pada layar monitor.
Cek_Zodiak Menentukan id dari zodiac berdasarkan nilai tanggal dan bulan yang diterima.
Input_TanggalMenerima nilai entri untuk mengisi nilai tanggal dan bulan.

Fungsi

Nama Prosedur
Kegunaan
IntToStrMengkonversi nilai bertipe LongInt menjadi String
Hari_IniMencetak nama hari dan bulan menurut data tanggal pada sistem

Code:

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.

_________________
Tidak ada yang menarik, datang kemudian hilang, pergi tak kembali.

PujanggaBageur
Admin
Admin

Jumlah posting : 148
Join date : 07.08.08
Age : 34
Lokasi : Cirebon

Lihat profil user http://inochi.forumotion.net

Kembali Ke Atas Go down

Topik sebelumnya Topik selanjutnya Kembali Ke Atas

- Similar topics

 
Permissions in this forum:
Anda tidak dapat menjawab topik