MERGE SORT:Urut Data

USES CRT;

CONST
MAX = 15;
TYPE
LARIK = ARRAY [1..MAX] OF INTEGER;



VAR
X,Y,I : INTEGER;
PILIH : CHAR;
N : INTEGER;
S : STRING;
DATA : LARIK;


PROCEDURE DEMO;
VAR
X : INTEGER;
Q : STRING;
BEGIN
TEXTBACKGROUND(BLACK);
CLRSCR;
Q:=' TUGAS SISTEM BERKAS ALGORITMA MERGE SORT DALAM PEMROGRAMAN PASCAL';
FOR I:=1 TO LENGTH(Q) DO
BEGIN
GOTOXY(I,5); WRITE(COPY(Q,I,1));
DELAY(100);
END;
FOR I:=1 TO LENGTH(Q) DO
BEGIN
FOR X:= 5 TO 20 DO
BEGIN
GOTOXY(I,X-1); WRITE(' ');
GOTOXY(I,X) ; WRITE(COPY(Q,I,X));
DELAY(2);
END;
END;
CLRSCR;
END;

PROCEDURE DATA_PENULIS;
VAR
Q,A,B,C,D,E,F : STRING;
X : INTEGER;

BEGIN
TEXTCOLOR(YELLOW);
Q := 'DATA PENULIS';
FOR I := 1 TO LENGTH(Q) DO
BEGIN
FOR X := 1 TO 5 DO
BEGIN
GOTOXY(30+I,X+1);WRITE(COPY(Q,I,1));
GOTOXY(30+I,X);WRITE(' ');
DELAY(50);
END;
END;

TEXTCOLOR(RED);
A := 'NAMA : LAILATUL BADRIYAH';
FOR I := 1 TO LENGTH(A) DO
BEGIN
GOTOXY(23,8);WRITE(COPY(A,1,I));
DELAY(70);
END;

B := 'NPM : 2009.02.01.0.0028';
FOR I := 1 TO LENGTH(B) DO
BEGIN
GOTOXY(23,9);WRITE(COPY(B,1,I));
DELAY(70);
END;

C := 'FAKULTAS : TEKHNIK';
FOR I := 1 TO LENGTH(C) DO
BEGIN
GOTOXY(23,10);WRITE(COPY(C,1,I));
DELAY(70);
END;

D := 'JURUSAN : INFORMATIKA';
FOR I := 1 TO LENGTH(D) DO
BEGIN
GOTOXY(23,11);WRITE(COPY(D,1,I));
DELAY(70);
END;

E := 'SEMESTER : 5A';
FOR I := 1 TO LENGTH(E) DO
BEGIN
GOTOXY(23,12);WRITE(COPY(E,1,I));
DELAY(70);
END;


TEXTCOLOR(WHITE);
GOTOXY(28,19);WRITELN('PRESS TO CONTINUE...!!!');
TEXTCOLOR(GREEN+BLINK);
GOTOXY(34,19);WRITELN('ENTER');
TEXTCOLOR(WHITE);
READLN;
END;

PROCEDURE ENDING;
VAR
I : INTEGER;
S : STRING;
X : INTEGER;
Q : STRING;

BEGIN
TEXTCOLOR(WHITE);
S := 'SEKIAN DAN MATOR SAKALANGKONG';
FOR I := 1 TO LENGTH(S) DO
BEGIN
FOR X := 1 TO 12 DO
BEGIN
GOTOXY(30+I,25-X);WRITE(COPY(S,I,1));
GOTOXY(30+I,25-X+1);WRITE(' ');
DELAY(20);
GOTOXY(30+I,X+1);WRITE(COPY(S,I,1));
GOTOXY(30+I,X);WRITE(' ');
DELAY(20);
END;
END;

Q := 'SEKIAN DAN MATOR SAKALANGKONG';
FOR I := 1 TO LENGTH(Q) DO
BEGIN
FOR X := 1 TO 14 DO
BEGIN
GOTOXY(30+I,14-X);WRITE(COPY(Q,I,1));
GOTOXY(30+I,14-X);WRITE(' ');
DELAY(10);
END;
END;

END;

{=========PROCEDURE-PROCEDURE UNTUK DEKORASI TAMPILAN PROGRAM==========}

PROCEDURE FINISHING;
VAR
I : INTEGER;
S : STRING;
X : INTEGER;

BEGIN
CLRSCR;
TEXTBACKGROUND(BLACK);
CLRSCR;

