Contoh Program Data Mahasiswa

Baiklah tanpa basa basi ini dia source codenya...


Program nilaimahasiswa;
uses wincrt;
const
     Nmaks = 100;      {banyaknya elemen array}
Type Mahasiswa = record
    Nim : integer;
    NamaMhs : string[30];
    IPK : real;
                  end;
type TabMhs = array[1..Nmaks] of Mahasiswa;
var
   Fin : text;
   Fout : text;
   Mhs : TabMhs;
   i : integer; {indeks array}
   n : integer; {banyaknya elemen array}
   nomor:integer;

procedure BacaArsip(var A : TabMhs; var n:integer);
begin
    assign (Fin, 'datamhs.txt');
    reset (Fin);
    readln(Fin,n);
    for i := 1 to n do
    begin
         readln (Fin, A[i].Nim);
         readln (Fin, A[i].NamaMhs);
         readln (Fin, A[i].IPK);
    end;
end;
procedure CetakArray(A : TabMhs; n:integer);
begin
         write('No');
         write('   ');
         write('NIM');
         write('   ');
         write('Nama');
         write('   ');
         writeln('IPK');
    for i := 1 to n do
    begin
         write(i);
         write('   ');
         write(A[i].Nim);
         write('   ');
         write(A[i].NamaMhs);
         write('   ');
         writeln(A[i].IPK:0:2);
    end;
end;
procedure TambahData(var A : TabMhs; var n:integer);
begin
    i := n+1;
    begin
         writeln('Masukkan data mahasiswa [',i,']: ');
         write('Nim      : ');readln(A[i].Nim);
         write('Nama     : ');readln(A[i].NamaMhs);
         write('IPK      : ');readln(A[i].IPK);
    end;
    n :=n+1;
end;

procedure UbahData(var A : TabMhs; var n:integer);
begin
    write('Masukkan Nomor data yang akan diubah : ');  readln(i);
         write(i);
         write('   ');       
         write(A[i].Nim);
         write('   ');
         write(A[i].NamaMhs);
         write('   ');
         writeln(A[i].IPK:0:2);

    begin
         writeln('Masukkan data baru : ');
         write('Nim      : ');readln(A[i].Nim);
         write('Nama     : ');readln(A[i].NamaMhs);
         write('IPK      : ');readln(A[i].IPK);
    end;
end;

procedure HapusData(var A : TabMhs; var n:integer);
var cek:char;
    x:integer;
begin
    write('Masukkan Nomor data yang akan dihapus : ');  readln(x);
         write(x);
         write('   ');       
         write(A[x].Nim);
         write('   ');
         write(A[x].NamaMhs);
         write('   ');
         writeln(A[x].IPK:0:2);
    begin
         write('Apakah benar akan dihapus (y=ya, t=tidak)');readln(cek);
         if (cek='y') then
            begin
                 for i := x to n-1 do
                begin
                      A[i].Nim := A[i+1].Nim;
                      A[i].NamaMhs := A[i+1].NamaMhs;
                      A[i].IPK :=A[i+1].IPK;
                 end;
           n:=n-1;
           end
         else
             writeln('Penghapusan Batal');
    end;
end;
procedure SimpanArsip(A : TabMhs; n:integer);
begin
    assign (Fout,'datamhs.txt');
    rewrite (Fout);
    writeln(Fout,n);
    for i := 1 to n do
    begin   
         writeln(Fout,A[i].Nim);
         writeln(Fout,A[i].NamaMhs);
         writeln(Fout,A[i].IPK:0:2);
    end;
    close(Fout);
    writeln('Data sudah disimpan');
end;
begin
 repeat
 begin
 clrscr;
 writeln('***************************************');
 writeln('**** Sistem Administrasi Mahasiswa ****');
 writeln('***************************************');
 writeln('1. Tampilkan Data');
 writeln('2. Tambah Data');
 writeln('3. Ubah data');
 writeln('4. Hapus data');
 writeln('5. Keluar program');
 write('Masukkan pilihan anda (1/2/3/4/5) : ');readln(nomor);
 clrscr;
 case nomor of
 1: begin
        BacaArsip(Mhs,n);
        CetakArray(Mhs,n);
    end;
 2: begin
        BacaArsip(Mhs,n);
        TambahData(Mhs,n);
        SimpanArsip(Mhs,n);
    end;

 3: begin

        BacaArsip(Mhs,n);

        UbahData(Mhs,n);

        SimpanArsip(Mhs,n);
    end;
 4: begin
        BacaArsip(Mhs,n);
        HapusData(Mhs,n);
        SimpanArsip(Mhs,n);
    end;
 5: writeln('Keluar Program');
 else
  writeln('Nomor yang anda masukkan tidak ada di menu');
 end;
 end;
 readln;
 until(nomor=5);
end.