Praktikum 10 Bekerja dengan RECORD

1. Program Record
program record1;
uses wincrt;  
type
mahasiswa = record
nama: string[20];
nim: string[10];
prodi: string[20];
alamat: string[30];
end;
var
data_mhs: array[1..50] of mahasiswa;
n,i: integer;
begin
clrscr;
writeln('Contoh pemakaian record: Data Mahasiswa');
write('Masukkan cacah data: ');readln(n);
for i:=1 to n do
begin
writeln('data ke-',i);
write('nama mahasiswa: ');readln(data_mhs[i].nama);
write('nomor mahasiswa: ');readln(data_mhs[i].nim);
write('program studi: ');readln(data_mhs[i].prodi);
write('alamat: ');readln(data_mhs[i].alamat);
end; {perhatikan pemakaian indeks untuk array !}
writeln;
write('Tekan ENTER ...');readln;
clrscr;
writeln('Tabel Data');
for i:=1 to n do
begin
with data_mhs[i] do {#32 = SPASI}
begin
write(i,#32,nama,#32:20-length(nama));
write(nim,#32:8-length(nim));
write(prodi,#32:20-length(prodi));
writeln(alamat);
end;
end;
end.

Praktikum 9 Pemrograman Prosedural: Prosedur, Fungsi, dan Rekursi

1. Operasi 2 Bil. Bulat dengan Prosedur
program prosedu1;
uses wincrt;
var
x, y : integer;
function NamaFungsi:jenis;
begin
statemen1;
statemen2;
...
end;
function
NamaFungsi(parameter):jenis;
begin
statemen1;
statemen2;
...
Petunjuk Praktikum Pemrograman Komputer dengan Turbo Pascal  57
hasil : integer;
hasilkali: longint;
lagi : char;
procedure tambah(bil1, bil2: integer; var jumlah: integer);
begin
jumlah := bil1 + bil2;
end;
procedure selisih(bil1, bil2: integer; var sisa: integer);
begin
sisa := bil1 - bil2;
end;
procedure kali(bil1, bil2: longint; var hasil: longint);
begin
hasil := bil1*bil2;
end;
label baca;
begin
baca: clrscr;
writeln('Operasi dua buah bilangan bulat dengan prosedur');
writeln('Masukkan dua buah bilangan (pisahkan dengan spasi).');
readln(x, y);
tambah(x, y, hasil);
writeln('Jumlahnya adalah ', hasil, '.');
selisih(x, y, hasil);
writeln('Selisihnya adalah ', hasil, '.');
kali(x, y, hasilkali);
writeln('Hasil kalinya adalah ', hasilkali, '.');
write('Coba lagi?<Y/T>_');readln(lagi);
if upcase(lagi)='Y' then goto baca;
donewincrt;

end.

Praktikum 8 Variabel String: Operasi dan Fungsi-fungsi String

1. Program String 1
Program string1;
uses wincrt;
type
teks=string[10];
var
teks1,teks2 : teks;
n1,n2,i,j : integer;
lagi : char;
label baca;
begin
baca: clrscr;
writeln('Pengolahan String (Teks)');
write('Tuliskan teks I, maksimum 10 karakter: ');
readln(teks1);
write('Tuliskan teks II, maksimum 10 karakter: ');
readln(teks2);
writeln;
writeln('Teks pertama Anda adalah: ',teks1);
n1:=length(teks1);
write('Terdiri atas ',n1);
writeln(' karakter (termasuk spasi).');
write('Jika dibalik tulisan tersebut menjadi: ');
for i:=n1 downto 1 do write(teks1[i]);writeln;
write('Jika ditulis dengan HURUF BESAR: ');
for i:=1 to n1 do write(upcase(teks1[i]));writeln;
writeln;
writeln('Teks kedua Anda adalah: ',teks2);
n2:=length(teks2);
write('Terdiri atas ',n2);
writeln(' karakter (termasuk spasi).');
write('Jika dibalik tulisan tersebut menjadi: ');
for i:=n2 downto 1 do write(teks2[i]);writeln;
write('Jika ditulis dengan HURUF BESAR: ');
for i:=1 to n2 do write(upcase(teks2[i]));writeln;
writeln;
writeln('Urutan kedua teks tersebut adalah:');
if teks1 <= teks2 then writeln(teks1,', ',teks2)
else writeln(teks2,', ',teks1);
writeln('Tekan ENTER ...');readln;
writeln('Huruf-huruf yang sama pada kedua teks:');
for i:=1 to n1 do
for j:=1 to n2 do
if upcase(teks1[i])=upcase(teks2[j]) then
begin
write(teks1[i],'(posisi ke-',i,') dan ');
write(teks2[j],'(posisi ke-',j,').');
writeln
end;
write('Coba lagi?<Y/T>_');readln(lagi);
if upcase(lagi)='Y' then goto baca;
donewincrt;
end.

Praktikum 7 Array: Variabel Berdimenasi / Jajaran Variabel

1. Program Olah data
Program olahdata;
uses wincrt;
var x:array[1..100] of real; {maksimum 100 data}
n,i,j:integer;
s,m,v,d:real;
begin
writeln('Program Olah Data Sederhana:');writeln;
write('Cacah data: 100 <= ');readln(n);
writeln('Data acak dalam rentang 0 - 100:');
writeln;
{hasilkan data langsung hitung jumlahnya}
s:=0;
randomize;
for i:=1 to n do
begin
x[i]:=random(101);
writeln(' Data ke-',i,': ',x[i]:5:2);
s:=s+x[i];
if i mod 15 = 0 then
begin write('Tekan ENTER ...');readln;end;
end;
m:=s/n; {rata-rata}
v:=0;{hitung varians}
for i:=1 to n do v:=v+sqr((x[i]-m));
v:=v/n;
{urutkan data dari terbesar ke terkecil ...}
for i:=1 to n-1 do
for j:=i+1 to n do
if x[i]<x[j] then {tukar nilai x[i] dan x[j]}
begin
d:=x[i];x[i]:=x[j];x[j]:=d;
end;
{cetak data ...}
writeln;
writeln('Jumlah data = ',s:5:3);
writeln('Rata-rata = ',m:5:3);
writeln('varians = ',v:5:3);
writeln('Simpangan baku = ',sqrt(v):5:3);
writeln;
writeln('Data setelah diurutkan:');writeln;
for i:=1 to n do

begin write(x[i]:8:2); if i mod 8 = 0 then writeln; end;

Praktikum 6 Enumerasi dan Himpunan

1. Program Enumerasi
Program enum1;
uses wincrt;
type
namabulan =(Jan,Feb,Mar,April,Mei,Juni,Juli,Agust,Sept,Okt,Nop,Des);
var n,hari :integer;
bulan:namabulan;
lagi : char;
const
K: set of namabulan =[April..Sept];
begin
randomize;
writeln('Program Pemakaian Enumerasi/Daftar');
repeat
n:=random(12); bulan:=namabulan(n);
write('Tahukah Anda bahwa bulan ');
case bulan of
Jan : begin write(' Januari ');hari:=31;end;
Feb : begin write(' Pebruari ');hari:=28;end;
Mar : begin write(' Maret ');hari:=31;end;
April: begin write(' April ');hari:=30;end;
Mei : begin write(' Mei ');hari:=31;end;
Juni : begin write(' Juni ');hari:=30;end;
Juli : begin write(' Juli ');hari:=31;end;
Agust: begin write(' Agustus ');hari:=31;end;
Sept : begin write(' September ');hari:=30;end;
Okt : begin write(' Oktober ' );hari:=31;end;
Nop : begin write(' Nopember ');hari:=30;end;
Des : begin write(' Desember ');hari:=31;end;
end;
writeln('bulan ke-',ord(bulan)+1,' dan terdiri atas ',hari,' hari?');
if (bulan in K) then
writeln('Pada bulan tersebut biasanya musim kemarau.')
else writeln('Pada bulan tersebut biasanya musim penghujan.');
writeln;
write('Mau tahu bulan lain? <Y/T>_');readln(lagi);

until upcase(lagi)<>'Y';
donewincrt;
end.

2. Program 
Program enum2;
uses wincrt;
type
namahari=(Ahad,Senin,Selasa,Rabu,Kamis,Jumat,Sabtu);
var n : integer;
hari : namahari;
lagi : char;
const
Libur:set of namahari=[Ahad];
begin
writeln('Program Pemakaian Enumerasi/Daftar');
repeat
randomize;
n:=random(7); hari:=namahari(n);
write('Jika sekarang hari ');
case hari of
Ahad : write('Ahad ');
Senin : write('Senin ');
Selasa : write('Selasa ');
Rabu : write('Rabu ');
Kamis : write('Kamis ');
Jumat : write('Jum''at ');
Sabtu : write('Sabtu ');
end;
if (hari in Libur) then
writeln('(Libur).')
else writeln('(Hari kerja).');
hari:=pred(namahari(n));
write('Maka hari sebelumnya adalah ');
case hari of
Ahad : write('Ahad ');
Senin : write('Senin ');
Selasa : write('Selasa ');
Rabu : write('Rabu ');
Kamis : write('Kamis ');
Jumat : write('Jum''at ');
Sabtu : write('Sabtu ');
else write('Sabtu ');
end;
if (hari in Libur) then
writeln('(Libur).')
else writeln('(Hari kerja).');
hari:=succ(namahari(n));
write('Hari sesudahnya adalah ');
case hari of
Ahad : write('Ahad ');

Senin : write('Senin ');
Selasa : write('Selasa ');
Rabu : write('Rabu ');
Kamis : write('Kamis ');
Jumat : write('Jum''at ');
Sabtu : write('Sabtu ');
else write('Ahad ');
end;
if (hari in Libur) then
writeln('(Libur).')
else writeln('(Hari kerja).');
writeln;
write('Mau tahu hari lain? <Y/T>_');readln(lagi);
until (lagi in ['Y','y']) = false;
donewincrt;
end.

3. Program Himpunan
Program himpunan;
uses wincrt;
const
HURUFBESAR:set of char =['A'..'Z'];
hurufkecil:set of char =['a'..'z'];
angka :set of char =['0'..'9'];
hurufhidup:set of char
=['A','a','E','e','I','i','O','o','U','u'];
var k,huruf,lagi : char;
begin
writeln('Program pengujian karakter input.');
repeat
write('Ketikkan sebuah karakter : ');readln(huruf);
if huruf in HURUFBESAR then
begin
write('Anda telah mengetik sebuah huruf besar ');
if huruf in hurufhidup then writeln('(HURUF HIDUP).')
else writeln('(HURUF MATI).');
end
else if huruf in hurufkecil then
begin
write('Anda telah mengetik sebuah huruf kecil ');
if huruf in hurufhidup then writeln('(huruf hidup).')
else writeln('(huruf mati).');
end
else if huruf in angka then
writeln('Anda telah mengetik sebuah angka digit.')
else writeln('Anda mengetik karakter khusus.');
writeln;
write('Mau tahu hari lain? <Y/T>_');readln(lagi);

until (lagi in ['Y','y']) = false;
donewincrt;
end.

Praktikum 5 Penggunaan Fungsi-fungsi Matematika

1. Program Tebak Bilangan
program Tebakbil;
uses wincrt;
var
pilih: char;
bil_acak,tebakan,kesempatan: integer;
label mulai;
begin
mulai:
clrscr;
randomize; {panggil pembangkit bilangan acak}
bil_acak := random(100) + 1; {hasilkan sebuah
bilangan acak yang harus ditebak}
kesempatan := 6; {banyaknya kesempatan menebak}
tebakan := 1000; {beri nilai awal tebakan}
writeln('Saya mempunyai bilangan antara 1 dan 100.');
writeln('Cobalah Anda tebak!');
while (kesempatan > 0) and (tebakan <> bil_acak) do
{selagi masih punya kesempatan menebak}
begin
readln(tebakan);
if tebakan = bil_acak then
writeln('Tepat sekali, Anda memang hebat!')
else
begin
dec(kesempatan);
if kesempatan = 0 then
begin
writeln('Maaf ya, Anda kehabisan kesempatan menebak.');
writeln('Bilangan tersebut adalah',bil_acak,'.');
end
else
if tebakan > bil_acak then
begin
writeln('Aduh, kurang daripada ',tebakan);
writeln('(Anda masih punya ',kesempatan,'kesempatan menebak.)');
end
else
begin

writeln('Ah, lebih besar daripada ',tebakan);
writeln('(Anda masih punya ',kesempatan,'kesempatan menebak.)');
end;
end;
end;
writeln;
writeln('Anda ingin bermain lagi? (Y/T)');
readln(pilih);  if upcase(pilih)='Y' then goto mulai;
end.

Praktikum 4 FOR … TO … DO, WHILE ... DO, ... REPEAT … UNTIL …

1. Program Tabel Perkalian
Program Tblkali;
uses wincrt;
var
dimensi, i,j: integer;
begin
writeln('Mencetak tabel perkalian');
write('Masukkan ukuran tabel (1 .. 15): ');
readln(dimensi); writeln;
if (dimensi>=1) and (dimensi<=15) then

begin
write('*|':3); {judul tabel & pembatas judul}
for i := 1 to dimensi do write(i:4);
writeln;
for i := 1 to (dimensi+1)*4 do write('=');
writeln;
for i := 1 to dimensi do {cetak tabel }
begin
if i < 10 then write(' ');
write(i,'|');
for j := 1 to dimensi do write(i*j :4);
writeln;
end;
end
else writeln('Anda salah memasukkan ukuran!');
end.