Materi Pascal


program Kriptography;

Uses wincrt;
var
i, pilihan : byte;
kata : string;
label
a, b, c ;

begin
gotoxy(25,5);writeln(‘=========================================’);
gotoxy(25,6);writeln(‘   Contoh Program Enkripsi & Dekripsi ‘);
gotoxy(25,7);writeln(‘=========================================’);
gotoxy(33,8);writeln(‘           == By  ==’);
gotoxy(25,9);writeln(‘=========================================’);
gotoxy(32,10);writeln(‘           narkovic ‘);
gotoxy(32,11);writeln(‘ STT DUTA BANGSA@2009 – cikarang  ‘);
gotoxy(25,16);writeln(‘=========================================’);
gotoxy(38,17); readkey;
a:
clrscr;
gotoxy(25,5);writeln(‘=========================================’);
gotoxy(35,6);writeln(‘ MENU ‘);
gotoxy(25,7);writeln(‘=========================================’);
gotoxy(27,8);writeln(‘1. Enkripsi & Dekripsi’);
gotoxy(27,9);writeln(‘2. Exit ‘);
gotoxy(27,10);write(‘Pilihan Anda : ‘);readln(pilihan);
case pilihan of
1: begin
clrscr;
gotoxy(25,4); write (‘Tuliskan kata : ‘); readln(kata);
gotoxy(24,5); writeln(‘=========================================’);
gotoxy(30,8); writeln(‘program enkripsi’);
gotoxy(24,9); writeln(‘=========================================’);
for i:=1 to length(kata) do ;
begin
kata[i]:=chr(ord(kata[i])+6);
end;
gotoxy(24,10); writeln(‘hasil enkripsi : ‘,kata);
gotoxy(24,11); writeln(‘=========================================’);
gotoxy(24,13);write(‘tekan enter untuk mendekripsi’);readln;
gotoxy(30,15); writeln(‘program dekripsi’);
gotoxy(24,16); writeln(‘=========================================’);
for i:=1 to length(kata) do
begin
kata[i]:=chr(ord(kata[i])-6);
end;
gotoxy(24,17); writeln(‘hasil dekripsi : ‘,kata);
gotoxy(24,18); writeln(‘=========================================’);
gotoxy(21,20); write(‘Tekan enter untuk kembali ke menu’); readln;
goto a;
end;
2: begin
clrscr;
gotoxy(33,12); writeln(‘ ..::::.. ‘);
gotoxy(33,13); writeln(‘ Terima kasih ‘);
gotoxy(39,14); readkey;
donewincrt;
end;
end;
end.

Program untuk mendifinisikan array buah berisi 3 deret dengan type string *)
(*menginisialisasi isi inputan buah dari user*)
(*Seluruh isi buah berurutan mulai dari deret 1 sampai dengan 3*)
program array_dengan_while_do;

uses wincrt; {untuk tp for dos ganti libnya dengan crt}

var
buah :array[1..3] of string;

i:integer;
begin

i:=1;
while i<4 do {membatasi inputan sampai dengan 3 deret}
begin
write(‘Masukkan buah buahan ke’,i,’:’);readln(buah[i]);
i :=i+1;
end;
(*menampilkan isi Buah secara berurutan*)
clrscr;
writeln(‘+++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘Isi buah buahan yang dimasukkan tadi adalah :’);
writeln(‘+++++++++++++++++++++++++++++++++++++++++++++’);
i :=1;
while (i<4) do {membatasi keluaran sampai dengan 3 deret}

begin
writeln(‘Buah ke’,i,’:’,buah[i]);
i :=i+1;
end;

end.
program pembuatan_record;
uses crt;
procedure garis;
begin
writeln(’==============================================’);
end;

type
reckaryawan=record
jab,nip,nama:string;
gol:integer;
gapok,tunj:real;
end;

var pegawai:reckaryawan;
total:real;

