Pages

Selasa, 08 November 2011

program sortir data

Program sortir ini di buat menggunakan turbo pascal.

Ketikan koding yang ada dibawah ini :

program sortir_2db01;
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,'dataimam.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<j do
    begin
        WHILE x[J]>sementara Do
             J:=J-1;
         x[i]:=x[j];
             while(i<j) and (x[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 kelompok;
begin
clrscr;
GOTOXY(28,4);
GARIS;
GOTOXY(27,5);WRITE('|');  GOTOXY(68,5);WRITE('|');
GOTOXY(27,6);WRITE('|');  GOTOXY(68,6);WRITE('|');
gotoxy(35,6);writeln('<<<KELOMPOK  PEMROGRAMAN >>>'); GOTOXY(68,7);WRITE('|');
GOTOXY(27,7);WRITE('|'); GOTOXY(68,7);WRITE('|');
GOTOXY(47,7);WRITELN('2DB01');GOTOXY(68,8);WRITE('|');
GOTOXY(27,8);WRITE('|');GOTOXY(68,9);WRITE('|');
GOTOXY(27,9);WRITE('|'); GOTOXY(68,10);WRITE('|');
GOTOXY(28,9);GARIS;
GOTOXY(27,10);WRITE('|');
gotoxy(29,10);WRITELN('1. ASTRI');
GOTOXY(27,11);WRITE('|'); GOTOXY(68,11);WRITE('|');
gotoxy(29,11);WRITELN('2. DWI');
GOTOXY(27,12);WRITE('|');GOTOXY(68,12);WRITE('|');
gotoxy(29,12);WRITELN('3. IMAM');
GOTOXY(27,13);WRITE('|');GOTOXY(68,13);WRITE('|');
gotoxy(29,13);WRITELN('4. MAYA');
GOTOXY(27,14);WRITE('|');GOTOXY(68,14);WRITE('|');
gotoxy(29,14);WRITELN('5. MILA');
GOTOXY(28,15);
GARIS;
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,'dataimam.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 <ULANGI(y/n)!!>');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':begin kelompok; end;
end;
readln;
end.

Setelah itu compile program dengan alt+f9 , lalu run program dengan ctrl+f9. Setelah di run akan muncul hasil seperti di bawah ini :



Muncul menu file , pilih nomor 1 untuk menginput data yang akan di sortir, seperti dibawah ini :

 
Pilih nomor 2 untuk melihat data acak yang telah diinput :

 
Untuk sortir data menurut nama pilih nomor 3 , seperti dibawah ini :



Untuk sortir data menurut kelas pilih nomor 4 , seperti dibawah ini :
 
 
 
Untuk menampilkan kelas yang diinginkan pilih nomor 5 dan masukkan kelas
yang ingin dilihat datanya :



Pilih nomor 6 untuk melihat tampilan nama anggota kelompok pembuat 
program sortir 2DB01, seperti dibawah ini :
 
 
 

1 komentar:

adjie mengatakan...

Sungguh saya sangat pengen banget tau tentang ini..

http://ajicena.blogspot.com/

Posting Komentar