Program Pascal Antrian (Queue) - Array Statis


Berikut ini adalah Program Pascal membuat Queue ( Antrian ), yang hari ini telah saya serahkan kepada dosen sebagai pemenuhan tugas pada mata kuliah Struktur Data..untuk lebih jelasnya bisa lihat di posting coding kali ini, atau mendownload programnya di akhir postingan ini. Semoga bermanfaat...!!!




{***********************************************************
 * Tugas Program Struktur Data - Materi Antrian ( QUEUE ). *
 * TARKIMAN 10110738             tarkiman_zone@yahoo.co.id *
 ***********************************************************}

PROGRAM ANTRIAN_ARRAY_STATIS;

USES CRT;
   CONST
      MAX_QUEUE = 10;
   TYPE
      QUEUE = ARRAY[1..MAX_QUEUE] OF CHAR;

VAR
   ANTRIAN      : QUEUE;
   I  : INTEGER;
   DEPAN        : INTEGER;
   BELAKANG     : INTEGER;
   PILIH        : CHAR;
   ELEMEN       : CHAR;

{***************************************
 * Procedure menampilkan antrian data. *
 ***************************************}
   PROCEDURE TAMPILKAN( X :INTEGER);
      VAR
         I : INTEGER;
      BEGIN
         FOR I := 1 TO X DO
         BEGIN
            TEXTCOLOR(YELLOW);
            GOTOXY(18 + 4 * I, 19);
            WRITE(ANTRIAN[I]);
            TEXTCOLOR(WHITE);
         END;
      END; {*Procedure TAMPILAKAN*}

   PROCEDURE CLEAR;
      VAR
         I : INTEGER;
      BEGIN
         FOR I := 1 TO 10 DO
         BEGIN
            GOTOXY(62 - 4 * I, 19);WRITELN(' ');
         END;
      END; {*Procedure HUPUS*}

{****************************************************************
 * Fungsi untuk menge-cek keadaan antrian ( Penuh atau Kosong ) *
 ****************************************************************}
   FUNCTION KOSONG(BELAKANG:INTEGER):BOOLEAN;
      BEGIN
         KOSONG := FALSE;
         IF (BELAKANG = 0) THEN
         KOSONG := TRUE;
      END;

   FUNCTION PENUH(BELAKANG:INTEGER):BOOLEAN;
      BEGIN
         PENUH := FALSE;
         IF (BELAKANG = MAX_QUEUE) THEN
         PENUH := TRUE;
      END;

{*******************************************************************
 * Procedure untuk menambah elemen baru selama antrian belum penuh.*
 * Jika antrian sudah penuh. Program akan menampilkan suatu pesan. *
 *******************************************************************}
   PROCEDURE TAMBAH_ELEMEN (VAR DEPAN, BELAKANG: INTEGER; ELEMEN: CHAR);
      BEGIN
         IF ( PENUH(BELAKANG)) THEN
         BEGIN
            TEXTCOLOR(RED+BLINK);
            GOTOXY(32,16); WRITE('ANTRIAN SUDAH PENUH');
            TEXTCOLOR(WHITE);
         END

         ELSE
         BEGIN
            GOTOXY(49,15);WRITELN('    ');
            GOTOXY(31,15);WRITE('ISIKAN ELEMENNYA : ');
            TEXTCOLOR(YELLOW);
            READLN(ELEMEN);
            TEXTCOLOR(WHITE);
            GOTOXY(49,15);WRITELN('    ');

            IF (KOSONG(BELAKANG)) THEN
            BEGIN
               DEPAN := 1;
               BELAKANG := 1;
               ANTRIAN[BELAKANG] := ELEMEN;
            END

            ELSE
            BEGIN
               BELAKANG := BELAKANG + 1;
               ANTRIAN[BELAKANG] := ELEMEN;
            END;
            TAMPILKAN(BELAKANG);
         END;
         GOTOXY(31,15);WRITE('                   ');
      END;

{*******************************************************************
 * Procedure untuk menghapus elemen dari antrian yang belum kosong.*
 * Jika antrian kosong, program akan menampilkan suatu pesan.      *
 *******************************************************************}
   PROCEDURE HAPUS (VAR DEPAN, BELAKANG : INTEGER);
      VAR
         I : INTEGER;
      BEGIN
         IF (NOT KOSONG(BELAKANG)) THEN
         BEGIN
            ELEMEN := ANTRIAN[DEPAN];
            FOR I := DEPAN TO (BELAKANG - 1) DO
            BEGIN
               ANTRIAN[I] := ANTRIAN[I+1];
            END;

            BELAKANG := BELAKANG - 1;
            CLEAR;
         END

         ELSE
         BEGIN
            TEXTCOLOR(RED+BLINK);
            GOTOXY(33,16); WRITELN('ANTRIAN KOSONG...!');
            TEXTCOLOR(WHITE);
         END;
         TAMPILKAN(BELAKANG);
      END; {*Procedure Hapus*}