begin
clrscr;
writeln(’ LAPORAN PERHITUNGAN GAJI KARYAWAN PT MAJU TAK GENTAR’);
garis;
writeln;
write(’Masukan NIP Karyawan : ‘);readln(pegawai.nip);
write(’Masukan Nama Karyawan : ‘);readln(pegawai.nama);
write(’Golongan[1/2/3] : ‘);readln(pegawai.gol);
garis;
case pegawai.gol of
1:
begin
pegawai.jab:=’Staf dan Tetap’;
pegawai.gapok:=900000;
end;
2:
begin
pegawai.jab:=’Staf dan Kontrak’;
pegawai.gapok:=700000;
end;
3:
begin
pegawai.jab:=’Kontrak’;
pegawai.gapok:=500000;
end;
end;

if pegawai.jab=’Staf dan Tetap’ then
pegawai.tunj:=25/100*pegawai.gapok
else
if pegawai.jab=’Staf dan Kontrak’ then
pegawai.tunj:=10/100*pegawai.gapok
else
pegawai.tunj:=0;
total:=(pegawai.gapok)+(pegawai.tunj);

writeln(’Jabatan Karyawan : ‘,pegawai.jab);
writeln(’Gaji Pokok : ‘,pegawai.gapok:8:0);
writeln(’Tunjangan : ‘,pegawai.tunj:8:0);
garis;
writeln(’Total Gaji Karyawan : ‘,total:8:0);
readln;
end.

program pembuatan_record;
uses crt;
procedure garis;
begin
writeln(’==============================================’);
end;

type
reckaryawan=record
jab,nip,nama:string;
gol:integer;
gapok,tunj:real;
end;

var pegawai:reckaryawan;
total:real;

begin
clrscr;
writeln(’ LAPORAN PERHITUNGAN GAJI KARYAWAN PT MAJU TAK GENTAR’);
garis;
writeln;
write(’Masukan NIP Karyawan : ‘);readln(pegawai.nip);
write(’Masukan Nama Karyawan : ‘);readln(pegawai.nama);
write(’Golongan[1/2/3] : ‘);readln(pegawai.gol);
garis;
;    case pegawai.gol of
1:
begin
pegawai.jab:=’Staf dan Tetap’;
pegawai.gapok:=900000;
end;
2:
begin
pegawai.jab:=’Staf dan Kontrak’;
pegawai.gapok:=700000;
end;
3:
begin
pegawai.jab:=’Kontrak’;
pegawai.gapok:=500000;
end;
end;

if pegawai.jab=’Staf dan Tetap’ then
pegawai.tunj:=25/100*pegawai.gapok
else
if pegawai.jab=’Staf dan Kontrak’ then
pegawai.tunj:=10/100*pegawai.gapok
else
pegawai.tunj:=0;
total:=(pegawai.gapok)+(pegawai.tunj);

writeln(’Jabatan Karyawan : ‘,pegawai.jab);
writeln(’Gaji Pokok : ‘,pegawai.gapok:8:0);
writeln(’Tunjangan : ‘,pegawai.tunj:8:0);
garis;
writeln(’Total Gaji Karyawan : ‘,total:8:0);
readln;
end.

1: Program Menghitung_Luas_dan_Keliling;

2: var alas, tinggi, sisimiring, luas, keliling: real;

3: Begin

4:   writeln(‘MENGHITUNG LUAS DAN KELILING SEGITIGA’);

5:   writeln(‘————————————-’);

6:   write(‘Masukkan alas : ‘);readln(alas);

7:   write(‘Masukkan tinggi : ‘);readln(tinggi);

8:   luas:= 0.5*alas*tinggi;

9:   sisimiring:=sqrt(sqr(alas)+sqr(tinggi));

10:   keliling:= alas+tinggi+sisimiring;

11:   writeln;

12:   writeln(‘luas segitiga : ‘, luas:0:2);

13:   writeln(‘keliling segitiga : ‘, keliling:0:2);

14:   readln;

Procedure Assign (var f, NamaFile: string);

Procedure Rewrite (var f);

Procedure Reset(var f);

Procedure Close(var f);

Procedure Write(var f, var1 [, var2, …, varn]);

Procedure Read(var f, var1 [, var2, …, varn]);

Function Eof(var f): Boolean;

Function FilePos(var f): longint;

Function FileSize(var f): longint;

Procedure Seek(var f, N: longint);

Procedure Truncate(var f);

