LISTING PEMROGRAMAN

program file_record;

uses

 crt, dos;

type

 mahasiswa=record

   nim     :string[12];

   nama    :string[50];

   jurusan :string[20];

 end;

var

 I:integer;

 FileMhs:File of mahasiswa;

 DtMhs:mahasiswa;

 CekFile:PathStr;

begin

 Clrscr;

 Assign(FileMhs,'Mhs.dat');

 CekFile:=FSearch('Mhs.dat','');

 if CekFile='' then

    ReWrite(FileMhs)

 else

    Reset(FileMhs);

 Write('Masukkan nim       :');

 Readln(DtMhs.nim);

 Write('Masukkan nama      :');

 Readln(DtMhs.nama);

 Write('Masukkan jurusan   :');

 Readln(DtMhs.jurusan);

 Seek(FileMhs,FileSize(FileMhs));

 Write(FileMhs,DtMhs);

 Reset(FileMhs);

 for I:=0 to FileSize (FileMhs)-1 do

 begin

    Read(FileMhs,DtMhs);

    Writeln(DtMhs.nim,'',DtMhs.nama,'',DtMhs.Jurusan);

 end;

 Close(FileMhs);

 Readln;

End.

Program NilaiRecFile;

Uses

  Crt,Dos;

Type

  Nilai = Record

     Nama:String[50];

     NilPPN,NilPPA,NilLog,NilAgm,JmlNil: Integer;

     Grade:Char;

     Lulus:String;

  End;

Var

  Indeks: Integer;

  FileNil: File Of Nilai;

  DtNil: Nilai;

  CekFile: PathStr;

Begin

Clrscr;

  Assign(FileNil,'File Nilai.dat');

  CekFile:=FSearch('File Nilai.dat','');

  If CekFile='' Then

    ReWrite(FileNil)

  Else

    Reset(FileNil);

  Write('Masukkan Nama : '); Readln(DtNil.Nama);

  Write('Masukkan Nilai PPN ',DtNil.Nama,'   = '); Readln(DtNil.NilPPN);

  Write('Masukkan Nilai PPA ',DtNil.Nama,'   = '); Readln(DtNil.NilPPA);

  Write('Masukkan Nilai Logika ',DtNil.Nama,'= '); Readln(DtNil.NilLog);

  Write('Masukkan Nilai Agama ',DtNil.Nama, '= '); Readln(DtNil.NilAgm);

  DtNil.JmlNil:=DtNil.NilPPN+DtNil.NilPPA+DtNil.NilLog+DtNil.NilAgm;

  Seek(FileNil,FileSize(FileNil));

  Write(FileNil,DtNil);

  Reset(FileNil);

  Clrscr;

          {123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789}

  Writeln('=============================================================================');

  Writeln('|  Nama  | Nilai PPN | Nilai PPA | Nilai Logika | Nilai Agama | Grade | Ket |');

  Writeln('=============================================================================');

  For Indeks := 0 to FileSize(FileNil)-1 do

  Begin

  Read(FileNil,DtNil);

  If DtNil.JmlNil > 34 Then DtNil.Grade:='A' Else

  If DtNil.JmlNil > 28 Then DtNil.Grade:='B' Else

  If DtNil.JmlNil > 24 Then DtNil.Grade:='C' Else

  If DtNil.JmlNil <=24 Then DtNil.Grade:='D' Else

  DtNil.Grade:='E';

  If DtNil.NilLog > 7 Then DtNil.Lulus:='L' Else

  DtNil.Lulus:='TL';

  GotoXY(1,indeks+4);Write('| ',DtNil.Nama);

  GotoXY(10,indeks+4);Write('| ',DtNil.NilPPN);

  GotoXY(22,indeks+4);Write('| ',DtNil.NilPPA);

  GotoXY(34,indeks+4);Write('| ',DtNil.NilLog);

  GotoXY(49,indeks+4);Write('| ',DtNil.NIlAgm);

  GotoXY(63,indeks+4);Write('| ',DtNil.Grade);

  GotoXY(71,indeks+4);Write('| ',DtNil.Lulus);

  GotoXY(77,indeks+4);Writeln('|');

  End;

  Writeln('=============================================================================');

Close(FileNil);

Readln;

End.

Program buble_sort;

Uses

    crt;

Const

     max=10;

Type

    arr = array[1..max] of byte;

Var

   I    : byte;

   Data : arr;

Procedure Input;

Begin

  Clrscr;

  writeln ('masukkan 10 data');

  writeln ('================');

  for I := 1 to max do {input 10 data}

  Begin

       write('Data ke-',I,'=');

       readln(Data[I]);

  End;

  clrscr;

  for I :=1 to max do

      write(Data[i],' ');

  writeln;

  writeln ('* * * * * * * * * * * * * * *');

  writeln ('Data yang telah diurutkan :');

  writeln;

End;

Procedure Change (var a,b :byte); {procedure untuk menukar data}

Var

   c : byte;

Begin

     c := a; a := b; b := c;

End;

procedure Asc_buble;

Var

   p,q   : byte;

   flaq : boolean;

Begin

   flaq:=false;

   p:=2;

   while (p<max) and (not flaq) do

   Begin

      flaq:=true;

      for q := max downto p do

        if data[q] < data[q-1] then

        Begin

           change (data[q], data[q-1]);

           flaq:=false;

        End;

        inc(i);

   End;

   write('Ascending :');

End;

Procedure Desc_Buble;

Var

   p, q : byte;

   flaq : boolean;

Begin

   flaq:=false;

   p:=2;

   while (p<max) and (not flaq) do

   begin

      flaq:=true;

      for q := max downto p do

     if data[q] > data[q-1] then

     Begin

       change (data[q], data[q-1]);

       flaq:=false;

     End;

     inc(i);

   End;

   write('Descending :');

End;

Procedure output;

Begin

   for i := 1 to max do

      write(data[i],' ');

   writeln;

End;

Begin {program utama}

   Input;

   Asc_buble;

   output;

   writeln;

   Desc_buble; output;

   Readkey;

End.