Contoh Program Pengurutan (Selection Sort)

uses crt;

type mhs=record

     nama, nim:string;

     ipk:real;

end;

var data :array [1..10] of mhs;

    nama1, nim1:string;

    ipk1:real;

    i, j, n, rank, temp:integer;

    plh :string;

procedure input;

begin

clrscr;

  write('Masukkan Jumlah Data : ');readln(n);

  for i:=1 to n do

  begin

   with data[i] do

   begin

    writeln('Mahasiswa [',i,'] : ');

    write('Nama  : ');readln(nama);

    write('NIM   : ');readln(nim);

    write('IPK   : ');readln(ipk);

    writeln;

   end;

  end;

readkey;

end;

procedure output;

begin

clrscr;

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

  writeln('|                 DATA NILAI MAHASISWA                  |');

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

  writeln('| No |         Nama             |    NIM    |    IPK    |');

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

  for i:=1 to n do

  begin

  with data[i] do

  begin

  gotoxy(1,5+i);writeln('|    |                          |           |           |');

  gotoxy(3,5+i);writeln(i);

  gotoxy(8,5+i);writeln(nama);

  gotoxy(35,5+i);writeln(nim);

  gotoxy(50,5+i);writeln(ipk:2:2);

  end;

  end;

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

readkey;

end;

procedure urut;

begin

 for i:=1 to n-1 do

  begin

   for j:=i+1 to n do

    begin

    if(data[j].ipk > data[i].ipk) then

     begin

      nama1:= data[j].nama;

      data[j].nama:= data[i].nama;

      data[i].nama:=nama1;

      nim1:=data[j].nim;

      data[j].nim:=data[i].nim;

      data[i].nim:=nim1;

      ipk1:=data[j].ipk;

      data[j].ipk:=data[i].ipk;

      data[i].ipk:=ipk1;

     end;

    end;

   end;

end;

procedure output2;

begin

urut;

clrscr;

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

  writeln('|                  DATA NILAI MAHASISWA                  |');

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

  writeln('| No |         Nama             |    NIM    |    IPK     |');

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

  for i:=1 to n do

  begin

  with data[i] do

  begin

  gotoxy(1,5+i);writeln('|    |                          |           |           |');

  gotoxy(3,5+i);writeln(i);

  gotoxy(8,5+i);writeln(nama);

  gotoxy(35,5+i);writeln(nim);

  gotoxy(50,5+i);writeln(ipk:2:2);

  end;

  end;

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

readkey;

end;

begin

repeat

clrscr;

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

  writeln('|               MENU UTAMA               |');

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

  writeln('| [1] Input data                         |');

  writeln('| [2] Tampilkan data yg belum diurutkan  |');

  writeln('| [3] Tampilkan data yg sudah diurutkan  |');

  writeln('| [0] Keluar                             |');

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

  writeln('| Pilihan    :                           |');

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

  gotoxy(17,9);readln(plh);

  case plh of

   '1' : input;

   '2' : output;

   '3' : output2;

   '0' : exit;

  end;

until plh='0';

end.

Screenshoot :








Sekian Terima kasih, semoga bermanfaat.

Contoh Program Rekursif

• Source Code

uses crt; var     I,Jum_Suku,a,b,n:integer;Bil_X:real;     dame:char; label     awal; function fak(n:integer):longint;  begin   if n=0 then fak:=1   else fak:=n*fak(n-1);  end; function legendre(X: real; N :integer) : real; var Suku_1, Suku_2 : real; begin if N = 0 then Legendre := 1 else if N = 1 then Legendre := X else begin Suku_1 := ((2*N - 1) * (X * Legendre(X, N-1))) / N; Suku_2 := ((N-1) * Legendre(X, N-2)) / N; Legendre := Suku_1 + Suku_2; end; end; function fibonacci(n:integer):longint;  begin  if (n=1) then fibonacci:=0   else     if (n=2) then fibonacci:=1   else fibonacci:=fibonacci(n-1)+fibonacci(n-2);  end; procedure fak;  begin   Writeln('  ==Menghitung Nilai Faktorial==');   writeln;   writeln;   write('Masukan nilai factorial : ');   readln(n);   writeln;   writeln(n,'! = ',fak(n));  end; procedure Legendre; begin Writeln('==Menghitung Suku Banyak Legendre=='); Writeln; Write('Sampai suku ke : '); Readln(Jum_Suku); Write('Masukkan nilai X :'); Readln(Bil_X); Writeln; for I := 0 to Jum_Suku do begin Writeln('Suku ke-',I:2,',',' Nilainya = ',Legendre(Bil_X, I):8:3); end; end; procedure fibo;  begin  writeln('   ==Deret Bilangan Fibonacci==');  writeln;writeln;    write('Masukan Jumlah deret bilangan fibonacci : ');   readln(n);   for a:=1 to n do    begin     write(fibonacci(a),' ');    end;   writeln;  end; begin  awal:  repeat  clrscr;  writeln('|==========================================|');  writeln('|                                 MENU UTAMA                                  |');  writeln('|==========================================|');  writeln('| 1. Faktorial                                                                           |');  writeln('| 2. Bilangan Legendre                                                           |');  writeln('| 3. Bilangan Fibonacci                                                          |');  writeln('| 0. Keluar                                                                               |');  writeln('|==========================================|');  writeln;  write('Pilih Menu : ');  readln(dame);  case dame of  '1' :   begin    clrscr;   fak;  readkey;  goto awal;   end;  '2' :   begin    clrscr;    legendre;    readkey; goto awal;   end;  '3' :   begin    clrscr;    fibo;    readkey; goto awal;   end;  end;  until (dame)='0'; end.

 

•  Screenshoot

·     

 

 

Sekian terima kasih, semoga bermanfaat.