TUGAS PRAKTIKUM

ALGORITMA II

Yang dibimbing oleh Bapak Budi Santoso [Link], [Link]

Febi Abdul Fadillah

201943501649
X2G

INFORMATIKA
UNIVERSITAS INDRAPRASTA PGRI

2020
 File Pascal

1. Program pada Halaman 3 - Array

Program HITUNG_RATA;
{Contoh penggunaan array dalam program}
uses crt;
var
i,k, n: integer;
Jumlah : longint;
RATA : real;
A : array [0..100] of integer;
begin
{input data}
clrscr;
while A[n] <> -9 do
begin
n := n+1;
Write ('Masukkan bilangannya : '); readln(A[n]);
end; {end of while}
n := n-1;
writeln ('Banyaknya bilangan : ', n);
{Mencetak elemen array}
write ('Elemen array-nya adalah : ');
for i := 1 to n do
write (A[i],',');writeln;
{Menghitung jumlah elemen array}
for i := 1 to n do Jumlah := Jumlah + A[i];
write('Jumlah akhir =', Jumlah);

{Menghitung rata-rata}
RATA := Jumlah/n;
writeln(' dan Rata-rata = ',RATA:2:2);
writeln(' --o SELESAI o--');
readln;
end.
Output :

2. Program pada Halaman 4 – Array Record

Program Array_Record;
Uses crt;
Type mahasiswa = record
Nama : string;
NPM : string;
Nilai : integer;
end;
Var Mhs : array [1..10] of mahasiswa;
Jumlah : byte;
I,J : integer;
Procedure Input;
Begin
Writeln (' DATA MAHASISWA');
Write (' Jumlah Data : ');
Readln (Jumlah);
Writeln;
For I := 1 to Jumlah do
begin
writeln (' Data ke- ', I);
write(' Nama : '); readln (Mhs[I].Nama);
write (' NPM : '); readln (Mhs[I].NPM);
write (' Nilai : '); readln (Mhs[I].Nilai);
 writeln;
end;
end;

Procedure Judul;
Begin
Clrscr;
Gotoxy(13,1); writeln(' DATA MAHASISWA ');
Writeln(' ------------------------------ ');
gotoxy(3,3); write('No ');
gotoxy(7,3); write('Nama ');
gotoxy(27,3); write('NPM ');
gotoxy(45,3); writeln('Nilai ');
Writeln(' ------------------------------- ');
end;

Procedure Tampil;
Begin

for I := 1 to Jumlah
do

begin
gotoxy(3,4 + I); write(I);
gotoxy(7,4 + I); write(Mhs[I].Nama);
gotoxy(27,4 + I); write(Mhs[I].NPM);
gotoxy(45,4 + I); write(Mhs[I].Nilai);
end; readln;
writeln(' ------------------------------- ');
end;

{program utama }
Begin
Clrscr;
Input;
Judul;
Tampil;
Readln;
end.

Output:
 3. Program pada Halaman 13 - Matriks
Program Perkalian_Matriks;
uses crt;
Type
Larik = array [1..25, 1..25] of real;
Var
I,J,K : byte;
M,N,L : byte;
A,B,C : larik;

Begin
Clrscr;
Write('Baris matriks pertama ? ');
readln(M);
Write('Baris matriks pertama/baris matriks kedua ? ');
 readln(N);
Write('Kolom matriks kedua ? ');
readln(L);
Writeln;

{Masukkan data matriks pertama}

Writeln('Matriks yang pertama : ');
for I := 1 to M do
begin
for J := 1 to N do
begin
write('Nilai [',I,',',J,'] ? '); readln(A[I,J]);
end;
writeln;
end;

{Masukkan data matriks kedua}

Writeln('Matriks yang kedua : ');
for I := 1 to N do
begin
for J := 1 to L do
begin
write('Nilai [',I,',',J,'] ? ');
readln(B[I,J]);
end;
writeln;
end;
{Perkalian matriks}
for I := 1 to M do
begin
for J := 1 to N do
begin
C[I,J] := 0;
For k := 1 to L do
C[I,J] := C[I,J] + A[I,K]* B[K,J];
end;
end;

{Mencetak hasil perkalian}

Clrscr;
Writeln(' Hasil dari perkalian matriks : ');
Writeln;
for I := 1 to M do
 begin