Function Eoln(var f:text):boolean;

Function SeekEoln(var f:text):boolean;

Function SeekEof(var f:text):boolean;

Procedure Flush(var f:text);

Procedure SetTextBuf(var f:text, var buf[, ukuran: word]);

Penjelasannya di bawah ini:

Pengacuan suatu file melalui variabel file. Setiap ingin melakukan manipulasi atau yang lainya, harus melakukan ini dulu

Apabila file tidak ada, maka file itu akan terbentuk. Tetapi bila ada, maka isi file itu akan hilang.

Membuka file yang sudah ada, tetapi tidak menghapus isinya

Menutup suatu file (lakukan setelah setelah file itu di manipulasi)

Mengisi file dengan data. (apabila filenya bertipe text, maka writeln bisa digunakan)

Membaca isi file. (apabila filenya bertipe text, maka readln bisa digunakan untuk membaca perbaris)

Memeriksa akhir file. Hasilnya akan True bila posisinya diakhir dan False apabila tidak diakhir. Biasa digunakan untuk membaca/mengubah data.

Mengetahui posisi file sekarang. Penomoran data mulai dari 0.

Mengetahui jumlah data yang ada.

Memindahkan posisi file. Data pertama bernilai 0.

Menghapus data dari posisi sekarang sampai akhir file

Menghasilkan status akhir baris file teks. Nilainya akan true kalau diakhir baris atau Eof memberikan nilai True.

Sama seperti Eoln, tetapi spasi dan tab diabaikan.

Sama seperti Eof, tetapi mengabaikan spasi, tab ataupun tanda akhir baris

Mengosongkan penyangga (buffer) file teks yang dibuka
untuk keluaran (perekaman). Prosedur ini menjamin bahwa data yang direkam benar-benar telah disimpan ke file (normalnya, data akan disimpan ke file kalau penyangga file sudah penuh)

Menentukan ukuran penyangga yang digunakan file.
Dipanggil setelah assign. Semakin besar semakin cepat pemrosesannya,
defaultnya 128 byte.

Bila ada tulisan var f, itu artinya variabel file.
NamaFile artinya nama databasenya (bila perlu pathnya).
var1 artinya variabel yang bersesuaian dengan tipe filenya.
N artinya data ke-N. Bila dalam bentuk fungsi, maka ia akan mengembalikan nilai tergantung jenisnya (apabila boolean maka akan mengembalikan True atau False, bila longint akan mengembalikan angka).

Waahhh… banyak yach? emang gitulah… Bahkan ada
lagi yang lain loh untuk file tak bertipe. Prosedur
dan fungsi di atas gua ambil dari bukunya pak Ir. Abdul Kadir, Pemrograman Pascal. Bukunya bagus juga, ada 2 jilid tebel-tebel tapinya😀 . O iya, di sini gua gak ngasih contohnya loh… abis kepanjangan kalo ditulis di sini.Untuk contoh-contoh penggunaan prosedur dan fungsi di atas bisa di lihat di Program 9.

Program Menghitung_Luas_dan_Keliling;

var alas, tinggi, sisimiring, luas, keliling: real;
Begin
writeln(‘MENGHITUNG LUAS DAN KELILING SEGITIGA’);
writeln(‘————————————-’);
write(‘Masukkan alas : ‘);readln(alas);
write(‘Masukkan tinggi : ‘);readln(tinggi);
luas:= 0.5*alas*tinggi;
sisimiring:=sqrt(sqr(alas)+sqr(tinggi));
keliling:= alas+tinggi+sisimiring;
writeln;
writeln(‘luas segitiga : ‘, luas:0:2);
writeln(‘keliling segitiga : ‘, keliling:0:2);
readln;
end.

Program JenisBilangan;
var bil: longint;
begin
writeln(‘MENENTUKAN JENIS BILANGAN’);
writeln(‘————————-’);
write(‘Masukkan angka: ‘);readln(bil);
if ((bil=2) or (bil=3) or (bil=5) or (bil=7)) then
write(‘bilangan prima’)
else if ((bil mod 2 <> 0) and (bil mod 3 <> 0) and (bil mod 5 <> 0) and (bil mod 7 <> 0)) then
write(‘bilangan prima’)
else write(‘bukan bilangan prima’);
if bil mod 2 = 0 then
writeln(‘ dan genap’)
else
writeln(‘ dan ganjil’);
readln;
end.