{*******************************************************************
 * Procedure pembukaan program, Nama : TARKIMAN NIM : 10110738.    *
 *******************************************************************}
   PROCEDURE TARKIMAN;
      VAR
         S,T : STRING;
         I,X : INTEGER;

      BEGIN
         TEXTCOLOR(YELLOW);
         S := 'TUGAS STRUKTUR DATA - PROGRAM ANTRIAN ( QUEUE )';
         FOR I := 1 TO LENGTH(S) DO
         BEGIN
            FOR X := 1 TO 5 DO
            BEGIN
               GOTOXY(17+I,X+1);WRITE(COPY(S,I,1));
               GOTOXY(17+I,X);WRITE(' ');
               DELAY(20);
            END;
  END;

         TEXTCOLOR(RED);
         T := 'TARKIMAN ( 10110738 )';
         FOR I := 1 TO LENGTH(T) DO
         BEGIN
            GOTOXY(30,10);WRITE(COPY(T,1,I));
            DELAY(70);
         END;
         DELAY(1000);
 END;


{*******************************************************************
 * Procedure Menu Program, Bingkai tampilan pilihan menu.          *
 * dan ilustrasi kotak-kotak antrian.                              *
 *******************************************************************}

   PROCEDURE MENUPROGRAM;
      BEGIN
         TEXTCOLOR(WHITE);
         GOTOXY(12,2); WRITELN('8*******************************************************8');
         TEXTCOLOR(GREEN);
         GOTOXY(24,3); WRITELN('MENU PROGRAM ANTRIAN DATA ( QUEUE )');
         TEXTCOLOR(WHITE);
         GOTOXY(12,4); WRITELN('=========================================================');
         GOTOXY(12,3);WRITELN('|');GOTOXY(68,3);WRITELN('|');
         GOTOXY(12,4);WRITELN('|');GOTOXY(68,4);WRITELN('|');
         GOTOXY(12,5);WRITELN('|');GOTOXY(68,5);WRITELN('|');
         GOTOXY(12,6);WRITELN('|');GOTOXY(68,6);WRITELN('|');
         GOTOXY(12,7);WRITELN('|');GOTOXY(68,7);WRITELN('|');
         GOTOXY(12,8);WRITELN('|');GOTOXY(68,8);WRITELN('|');
         GOTOXY(12,9);WRITELN('|');GOTOXY(68,9);WRITELN('|');
         GOTOXY(12,10);WRITELN('|');GOTOXY(68,10);WRITELN('|');
         GOTOXY(12,11);WRITELN('|');GOTOXY(68,11);WRITELN('|');
         GOTOXY(13,11);WRITELN('=======================================================');
         GOTOXY(12,12);WRITELN('|');GOTOXY(68,12);WRITELN('|');
         TEXTCOLOR(GREEN);
         GOTOXY(24,12);WRITELN('ILUSTRASI TAMPILAN ANTRIAN ( QUEUE )');
         TEXTCOLOR(WHITE);
         GOTOXY(12,13);WRITELN('|');GOTOXY(68,13);WRITELN('|');
         GOTOXY(13,13);WRITELN('=======================================================');
         GOTOXY(12,14);WRITELN('|');GOTOXY(68,14);WRITELN('|');
         GOTOXY(12,15);WRITELN('|');GOTOXY(68,15);WRITELN('|');
         GOTOXY(12,16);WRITELN('|');GOTOXY(68,16);WRITELN('|');
         GOTOXY(12,17);WRITELN('|');GOTOXY(68,17);WRITELN('|');
         GOTOXY(12,18);WRITELN('|');GOTOXY(68,18);WRITELN('|');
         GOTOXY(12,19);WRITELN('|');GOTOXY(68,19);WRITELN('|');
         GOTOXY(12,20);WRITELN('|');GOTOXY(68,20);WRITELN('|');
         GOTOXY(12,21);WRITELN('|');GOTOXY(68,21);WRITELN('|');
         GOTOXY(12,22);WRITELN('|');GOTOXY(68,22);WRITELN('|');
         GOTOXY(12,22);WRITELN('8*******************************************************8');
         TEXTCOLOR(MAGENTA);
         GOTOXY(36,21);WRITELN('F  I  F  O');
         TEXTCOLOR(CYAN);
         GOTOXY(20,18);WRITELN('*****************************************');
         GOTOXY(20,19);WRITELN('|');GOTOXY(24,19);WRITELN('|');GOTOXY(28,19);WRITELN('|');
         GOTOXY(32,19);WRITELN('|');GOTOXY(36,19);WRITELN('|');GOTOXY(40,19);WRITELN('|');
         GOTOXY(44,19);WRITELN('|');GOTOXY(48,19);WRITELN('|');GOTOXY(52,19);WRITELN('|');
         GOTOXY(56,19);WRITELN('|');GOTOXY(60,19);WRITELN('|');
         GOTOXY(20,20);WRITELN('*****************************************');
         TEXTCOLOR(GREEN+BLINK);
         GOTOXY(16,18);WRITELN('OUT');GOTOXY(63,18);WRITELN('IN');
         TEXTCOLOR(YELLOW+BLINK);
         GOTOXY(16,19);WRITELN('<==');GOTOXY(62,19);WRITELN('<==');
         TEXTCOLOR(WHITE);
         GOTOXY(25,6);WRITELN('1. MENAMBAH ELEMEN BARU (ENQUEUE)');
         GOTOXY(25,7);WRITELN('2. MENGHAPUS ELEMEN (DEQUEUE)');
         GOTOXY(25,9);WRITELN('0. EXIT');
         GOTOXY(7,24);WRITELN('Silahkan tekan tombol 1 atau 2 pada keyboard anda dan 0 untuk Exit');
         TEXTCOLOR(RED);
         GOTOXY(29,24);WRITELN('1');GOTOXY(36,24);WRITELN('2');GOTOXY(61,24);WRITELN('0');
         TEXTCOLOR(WHITE);
      END;