for J := 1 to L do
write(C[I,J]:9:2);
writeln;
Readln;
end;
end.

Output :
 4. Program pada Halaman 21 - Searching

Program binary_search;
Uses crt;

Type Tipe_larik = word;

Larik = array [1..8] of tipe_larik;

Procedure caribiner ( x : larik; cari : tipe_larik; Bawah, atas : word;

Var urutketemu : word);
Var tengah : word;

begin
if bawah > atas then urutketemu := 0
else
begin
tengah := (bawah + atas) div 2 ;
if cari = x[tengah] then
urutketemu := tengah
else
if cari < x[tengah] then
caribiner(x, cari, bawah, tengah-1, urutketemu)
else
caribiner(x, cari, tengah+1, atas, urutketemu);
end;
end;

type nama = string[20];

const
npm : larik = (1234, 1235, 1236, 1237, 1238, 1239, 1240,
1241);
nama_mhs : array [1..8] of nama = ('Arief','Ani','Budi','Citra','Dewi','Erni','Fanny','Ghana');

var
cari : word;
ketemu : word;
lagi : char;

begin
lagi := 'Y';
while upcase(lagi) = 'Y' do
begin
 clrscr;
write('NPM mahasiswa yang dicari : ');
readln(cari);

writeln;
caribiner(npm, cari, 1, 8, ketemu);
if ketemu = 0 then
writeln('NPM Mahasiswa ini tidak ada')
else
begin
writeln('NPM mahasiswa : ', npm[ketemu]);
writeln('Nama mahasiswa : ', nama_mhs[ketemu]);
end;

writeln;
write('Cari yang lain lagi (Y/T) ? '); readln(lagi);
end;
end.

Output:
 5. Program pada Halaman 27 – Faktorial A

Program Faktorial_A;
uses crt;
Procedure faktorial(n: byte; var hasil: longint);
Begin
If N <= 1 then hasil := 1
Else Begin
Faktorial(N-1, hasil);
Hasil := N*hasil;
End; end;
Var N : byte; F : longint;
Begin
Write('Berapa Faktorial? '); readln(N);
Faktorial(N,F); Writeln('Faktorial = ',F); readln;
End.

Output:

6. Program pada Halaman 27 – Faktorial B

Program Faktorial_B;
uses crt;
Function faktorial (N: byte): longint;
Begin
if N <= 1 then faktorial := 1
else
faktorial := N*faktorial (N-1);
end;
var N : byte;
begin
write ('Berapa faktorial? '); readln (N);
writeln ('Faktorial = ', faktorial (N)); readln;
end.
Output:

7. Program pada Halaman 28 – Fibonacci A

Program Fibonacci_A;
uses crt;
function fibonacci (n:word): word;
begin
if n < 2 then fibonacci := n
else
fibonacci := fibonacci (n-2) + fibonacci (n-1);
end;
var n : word;
begin
write ('Suku ke berapa? '); readln(n);
writeln ('Nilai suku ke ',n,' adalah ',fibonacci (n));
readln;
end.

Output:
 8. Program pada Halaman 28 – Fibonacci B

Program Fibonacci_B;
uses crt;
var
fibobawah, fiboatas : integer;
i,x : integer;
Function Fibonacci (n:word):word;
Begin
If n < 2 then Fibonacci := n;
Else begin
Fibobawah := 0;
Fiboatas := 1;
For i := 2 to n do
Begin
X := fibobawah; Fiboatas := fiboatas;
End; Fibonacci := fiboatas;
End; end;
Var n : word;
Begin
Write(‘Suku ke berapa? ’);readln(n);
Writeln(‘Nilai suku ke ‘,n,’ adalah ‘,Fibonacci(n));
readln;
End.

Output:
 9. Program pada Halaman 28 – Hitung Rata 1

Program HITUNG_RATA_1;
uses crt;
var
k,n,bil: integer;
jumlah: longint;
Rata: real;
a : array [0..100] of integer;

procedure Inputdata(var a: array of integer;

var i: integer);
begin
while a[i] <> -9 do begin
i := i+1;
write ('Masukkan bilangannya : '); readln(a[i]);
end;
i:= i-1;
end;

procedure cetakarray(a:array of integer; n:integer);

