FANI TAMALA 안녕하세요: PROGRAM SORT DATA

Dibawah ini contoh codingan program sort menggunakan poascal:
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 ');readln(coba);
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.