{*********************************************************************
 * Procedure Pilihan Menu, sesuai tombol yang di tekan pada keyboard *
 * 1. Menambahkan Elemen Antrian ( Proses Enqueue )                  *
 * 2. Menghapus Elemen Antrian ( Proses Dequeue )                    *
 * 0. Exit ( Mengakhiri Program )                                    *
 *********************************************************************}

   PROCEDURE MENU( PILIH:CHAR);
      BEGIN
         CASE PILIH OF
         '1' : BEGIN
                  GOTOXY(30,16);WRITELN('                        ');
                  TEXTCOLOR(MAGENTA+BLINK);
                  GOTOXY(25,6);WRITELN('1. MENAMBAH ELEMEN BARU (ENQUEUE)');
                  DELAY(100);
                  TEXTCOLOR(WHITE);
                  TAMBAH_ELEMEN(DEPAN,BELAKANG,ELEMEN);
               END;

         '2' : BEGIN
                  GOTOXY(30,16);WRITELN('                        ');
                  TEXTCOLOR(MAGENTA+BLINK);
                  GOTOXY(25,7);WRITELN('2. MENGHAPUS ELEMEN (DEQUEUE)');
                  DELAY(300);
                  TEXTCOLOR(WHITE);
                  HAPUS(DEPAN,BELAKANG);
               END;

  '0' : BEGIN
                  TEXTCOLOR(MAGENTA+BLINK);
                  GOTOXY(25,9);WRITELN('0. EXIT');
                  TEXTCOLOR(WHITE);
                  DELAY(500);
                  CLRSCR;
               END;
         END;
      END;

{*******************************************************************
 * Program Utama...................................................*
 *******************************************************************}

BEGIN
   CLRSCR;
   TARKIMAN;
   CLRSCR;

   DEPAN := 0;
   BELAKANG := 0;

   CLRSCR;
   REPEAT
      MENUPROGRAM;
      PILIH:=READKEY;
      MENU(PILIH);
   UNTIL PILIH='0'
END.

{*******************************************************************
 * Program Selesai                                                 *
 *******************************************************************
 * Nama     : TARKIMAN                                             *
 * NIM      : 10110738                                             *
 * Kelas    : IF-16                                                *
 * Email    : tarkiman_zone@yahoo.co.id                            *
 * Jurusan  : Teknik Informatika                                   *
 * Fakultas : Teknik dan Ilmu Komputer                             *
 * Universitas Komputer Indonesia                                  *
 *******************************************************************}

Download Source Code

Download it – Click Here

Post a Comment

4 Comments

  1. hatur nuhun kang, ijin di sedot kang,.,

    ReplyDelete
  2. TERIMAKSIH, IJIN COPASDIt.
    tapi elemen yang sebelumnya tidak tampil alias hilang yah?
    mohon bantuannya :)

    ReplyDelete