var i: integer;
begin
for i:= 1 to n do write(A[i],',');
end;

procedure hitungjumlah (a:array of integer; x:integer;

var total: longint);
var i : integer;
begin
for i:= 1 to x do
total := total + a[i];
end;

begin
inputdata (a,n);
writeln ('Banyaknya bilangan : ',n);
write ('Elemen arraynya adalah : ');
cetakarray(a,n);
writeln;
hitungjumlah (a,n,jumlah);
writeln('Jumlah akhir = ',jumlah);
rata := jumlah/n;
 writeln ('Rata-rata = ',rata:2:2);
writeln ('--SELESAI--');
readln;
end.

Output:

[Link] pada Halaman 30 - Hitung Rata 2

Program HITUNG_RATA2;
uses crt;
{contoh Penggunaan Procedure dan array}
var k, n : integer;
Jumlah : longint;
RATA : real;
A : array[0..100]of integer;

procedure InputData;
begin
while A[n] <> -9 do begin
n := n + 1;
write('Masukkan bilangannya : ') ; readln (A[n]);
end; {end of while}
n := n-1;
end; {end of procedure}

procedure CetakArray; var i : integer;

begin
for i := 1 to n do write (A[i],' , ');
end;

procedure HitungJumlah(var Total:longint);

var i : integer;
begin
for i := 1 to n do
Total := Total + A[i];
end; {end of procedure}
begin {Program Utama}
InputData; {Panggil prosedur InputData}
writeln ('Banyaknya bilangan : ' ,n);
write (' Elemen array-nya adalah : ' );
CetakArray; {Panggil prosedur CetakArray}
writeln;
HitungJumlah(Jumlah); {Panggil HitungJumlah}
write ('Jumlah akhir = ', Jumlah);
RATA := Jumlah/n;
writeln (' dan Rata-rata = ', rata:2:2);
writeln (' --o SELESAIi o--');
readln;
end.

Output:

[Link] pada Halaman 31 – Hitung Rata 3

Program HITUNG__RATA3 ;
uses crt;

{contoh Penggunaan Function dan array}

var k, n, Maksimum, Minimum : integer;
Jumlah : longint;
RATA : real;
A :array[0..100] of integer;

procedure InputData;
begin
while A[n] <> -9 do begin
n := n + 1;
write( 'Masukkan bilangannya : '); readln(A[n]);
end; {end of while}
n := n-1;
end; {end of procedure}

procedure CetakArray;
var i: integer;
begin
for i := 1 to n do write(A[i],' , ' );
end;

function Total (B:array of integer; x:integer):longint;

var i : integer;
temp : longint;
begin
temp := 0;
for i := 1 to X do temp := temp + B[i];
Total := temp;
end; {end of function}

function MIN(B:array of integer; x:integer):integer;

var i : integer;
temp : integer;
begin
temp := B[1];
for I := 2 to x do if temp > B[i] then temp := B[i];
MIN := temp;
end; {end of function}
function MAX(D:array of integer; n:integer):integer;
var i : integer;
temp : integer;
begin
temp := D[1] ;
for i:= 2 to N do if temp < D[i] then temp := D[i];
end; {end Of function}

begin { Program Utama }

InputData;
writeln ('Banyaknya bilangan : ',n);
write('Elemen array nya adalah : ' ); CetakArray; writeln;
Jumlah := Total (A,n); write('Jumlah akhir = ',Jumlah) ;
RATA := Jumlah/n; writeln(' dan Rata rata = ',RATA:2:2);
Minimum := Min(a,n); writeln('Elemen terkecil = ',minimum) ;
Maksimum := MAX(A,n); writeln('Elemen terbesar = ',Maksimum) ;
writeln('---o SELESAI o---');
readln;
end.

Output:
 [Link] pada Halaman 34 – Pengurutan Bubble

Program Urut_BUBBLE;
uses crt;
var i,j,k,temp,n : integer;
A, B, C : array [1..100] of integer;

begin
clrscr; textcolor(12);
write('Banyaknya Elemen Array : ') ; readln(n); {Input Data}
for i := 1 to n do A[i]:=random(1000);

{Cetak Array Sebelum Pengurutan}

