program sort data
uses crt;
label awal;
var
oke:char;
type
tipelarik=string[25];
larikurut=array[1..100] of
tipelarik;
procedure masukkan;
label akhir;
const b=' ';
type mhs= record
npm:string[8];kelas:string
[5];nm:string[12];
end;
var vfilemhs:file of mhs;
recmhs:mhs; i:integer; oke:char;
begin
clrscr;
assign(vfilemhs,'kelompok.TXT');
{$i-}reset(vfilemhs);{$i+}
if ioresult <> 0 then rewrite
(vfilemhs);
i:=filesize(vfilemhs);
with recmhs do
begin
write('npm :');readln(npm);
while (npm <>'') and (length
(npm)=8)do
begin
write ('kelas :');readln(kelas);
if length(kelas)<5 then
goto akhir;
write('nama :');readln(nm);
if length(nm) <12 then
nm:=concat(nm,b);
repeat
write('save file ... y/n?');readln(oke);
until oke in ['Y','y','n','N'];
if oke in ['y','Y'] then
begin
seek(vfilemhs,i);write
(vfilemhs,recmhs);inc(i);
end;
akhir
:writeln;
write('npm:');readln(npm);
end;
writeln('data yang anda masukin salah');
end;
close(vfilemhs);readln;
end;
procedure quicksort(var
x:larikurut; bawah,atas:word);
var i,j:word;
Sementara:tipelarik;
begin
while atas>bawah do
begin
i=bawah;
j:=atas;
sementara:=x[bawah];
while i
begin
WHILE x[J]>sementara
Do
J:=J-1;
x[i]:=x[j];
while(i
[i]<=sementara) do
i:=i+1;
x[j]:=x[i];
end;
x[i]:=sementara;
quicksort(x,bawah,i-1);
bawah:=i+1;
end;
end;
PROCEDURE GARIS;
BEGIN
writeln
('----------------------------------------');
END;
procedure tampilan(var x:char);
type
mhs=record
npm:string[8];
kelas:string[5];
nm:string[12];
end;label awal,akhir,empat;
var
gabung,gabung1,name,npms,class:larikurut;
vfilemhs: file of mhs;
recmhs:mhs;
i,J:integer;temp:STRING[5];
COBA:CHAR;
begin
awal:
clrscr;
assign(vfilemhs,'kelompok.txt');
reset(vfilemhs);
for i:= 1 to filesize(vfilemhs)
do
begin
seek(vfilemhs,i-1);
read(vfilemhs,recmhs);
name[i]:=recmhs.nm;
class[i]:=recmhs.kelas;
npms[i]:=recmhs.npm;
gabung[i]:=concat(name[i],npms
[i],class[i]);
gabung1[i]:=concat(class[i],name
[i],npms[i]);
end;
J:=2;
if x='2' then
quicksort(gabung,1,filesize
(vfilemhs));
if x='3' then
quicksort(gabung1,1,filesize
(vfilemhs));
if x='4' then
begin
quicksort
(gabung1,1,filesize(vfilemhs));
write('kelas:');readln(temp);
IF LENGTH(TEMP)<>5
THEN
BEGIN
clrscr; gotoxy
(28,10);repeat writeln('SEARCH KELAS TIDAH DI TEMUKAN
until COBA in
['Y','y','n','N'];
if COBA in
['y','Y'] then
goto AWAL else goto
akhir;
end;
clrscr;
gotoxy
(30,2);writeln('KELAS :',temp);
gotoxy
(29,3);writeln('DAFTAR MAHASISWA');
goto empat;
end;
clrscr;
empat:
GOTOXY (23,4);
GARIS;
GOTOXY (23,6);
writeln('|no npm kelas nama;|');
GOTOXY (23,8);
GARIS;
writeln;
for i:=1 to filesize(vfilemhs)
do
begin
if (name[i]<>'') then ;begin
if x='1' then ;BEGIN
GOTOXY (23,I+9);writeln
('|',i:2,'| ',copy(gabung
[i],13,8),' ; ',copy(gabung
[i],21,5) ,';',copy(gabung
[i],0,12),'|'); END;
if x='2' then ;BEGIN
GOTOXY (23,I+9);writeln
('|',i:2,'| ',copy(gabung
[i],13,8),' ; ',copy(gabung
[i],21,5) ,' ;',copy(gabung
[i],0,12)); ; END;
if x='3' then ;BEGIN
GOTOXY (23,I+9);writeln
('|',i:2,'| ',copy(gabung1
[i],18,8),' ; ',copy(gabung1
[i],0, 5) ,' ;',copy(gabung1
[i],6,12));END;
if (x='4') and (copy(gabung1
[i],1,5)=temp) then ;BEGIN
GOTOXY (23,I+9);writeln
('|',i:2,'| ',copy(gabung1
[i],18,8),' ; ',copy(gabung1
[i],0, 5) ,' ;',copy(gabung1
[i],6,12));END;
end;
J:=I+10;
end;
GOTOXY(23,J);GARIS;
akhir:
end;
var
m:char;
begin
awal:
clrscr;
GOTOXY (28,3);WRITELN('>>>>>>> MENU FILE >>>>>>>;');
GOTOXY (28,5);writeln('1 INPUT DATA');
GOTOXY (28,6);writeln('2 DATA ACAK');
GOTOXY (28,7);writeln('3 SORTIR NAMA');
GOTOXY (28,8);writeln('4 SORTIR KELAS');
GOTOXY (28,9);writeln('5 MENAMPILKAN KELAS');
GOTOXY(28,10);WRITELN('6 SELESAI');
GOTOXY (28,12);write('PILIHAN ?');readln(oke);
IF NOT (OKE IN ['1'..'6']) THEN
BEGIN
WRITELN(CHAR(7));
GOTOXY (28,13);WRITELN('PILIHAN SALAH !!!');
READLN;
GOTO awal;
END;
case oke of
'1':begin masukkan;goto awal;end;
'2':BEGIN m:='1';tampilan (m);readln;goto awal; end;
'3':begin m:='2';tampilan (m);readln;goto awal; end;
'4':begin m:='3';tampilan (m);readln;goto awal; end;
'5':begin m:='4';tampilan (m);readln;goto awal; end;
'6':
end;
readln;
end.
Gambar dibawa setelah kita menginput data, termaksud dalam menu bfile 2 data acak