Program BilanganTerbesar;
Var bil1, bil2, bil3 :real;
Begin
Write(‘Masukkan Bilangan Pertama : ‘);Readln(bil1);
Write(‘Masukkan Bilangan Kedua : ‘);Readln(bil2);
Write(‘Masukkan Bilangan Ketiga : ‘);Readln(bil3);
If (bil1=bil2) and (bil2=bil3) then
Writeln(‘Semua bilangan yang anda masukkan sama bbesar ‘,bil1:0:0)
Else If (bil1=bil2) or (bil1=bil3) or (bil2=bil3) then
Begin
If bil1=bil2 then
Begin
Writeln(‘Bilangan Pertama dan Kedua Adalah Sama’);
If Bil1 < bil3 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil3:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
Else If bil1=bil3 then
Begin
Writeln(‘Bilangan Pertama dan Ketiga Adalah Sama’);
If Bil1 < bil2 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil2:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
Else If bil2=bil3 then
Begin
Writeln(‘Bilangan Kedua dan Ketiga Adalah Sama’);
If Bil1 < bil3 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil3:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
End
Else If bil1 > bil2 then
begin
If bil1 > bil3 then
Writeln(‘Bilangan terbesar adalah ‘,bil1:0:0)
Else
Writeln(‘Bilangan terbesar adalah ‘,bil3:0:0);
End
Else If bil1 < bil2 then
Begin
If bil2 > bil3 then
Writeln(‘Bilangan terbesar adalah ‘,bil2:0:0)
Else
Writeln(‘Bilangan terbesar adalah ‘,bil3:0:0);
End;
readln;
End.

1: Program Pengurutan;

2: var i, j: integer;

3:   k : longint;

4:   a: array[1..5] of longint;

5: begin

6:   writeln(‘PROGRAM MENGGURUTKAN ANGKA’);

7:   writeln(‘————————–’);

8:   for i:=1 to 4 do

9:     begin

10:       write(‘Masukkan bilangan ke- ‘, i, ‘ : ‘);readln(a[i])

11:     end;

12:   for j:=2 to 4 do

13:     begin

14:       k:=a[j];

15:       i:=j-1;

16:       while (i>0) and (a[i]>k) do

17:         begin

18:           a[i+1]:=a[i];

19:           i:=i-1;

20:         end;

21:       a[i+1]:=k

22:     end;

23:   for i:=1 to 4 do

24:     writeln(a[i]);

25:   readln;

26: end.

1: Program BintangTangga;

2: const akhir=18;

3: var baris, kolom: integer;

4: begin

5:   for baris:=1 to akhir do

6:   begin

7:     for kolom:=1 to baris do

8:     write(‘*’);

9:   writeln;

10:   end;

11: readln;

12: end.

1: Program BintangKubus;

2: uses crt;

3: Var i, j, x, y:integer;

4: Begin

5:   clrscr;

6:   Write(‘Masukkan Dimensi Kubus: ‘);Readln(x);

7:   y:=0;

8:   For i:=1 to x do

9:   Begin

10:     for j:=1 to x do

11:       Begin

12:         y:=y+1;

13:         write(y:4);

14:         if y mod x=0 then

15:           Writeln;

16:       End;

17:     End;

18: readkey;

19: End.

1: Program Gabung;

2: uses crt;

3: var pilih: integer;

4: Procedure luas;

5:   {copy dan paste program 1}

6: end;

7: Procedure JenisBilangan;

8:   {copy dan paste program 2}

9: end;

10: Procedure Pengurutan;

11:   {copy dan paste program 4}

12: End;

13: begin {program utama}

14:   repeat

15:     clrscr;

16:     writeln(‘ PILIHAN’);

17:     writeln(‘——————————————-’);

18:     writeln(‘ 1. Menghitung Luas’);

19:     writeln(‘ 2. Jenis Bilangan’);

20:     writeln(‘ 3. Pengurutan’);

21:     writeln(‘ 4. Exit’);