writeln; textcolor(10);
write('Sebelum diurutkan : ');
for i := 1 to n do write(A[i],' ');
writeln; textcolor(11);
writeln('Proses Pengurutan Bubble : ');
for i := 1 to n-1 do begin
for j := n downto i+1 do begin
if A[j-1] > A[j] then begin
temp := A[j-1];
A[j-1] := A[j];
A[j] := temp;
end;
end;

{Cetak Array tiap langkah pengurutan}

writeln; write('Hasil akhir langkah ke-',i,' : ');
for k := 1 to n do write(A[k],' ');
end;

{Cetak Array Setelah Pengurutan}

writeln; writeln;
textcolor(15); write('Hasil Pengurutan Bubble : ');
for i := 1 to n do write(A[i],' ');
readln;
end.

Output:
 [Link] pada Halaman 37 - Pengurutan Gravitasi

Program Urut_GRAVITASI;
uses crt;
var i,j,k,temp,n : integer;
A, B, C : array [1..100] of integer;
begin
clrscr; textcolor(12);
write('Banyaknya Elemen Array : '); readln(n);

{Input Data}
for i := 1 to n do
begin
write('Elemen ke-' ,i,': '); readln(A[i]);
end;

{Cetak Array Sebelum Pengurutan}

writeln; textcolor(15); write('Sebelum diurutkan : ');
for i := 1 to n do
write(A[i],' ');
writeln; textcolor(15);
writeln; writeln('Proses Pengurutan Gravitasi : ');
for i := 1 to n-1 do begin
for j := 1 to n-i do begin
if A[j] > A[j+1] then begin
temp := A[j+1];
 A[j+1] := A[j];
A[j] := temp;
end;
end;
writeln; textcolor(i);

{Cetak Array tiap Iangkah pengurutan :}

write('Hasil akhir langkah ke-',i,' : ');
for k := 1 to n do
write(A[k],' ');
end;

{Cetak Array Setelah Pengurutan}

writeln; writeln; textcolor(11);
write('Hasil Pengurutan Gravitasi : ');
for i := 1 to n do
write(A[i],' ');
writeln; writeln; textcolor(10);
write ('Sudah terurut dengan benar khan ..?');
readln;
end.

Output:

[Link] pada Halaman 40 - Pengurutan Selection

Program Urut_SELEKSI;
uses crt;
var i,j,k,temp,imaks,n : integer ;
A,B,C : array [1..100] of integer;

begin
clrscr; textcolor(8);
write('Banyaknya Elemen Array: '); readln(n);
{InputData}
for i := 1 to n do begin
write( 'Elemen ke-' ,i, ': '); readln(A[i]);
end;
{Cetak Array Sebelum Pengurutan}
writeln; textcolor(9); write('Sebelum diurutkan : ');
for i := 1 to n do write(A[i],' ');
writeln; writeln; textcolor(6);
writeln('Proses Pengurutan Seleksi : ');
for i := 1 to n-1 do begin
imaks := i;
for j := i+1 to n do
if A[j] < A[imaks] then imaks := j;

{Tukar A[j] dengan A[imaks]}

temp := A[imaks];
A[imaks] := A[i];
A[i] := temp;
writeln; textcolor(2);
{Cetak Array tiap langkah pengurutan : }
write ( 'Hasil akhir langkah ke-' , i ,' : ' );
for k := 1 to n do
write(A[k],' ');
end;
{Cetak Array Setelah Pengurutan}
textcolor(12);
writeln;
writeln('Hasil Pengurutan Seleksi : ');
for i := 1 to n do write (A[i], ' ');
readln;
end.

Output :
 [Link] pada Halaman 43 - Pengurutan Insertion

Program INSERTION_SORT;
uses crt;
var i,j,k,temp,n : integer;
A,B,C : array [1..100] of integer;
begin
clrscr; textcolor(12);
write('Banyaknya Elemen Array : '); readln(n);

{Input Data}
for i := 1 to n do
begin
write('Elemen ke-' ,i,' : ') ; readln(A[i]);
end;

{Cetak Array Sebelum Pengurutan}

writeln; textcolor(15);
write('Sebelum diurutkan : ');
for i := 1 to n do
write(A[i],' ');
writeln; textcolor(15) ; writeln;
writeln ('Proses Pengurutan Insertion : ');
for i := 2 to n do begin
 temp := A[i];