TEXTBACKGROUND(BLUE);
FOR I := 1 TO 10 DO
BEGIN
WINDOW(1,1,I,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(WHITE);
FOR X:=11 TO 20 DO
BEGIN
WINDOW(11,1,X,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(BROWN);
FOR I := 21 TO 30 DO
BEGIN
WINDOW(21,1,I,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(CYAN);
FOR X:=31 TO 40 DO
BEGIN
WINDOW(31,1,X,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(MAGENTA);
FOR I := 41 TO 50 DO
BEGIN
WINDOW(41,1,I,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(YELLOW);
FOR X:=51 TO 60 DO
BEGIN
WINDOW(51,1,X,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(GREEN);
FOR I := 61 TO 70 DO
BEGIN
WINDOW(61,1,I,25);
DELAY(100);
CLRSCR;
END;

TEXTBACKGROUND(RED);
FOR X:=71 TO 80 DO
BEGIN
WINDOW(71,1,X,25);
DELAY(100);
CLRSCR;
END;

READLN;
END;


PROCEDURE BUKA;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 40 DO
BEGIN
WINDOW(40-I,1,41+I,25);
DELAY(30);
CLRSCR;
END;
END;

PROCEDURE BUKAX;
BEGIN
TEXTBACKGROUND(BROWN);
FOR I:= 1 TO 40 DO
BEGIN
WINDOW(40-I,1,41+I,25);
DELAY(30);
CLRSCR;
END;
END;

PROCEDURE TUTUP;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 40 DO
BEGIN
WINDOW(1,1,I,25);
DELAY(30);
CLRSCR;
WINDOW(81-I,1,81-I,25);
DELAY(30);
CLRSCR;
END;
END;

PROCEDURE HAPUSKIRIKEKANAN;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 80 DO
BEGIN
WINDOW(1,1,I,25);
DELAY(20);
CLRSCR;
END;
END;

PROCEDURE HAPUSKANANKEKIRI;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 80 DO
BEGIN
WINDOW(80-I,1,80,25);
DELAY(20);
CLRSCR;
END;
END;

PROCEDURE HAPUSATASKEBAWAH;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 25 DO
BEGIN
WINDOW(1,1,80,I);
DELAY(30);
CLRSCR;
END;
END;

PROCEDURE HAPUSBAWAHKEATAS;
BEGIN
TEXTBACKGROUND(BLACK);
FOR I:= 1 TO 25 DO
BEGIN
WINDOW(1,25-I,80,25);
DELAY(30);
CLRSCR;
END;
END;

PROCEDURE BLANK;
BEGIN
TEXTBACKGROUND(BLUE);
BEGIN
WINDOW(1,1,80,25);
DELAY(1);
CLRSCR;
END;
END;

PROCEDURE SPASI;
BEGIN
WRITELN;
END;

PROCEDURE PUTIH;
BEGIN
TEXTCOLOR(WHITE);
END;

PROCEDURE MERAH;
BEGIN
TEXTCOLOR(RED);
END;

PROCEDURE BIRU;
BEGIN
TEXTCOLOR(BLUE);
END;

PROCEDURE HIJAU;
BEGIN
TEXTCOLOR(GREEN);
END;

PROCEDURE KUNING;
BEGIN
TEXTCOLOR(YELLOW);
END;

PROCEDURE KEDIP2;
BEGIN
TEXTCOLOR(RED+BLINK);
END;

PROCEDURE WANIPIRO;
VAR U : STRING;
BEGIN
U := ' SILAHKAN TEKAN ENTER, UNTUK MELIHAT HASIL PENGURUTAN SECARA DESCENDING ';
FOR I := 1 TO LENGTH(U) DO
BEGIN
GOTOXY(1,8);WRITE(COPY(U,1,I));
DELAY(10);
END;
KEDIP2;
GOTOXY(20,8);WRITELN('ENTER');
PUTIH;
END;

PROCEDURE RUN;
VAR
S,T : STRING;
BEGIN
CLRSCR;
TEXTCOLOR(BLUE);
S:='=>';
T:='<='; FOR I := 1 TO 80 DO BEGIN GOTOXY(I,8);WRITELN(COPY(S,1,I)); GOTOXY(I-1,8);WRITELN(' '); DELAY(50); END; FOR I := 1 TO 80 DO BEGIN GOTOXY(80-I,8);WRITELN(COPY(T,1,I)); GOTOXY(80-I+2,8);WRITELN(' '); DELAY(50); END; CLRSCR; END; PROCEDURE START; BEGIN TEXTBACKGROUND(BLACK); CLRSCR;KUNING; GOTOXY(29, 9);WRITELN('http://layla-innocent.blogspot.com'); GOTOXY(15,11);WRITELN('MOHON TEKAN TOMBOL ALT+ENTER UNTUK TAMPILAN FULLSCREEN...'); GOTOXY(15,13);WRITELN('SETELAH ITU SILAHKAN TEKAN ENTER UNTUK MEMULAI PROGRAM...'); GOTOXY(35,15);WRITELN('TERIMA KASIH...!!'); MERAH; GOTOXY(34,11);WRITELN('ALT+ENTER'); GOTOXY(59,11);WRITELN('FULLSCREEN'); GOTOXY(42,13);WRITELN('ENTER'); PUTIH; READLN; END; PROCEDURE MENUPROGRAM; BEGIN BLANK; PUTIH; GOTOXY(12,5); WRITELN('8*****************************************************8'); KUNING; GOTOXY(12,6); WRITELN(' MENU PROGRAM PENGURUTAN DATA '); PUTIH; GOTOXY(12,7); WRITELN('======================================================='); GOTOXY(12, 6);WRITELN('|');GOTOXY(66, 6);WRITELN('|'); GOTOXY(12, 7);WRITELN('|');GOTOXY(66, 7);WRITELN('|'); GOTOXY(12, 8);WRITELN('|');GOTOXY(66, 8);WRITELN('|'); GOTOXY(12, 9);WRITELN('|');GOTOXY(66, 9);WRITELN('|'); GOTOXY(12,10);WRITELN('|');GOTOXY(66,10);WRITELN('|'); GOTOXY(12,11);WRITELN('|');GOTOXY(66,11);WRITELN('|'); GOTOXY(12,12);WRITELN('|');GOTOXY(66,12);WRITELN('|'); GOTOXY(12,13);WRITELN('|');GOTOXY(66,13);WRITELN('|'); GOTOXY(12,14);WRITELN('|');GOTOXY(66,14);WRITELN('|'); GOTOXY(12,15);WRITELN('|');GOTOXY(66,15);WRITELN('|'); GOTOXY(12,16);WRITELN('|');GOTOXY(66,16);WRITELN('|'); GOTOXY(12,17);WRITELN('|');GOTOXY(66,17);WRITELN('|'); GOTOXY(12,18);WRITELN('|');GOTOXY(66,18);WRITELN('|'); GOTOXY(12,18);WRITELN('8*****************************************************8'); PUTIH; GOTOXY(30,9); WRITELN('1. INPUT DATA'); GOTOXY(30,10);WRITELN('2. MERGESORTING'); GOTOXY(30,11);WRITELN('3. SEARCHING'); GOTOXY(30,12);WRITELN('4. PENGHANCURAN'); GOTOXY(30,16);WRITELN('0. EXIT'); PUTIH; GOTOXY(2,20);WRITELN('Silahkan tekan tombol 1,2,3 atau 4 pada keyboard anda dan "0" untuk Exit'); END; PROCEDURE BINGKAI; BEGIN CLRSCR; HIJAU; GOTOXY(9, 2);WRITELN('8***********************************************************8'); GOTOXY(9, 4);WRITELN('|***********************************************************|'); GOTOXY(9, 6);WRITELN('|***********************************************************|'); GOTOXY(9, 3);WRITELN('|');GOTOXY(69, 3);WRITELN('|'); GOTOXY(9, 5);WRITELN('|');GOTOXY(69, 5);WRITELN('|'); GOTOXY(9, 6);WRITELN('|');GOTOXY(69, 6);WRITELN('|'); GOTOXY(9, 7);WRITELN('|');GOTOXY(69, 7);WRITELN('|'); GOTOXY(9, 8);WRITELN('|');GOTOXY(69, 8);WRITELN('|'); GOTOXY(9, 9);WRITELN('|');GOTOXY(69, 9);WRITELN('|'); GOTOXY(9,10);WRITELN('|');GOTOXY(69,10);WRITELN('|'); GOTOXY(9,11);WRITELN('|');GOTOXY(69,11);WRITELN('|'); GOTOXY(9,12);WRITELN('|');GOTOXY(69,12);WRITELN('|'); GOTOXY(9,13);WRITELN('|');GOTOXY(69,13);WRITELN('|'); GOTOXY(9,14);WRITELN('|');GOTOXY(69,14);WRITELN('|'); GOTOXY(9,15);WRITELN('|');GOTOXY(69,15);WRITELN('|'); GOTOXY(9,16);WRITELN('|');GOTOXY(69,16);WRITELN('|'); GOTOXY(9,17);WRITELN('|');GOTOXY(69,17);WRITELN('|'); GOTOXY(9,18);WRITELN('|');GOTOXY(69,18);WRITELN('|'); GOTOXY(9,19);WRITELN('|');GOTOXY(69,19);WRITELN('|'); GOTOXY(9,20);WRITELN('|');GOTOXY(69,20);WRITELN('|'); GOTOXY(9,21);WRITELN('|');GOTOXY(69,21);WRITELN('|'); GOTOXY(9,22);WRITELN('|');GOTOXY(69,22);WRITELN('|'); GOTOXY(9,23);WRITELN('|');GOTOXY(69,23);WRITELN('|'); GOTOXY(9,24);WRITELN('|');GOTOXY(69,24);WRITELN('|'); GOTOXY(9,24);WRITELN('8***********************************************************8'); END; PROCEDURE BINGKAI_2; BEGIN GOTOXY(1,1) ;WRITELN('==============================================================================='); GOTOXY(1,3) ;WRITELN('==============================================================================='); GOTOXY(1,7);WRITELN('==============================================================================='); GOTOXY(1,9);WRITELN('==============================================================================='); GOTOXY(1,13);WRITELN('==============================================================================='); GOTOXY(1,22);WRITELN('==============================================================================='); END; PROCEDURE BINGKAI_3; BEGIN CLRSCR; HIJAU; GOTOXY(9, 7);WRITELN('8***********************************************************8'); GOTOXY(9, 9);WRITELN('|***********************************************************|'); GOTOXY(9, 11);WRITELN('|***********************************************************|'); GOTOXY(9, 8);WRITELN('|');GOTOXY(69, 8);WRITELN('|'); GOTOXY(9, 9);WRITELN('|');GOTOXY(69, 9);WRITELN('|'); GOTOXY(9,10);WRITELN('|');GOTOXY(69,10);WRITELN('|'); GOTOXY(9,11);WRITELN('|');GOTOXY(69,11);WRITELN('|'); GOTOXY(9,12);WRITELN('|');GOTOXY(69,12);WRITELN('|'); GOTOXY(9,13);WRITELN('|');GOTOXY(69,13);WRITELN('|'); GOTOXY(9,14);WRITELN('|');GOTOXY(69,14);WRITELN('|'); GOTOXY(9,15);WRITELN('|');GOTOXY(69,15);WRITELN('|'); GOTOXY(9,16);WRITELN('|');GOTOXY(69,16);WRITELN('|'); GOTOXY(9,17);WRITELN('|');GOTOXY(69,17);WRITELN('|'); GOTOXY(9,18);WRITELN('|');GOTOXY(69,18);WRITELN('|'); GOTOXY(9,19);WRITELN('|');GOTOXY(69,19);WRITELN('|'); GOTOXY(9,20);WRITELN('|');GOTOXY(69,20);WRITELN('|'); GOTOXY(9,21);WRITELN('|');GOTOXY(69,21);WRITELN('|'); GOTOXY(9,22);WRITELN('|');GOTOXY(69,22);WRITELN('|'); GOTOXY(9,23);WRITELN('|');GOTOXY(69,23);WRITELN('|'); GOTOXY(9,24);WRITELN('|');GOTOXY(69,24);WRITELN('|'); GOTOXY(9,24);WRITELN('8***********************************************************8'); END; {======================================##########===============================} {===============================CODING PROGRAM UTAMA============================} PROCEDURE CREATE_ARRAY( VAR DATA : LARIK ); VAR I : INTEGER; BEGIN FOR I := 1 TO MAX DO DATA[I] := 0 ; END; PROCEDURE INPUT_DATA(VAR DATA:LARIK; VAR N:INTEGER); VAR I : INTEGER; BEGIN; KUNING; GOTOXY(28, 3);WRITELN('INPUT DATA (CREATE ARRAY)'); PUTIH; GOTOXY(13, 5);WRITE('PAMASOK DATA SE EKASOKAN, (PALENG BENYAK 15): '); READLN(N); FOR I := 1 TO N DO BEGIN GOTOXY(31,7+ I);WRITE('DATA KE-',I,' : ');READLN(DATA[I]); END; END; PROCEDURE ASCENDING(VAR DATA:LARIK;N:INTEGER); VAR I,J : INTEGER; TEMP: INTEGER; BEGIN FOR I := 2 TO N DO BEGIN TEMP := DATA[I]; J := I - 1 ; WHILE ( DATA[J] > TEMP ) AND ( J > 0 ) DO
BEGIN
DATA [ J + 1 ] := DATA[J];
DEC(J);
END;
DATA[ J + 1 ] := TEMP;
END;
END;


PROCEDURE DESCENDING(VAR DATA:LARIK;N:INTEGER);
VAR
I,J : INTEGER;
TEMP: INTEGER;
BEGIN
FOR I := 2 TO N DO
BEGIN
TEMP := DATA[I];
J := I - 1 ;
WHILE ( DATA[J] < TEMP ) AND ( J > 0 ) DO
BEGIN
DATA [ J + 1 ] := DATA[J];
DEC(J);
END;
DATA[ J + 1 ] := TEMP;
END;
END;


PROCEDURE OUTPUT;
BEGIN
WRITE;
WRITELN;
WRITELN;
KUNING;
FOR I := 1 TO N DO
WRITE(DATA[I],' ');
WRITELN;
END;

PROCEDURE SORTING;
BEGIN
HIJAU;
BINGKAI_2;
BIRU;
GOTOXY(19,2);WRITELN('DATA ARRAY YANG TELAH DI INPUT (MASIH ACAK)');GOTOXY(1,14);GOTOXY(1,14);GOTOXY(1,14);
MERAH;
GOTOXY(1,2);OUTPUT;
PUTIH;
GOTOXY(27,11);WRITELN('INSERTION SORT - DESCENDING');
WANIPIRO;
READLN;

TEXTCOLOR(MAGENTA+BLINK);
GOTOXY(27,11);WRITELN('INSERTION SORT - DESCENDING');
TEXTCOLOR(WHITE);
DELAY(500);
DESCENDING(DATA,N);
GOTOXY(1,14);WRITELN('AFTER SORTING DESCENDING : ');
GOTOXY(1,14);OUTPUT;
END;




PROCEDURE BINARY_SEARCH (VAR DATA:LARIK;N:INTEGER);
VAR
ATAS,TENGAH,BAWAH,CARI :INTEGER;
KETEMU :BOOLEAN;
BEGIN
BINGKAI_3;
GOTOXY(1,1);WRITELN('DATA AFTER SORTING DESCENDING : ');
GOTOXY(1,1);OUTPUT;
WRITELN('_______________________________________________________________________________');
GOTOXY(17, 8);WRITELN('PROGRAM PENCARIAN DATA MENGGUNAKAN BINARY SEARCH');
PUTIH;
GOTOXY(11,10);WRITE('MASUKAN BILANGAN YANG AKAN ANDA CARI : ');READLN(CARI);
ATAS:=N;BAWAH:=1;KETEMU:=FALSE;
WHILE NOT(KETEMU) DO
BEGIN
TENGAH:=(ATAS+BAWAH) DIV 2;
IF DATA[TENGAH]=CARI THEN
BEGIN
KETEMU:=TRUE;
GOTOXY(19,15);WRITELN('BILANGAN YANG ANDA CARI BERADA PADA INDEX ');
KEDIP2;
GOTOXY(35,17);WRITELN('KE - ',TENGAH);
END
ELSE IF CARI > DATA[TENGAH] THEN ATAS:=TENGAH-1
ELSE BAWAH:= TENGAH+1;
IF (BAWAH > ATAS) THEN
BEGIN
KETEMU:=TRUE;
KEDIP2;
GOTOXY(16,17);WRITELN('TAK LANGKONG,DATA SE ESARE SAMPEAN TADHEK NENG DATA!');
END;
END;
END;


PROCEDURE PENGHANCURAN_ARRAY(VAR DATA:LARIK;N:INTEGER);
BEGIN
BIRU;
GOTOXY(29,2);WRITELN('PROGRAM PENGHANCURAN ARRAY');
BINGKAI_2;
HIJAU;
GOTOXY(1,4);WRITELN('DATA ARRAY SEBELUM DIHANCURKAN : ');
GOTOXY(1,4);OUTPUT;
GOTOXY(16,11);WRITELN('SILAHKAN TEKAN ENTER UNTUK MENGHANCURKAN ARRAY..!');
KEDIP2;
GOTOXY(31,11);WRITELN('ENTER');
READLN;
TEXTCOLOR(GREEN+BLINK);
GOTOXY(9,11);WRITELN('ARRAY TELAH DI HANCURKAN DAN DI KEMBALIKAN KENILAI "0" SEMUA');
PUTIH;
FOR I := 1 TO N DO
BEGIN
DATA[I] := 0;
END;
MERAH;
GOTOXY(1,14);WRITELN('DATA ARRAY SETELAH DI HANCURKAN : ');
GOTOXY(1,14);
OUTPUT;
END;

PROCEDURE MENU( PILIH:CHAR);
BEGIN
CASE PILIH OF
'1' : BEGIN
TEXTCOLOR(RED+BLINK);
GOTOXY(30,9);WRITELN('1. INPUT DATA');
DELAY(1000);
CLRSCR;
BUKA;
HIJAU;
BINGKAI;
INPUT_DATA(DATA,N);
READLN;
BLANK;
CLRSCR;
END;
'2' : BEGIN
TEXTCOLOR(RED+BLINK);
GOTOXY(30,10);WRITELN('2. SORTING');
DELAY(1000);
CLRSCR;
HAPUSATASKEBAWAH;
PUTIH;
SORTING;
READLN;
BLANK;
CLRSCR;
END;
'3' : BEGIN
TEXTCOLOR(RED+BLINK);
GOTOXY(30,11);WRITELN('3. SEARCHING');
DELAY(1000);
CLRSCR;
HAPUSBAWAHKEATAS;
PUTIH;
BINARY_SEARCH(DATA,N);
READLN;
BLANK;
CLRSCR;
END;
'4' : BEGIN
TEXTCOLOR(RED+BLINK);
GOTOXY(30,12);WRITELN('4. PENGHANCURAN');
DELAY(1000);
CLRSCR;
HAPUSKIRIKEKANAN;
PUTIH;
PENGHANCURAN_ARRAY(DATA,N);
READLN;
BLANK;
CLRSCR;
END;
'0' : BEGIN
TEXTCOLOR(RED+BLINK);
GOTOXY(30,16);WRITELN('0. EXIT');
DELAY(1000);
TUTUP;
BUKAX;
ENDING;
FINISHING;
CLRSCR;
END;


END;
END;

BEGIN
CLRSCR;
START;
DEMO;
DATA_PENULIS;
TEXTCOLOR(BLACK);
CLRSCR;
REPEAT
TEXTCOLOR(BLACK);
MENUPROGRAM;
SPASI;
PILIH:=READKEY;
MENU(PILIH);

UNTIL PILIH='0'

END.
{layla_innocent@yahoo.coM}

CASE OF:Menu Makanan

program menu_pilihan;
uses wincrt;

var harga,tambah,menu,total,jumlah,plus,i:longint;
var porsi,porsi2,jenis,nama,najen:string;

begin
writeln(' MENU-MENU ALA LAYLA ');
writeln(' -----------------------------');
writeln(' Menu Yang Tersedia');
writeln(' 1. Nasi Goreng Sapi ');
writeln(' 2. Nasi Goreng Ayam ');
writeln(' 3. Mie Goreng Sapi ');
writeln(' 4. Mie Goreng Ayam ');
writeln(' 5. Soto ');
writeln(' 6. Keluar ');
writeln;
write(' Masukkan menu pilihan anda : ');readln(menu);

case menu of
1: begin
harga:=6000;
nama:='Nasi Goreng Sapi';
write(' Porsi (kecil/sedang/besar) : ');readln(porsi);
write(' Jenis(DT/TH) : ');readln(jenis);
end;
2: begin
harga:=5000;
nama:='Nasi Goreng Ayam';
write(' Porsi (kecil/sedang/besar) : ');readln(porsi);
write(' Jenis(DT/TH) : ');readln(jenis);
end;
3: begin
harga:=6000;
nama:='Mie Goreng Sapi ';
write(' Porsi (kecil/sedang/besar) : ');readln(porsi);
write(' Jenis(DT/TH) : ');readln(jenis);
end;
4: begin
harga:=5000;
nama:='Mie Goreng Ayam ';
write(' Porsi (kecil/sedang/besar) : ');readln(porsi);
write(' Jenis(DT/TH) : ');readln(jenis);
end;
5: begin
harga:=4000;
nama:='Soto ';
write(' Porsi (kecil/sedang/besar) : ');readln(porsi);
write(' Jenis(DT/TH) : ');readln(jenis);
end;
6: begin

end;
end;

if porsi='besar' then
begin
tambah:=3000;
porsi2:='Besar';
end;
if porsi='sedang' then
begin
tambah:=2000;
porsi2:='Sedang';
end;
if porsi='kecil' then
begin
tambah:=1000;
porsi2:='Kecil';
end;

if jenis='DT' then
begin
plus:=0;
najen:='Di tempat';
end;
if jenis='TH' then
begin
plus:=2000;
najen:='Take Home';
end;

jumlah:=harga+tambah;
total:=jumlah+plus;

if menu<=5 then
begin
writeln;
writeln;
writeln(' =============================');
writeln;
writeln;
writeln(' Pesanan Anda ');
writeln;
writeln(' ',nama,' : ','Rp. ',jumlah,',-');
writeln(' Porsi : ',porsi2);
writeln(' Jenis : ',najen);
writeln(' Total : Rp. ',total,',-');
readkey();
end;
end.

http://Layla-innocent.blogspot.com

DERET HITUNG:Kelipatan tiga

uses crt;
var
a,i,n:integer;
pil:char;
begin
clrscr;
write('program penghitungan deret hitung,silahkan klik enter:');readln;
writeln;
writeln;
write('Msukkan suku pertama:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+3;
write('.........)
end;
readln;
write('Hitung lagi[Y/T]?'); readln(pil);
case(pil)of
'Y':begin
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+2;
end;
readln;
end;
'T':begin
write('Thanks'); readln;
end;
end;
readln;
end.

http://layla-innocent.blogspot.com

BARIS BINTANG:Tingkat 3

uses crt;

var

x,y,z : integer;

begin

clrscr;

write ('masukan jumlah baris: ');

readln(x);

for y:=1 to x do

begin

for z:=1 to x-y do

begin

write(' ');

end;

for z:=1 to y do

begin

write('* ');

end;

writeln(x);

end;

readln(x);

end.

http://Layla-innocent.blogspot.com

CONTOH ARRAY:input data-data mahasiswa

PROGRAM pemakaian_Array_Untuk_10_data_dengan_menggunakan_For;
USES CRT;
CONSt
garis='------------------------------------------------------';
VAR
nil1,nil2 : ARRAY [1..10] OF 0..100; {Array dgn Type subjangkauan}
npm : ARRAY [1..10] OF STRING[8];
nama : ARRAY [1..10] OF STRING[15];
n,i,bar : INTEGER;
jum : REAL;
t1: CHAR;
BEGIN
CLRSCR;
{ pemasukan data dalam array }
WRITE('MAU ISI BERAPA DATA :');
READLN(N);
FOR i:= 1 TO n DO
BEGIN
CLRSCR;
GOTOXY(30,4+1); WRITE('DATA KE-:',i:2);
GOTOXY(10,5+i); WRITE('NPM :'); READLN(NPM[i]);
GOTOXY(10,6+i); WRITE('NAMA :'); READLN(NAMA[i]);
GOTOXY(10,7+i); WRITE('NILAI 1 :'); READLN(NIL1[i]);
GOTOXY(10,8+i); WRITE('NILAI 2 :'); READLN(NIL2[i]);
END;
{ proses data dalam array }
CLRSCR;
GOTOXY(5,4); WRITE(GARIS);
GOTOXY(5,5); WRITE('NO');
GOTOXY(9,5); WRITE('NPM');
GOTOXY(18,5); WRITE('NAMA');
GOTOXY(34,5); WRITE('NIL.1');
GOTOXY(41,5); WRITE('NIL.2');
GOTOXY(47,5); WRITE('RATA');
GOTOXY(54,5); WRITE('ABJAD');
GOTOXY(5,6); WRITE(GARIS);
{ proses Cetak isi array dan seleksi kondisi }
bar:=7;
FOR i:= 1 TO n DO
BEGIN
jum:=(nil1[i]+nil2[i])/2;
IF jum>=90 THEN t1:='A'
ELSE
IF jum>80 THEN t1:='B'
ELSE
IF jum>60 then t1:='C'
ELSE
IF jum>50 THEN t1:='D'
ELSE
t1:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyeleksian kondisi }
GOTOXY(5,bar); WRITELN(i:2);
GOTOXY(9,bar); WRITELN(NPM[i]);
GOTOXY(18,bar); WRITELN(NAMA[i]);
GOTOXY(34,bar); WRITELN(NIL1[i]:4);
GOTOXY(41,bar); WRITELN(NIL2[i]:4);
GOTOXY(47,bar); WRITELN(jum:5:1);
GOTOXY(54,bar); WRITELN(t1);
bar:=bar+1;
END;
GOTOXY(5,bar+1);WRITELN(garis);
READLN;
END.

http://Layla-innocent.blogspot.com

INPUT NAMA-NPM

program data_mahasiswa;

var Nama,NPM,hasil:string;
begin
writeln('Masukkan Nama Dan NPM Anda');
writeln('----------------------------');
write('Nama Anda:');readln(Nama);
Write('NPM Anda:');readln(NPM);
writeln('Nama dan NPM Anda Masukkan Adalah:',Nama, NPM);
readln;
end.

http://Layla-innocent.blogspot.com

KALKULATOR-PENAMBAHAN

program kalkulator;

var n1,n2,h:real;
begin
writeln('Program Kalkulatorku');
write('Angka Pertama= ');readln(n1);
write('Angka Kedua= ');readln(n2);
h:=n1+n2;
writeln('Hasilnya Adalah= ',h:0:0);
readln;
end.

http://layla-innocent.blogspot.com

DERET ANGKA

uses crt;
var
a,i,n:integer;
pil:char;
begin
clrscr;
write('Program ini adalah program penghitungan deret angka setiap suku angka.');
write('langkah kerja program ini yaitu tinggal memasukkan angka dan kemudian tekan enter untuk');
write('mengetahui hasil dan menuju tahap selanjutnya'); readln;
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+4;
end;
readln;
write('Hitung lagi[Y/T]?'); readln(pil);
case(pil)of
'Y':begin
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+4;
end;
readln;
end;
end;
write('Hitung lagi[Y/T]?'); readln(pil);
case(pil)of
'Y':begin
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+4;
end;
readln;
end;
end;
write('Hitung lagi[Y/T]?'); readln(pil);
case(pil)of
'Y':begin
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+4;
end;
readln;
end;
end;
write('Hitung lagi[Y/T]?'); readln(pil);
case(pil)of
'Y':begin
write('Msukkan suku ke:'); readln(n);
a:=3;
for i:=1 to n do
begin
write(a);
write('');
a:=a+4;
end;
readln;
end;
'T':begin
write('Thanks'); readln;
end;
end;
readln;
end.

http://Layla-innocent.blogspot.com

Menghitung Luas Lingkaran-segitiga-persegi panjang

Uses crt;
Var
a, b, t, PJ, r, lb, L: real;
ops : integer;
Const
c1 = 1/2;
phi = 3.14;

Begin
ClrScr;
TextColor(Green);
Writeln ('l-------------------------------------------------------l');
Writeln ('l << PILIHAN >> l');
Writeln ('l-------------------------------------------------------l');
Writeln ('l 1.Menghitung Luas Lingkaran l');
Writeln ('l 2.Menghitung Luas Segitiga l');
Writeln ('l 3.Menghitung Luas Persegi Panjang l');
Writeln ('l-------------------------------------------------------l');
Writeln ('l Pilihan Nomer Berapa {1-3} : l');
Writeln ('l-------------------------------------------------------l');
Writeln;
Readln (ops);
Case ops of
1:
Begin
L:= phi*r*r;
Write ('Masukkan Jari-Jari Lingkaran = ');
Readln (r);
Writeln;
L:= phi*r*r;
Writeln ('Luas Lingkaran Adalah = ',L:4:6);
Readln;
End;
2:
Begin
L:= a*t*c1;
Write ('Masukkan Nilai Alas = ');
Readln (a);
Write ('Masukkan Nilai Tinggi = ');
Readln (t);
Writeln;
L:= a*t*c1;
Writeln ('Luas Segitiga Adalah = ',L:4:6);
Readln;
End;
3:
Begin
L:= PJ*lb;
Write ('Masukkan Nilai Panjang = ');
Readln (PJ);
Write ('Masukkan Nilai Lebar = ');
Readln(lb);
Writeln;
L:= PJ*lb;
Writeln ('Luas Persegi Panjang Adalah = ', L:4:6 );
Readln;
End;
Else
Write ('Ngawuuur, Pilihan Anda Salah !! ');
Readln;
End;
End.

http://layla-innocent.blogspot.com