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
4 Comments
hatur nuhun kang, ijin di sedot kang,.,
ReplyDeleteSilahkan, semoga bermanfaat... :)
DeleteTERIMAKSIH, IJIN COPASDIt.
ReplyDeletetapi elemen yang sebelumnya tidak tampil alias hilang yah?
mohon bantuannya :)
Silahkan, semoga bermanfaat. :)
Delete