j := i-1;
while (temp < A[j]) and (j > 0) do
j := j - 1;
for k := i downto j+1 do
A[k]:= A[k-1];
A[j+1]:= temp;
writeln; textcolor(i);
write('Hasil akhir langkah ke-' ,i-1,' : ');

{Cetak Array tiap langkah pengurutan}

for k := 1 to n do
write(A[k],' ');
end;

{Cetak Array Setelah Pengurutan}

writeln; writeln; textcolor(15);
write('Hasil Pengurutan Insertion : ');
for i := 1 to n do
write(A[i],' ');
writeln; writeln; textcolor(10);
write (' Sudah terurut dengan benar khan ..? ');
readln;
end.

Output:

[Link] pada Halaman 46 – Pengurutan Insertion Swap

Program INSERTION_SWAP_SORT;
uses crt;
var i,j,k,temp,n : integer;
A,B,C : array [1..100] of integer;
begin
clrscr; textcolor(4);
Write(' Banyaknya Elemen Array : '); readln(n);

{Input Data}
for i := 1 to n do
begin write( 'Elemen ke -' ,i,' :' ) ; readln(A[i]);
end;

{Cetak Array Sebelum Pengurutan}

writeln; textcolor(15);
write(' Sebelum diurutkan : ' );
for i := 1 to n do write(A[i],' ' );
writeln; writeln; textcolor(3);
writeln('Proses Pengurutan Swap_Insertion: ');
for i := 1 to n-1 do
begin j := i + 1;
while (A[j] < A[j-1]) and (j > 1) do begin
temp := A[j-1];
A[j-1]:= A[j];
A[j]:= temp;
j := j-1;
end;
writeln; textcolor(i);
write(' Hasil akhir langkah ke-',i,' : ');
{Cetak Array tiap Ian gkah pengurutan}
for k := 1 to n do Write(A[k],' ');
end;
{Cetak Array Setelah Pengurutan}
writeln; writeln; textcolor(15);
write('Hasil Pengurutan Insertion : ');
for i := 1 to n do write(A[i],' ');
readln;
end.

Output:
 [Link] pada Halaman 47 – Sorting Selection

Program sorting_bubble_selection;
uses crt;
Type larik = array [1..10] of byte;
objek = object
bykdata : byte;
dataawal : larik;

procedure input;
procedure tukar (var a,b : byte);
procedure bubble (data : larik);
procedure selection (data : larik);
procedure cetak (data : larik);
end;

procedure [Link];
var I : byte;
begin
repeat
write( 'Banyak Data [max 110] ? ');
readln (bykdata);
if (bykdata > 10) then
begin
writeln ( 'Data yang dimasukkan kebanyakan ');
readkey; writeln;
end;
 until (bykdata<= 10);
for i := 1 to bykdata do
begin
write( 'Data ke-' ,i,' = '); readln (dataawal[i]);
end;
end;

procedure [Link] (var a, b : byte);

var temp : byte;
begin
temp := a; a := b; b:= temp;
end;

procedure [Link] (data : larik);

var i,j : byte;
begin
clrscr;
writeln ('bubble sort ' );
write ( 'awal : ');
cetak (data);
for i := 1 to bykdata-1 do
begin
if (data [j] > data[j+1])then
tukar(data[j], data[j+1]);
gotoxy (6, wherey);
end; readkey;
write ( ' akhir : ');
cetak(data); readkey;
end;

procedure [Link] (data : larik);

var i, j, lok : byte;
begin
clrscr;
writeln ('selection sort'); write ('awal');
cetak (data);
for i := 1 to bykdata do
begin
lok :=i;
for j := i+1 to bykdata do
if(data[lok] > data [j] ) then
lok := j; tukar (data [i], data[lok]);
write ( 'I = ',i,' lok = ' , lok);
 cetak(data);
end;
end;

procedure [Link] (data : larik);

var i : byte;
begin
for i := 1 to bykdata do
begin
gotoxy (i*10, wherey);
write(data[i] : 5);
end; writeln;
end;
var sort : objek;
begin
clrscr;
[Link];
[Link] ([Link]);
[Link] ([Link]);
readln;
end.

Output:

[Link] pada Halaman 49 – Sorting Swap Insertion

Program Sorting_swap_insertion;
uses crt;
 Type larik = array [1..10] of byte;