22:     writeln(‘——————————————-’);

23:     writeln;

24:     writeln;

25:     write(‘ Pilih Angka untuk Memilih Pilihan : ‘);

26:     readln(pilih);

27:     case pilih of

28:       1 : luas;

29:       2 : JenisBilangan;

30:       3 : Pengurutan;

31:       4 : exit;

32:     end;

33:   until pilih = 4;

34: end.

1: Program Array_dan_Record;

2: type dmhs=record

3:   nrp:string[10];

4:   nama:string[25];

5:   alamat:string[50];

6: end;

7: var data:array[1..3] of dmhs;

8:     i:integer;

9: begin

10:   for i:=1 to 3 do

11:     begin

12:       write(‘nrp : ‘);readln(data[i].nrp);

13:       write(‘nama : ‘);readln(data[i].nama);

14:       write(‘alamat : ‘);readln(data[i].alamat);

15:     end;

16:   writeln;

17:   writeln(‘Data ditampilkan’);

18:   for i:=1 to 3 do

19:     begin

20:       writeln(‘nrp : ‘, data[i].nrp);

21:       writeln(‘nama : ‘, data[i].nama);

22:       writeln(‘alamat : ‘, data[i].alamat);

23:     end;

24:   readln;

25: end.

1: var nama : string;

2:     urutan, posisi: integer;

3: begin

4:   nama:=’Dijas Keren’;

5:   writeln(‘Yang ini delete’);

6:   for urutan:=1 to 11 do

7:     begin

8:       posisi:= 13 – urutan;

9:       delete(nama, posisi, 1);

10:       writeln(nama);

11:     end;

12:   writeln;

13:   nama:=’DijasKeren’;

14:   writeln(‘Yang ini insert’);

15:   writeln(‘Sebelum di Insert : ‘, nama);

16:   insert(‘-’, nama, 6);

17:   writeln(‘Setelah di Insert : ‘, nama);

18:   readln;

19: end.

1: program pembalik_kata;

2: var kata,hasil,tmp:string; i:integer;

3: begin

4:   write(‘Kata : ‘);readln(kata);

5:   hasil:=”;

6:   for i :=length(kata) downto 1 do

7:     begin

8:       tmp:=copy(kata,i,1);

9:       hasil:=hasil+tmp;

10:     end;

11:   write(‘Dibalik ‘,hasil);

12:   readln;

13: end.

1: Program Tutorial3_for;

2: var i: Integer;

3: Begin

4:   For i:=1 to 5 do

5:     writeln(‘ini yang ke ‘, i);

6: End.

1: Program Tutorial3_while;

2: var i: Integer;

3: Begin

4: i:=1;

5:   while i < 5 do

6:     begin

7:       writeln(‘ini yang ke ‘, i);

8:       i:=i+1;

9:     end;

10: End.

1: Program Tutorial3_while;

2: var pilih: char;

3: Begin

4:   i:=1;

5:   repeat

6:     writeln(‘ini yang ke ‘,i);

7:     i:=i+1;

8:     until i<0;

9: End
uses Crt;
var
x,y,z    :  longint;
lagi     :  char;
namak    :  string[20];

begin
lagi  :=  ‘y’;
while (lagi  =  ‘y’) or (lagi  =  ‘Y’) do
begin
clrscr;
write(‘Siapa Nama Anda..?’);  ReadLn(namak);
writeLn;
write(‘Hallo ‘,namak,’, Coba kamu’);
WriteLn(‘ masukan nilai x,y dan z ‘);
writeLn(‘pada operasi matematika ini.’);
writeLn;
writeLn(‘Operasi matematika X^2 + y^2 + z =….. ‘);
write(‘masukan nilai x..= ‘); ReadLn(x);
write(‘masukan nilai y..= ‘); ReadLn(y);
write(‘masukan nilai z..= ‘); ReadLn(z);
writeLn;
writeLn(‘nilai operasi x^2 + y^2 + z adalah : ‘,x*x+y*y+z);
writeLn;
write(‘Mau hitung lagi apa tidak (y/t), ‘,namak,’ ? ‘);
readLn(lagi);
end;
end.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: