16/03/15

Program Pengurutan Data Mahasiswa Pada Pascal

Karena dalam beberapa request yang minta diposting untuk contoh program pengurutan maka kali ini saya akan berbagi bagaimana contoh program pengurutan data mahasiswa berdasarkan nim, umur dan nilai.










program pengembangan;
uses crt;
type mahasiswa = record
        nim,nama:string;
        umur:byte;
        nilai:byte;
        end;
        mhsw=array[1..100] of mahasiswa;
var     data    :mhsw;
        n,k,i   :integer;
        pilih   :char;

procedure input;
begin
inc(n);
clrscr;
writeln('+--------------------------------------------');
writeln('                 Masukkan Data   ');
writeln('---------------------------------------------');
writeln('Nama     : ');
writeln('NIM      : ');
writeln('Umur     : ');
writeln('Nilai    : ');
writeln('---------------------------------------------');
gotoxy(18,4);readln(data[n].nama);
gotoxy(18,5);readln(data[n].nim);
gotoxy(18,6);readln(data[n].umur);
gotoxy(18,7);readln(data[n].nilai);
end;

procedure swap (var i,j:byte );
var temp:byte;
begin
        begin
        temp:=j;
        j:=i;
        i:=temp;
        end;
end;

procedure swap2 (var i,j:string);
var temp:string;
begin
        begin
        temp:=j;
        j:=i;
        i:=temp;
        end;
end;

procedure buble(m:byte; a:mhsw; var b:mhsw);
var
i,j:byte;
begin
        for i:=m downto 2 do
        begin
                for j:=1 to i-1 do
                if a[j].umur>a[j+1].umur then
                begin
                        swap (a[j].umur,a[j+1].umur);
                        swap2(a[j].nim,a[j+1].nim);
                        swap2(a[j].nama,a[j+1].nama);
                        swap (a[j].nilai,a[j+1].nilai);
                end;
        end;
        b:=a;
end;

procedure buble2(m:byte; a:mhsw;var b:mhsw);
var
i,j:byte;
begin
        for i:=m downto 2 do
        begin
                for j:=1 to i-1 do
                if a[j].nim>a[j+1].nim then
                begin
                        swap (a[j].umur,a[j+1].umur);
                        swap2(a[j].nim,a[j+1].nim);
                        swap2(a[j].nama,a[j+1].nama);
                        swap (a[j].nilai,a[j+1].nilai);
                end;
        end;
        b:=a;
end;

procedure buble3(m:byte; a:mhsw;var b:mhsw);
var
i,j:byte;
begin
        for i:=m downto 2 do
        begin
                for j:=1 to i-1 do
                if a[j].nilai>a[j+1].nilai then
                begin
                        swap (a[j].umur,a[j].umur);
                        swap2(a[j].nim,a[j+1].nim);
                        swap2(a[j].nama,a[j+1].nama);
                        swap (a[j].nilai,a[j+1].nilai);
                end;
        end;
        b:=a;
end;

procedure laporan;
var v:byte;
begin
        for v:=1 to n do
        begin
                writeln('Data ke ',v);
                writeln('NIM    : ',data[v].nim);
                writeln('Nama   : ',data[v].nama);
                writeln('Umur   : ',data[v].umur);
                writeln('Nilai  : ',data[v].nilai);
                writeln;
        end;
        readln;
end;

procedure menu;
begin
clrscr;
        writeln('       Menu');
        writeln('--------------------');
        writeln('[1] - Input Data');
        writeln('[2] - Sorting NIM');
        writeln('[3] - Sorting Umur');
        writeln('[4] - Sorting Nilai');
        writeln('[5] - Laporan');
        writeln('[6] - Keluar');
        write('Pilihan [1..6] : ');pilih:=readkey;
        case pilih of
        '1':input;
        '2':begin
                buble2(n,data,data);
                clrscr;
                writeln('       Sorting NIM');writeln;
                laporan;
                writeln('Sorting selesai, Tekan ENTER');
                readln;
                end;
        '3':begin
                buble(n,data,data);
                clrscr;
                writeln('       Sorting Umur');writeln;
                laporan;
                writeln('Sorting selesai, Tekan ENTER');
                readln;
                end;
        '4':begin
                buble3(n,data,data);
                clrscr;
                writeln('       Sorting Nilai');writeln;
                laporan;
                writeln('Sorting selesai, Tekan ENTER');
                readln;
                end;
        '5':begin
        clrscr;
        writeln('       Laporan');writeln;
        laporan;
        end;
        '6':;
        end;
end;

begin
n:=0;
repeat
menu;
until pilih='6';
end.

Mungkin segitu saja untuk postingan kali ini, sampai berjumpa lagi pada postingan yang lain.