Objek = object
Bykdata : byte;
Dataawal : larik ;
procedure input;
procedure tukar (var a,b : byte);
procedure swap_insertion (data : larik);
procedure cetak (data : larik);
end;
procedure [Link];
var i : byte;
begin
repeat
write('Banyak Data [max 110] ? ');
readln (bykdata); if (bykdata > 10) then
begin
writeln ( 'Data yang dimasukkan kebanyakan ');
readkey;
writeln;
end;
until (bykdata <= 10); for i := 1 to bykdata do
begin
write( ' Data ke-' ,i,'= ' ); readln (dataawal[i]);
end;
end;
procedure [Link] (var a, b : byte); var temp : byte;
begin
temp := a; a := b; b := temp;
end;
procedure objek.swap_insertion (data : larik);
var i, j, lok : byte;
begin
clrscr; writeln ( 'swap insertion sort ');
write ( 'awal' ); cetak (data);
for i := 1 to bykdata-i do begin
write( 'I = ',i,' '); j := i+1;
begin while (data[j] < data [j-1]) and (j > 1) do
begin tukar (data[j], data [j-1]); j := j-1;
{gotoxy (6, wherey);}
{write ( 'J = ',j); }
Cetak (data);
end;
end;
 writeln ( ' akhir = ');
cetak (data);
readkey;
end;
end;
procedure [Link] (data : larik); var i : byte;
begin
for i := 1 to bykdata do
begin
gotoxy (i*10, wherey); write(data[i] : 5);
end;
writeln;
end;
var sort : objek;
begin
clrscr;
[Link];
sort.swap_insertion([Link]); writeln; readln;
end.

Output:

[Link] pada Halaman 55 – Merging Array

PROGRAM MERGING_ARRAY;
uses crt;
var i,j,k,m,n,y,Temp : integer;
 A,B,C : array[1..100] of integer;
Procedure Cetak_array(A:array of integer; x:integer);
var i : integer;
begin
write(' Hasilnya : ');
for i:= 0 to x-1 do write(A[i], ' ');
end;
procedure sisip(var A : array of integer; x:integer);
var i,j,temp : integer;
begin
for i := 1 to x-1 do
begin
temp := A[i]; j := i;
while (temp < A[j-1]) and (j > 0) do
j := j-1;
for k := i downto j do
A[k] := A[k-1];
A[j] := temp;
end;
end;
procedure Gabung(A,B : array of integer; m,n : integer;
var C : array of integer; var x : integer);
var i, j, k, y : integer;
begin
i := 0; j := 0; k := 0;
while (i <= m) and (j <= n) do
begin
if A[i] < B[j] then
begin
C[k]:= A[i];
i := i + 1;
end
else
begin
C[k] := B[j];
j := j + 1;
end;
k := k + 1;
write('i=',i,' j=',j,' k=',k,' ');
cetak_array(C,k-1);
writeln;
end;
if i > m then
 begin
for y := k-1 to m+n do
begin
C[y] := B[j];
j := j + 1;
end;
end
else
if j > n then
begin
for y := k-1 to m+n do
begin
C[y] := A[i];
i := i + 1;
end;
end;
write('Setelah penggabungan : '); cetak_array(C,y);
x := y;
end;
begin
clrscr;
randomize;
writeln(' M E R G I N G');
write('Banyaknya elemen array pertama : ');
readln(m);
write('Banyaknya elemen array kedua : ');
readln(n);
for i := 1 to m do
A[i] := random(100);
for i := 1 to n do
B[i] := random(100);
writeln( 'Sebelum Penggabungan : ');
sisip(A,m);
write(' Array pertama : ');
cetak_array(A,m); writeln;
sisip(B,n);
write(' Array kedua : ');
cetak_array(B,n); writeln;
writeln('Proses Penggabungan : ');
Gabung(A,B,m,n,C,y);
writeln;
write('Setelah penggabungan : ');
cetak_array(C,y);
readln;
end.

Output:

[Link] pada Halaman 60 – Record A

Program Type_Data_Record;

