PROGRAM PASCAL SAVE & SORTIR

Program pascal_save_sortir ;
uses crt;
label z,l;
var textfile:text;
a,b,c:array[1..20] of string;
i,j,k:integer;
temp,temp1,temp2:string;
q:char;

procedure sort; (* membuat block program untuk menyortir data *)
begin
clrscr;
writeln('1.Nama');
writeln('2.Npm');
writeln('3.Kelas');
writeln('Pilih yang ingin di sortir : ');readln(q);
if q = '1' then
begin
for i := 1 to k-1 do (* untuk membandingkan angka sesudahnya untuk mengetahui nilai yang lebih kecil*)
for j:=i+1 to k do
if a[j]
begin
temp:=a[i] ; temp1:=b[i] ; temp2:=c[i];
a[i]:=a[j] ; b[i]:=b[j] ; c[i]:=c[j];
a[j]:=temp ; b[j]:=temp1 ; c[j]:=temp2;
end;
end;
if q = '2' then
begin
for i := 1 to k-1 do
for j:=i+1 to k do
if b[j]
begin
temp:=a[i] ; temp1:=b[i] ; temp2:=c[i];
a[i]:=a[j] ; b[i]:=b[j] ; c[i]:=c[j];
a[j]:=temp ; b[j]:=temp1 ; c[j]:=temp2;
end;
end;

if q = '3' then
begin
for i := 1 to k-1 do
for j:=i+1 to k do
if c[j]
begin
temp:=a[i] ; temp1:=b[i] ; temp2:=c[i];
a[i]:=a[j] ; b[i]:=b[j] ; c[i]:=c[j];
a[j]:=temp ; b[j]:=temp1 ; c[j]:=temp2;
end;
end;

Assign(textfile,'NAMA.TXT');
Rewrite(textfile);
for i:= 1 to k do writeln(textfile,a[i]);
close(textfile);
Assign(textfile,'NPM.TXT');
Rewrite(textfile);
for i:= 1 to k do writeln(textfile,b[i]);
close(textfile);
Assign(textfile,'KELAS.TXT');
Rewrite(textfile);
for i:= 1 to k do writeln(textfile,c[i]);
close(textfile);
(* untuk menulis hasil sortir ke format .txt *)
end;

procedure tulis; (* membuat block program menulis data baru *)
Begin
clrscr;
writeln('Masukkan Banyaknya Data : ');readln(k);
Assign(textfile,'NAMA.TXT');
Rewrite(textfile);
for i:= 1 to k do
begin
clrscr;
Writeln('Masukkan nama ke-',i,' : ');readln(a[i]);
writeln('Masukkan npm ke-',i,' : ');readln(b[i]);
writeln('Masukkan kelas ke-',i,' : ');readln(c[i]);
writeln(textfile,a[i]);
end;
Close(textfile);

Assign(textfile,'NPM.TXT');
Rewrite(textfile);
for i:= 1 to k do writeln(textfile,b[i]);
close(textfile);

Assign(textfile,'KELAS.TXT');
Rewrite(textfile);
for i:= 1 to k do writeln(textfile,c[i]);
close(textfile);
(* untuk menulis hasil data yang di input ke format .txt *)
End;

procedure output; (* untuk membuat block program untuk hasil *)
begin
clrscr;
writeln('************************************************************************');
writeln('* no * Nama * Kelas * NPM *');
writeln('************************************************************************');
for i:=1 to k do
writeln('*',i:2,'. ','*':1,a[i]:15,'*':10,c[i]:11,'*':7,b[i]:16,'*':7);
writeln('************************************************************************');

assign(textfile,'HASIL.TXT');
rewrite(textfile);
writeln(textfile,'************************************************************************');
writeln(textfile,'* no * Nama * Kelas * NPM *');
writeln(textfile,'************************************************************************');
for i:=1 to k do
writeln(textfile,'*',i:2,'. ','*':1,a[i]:15,'*':10,c[i]:11,'*':7,b[i]:16,'*':7);
writeln(textfile,'************************************************************************');
close(textfile);
(*untuk memcetak ke layar hasil sortir atau yang belum di sortir ke layar dan membuatnya ke format .txt *)
end;


begin
clrscr;
writeln('Mulai baru(y/t) : ');readln(q);
if (q='t') or (q='T') then
begin
k:=1;
assign(textfile,'NAMA.TXT');
reset(textfile);
repeat
readln(textfile,a[k]);
k :=k+1;
until a[k] ='';
close(textfile);
(* untuk membaca jumlah data yang di miliki *)

assign(textfile,'KELAS.TXT');
reset(textfile);
for j := 1 to k do readln(textfile,c[j]);
close(textfile);

assign(textfile,'NPM.TXT');
reset(textfile);
for j := 1 to k do readln(textfile,b[j]);
close(textfile);
end;

z: clrscr;
writeln('******************');
writeln('Program Sorting');
Writeln('******************');
writeln('1.Masukkan Data');
writeln('2.Sortir Data');
writeln('3.Output');
writeln('4.Exit');
writeln('Masukkan (1,2,3,4) : ');readln(q);
case q of
'1' : tulis;
'2' : sort;
'3' : output;
'4' : goto l;
end;
writeln('Selesai(press Enter)');readln;
goto z;
l: end.


OUTPUT :


Menu



Data Sebelum Sortir


Sortir Menurut NPM

Posted in: Pascal, Softskill, Tugas