Const pi=3.14;
Type Hasil = Record
JariJari : real;
Keliling : real;
Luas : real;
End;
Var Lingkaran : Hasil;
Begin
With Lingkaran Do
Begin
Write ('Jari-Jari lingkaran? '); readln (JariJari);
Keliling := 2*PI*JariJari;
Luas := PI * sqr(JariJari);
writeln;
Writeln ('Keliling Lingkaran = ', Keliling:7:2);
Writeln('Luas Lingkaran = ', Luas:7:2);
End;
readln;
End.

Output:

[Link] pada Halaman 60 – Record B

Program data_mhs;
Type
DataMhs : Record
NPM : Integer;
Nama : String[20];
IP : Real;
End;
Var
JumlahMhs, I, J : Byte;
Mahasiswa : Array [1..50] of DataMhs;
Temp : DataMhs;
Begin
{masukkan data mahasiswa}
Write ('Jumlah Mahasiswa ? ');
Readln(JumlahMhs);
For I := 1 to JumlahMhs Do
Begin
Writeln;
With Mahasiswa[I] Do
Begin
Writeln;
Write('NPM ke ', I:2,' ? ');
Readln (NPM);
Write ('Nama Mahasiswa ke ', I:2,' ? ');
Readln (Nama);
 Write ('IP Mahasiswa ke ', I:2, ' ? ');
Readln (IP);
End;
End;
{Mengurutkan data berdasarkan NPM mahasiswa dengan Bubble Sort}
For I:= 1 to JumlahMhs-1 Do
For J:= 1 to JumlahMhs-I do
If Mahasiswa[J].NPM > Mahasiswa[J+1].NPM then
Begin
Temp := Mahasiswa[J];
Mahasiswa [J] := Mahasiswa [J+1];
Mahasiswa [J+1] := Temp;
End;
{menampilkan hasil}
Writeln;
Writeln('---------------------------------------------------------');
Writeln(' NPM Nama Mahasiswa IP ');
Writeln('---------------------------------------------------------');
For I := 1 to JumlahMhs Do
Begin
With Mahasiswa[I] Do
Writeln (NPM:5, Nama:20, IP:8:2);
End;
Writeln('---------------------------------------------------------');
readln;
End.
Output:

[Link] pada Halaman 61 – Record Data Mahasiswa

Program Hal61_datamhs;Type
TglLhr = Record
Hari : 1..31;
Bulan : 1..12;
Tahun : Word;
End;
Almt = Record
Jalan : String[35];
Kota : String [25];
End;
Mhs = Record
Nama: String[25];
Alamat : Almt;
TglLahir : TglLhr;
End;
Var
DataMhs : Mhs;
Begin {masukkan data Mahasiswa}
[Link] := 'intan';
[Link] := 'Muara 2';
[Link] := 'Jakarta';
[Link] := 19;
[Link] := 11;
[Link] := 1997;
{menampilkan hasil}
With DataMhs Do
Begin
Writeln ('Nama Mahasiswa = ', Nama);
With Alamat Do
Begin
Writeln ('Alamat = ', Jalan);
Writeln (' ',Kota);
End;
With TglLahir Do
Begin
Writeln ('Tanggal Lahir = ',Hari:2, ' -', Bulan:2, ' -', Tahun:4); readln;
End;
End;

End.

Output :
 23. Program pada Halaman 64 - Fileteks

Program FileTeks;
uses crt;
var
berkasteks : text;
kodebrg : string[5];
namabrg : string[20];
unitbrg : integer;
hargabrg : real;
lagi : char;
begin
assign (BerkasTeks, '[Link]'); {hubungan dengan eksternal file}
rewrite(berkasteks);
lagi := 'y';
while upcase (lagi) = 'y' do
begin
clrscr;
gotoxy(5,6); write ('kode barang : ');
gotoxy(5,8); write ('nama barang : ');
gotoxy(5,10); write ('unit barang : ');
gotoxy(5,12); write ('harga satuan barang :');
gotoxy(27,6);readln(kodebrg);
gotoxy(27,8);readln(namabrg);
gotoxy(27,10);readln(unitbrg);
gotoxy(27,12);readln(hargabrg);

writeln(berkasteks,kodebrg:5,namabrg:20,unitbrg,hargabrg:10:2);
gotoxy(5,15);
write('ada data lagi (y/t)?');
readln(lagi);
end;
close(berkasteks);
readln;
end.
Output:

Tidak bisa menampilkan hasil perogram dari sintak di atas.