1 DI SUSUN OLEH : FERDINAL. R, S.KOM DIGUNAKAN KHUSUS DILINGKUNGAN AMIK DEPATI PARBO KERINCI AKADEMI MANAJEMEN INFORMATIKA DAN KOMPUTER AMIK DEPATI PA...
DIGUNAKAN KHUSUS DILINGKUNGAN AMIK DEPATI PARBO KERINCI
AKADEMI MANAJEMEN INFORMATIKA DAN KOMPUTER
AMIK DEPATI PARBO KERINCI
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
1
{ Contoh 1. Program menggunakan write/writeln } uses crt; begin clrscr; { untuk membersihkan layar monitor } writeln('AMIK DEPATI PARBO KERINCI'); writeln('Jl. Pancasila No. 29 '); write('Sungai Penuh'); write(' Telp. 0748-21719'); end.
AMIK DEPATI PARBO KERINCI Jl. Pancasila No. 29 Sungai Penuh Telp. 0748-21719
{ Contoh 2. Program menggunakan write/writeln } uses crt; begin clrscr; writeln('Nama : Hanafa'); writeln('Alamat : Kerinci'); writeln('Jenis Kelamin : Perempuan'); readkey; { menunggu ditekan sembarang tombol } end.
Nama Alamat Jenis Kelamin
: Hanafa : Kerinci : Perempuan
{ Contoh 3. program menampilkan warna teks & latar} uses crt; begin textbackground(blue); { untuk menampilkan warna latar belakang } textcolor(white); { untuk menampilkan warna teks } clrscr; writeln('AMIK DEPATI PARBO KERINCI'); writeln('Jl. Pancasila No. 29 '); write('Sungai Penuh'); write(' Telp. 0748-21719'); end.
{ Contoh 4. Program menggunakan read } uses crt; var nm : string[10]; { mendefenisikan variabel } alt : string[25]; jekel : char; Nama begin Alamat clrscr; Jenis Kelamin write('Nama : ');read(nm); write('Alamat : ');read(alt); write('Jenis Kelamin : ');read(jekel); readkey; { menunggu ditekan sembarang tombol } end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
: ::
2
{ Contoh 5. Program menggunakan readln } uses crt; var nm : string[10]; { mendefenisikan variabel } alt : string[25]; jekel : char; begin clrscr; write('Nama : ');readln(nm); write('Alamat : ');readln(alt); write('Jenis Kelamin : ');readln(jekel); readkey; end.
Nama Alamat Jenis Kelamin
: : :
{ Contoh 6. program menggunakan readln } uses crt; var nilai1,nilai2,hasil : integer; begin clrscr; write('Input Nilai 1 : ');readln(nilai1); write('Input Nilai 2 : ');readln(nilai2); hasil := nilai1 + nilai2; writeln('Hasil Nilai 1 + Nilai 2 = ',hasil); readkey; end.
{ Contoh 7. Program menggunakan gotoxy uses crt; var nm : string[10]; alt : string[25]; jekel : char; begin clrscr; gotoxy(10,10);write('Nama gotoxy(10,11);write('Alamat gotoxy(10,12);write('Jenis Kelamin readkey; end.
Input Nilai 1 : Input Nilai 2 : Hasil Nilai 1 + Nilai 2 =
}
: ');read(nm); : ');read(alt); : ');read(jekel);
{ Contoh 8. Program menggunakan readln dan gotoxy } uses crt; var nm : string[10]; alt : string[25]; jekel : char; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
{ Contoh 9. Program menggunakan proses matematika } uses crt; var nilai1,nilai2,hasil : integer; begin textbackground(2); textcolor(0); clrscr; gotoxy(5,4);write('Input Nilai 1 : ');readln(nilai1); gotoxy(5,5);write('Input Nilai 2 : ');readln(nilai2); hasil := nilai1 * nilai2; gotoxy(5,6);writeln('Hasil Nilai 1 x Nilai 2 = ',hasil); readkey; end.
{ Contoh 10. Program menggunakan if..else dan case .. of } uses crt; var nik : string[9]; alt,nama : string[25]; jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; begin clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); write('Nama Karyawan : ');readln(nama); write('Alamat : ');readln(alt); write('Golongan : ');gol := readkey; writeln; write('Masa Kerja : ');readln(mk); if (gol='1') and (mk < 5) then gapok := 650000 else if (gol='2') and (mk < 5) then gapok := 750000 else if (gol='3') and (mk < 5) then gapok := 900000 else if (gol='4') and (mk < 5) then gapok := 1500000 else if (gol='1') and (mk >= 5) then gapok := 850000 Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
PT. ANDIKA PUTRA KERINCI ----------------------------------Nomor Induk Karyawan : Nama Karyawan : Alamat : Golongan : Masa Kerja : Gaji Pokok : Jenis Kelamin [L/P] : Status Keluarga [S/K] : Tunjangan : Gaji Bersih :
4
else if (gol='2') and (mk >= 5) then gapok := 950000 else if (gol='3') and (mk >= 5) then gapok := 1250000 else if (gol='4') and (mk >= 5) then gapok := 1800000; write('Gaji Pokok : ',gapok:9); writeln; write('Jenis Kelamin [L/P] : ');jekel:=readkey; writeln; write('Status Keluarga [S/K] : ');sk:=readkey; writeln; case sk of 'S','s' : tj := 0; 'K','k' : tj := 0.15 * gapok; end; writeln('Tunjangan : ',tj:9:0); gaber := gapok + tj; write('Gaji Bersih : ',gaber:9:0); readkey; end. { Contoh 11. Program menggunakan case..of } uses crt; var nik : string[9]; alt,nama : string[25]; jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; begin clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); write('Nama Karyawan : ');readln(nama); write('Alamat : ');readln(alt); write('Golongan : ');gol := readkey; writeln; write('Masa Kerja : ');readln(mk); if (mk < 5) then begin case gol of '1' : gapok := 650000; '2' : gapok := 750000; '3' : gapok := 900000; '4' : gapok := 1500000; end; end; if mk >= 5 then begin case gol of '1' : gapok := 850000; '2' : gapok := 950000; '3' : gapok := 1250000; '4' : gapok := 1800000; end; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
PT. ANDIKA PUTRA KERINCI ----------------------------------Nomor Induk Karyawan : Nama Karyawan : Alamat : Golongan : Masa Kerja : Gaji Pokok : Jenis Kelamin [L/P] : Status Keluarga [S/K] : Tunjangan : Gaji Bersih :
5
write('Gaji Pokok : ',gapok:9); writeln; write('Jenis Kelamin [L/P] : ');jekel:=readkey; writeln; write('Status Keluarga [S/K] : ');sk:=readkey; writeln; case sk of 'S','s' : tj := 0; 'K','k' : tj := 0.15 * gapok; end; writeln('Tunjangan : ',tj:9:0); gaber := gapok + tj; write('Gaji Bersih : ',gaber:9:0); readkey; end.
{ Contoh 12. Program Menggunakan While..Do { Menampilkan angka 1 s/d 20
} }
uses crt; var i : integer; begin clrscr; i:=1; while i <= 20 do begin writeln(i); inc(i); {penambahan satu satu} end; readkey; end.
1 2 3 4 5 6 7 8 9 … 20
{ Contoh 13. Program Menggunakan Repeat..Until } { Menampilkan bilangan genap 1 s/d 20 } uses crt; var i : integer; begin clrscr; i:=2; repeat writeln(i); i:=i+2; until i > 20; readkey; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
2 4 6 8 10 12 14 16 18 20
6
{ Contoh 14. Program Menggunakan For..Do } { Menampilkan bilangan ganjil } uses crt; var i : integer;
1 3 5 7 9 11 13 15 17 19
begin clrscr; for i:=1 to 20 do begin writeln(i); i:=i+1; end; readkey; end. { Contoh 15. Program Menggunakan For..Do } uses crt; var i : integer;
1 2 3 4 5 6 7 8 9 10 ….. 20
begin clrscr; for i:=1 to 20 do begin write(i); if i mod 2 = 0 then { mod = sisa pembagian } writeln(‘ Genap’) else writeln(‘Ganjil’); end; readkey; end.
{ Contoh 16. Program Menggunakan while … do } uses crt; var i, j : integer; begin clrscr; j := 1; i := 1; while i <= 20 do begin write(i:2); if i mod 2 = 0 then { mod = sisa pembagian } write(‘ Genap ’) else write(‘ Ganjil ’); if j mod 2 = 0 then writeln; i:=i+1; inc(j); end; readkey; end. Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
UNTUK CONTOH-CONTOH PROGRAM SELANJUTNYA TAMPILAN DAPAT DILIHAT SETELAH ANDA MENJALANKAN PROGRAM DI KOMPUTER………... { Contoh 17. Program menggunakan While .. do } uses crt; var dc,trf,ttl : real; jml : integer; nama : string[20]; alamat : string[25]; adl,vtj : char; tj : string[15]; begin adl:='Y'; while upcase(adl)='Y' do begin clrscr; gotoxy(10,4);write('>> DATA PENUMPANG PESAWAT GARUDA <<'); gotoxy(10,5);write('---------------------------------------------------------'); gotoxy(12,7);write('Nama Penumpang : ');readln(nama); gotoxy(12,8);write('Alamat : ');readln(alamat); gotoxy(36,9);write('Orang'); gotoxy(12,9);write('Jumlah Berangkat : ');readln(jml); gotoxy(12,10);write('Kode Tujuan : ');readln(vtj); if vtj in ['j','p','b','r','k','J','P','B','R','K'] then begin case vtj of 'j','J' : begin tj := 'Jakarta'; trf:= 450000; end; 'b','B' : begin tj := 'Bandung'; trf:= 350000; end; 'p','P' : begin tj := 'Padang'; trf:= 200000; end; 'r','R' : begin tj := 'Pekan Baru'; trf:= 250000; end; 'k','K' : begin tj := 'Kerinci'; trf:= 150000; end; end; gotoxy(12,11);write('Tujuan : ',tj); gotoxy(12,12);write('Tarif Pesawat : Rp. ',trf:6:0); if jml >= 3 then dc := 0.05 * trf * jml else dc := 0; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
8
ttl := trf * jml - dc; gotoxy(12,13);write('Discount : Rp. ',dc:6:0); gotoxy(12,15); write('Total Bayar untuk ',jml,' orang = Rp. ',ttl:7:0); end else begin gotoxy(12,13);write('Kode Tujuan tidak ada .... !!!'); end; gotoxy(12,16);write('Masih Ada Data Y/T : ');adl:=readkey; end; end.
{ Contoh 18. Program menggunakan While .. do } uses crt; var no_rek : string[6]; nm_lang: string[25]; mad,kd_wil,jns_lang : char; mba,mbi,i,pakai,hrg_air,dana_m,dana_adm : integer; jml_tagih : longint; begin mad := 'Y'; while upcase(mad) = 'Y' do begin clrscr; gotoxy(2,2);write('PDAM DAERAH'); gotoxy(2,3);write('DAFTAR PEMAKAIAN AIR/M3'); gotoxy(2,4);write('------------------------------------'); gotoxy(2,6);write('No_Rek : ');readln(no_rek); gotoxy(2,7);write('Nama Pelanggan : ');readln(nm_lang); gotoxy(2,8);write('Kode Wilayah : ');readln(kd_wil); gotoxy(2,9);write('Jenis Pelanggan : ');readln(jns_lang); gotoxy(2,10);write('MBA : ');readln(mba); gotoxy(2,11);write('MBI : ');readln(mbi); pakai:=mba-mbi; case jns_lang of '1' : hrg_air := 150; '2' : hrg_air := 200; '3' : hrg_air := 250; '4' : hrg_air := 275; end; case kd_wil of 'a','A' : begin dana_m := 850; dana_adm := 1500; end;
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
Program mencari nilai Diskriminan dan penggunaan statement : sqr -> pangkat dua sqrt -> akar
} } } }
uses crt; var A, B, C , D, x1, x2 : real; begin clrscr; writeln('MENGHITUNG PERSAMAAN KUADRAT'); writeln('----------------------------------------------'); writeln; write('Input Nilai A : ');readln(A); write('Input Nilai B : ');readln(B); write('Input Nilai C : ');readln(C); writeln; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
10
if A = 0 then exit else begin D := sqr(B)-4*A*C; if D < 0 then writeln('Akar tidak nyata') else begin if D = 0 then begin x1 := -B / 2 * A; x2 := -B / 2 * A; end else begin x1 := (-B+sqrt(D))/2 * A; x2 := (-B-sqrt(D))/2 * A; end; writeln('Nilai X1 = ',x1:4:2); writeln('Nilai X2 = ',x2:4:2); end; end; readln; end.
{ Contoh 20. Program menggunakan Repeat .. until } uses crt; var dc,trf,ttl : real; jml : integer; nama : string[20]; alamat : string[25]; adl,vtj : char; tj : string[15]; begin adl:='Y'; repeat clrscr; gotoxy(10,4);write('>> DATA PENUMPANG PESAWAT GARUDA <<'); gotoxy(10,5);write('---------------------------------------------------------'); gotoxy(12,7);write('Nama Penumpang : ');readln(nama); gotoxy(12,8);write('Alamat : ');readln(alamat); gotoxy(36,9);write('Orang'); gotoxy(12,9);write('Jumlah Berangkat : ');readln(jml); gotoxy(12,10);write('Kode Tujuan : ');readln(vtj); if vtj in ['j','p','b','r','k','J','P','B','R','K'] then { in digunakan apakah karakter yang kita inputkan ada dalam …..} begin case vtj of 'j','J' : begin tj := 'Jakarta'; trf:= 450000; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
11
'b','B' : begin tj := 'Bandung'; trf:= 350000; end; 'p','P' : begin tj := 'Padang'; trf:= 200000; end; 'r','R' : begin tj := 'Pekan Baru'; trf:= 250000; end; 'k','K' : begin tj := 'Kerinci'; trf:= 150000; end; end; gotoxy(12,11);write('Tujuan gotoxy(12,12);write('Tarif Pesawat
: ',tj); : Rp. ',trf:6:0);
if jml >= 3 then dc := 0.05 * trf * jml else dc := 0; ttl := trf * jml - dc; gotoxy(12,13);write('Discount : Rp. ',dc:6:0); gotoxy(12,15); write('Total Bayar untuk ',jml,' orang = Rp. ',ttl:7:0); end else begin gotoxy(12,13);write('Kode Tujuan tidak ada .... !!!'); end; gotoxy(12,16);write('Masih Ada Data Y/T : ');adl:=readkey; until upcase(adl)='T'; end.
{ Contoh 21. Program menggunakan while..do dan case .. of } uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; begin mad := 'Y'; while (upcase(mad)='Y') do begin clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
12
write('Nama Karyawan : ');readln(nama); write('Alamat : ');readln(alt); write('Golongan : ');gol := readkey; writeln; write('Masa Kerja : ');readln(mk); if (mk < 5) then begin case gol of '1' : gapok := 650000; '2' : gapok := 750000; '3' : gapok := 900000; '4' : gapok := 1500000; end; end; if mk >= 5 then begin case gol of '1' : gapok := 850000; '2' : gapok := 950000; '3' : gapok := 1250000; '4' : gapok := 1800000; end; end; write('Gaji Pokok : ',gapok:9); writeln; write('Jenis Kelamin [L/P] : ');jekel:=readkey; writeln; write('Status Keluarga [S/K] : ');sk:=readkey; writeln; case sk of 'S','s' : tj := 0; 'K','k' : tj := 0.15 * gapok; end; writeln('Tunjangan : ',tj:9:0); gaber := gapok + tj; write('Gaji Bersih : ',gaber:9:0); writeln; write('Masih Ada Data [Y/T] : ');mad:=readkey; end; end.
{ Contoh 22. Program menggunakan repeat .. until } uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; begin mad := 'Y'; repeat clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); write('Nama Karyawan : ');readln(nama); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
13
write('Alamat write('Golongan writeln; write('Masa Kerja if (mk < 5) then begin case gol of '1' : gapok := 650000; '3' : gapok := 900000; end; end; if mk >= 5 then begin case gol of '1' : gapok := 850000; '3' : gapok := 1250000; end; end; write('Gaji Pokok writeln; write('Jenis Kelamin [L/P] writeln; write('Status Keluarga [S/K] writeln; case sk of 'S','s' : tj := 0; 'K','k' : tj := 0.15 * gapok; end; writeln('Tunjangan gaber := gapok + tj; write('Gaji Bersih writeln; write('Masih Ada Data [Y/T] until (upcase(mad)='T'); end.
{ Contoh 23. Program menggunakan if..else dan case .. of } uses crt; var nik : string[9]; alt,nama : string[25]; jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,ta,ti,ts,pot : real; begin clrscr; gotoxy(15,02);writeln('PT. ANDIKA PUTRA KERINCI'); gotoxy(15,03);writeln(' ENTRY DATA KARYAWAN '); gotoxy(15,04);writeln('-----------------------------------'); gotoxy(10,05);write('Nomor Induk Karyawan : ');readln(nik); gotoxy(10,06);write('Nama Karyawan : ');readln(nama); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
14
gotoxy(10,07);write('Alamat gotoxy(10,08);write('Golongan gotoxy(10,09);write('Jenis Kelamin [L/P] gotoxy(10,10);write('Status Keluarga [S/K] if upcase(sk)='K' then begin gotoxy(10,11);write('Jumlah Anak end else ja := 0; clrscr; if gol = '1' then begin gapok := 650000; pot := 0; end else if gol = '2' then begin gapok := 750000; pot := 0.05 * gapok; end else if gol = '3' then begin gapok := 900000; pot := 0.07 * gapok; end else if gol = '4' then begin gapok := 1500000; pot := 0.1 * gapok; end; ts:=0;ti:=0; if jekel in ['L','l'] then begin case sk of 'K','k' : begin ts := 0.1 * gapok; ta := 0.1 * gapok; end; 'D','d' : begin ts := 0; ta := 0.05 * gapok; end; 'S','s' : begin ts := 0; ta := 0; end; end; end else if jekel in ['P','p'] then begin case sk of 'K','k' : begin ti := 0.07 * gapok; ta := 0.1 * gapok; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
'J','j' : begin ti := 0; ta := 0.1 * gapok; end; 'S','s' : begin ti := 0; ta := 0; end; end; end; gaber := gapok + (ta * ja) + ti + ts - pot; gotoxy(23,02);write(' SLIP GAJI KARYAWAN'); gotoxy(23,03);write('PT. ANDIKA PUTRA KERINCI'); gotoxy(10,05);write('NIK : ',nik); gotoxy(39,05);write('Gol : ',gol); gotoxy(10,06);write('Nama : ',nama); gotoxy(39,06);write('Gaji Pokok : ',gapok:-9); gotoxy(10,07);write('┌───────────────────────┬───────────┐'); gotoxy(10,08);write('| Tunjangan | |'); gotoxy(10,09);write('├───────┬───────┬───────┤ Potongan |'); gotoxy(10,10);write('| Anak | Istri | Suami | |'); gotoxy(10,11);write('├───────┼───────┼───────┼───────────┤'); gotoxy(10,12);write('| | | | |'); gotoxy(12,12);write(ta:9:0); gotoxy(26,12);write(ti:9:0); gotoxy(38,12);write(ts:9:0); gotoxy(51,12);write(pot:9:0); gotoxy(10,13);write('├───────┴───────┴───────┼───────────┤'); gotoxy(10,14);write('| Gaji Bersih | |'); gotoxy(51,14);write(gaber:9:0); gotoxy(10,15);write('└───────────────────────┴───────────┘'); readkey; end.
{ Contoh 24. Program menggunakan while..do { if..else dan case..of
} }
uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,ta,ti,ts,pot : real; begin mad:='Y'; while upcase(mad)='Y' do begin clrscr; gotoxy(15,02);writeln('PT. ANDIKA PUTRA KERINCI'); gotoxy(15,03);writeln(' ENTRY DATA KARYAWAN '); gotoxy(15,04);writeln('-----------------------------------'); gotoxy(10,05);write('Nomor Induk Karyawan : ');readln(nik); gotoxy(10,06);write('Nama Karyawan : ');readln(nama); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
16
gotoxy(10,07);write('Alamat gotoxy(10,08);write('Golongan gotoxy(10,09);write('Jenis Kelamin [L/P] gotoxy(10,10);write('Status Keluarga [S/K] if upcase(sk)='K' then begin gotoxy(10,11);write('Jumlah Anak end else ja := 0; clrscr; if gol = '1' then begin gapok := 650000; pot := 0; end else if gol = '2' then begin gapok := 750000; pot := 0.05 * gapok; end else if gol = '3' then begin gapok := 900000; pot := 0.07 * gapok; end else if gol = '4' then begin gapok := 1500000; pot := 0.1 * gapok; end; ts:=0;ti:=0;
if jekel in ['L','l'] then begin case sk of 'K','k' : begin ts := 0.1 * gapok; ta := 0.1 * gapok; end; 'D','d' : begin ts := 0; ta := 0.05 * gapok; end; 'S','s' : begin ts := 0; ta := 0; end; end; end else if jekel in ['P','p'] then begin case sk of 'K','k' : begin ti := 0.07 * gapok; ta := 0.1 * gapok; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
17
'J','j' : begin ti := 0; ta := 0.1 * gapok; end; 'S','s' : begin ti := 0; ta := 0; end; end; end; gaber := gapok + (ta * ja) + ti + ts - pot; gotoxy(23,02);write(' SLIP GAJI KARYAWAN'); gotoxy(23,03);write('PT. ANDIKA PUTRA KERINCI'); gotoxy(10,05);write('NIK : ',nik); gotoxy(39,05);write('Gol : ',gol); gotoxy(10,06);write('Nama : ',nama); gotoxy(39,06);write('Gaji Pokok : ',gapok:-9); gotoxy(10,07);write('┌───────────────────────┬───────────┐'); gotoxy(10,08);write('| Tunjangan | |'); gotoxy(10,09);write('├───────┬───────┬───────┤ Potongan |'); gotoxy(10,10);write('| Anak | Istri | Suami | |'); gotoxy(10,11);write('├───────┼───────┼───────┼───────────┤'); gotoxy(10,12);write('| | | | |'); gotoxy(12,12);write(ta:9:0); gotoxy(26,12);write(ti:9:0); gotoxy(38,12);write(ts:9:0); gotoxy(51,12);write(pot:9:0); gotoxy(10,13);write('├───────┴───────┴───────┼───────────┤'); gotoxy(10,14);write('| Gaji Bersih | |'); gotoxy(51,14);write(gaber:9:0); gotoxy(10,15);write('└───────────────────────┴───────────┘'); gotoxy(10,17);write('Ada Data Lain [Y/T] : ');mad:=readkey; end; end.
{ Contoh 25. Program menggunakan repeat..until
}
uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,ta,ti,ts,pot : real; begin mad:='Y'; repeat clrscr; gotoxy(15,02);writeln('PT. ANDIKA PUTRA KERINCI'); gotoxy(15,03);writeln(' ENTRY DATA KARYAWAN'); gotoxy(15,04);writeln('----------------------------------'); gotoxy(10,05);write('Nomor Induk Karyawan : ');readln(nik); gotoxy(10,06);write('Nama Karyawan : ');readln(nama); gotoxy(10,07);write('Alamat : ');readln(alt); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
18
gotoxy(10,08);write('Golongan gotoxy(10,09);write('Jenis Kelamin [L/P] gotoxy(10,10);write('Status Keluarga [S/K] if upcase(sk)='K' then begin gotoxy(10,11);write('Jumlah Anak end else ja := 0; clrscr; if gol = '1' then begin gapok := 650000; pot := 0; end else if gol = '2' then begin gapok := 750000; pot := 0.05 * gapok; end else if gol = '3' then begin gapok := 900000; pot := 0.07 * gapok; end else if gol = '4' then begin gapok := 1500000; pot := 0.1 * gapok; end; ts:=0;ti:=0; if jekel in ['L','l'] then begin case sk of 'K','k' : begin ts := 0.1 * gapok; ta := 0.1 * gapok; end; 'D','d' : begin ts := 0; ta := 0.05 * gapok; end; 'S','s' : begin ts := 0; ta := 0; end; end; end else if jekel in ['P','p'] then begin case sk of 'K','k' : begin ti := 0.07 * gapok; ta := 0.1 * gapok; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
'J','j' : begin ti := 0; ta := 0.1 * gapok; end; 'S','s' : begin ti := 0; ta := 0; end; end; end; gaber := gapok + (ta * ja) + ti + ts - pot; gotoxy(23,02);write(' SLIP GAJI KARYAWAN'); gotoxy(23,03);write('PT. ANDIKA PUTRA KERINCI'); gotoxy(10,05);write('NIK : ',nik); gotoxy(39,05);write('Gol : ',gol); gotoxy(10,06);write('Nama : ',nama); gotoxy(39,06);write('Gaji Pokok : ',gapok:-9); gotoxy(10,07);write('┌───────────────────────┬───────────┐'); gotoxy(10,08);write('| Tunjangan | |'); gotoxy(10,09);write('├───────┬───────┬───────┤ Potongan |'); gotoxy(10,10);write('| Anak | Istri | Suami | |'); gotoxy(10,11);write('├───────┼───────┼───────┼───────────┤'); gotoxy(10,12);write('| | | | |'); gotoxy(12,12);write(ta:9:0); gotoxy(26,12);write(ti:9:0); gotoxy(38,12);write(ts:9:0); gotoxy(51,12);write(pot:9:0); gotoxy(10,13);write('├───────┴───────┴───────┼───────────┤'); gotoxy(10,14);write('| Gaji Bersih | |'); gotoxy(51,14);write(gaber:9:0); gotoxy(10,15);write('└───────────────────────┴───────────┘'); gotoxy(10,17);write('Ada Data Lain [Y/T] : ');mad:=readkey; until upcase(mad)='T'; end.
{ Contoh 26. Program Array Satu Dimensi } uses crt; const jml = 100; var nama : array [1..jml] of string[25]; bp : array [1..jml] of string[8]; mtk : array [1..jml] of string[20]; nilai: array [1..jml] of real; i,j : integer; tot,rata : real; mad : char; begin textbackground(0);textcolor(white); mad := 'Y'; i := 1; repeat clrscr; write(i:2,' Nama Mahasiswa : ');readln(nama[i]); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
20
write(' Nomor Bp : ');readln(bp[i]); write(' Matakuliah : ');readln(mtk[i]); write(' Nilai : ');readln(nilai[i]); writeln; write(' Masih Ada Data [Y/T] : ');mad:=readkey; i:=i+1; until upcase(mad)='T'; clrscr; write('Data keberapa yang akan ditampilkan : ');readln(i); writeln(i:2,' Nama Mahasiswa : ',nama[i]); writeln(' Nomor Bp : ',bp[i]); writeln(' Matakuliah : ',mtk[i]); writeln(' Nilai : ',nilai[i]:4:2); readkey; end.
{ Contoh 27. Program Array Satu Dimensi } uses crt; var nama : array [1..50] of string[25]; mtk : array [1..50] of string[20]; nilai: array [1..50] of real; jml,i : integer; mad : char; begin textbackground(0);textcolor(white); mad := 'Y'; i := 1; jml:=0; repeat clrscr; gotoxy(20,5);write('ENTRY DATA NILAI MAHASISWA'); gotoxy(20,6);write('----------------------------------------'); gotoxy(20,8);write(i:2,' Nama Mahasiswa : ');readln(nama[i]); gotoxy(20,9);write(' Matakuliah : ');readln(mtk[i]); gotoxy(20,10);write(' Nilai : ');readln(nilai[i]); gotoxy(20,12);write(' Masih Ada Data [Y/T] : ');mad:=readkey; i:=i+1; jml:=jml+1; until upcase(mad)='T'; clrscr; gotoxy(23,06);write('DAFTAR NILAI MAHASISWA'); gotoxy(10,08);write('---------------------------------------------------------'); gotoxy(10,09);write('| No | Nama Mahasiswa | Matakuliah | Nilai |'); gotoxy(10,10);write('---------------------------------------------------------'); for i:=1 to jml do begin gotoxy(10,10+i);write('|'); gotoxy(12,10+i);write(i:2); gotoxy(15,10+i);write('|'); gotoxy(17,10+i);write(nama[i]); gotoxy(32,10+i);write('|'); gotoxy(34,10+i);write(mtk[i]); gotoxy(48,10+i);write('|'); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
{ Contoh 28. Program Array Satu Dimensi } uses crt; const jml = 100; var nama : array [1..jml] of string[25]; bp : array [1..jml] of string[8]; mtk : array [1..jml] of string[20]; nilai: array [1..jml] of real; jms,i,j,col : integer; tot,rata : real; mad : char; begin textbackground(0);textcolor(white); mad := 'Y'; i := 1; repeat clrscr; gotoxy(20,05);write('ENTRY DATA NILAI MAHASIWA'); gotoxy(20,06);write('-------------------------'); gotoxy(15,08);write('Nama Mahasiswa : '); gotoxy(15,09);write('Nomor Bp : '); gotoxy(15,10);write('Matakuliah : '); gotoxy(15,11);write('Nilai : '); gotoxy(15,13);write('Masih Ada Data [Y/T] : [ ]'); gotoxy(32,08);readln(nama[i]); gotoxy(32,09);readln(bp[i]); gotoxy(32,10);readln(mtk[i]); gotoxy(32,11);readln(nilai[i]); gotoxy(39,13);mad:=readkey; i:=i+1; until upcase(mad)='T'; clrscr; write('Data keberapa yang akan ditampilkan : ');readln(i); writeln(i:2,' Nama Mahasiswa : ',nama[i]); writeln(' Nomor Bp : ',bp[i]); writeln(' Matakuliah : ',mtk[i]); writeln(' Nilai : ',nilai[i]:4:2); readkey; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
22
{ Contoh 29. Program Array Dimensi Dua } uses crt; const jml = 100; var nama : array [1..jml] of string[25]; bp : array [1..jml] of string[8]; nilai : array [1..jml, 1..jml] of real; jms,i,j,col : integer; tot,rata : real; mad : char; begin textbackground(0);textcolor(white); clrscr; mad := 'Y'; repeat write('Input Jumlah Mahasiswa : ');readln(jms); writeln; for i:=1 to jms do begin write(i:2,' Nama Mahasiswa : ');readln(nama[i]); write(' Nomor Bp : ');readln(bp[i]); writeln; for j:=1 to 4 do begin write(' Nilai ke_',j, ' = ');readln(nilai[i,j]); end; writeln; end; mad:='T'; until upcase(mad)='T'; clrscr; gotoxy(2,04);write(' >> DAFTAR NILAI TEST MAHASISWA << '); gotoxy(2,06);write('---------------------------------------------------------------------------------'); gotoxy(2,07);write('| | | | Nilai Test | |'); gotoxy(2,08);write('| No | Nama Mahasiswa | No. Bp |------------------------|Rata-rata |'); gotoxy(2,09);write('| | | | 1 | 2 | 3 | 4 | |'); gotoxy(2,10);write('---------------------------------------------------------------------------------'); for i:=1 to jms do begin tot:=0;col:=28; gotoxy(2,10+i);write('|'); gotoxy(4,10+i);write(i:2); gotoxy(7,10+i);write('|'); gotoxy(8,10+i);write(nama[i]); gotoxy(24,10+i);write('|'); gotoxy(25,10+i);write(bp[i]); gotoxy(33,10+i);write('|'); for j:=1 to 4 do begin col := col + 6; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
23
gotoxy(col,10+i);write(nilai[i,j]:2:2); gotoxy(col+5,10+i);write('|'); tot := tot + nilai[i,j]; end; rata := tot / 4; gotoxy(61,10+i);write(rata:2:2); gotoxy(68,10+i);write('|'); writeln; end; gotoxy(2,11+i);write('---------------------------------------------------------------------------------'); gotoxy(2,12+i);write('Press anykey ...exit !!!'); readln; end.
{ Program 30. Array multi dimensi } uses crt; const jml = 50; var nama : array [1..jml] of string[25]; bp : array [1..jml] of string[8]; mtk : array [1..jml, 1..20] of string[25]; nilai: array [1..jml, 1..20, 1..3] of real; jsim : array [1..jml] of byte; ket : string[20]; jms,i,j,k,col : integer; tot,rata : real; mad,mad1,mad2 : char; begin clrscr; mad := 'Y'; repeat write('Input Jumlah Mahasiswa : ');readln(jms); writeln; for i:=1 to jms do begin clrscr; write(i:2,' Nama Mahasiswa : ');readln(nama[i]); write(' Nomor Bp : ');readln(bp[i]); writeln; mad1:='Y';j:=1; while upcase(mad1)='Y'do begin write(' Matakuliah : ');readln(mtk[i,j]); for k:=1 to 3 do begin case k of 1 : ket := ' Nilai Mid : '; 2 : ket := ' Nilai Sem : '; 3 : ket := ' Lain-lain : '; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
24
write(ket);readln(nilai[i,j,k]); end; writeln; write('Ada matakuliah lagi [Y/T] : ');readln(mad1); writeln; if upcase(mad1)='Y' then inc(j); jsim[i]:=j; end; end; mad:='T'; until upcase(mad)='T'; clrscr; for i:=1 to jms do begin gotoxy(2,02);write(' >> DAFTAR NILAI MAHASISWA << '); gotoxy(2,04);write('Nama Mahasiswa : ',nama[i]); gotoxy(2,05);write('Nomor Bp. : ',bp[i]); gotoxy(2,06);write('-----------------------------------------------------------------------'); gotoxy(2,07);write('| | | Nilai | |'); gotoxy(2,08);write('| No | Matakuliah |----------------------|Rata-rata |'); gotoxy(2,09);write('| | | MID | SEM |Lain | |'); gotoxy(2,10);write('-----------------------------------------------------------------------'); for j:=1 to jsim[i] do begin tot:=0;col:=29; gotoxy(2,10+j);write('|'); gotoxy(4,10+j);write(j:2); gotoxy(7,10+j);write('|'); gotoxy(8,10+j);write(mtk[i,j]); gotoxy(34,10+j);write('|'); for k:=1 to 3 do begin col := col + 6; gotoxy(col,10+j);write(nilai[i,j,k]:2:2); gotoxy(col+5,10+j);write('|'); tot := tot + nilai[i,j,k]; end; rata := tot / 4; gotoxy(55,10+j);write(rata:2:2); gotoxy(62,10+j);write('|'); writeln; end; gotoxy(2,11+j);write('-----------------------------------------------------------------------'); gotoxy(2,12+j);write('Press anykey ... !'); readln; clrscr; end; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
25
{ Contoh 31. Program menggunakan procedure } uses crt; var a,b,c : integer; procedure hitung(x,y,z : integer); var i, j : integer; begin i := x; j := y; a := i + j; z := x + y; writeln('Hasil x + y = ',z); writeln('Hasil i + j = ',a); end; begin clrscr; a:=3; b:=4; c:=8; hitung(a,b,c); writeln('Hasil a + b = ',c); readkey; end.
{ Contoh 32. Program menggunakan procedure } uses crt; var a,b,c : integer; procedure hitung(var x,y,z : integer); begin z := x + y; writeln('Hasil x + y = ',z); end; begin clrscr; a:=3; b:=4; c:=8; hitung(a,b,c); writeln('Hasil a + b = ',c); readkey; end.
{ Contoh 33. Program menggunakan procedure } uses crt; var a,b,c : integer; procedure judul; begin writeln('Contoh Program Penggunaan Prosedur'); writeln('-----------------------------------------------'); end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
26
procedure hitung(x,y,z : integer); var i, j : integer; begin i := x; j := y; a := i * j; z := x + y; writeln('Hasil x + y = ',z); writeln('Hasil i * j = ',a); end; begin clrscr; a:=3; b:=4; c:=8; judul; hitung(a,b,c); writeln('Hasil a + b = ',c); readkey; end.
{ Contoh 34. Program Menggunakan Procedure } Program Factorial; uses crt; type arr = record b : array[1..23] of string; end; var bil,i : integer; reco : arr; fer : char; brs,klm : integer; procedure cetak(x:integer; reco:arr); begin gotoxy(x,brs); write(reco.b[i]); end; procedure fact(n:integer; reco:arr); var i,hasil,m,j,k : integer; begin clrscr; for i:=1 to n do hasil:=hasil*i; brs:=5; m:=n; for i:=1 to n do begin klm:=5; cetak(i,i); gotoxy(klm,brs); write(reco.b[i]); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
27
for j:=2 to m do begin klm:=klm+1; gotoxy(klm,brs); write(reco.b[j]); end; brs:=brs+1; end; end; begin clrscr; gotoxy(23,5); write('input Jumlah bilangan = ');readln(bil); for i:=1 to bil do begin gotoxy(23,6); write('input bilangan = ');readln(reco.b[i]); end; fact(bil,reco); fer:=readkey; end.
{ Contoh 35. Program Menggunakan Fungsi } uses crt; function luas(als,ting:integer) :real; begin luas:=als*ting; end; var alas,tinggi: integer; begin clrscr; gotoxy(23,5); write('Input Nilai x = ');readln(alas); gotoxy(23,6); write('Input Nilai y = ');readln(tinggi); gotoxy(23,8); write('Hasil x * y = ',luas(alas,tinggi):2:2); readkey; end.
{ Contoh 36. Program Menggunakan Fungsi
}
uses crt; function tambah(a,b:integer) :integer; begin tambah :=a+b; end; var x,y : integer; begin clrscr; gotoxy(23,5); write('Input Nilai x = ');readln(x); gotoxy(23,6); write('Nnput Nilai y = ');readln(y); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
28
gotoxy(23,8); write('Hasil x + y readkey; end.
= ',tambah(x,y));
{ Contoh 37. Program Menggunakan Fungsi } uses crt; function luas(als,ting:integer) :real; begin luas:=als*ting; end; var alas,tinggi: integer; begin clrscr; gotoxy(23,5); write('Input Nilai x = ');readln(alas); gotoxy(23,6); write('Input Nilai y = ');readln(tinggi); gotoxy(23,8); write('Hasil x * y = ',luas(alas,tinggi):2:2); readkey; end.
{ Contoh 38. Program menggunakan Fungsi } Program Factorial; uses crt; function fact(n : integer) :integer; var i,hasil : integer; begin hasil:=1; for i:=1 to n do hasil:=hasil*i; fact:=hasil; end; var bil : integer; begin clrscr; gotoxy(23,5); write('Input Bilangan = ');readln(bil); gotoxy(23,6); write('Hasil Factorial = ',fact(bil):2); readkey; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
29
{ Contoh 39. Program Menggunakan Procedure } uses crt; var nik : string[9]; nama,alt : string[25]; mad,gol,st : char; gapok, pot, tj, gaber : real; procedure hitunggaji(gol1 : char; var gapok1,pot1 : real); begin case (gol1) of '1' : begin gapok1 := 650000; pot := 0; end; '2' : begin gapok1 := 750000; pot := 0.05 * gapok1; end; '3' : begin gapok1 := 900000; pot := 0.07 * gapok1; end; '4' : begin gapok1 := 1500000; pot := 0.1 * gapok1; end; end; end; procedure tunjangan(st1 : char; gapok2 : real; var tj1 : real); begin if (st1='S') or (st1='s') then tj1 := gapok2 * 0 else tj1 := gapok2 * 0.1; end; { program utama } begin mad := 'Y'; repeat clrscr; gotoxy(10,05);write('PT. ANDIKA PUTRA KERINCI'); gotoxy(10,06);write(' ENTRY DATA KARYAWAN '); gotoxy(10,07);write('-----------------------------------'); gotoxy(10,08);write('Nomor Induk Karyawan : ');readln(nik); gotoxy(10,09);write('Nama Karyawan : ');readln(nama); gotoxy(10,10);write('Alamat : ');readln(alt); gotoxy(10,11);write('Golongan [1,2,3,4] : ');gol:=readkey; hitunggaji(gol,gapok,pot); {memanggil procedure hitunggaji} Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
30
gotoxy(10,12);write('Gaji Pokok gotoxy(10,13);write('Potongan gotoxy(10,14);write('Status Keluarga S/K tunjangan(st,gapok,tj);
: ',gapok:9:0); : ',pot:9:0); : ');st:=readkey;
{memanggil procedure tunjangan}
gotoxy(10,15);write('Tunjangan gaber := gapok + tj - tj; gotoxy(10,16);write('Gaji Bersih gotoxy(10,17);write('Masih Ada Data [Y/T] until upcase(mad)='T'; end.
: ',tj:9:0); : ',gaber:9:0); : ');mad:=readkey;
{ Contoh 40. Program menggunakan procedure } { fungsi dan repeat .. until } uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; function gajikerja(gl : char;masa : integer) : longint; begin if (masa < 5) then begin case gl of '1' : gajikerja:= 650000; '2' : gajikerja:= 750000; '3' : gajikerja:= 900000; '4' : gajikerja:= 1500000; end; end; if masa >= 5 then begin case gl of '1' : gajikerja:= 850000; '2' : gajikerja:= 950000; '3' : gajikerja:= 1250000; '4' : gajikerja:= 1800000; end; end; end; procedure tunjangan(st : char;var tunj : real); begin case sk of 'S','s' : tunj := 0; 'K','k' : tunj := 0.15 * gapok; end; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
31
{program utama } begin mad := 'Y'; repeat clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); write('Nama Karyawan : ');readln(nama); write('Alamat : ');readln(alt); write('Golongan : ');gol := readkey; writeln; write('Masa Kerja : ');readln(mk); gapok:=gajikerja(gol,mk); write('Gaji Pokok : ',gapok:9); writeln; write('Jenis Kelamin [L/P] : ');jekel:=readkey; writeln; write('Status Keluarga [S/K] : ');sk:=readkey; writeln; tunjangan(sk,tj); writeln('Tunjangan : ',tj:9:0); gaber := gapok + tj; write('Gaji Bersih : ',gaber:9:0); writeln; write('Masih Ada Data [Y/T] : ');mad:=readkey; until (upcase(mad)='T'); end.
{ Contoh 41. Program menggunakan procedure } uses crt; var nik : string[9]; alt,nama : string[25]; jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,tj : real; procedure gaji(gl : char;masa : integer; var gajip : longint); begin if (gl='1') and (masa < 5) then gajip := 650000 else if (gl='2') and (masa < 5) then gajip := 750000 else if (gl='3') and (masa < 5) then gajip := 900000 else if (gl='4') and (masa < 5) then gajip := 1500000 else if (gl='1') and (masa >= 5) then gajip := 850000 else if (gl='2') and (masa >= 5) then Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
32
gajip := 950000 else if (gl='3') and (masa >= 5) then gajip := 1250000 else if (gl='4') and (masa >= 5) then gajip := 1800000; end; { Program utama } begin clrscr; writeln(' PT. ANDIKA PUTRA KERINCI'); writeln(' -----------------------------------'); write('Nomor Induk Karyawan : ');readln(nik); write('Nama Karyawan : ');readln(nama); write('Alamat : ');readln(alt); write('Golongan : ');gol := readkey; writeln; write('Masa Kerja : ');readln(mk); gaji(gol,mk,gapok); write('Gaji Pokok : ',gapok:9); writeln; write('Jenis Kelamin [L/P] : ');jekel:=readkey; writeln; write('Status Keluarga [S/K] : ');sk:=readkey; writeln; case sk of 'S','s' : tj := 0; 'K','k' : tj := 0.15 * gapok; end; writeln('Tunjangan : ',tj:9:0); gaber := gapok + tj; write('Gaji Bersih : ',gaber:9:0); readkey; end.
{ Contoh 42. Program menggunakan procedure } { if..else dan case..of } uses crt; var nik : string[9]; alt,nama : string[25]; mad,jekel,sk,gol : char; ja,mk : integer; gapok : longint; gaber,ta,ti,ts,pot : real; procedure hitunggaji(gl:char;var gpk:longint;var pt:real); begin if gl = '1' then begin gpk := 650000; pt := 0; end Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
33
else if gl = '2' then begin gpk := 750000; pt := 0.05 * gapok; end else if gl = '3' then begin gpk := 900000; pt := 0.07 * gapok; end else if gl = '4' then begin gpk := 1500000; pt := 0.1 * gapok; end; end; procedure tunjangan(jkl,st : char ; var tja,tji,tjs : real); begin if jkl in ['L','l'] then begin case st of 'K','k' : begin tjs := 0.1 * gapok; tja := 0.1 * gapok; end; 'D','d' : begin tjs := 0; tja := 0.05 * gapok; end; 'S','s' : begin tjs := 0; tja := 0; end; end; end else if jkl in ['P','p'] then begin case st of 'K','k' : begin tji := 0.07 * gapok; tja := 0.1 * gapok; end; 'J','j' : begin tji := 0; tja := 0.1 * gapok; end; 'S','s' : begin tji := 0; tja := 0; end; end; end; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
34
{ program utama } begin mad:='Y'; repeat clrscr; gotoxy(15,02);writeln('PT. ANDIKA PUTRA KERINCI'); gotoxy(15,03);writeln(' ENTRY DATA KARYAWAN'); gotoxy(15,04);writeln('-----------------------------------'); gotoxy(10,05);write('Nomor Induk Karyawan : ');readln(nik); gotoxy(10,06);write('Nama Karyawan : ');readln(nama); gotoxy(10,07);write('Alamat : ');readln(alt); gotoxy(10,08);write('Golongan : ');gol := readkey; gotoxy(10,09);write('Jenis Kelamin [L/P] : ');jekel := readkey; gotoxy(10,10);write('Status Keluarga [S/K] : ');sk := readkey; if upcase(sk)='K' then begin gotoxy(10,11);write('Jumlah Anak : ');readln(ja); end else ja := 0; clrscr; hitunggaji(gol,gapok,pot); ts:=0;ti:=0; tunjangan(jekel,sk,ta,ti,ts); gaber := gapok + (ta * ja) + ti + ts - pot; gotoxy(23,02);write(' SLIP GAJI KARYAWAN'); gotoxy(23,03);write('PT. ANDIKA PUTRA KERINCI'); gotoxy(10,05);write('NIK : ',nik); gotoxy(39,05);write('Gol : ',gol); gotoxy(10,06);write('Nama : ',nama); gotoxy(39,06);write('Gaji Pokok : ',gapok:-9); gotoxy(10,07);write('---------------------------------------------------------------------------'); gotoxy(10,08);write('| Tunjangan | |'); gotoxy(10,09);write(‘|----------------------------------------------------| Potongan |'); gotoxy(10,10);write('| Anak | Istri | Suami | |'); gotoxy(10,11);write('---------------------------------------------------------------------------'); gotoxy(10,12);write('| | | | |'); gotoxy(12,12);write(ta:9:0); gotoxy(26,12);write(ti:9:0); gotoxy(38,12);write(ts:9:0); gotoxy(51,12);write(pot:9:0); gotoxy(10,13);write('---------------------------------------------------------------------------'); gotoxy(10,14);write('| Gaji Bersih | |'); gotoxy(51,14);write(gaber:9:0); gotoxy(10,15);write('---------------------------------------------------------------------------'); gotoxy(10,17);write('Ada Data Lain [Y/T] : ');mad:=readkey; until upcase(mad)='T'; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
35
{ Contoh 43. Program Rekursif } uses crt; var nl,i : integer; function fakt(n : integer) : integer; begin if n = 1 then fakt := 1 else fakt := n * fakt(n-1); end; begin clrscr; write('Input Nilai Faktorial : ');readln(nl); writeln; for i:= 1 to nl do begin writeln('Nilai Faktorial dari ',i,' = ',fakt(i)); end; readln; end.
{ Contoh 44. Program Rekursif } uses crt; var nl,i : integer; function fibo(n : integer) : integer; begin if (n = 1) or (n = 2) then fibo := 1 else fibo := fibo(n-1) + fibo(n-2); end; begin clrscr; write('Input Deret Fibonacci : ');readln(nl); writeln; for i := 1 to nl do begin writeln('Nilai Fibonacci dari ',i,' = ',fibo(i)); end; readln; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
36
{ Contoh 45. Program Sorting / Pengurutan } uses crt; var i,j,jml, carry : byte; bil1,bil2 : array [1..20] of byte; begin clrscr; write('Input Jumlah Data : ');readln(jml); writeln; for i:=1 to jml do begin write(' Bilangan ke_',i,' = ');readln(bil1[i]); bil2[i]:=bil1[i]; end; writeln; writeln('Bilangan Setelah Diurut'); writeln('-----------------------'); for i:=1 to jml do begin for j:=1 to jml-1 do begin if bil1[i] < bil1[j] then begin carry := bil1[i]; bil1[i]:=bil1[j]; bil1[j]:=carry; end; end; end; for i:=1 to jml do begin for j:=1 to jml-1 do begin if bil2[i] > bil2[j] then begin carry := bil2[i]; bil2[i]:=bil2[j]; bil2[j]:=carry; end; end; end; writeln;write(' Dari Terkecil hingga Terbesar :'); for i:=1 to jml do begin write(bil1[i]:4); end; writeln;writeln; write(' Dari Terbesar hingga Terkecil :'); for i:=1 to jml do begin write(bil2[i]:4); end; readkey; end. Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
37
{ Contoh 46. Program membalikkan kalimat } uses crt; type n = string[255]; stack = record isi : n; atas : 0..255; end; var s : stack; procedure awal(var s:stack); begin s.atas := 0; end; procedure push(var s : stack ; x : char); begin s.atas := s.atas + 1; s.isi[s.atas] := x; end; function pop(var s : stack ):char; begin pop := s.isi[s.atas]; s.atas := s.atas - 1; end; var i : integer; kalimat : n; lagi : char; begin clrscr; awal(s); lagi :='Y'; while upcase(lagi) = 'Y' do begin gotoxy(10,02); write (' STACK UNTUK MEMBALIK KALIMAT'); gotoxy(10,03); write (' --------------------------------------------'); gotoxy(10,05); write (' Input Kalimat : '); gotoxy(34,05); readln(kalimat); gotoxy(10,07); write (' Dibalik Menjadi : '); gotoxy(33,07); write (' '); for i:=1 to length(kalimat) do push(s,kalimat[i]); for i:=1 to length(kalimat) do write (pop(s)); gotoxy(10,12); write ('Ada Data Lagi [Y/T] : '); gotoxy(34,12); readln(lagi); end; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
38
{ Contoh 47. Program Untuk Menampilkan Warna } uses crt; var j : integer; begin textbackground(10); clrscr; for j:=0 to 15 do begin textcolor(j); writeln('AMIK Depati Parbo Kerinci'); end; readln; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
39
PROGRAM GRAFIK Untuk menjalankan Program grafik perlu dilakukan beberapa setting pada compiler pascal terutama pada toolbar menu option – directory. Langkah-langkahnya adalah sebagai berikut : Jalankan program compiler pascal sehingga tampil seperti berikut :
Kemudian klik menu Option atau tekan tombol Alt + O sehingga tampil seperti berikut :
Kemudian pilih Directories …. Dan lakukan pengisian sesuai dengan folder tempat compiler pascal di simpan. Misalnya compiler/sistem pascal disimpan dalam direktori d:\data\ferdinal\pascal maka isilah Include directories dan Unit directories seperti gambar berikut. Setelah keduanya diisi kemudian tekan Esc (escape).
Langkah selanjutnya adalah menyimpan hasil setting dengan cara seperti berikut : Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
40
Pilih menu Option – save kemudian enter.
Jika semua setting telah sesuai maka program pascal yang berbasis grafik dapat anda jalankan dan jika masih terjadi kesalahan pada saat kompilasi maupun running kemungkinan setting compilernya masih ada kesalahan.
COBALAH BEBERAPA PROGRAM GRAFIK/ANIMASI BERIKUT SEMOGA ANDA DAPAT MENGEMBANGKAN DENGAN TAMPILAN YANG LEBIH BAIK
SELAMAT MENCOBA
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
41
{ Contoh 48. Program Membuat Ukuran Window/Layar } uses crt, graph3; begin textbackground(blue); window(5,10,40,20); clrscr; readkey; end.
{ Contoh 49. Program Animasi Pergeseran Karakter
}
uses crt; const posy = 12; posx = 25; waktutunda = 2120; teks:string[80] = 'HANAFA PUTRI'; var i, x : byte; begin textbackground(0); clrscr; textcolor(15); for i := 1 to length(teks) do begin x := 80; while x > (posx + i - 1) do begin gotoxy(x, posy); write(teks[i]); delay(waktutunda); gotoxy(x, posy); write(#32); x := x - 1; end; gotoxy(posx + i - 1, posy); write(teks[i]); end; readln; end.
{ Contoh 50. Program Animasi Pergeseran Karakter
}
uses crt; const posy = 12; posx = 28; waktutunda = 2120; teks:string[80] = 'AMIK DEPATI PARBO KERINCI'; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
42
var i,j,x,k : byte; begin textbackground(0); clrscr; j := 1; for i := length(teks) downto 1 do begin x := 1; if i > 15 then begin textcolor(j); j:=j+1; end else textcolor(i); while x < (posx + i - 1) do begin gotoxy(x, posy); write(teks[i]); delay(waktutunda); gotoxy(x, posy); write(' '); x := x + 1; end; gotoxy(posx + i - 1, posy); write(teks[i]); end; textbackground(green); for k:=40 downto 0 do begin window(41-k,1,41-k,25); clrscr; window(40+k,1,40+k,25); clrscr; delay(10000); end; readln; end.
{ Contoh 51. Program animasi layar } uses crt; var i : byte; begin textcolor(14);textbackground(3); clrscr; textbackground(1); gotoxy(19,10);write(' gotoxy(19,11);write(' Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
'); ');
43
gotoxy(19,11);write(' AMIK DEPATI PARBO KERINCI '); gotoxy(19,12);write(' Jl. Pancasila No. 29 - Sawahan '); gotoxy(19,13);write(' Sungai Penuh Kerinci, Telp. 0748-21719 '); gotoxy(19,14);write(' '); textbackground(0); gotoxy(62,11);write(' '); gotoxy(62,12);write(' '); gotoxy(62,13);write(' '); gotoxy(62,14);write(' '); gotoxy(20,15);write(' '); for i:=1 to 8 do begin textbackground(3); window(19,1,63,12); gotoxy(1,1); delline; window(19,13,63,25); gotoxy(1,1); insline; delay(19000); end; for i:=1 to 8 do begin window(19,1,63,12); insline; window(19,13,63,25); delline; delay(19000); end; window(1,1,80,1); textcolor(14);textbackground(3); textbackground(0); for i:=1 to 40 do begin window(41-i,1,41-i,25); clrscr; window(40+i,1,40+i,25); clrscr; delay(8000); end; end.
{ Contoh 52. Program grafik lingkaran } uses crt, graph3; var i, j, warna : integer; begin graphcolormode; graphwindow(0,0,639,199); fillscreen(0); i:=0; warna := 1; j:=0; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
44
repeat circle(80+i,30+i,20,1); circle(200-i,30+i,20,1); circle(140,30+i,20,warna); circle(80+i,90,20,warna); delay(10000); i:=i+5; if (i = 65) then i := i + 10; if (warna=3) then warna:=0; inc(warna); until i >= 130; repeat circle(140,90,0+j,0); delay(10000); sound(40*j); j:=j+1; until j >= 115; nosound; gotoxy(8,24);write('Tekan Enter .... Exit !!'); repeat until readkey=#13; textmode(C80); end.
{ Contoh 53. Program Grafik } uses crt, graph3; procedure gambar(warna : byte); var i, j : integer; begin i := 0; j := 0; repeat arc(250-i,70,360-j,20,warna); delay(10000); arc(250-i,70,360-j,20,0); i := i + 2; j := j + 30; until i >=150; arc(200-i,70,360,20,warna); end; begin graphcolormode; gotoxy(1,25);write('Tekan Enter ...!!!'); gambar(1); gambar(2); gambar(3); repeat until readkey=#13; textmode(C80); end. Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
45
{ Contoh 54. Program Grafik } uses crt, graph3; procedure gambar(warna : byte); var i : integer; begin i := 0; repeat draw(10+i,99,119,105-i+4,warna); draw(230-i,99,119,105-i+4,warna); draw(230-i,99,119,105+i-4,warna); draw(10+i,99,119,105+i-4,warna); delay(10000); i := i + 5; until i >=105; end; begin graphcolormode; gambar(2); gotoxy(1,25);write('Tekan Enter ...!!!'); graphwindow(20,20,319,199); gambar(3); graphwindow(40,40,319,199); gambar(1); repeat until readkey=#13; textmode(C80); end.
{ Contoh 55. Program Grafik } uses crt, graph3; var j : integer; procedure gambar1(warna : byte; k : integer); var i : integer; begin i := 0; repeat arc(140-i,100,360,k+i,warna); delay(10000); i := i + 2; until i >=90; end; procedure gambar2(warna : byte; k : integer); var i : integer; begin i := 0; repeat arc(50+i,100,360,k-i,warna); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
46
delay(10000); i := i + 2; until i >=90; end; begin j:=1; repeat graphcolormode; graphwindow(0,0,319,199); gambar1(j,10); graphwindow(0,0,319,199); gambar2(0,100); inc(j); if j > 3 then j := 1; until keypressed; textmode(C80); end.
{ Contoh 56. Program Grafik } uses crt, graph3; var j : integer; procedure gambar1(warna : byte; k : integer); var i : integer; begin i := 0; repeat circle(140,100,k+i,warna); delay(10000); i := i + 2; until i >=90; end; procedure gambar2(warna : byte; k : integer); var i : integer; begin i := 0; repeat circle(140,100,k-i,warna); delay(10000); i := i + 2; until i >=90; end; begin j:=1; repeat graphcolormode; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
47
graphwindow(0,0,319,199); gambar1(j,10); graphwindow(0,0,319,199); gambar2(0,100); inc(j); if j > 3 then j := 1; until keypressed; textmode(C80); end.
{ Contoh 57. Program Grafik } uses crt, graph3; var j : integer; procedure gambar1(x,y,z : integer; warna : byte); var i : integer; begin i := 0; repeat arc(x+i,y+i,360,z-i,warna); delay(10000); i := i + 2; until i >=50; end; procedure gambar2(x,y,z : integer; warna : byte); var i : integer; begin i := 0; repeat arc(x-i,y-i,360,i-z,warna); delay(10000); i := i + 2; until i >=50; end; procedure gambar3(x,y,z : integer; warna : byte); var i : integer; begin i := 0; repeat arc(x+i,y,360,z+i,warna); delay(10000); i := i + 2; until i >=50; end;
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
48
begin j:=1; repeat graphcolormode; graphwindow(0,0,319,199); gambar3(165,100,5,j); gambar3(100,100,-50,j); gambar1(110,50,45,j); gambar1(150,100,5,j); gambar2(200,150,45,0); if j <> 2 then gambar2(160,100,5,2) else gambar2(160,100,5,1); inc(j); if j > 3 then j := 1; until keypressed; textmode(C80); end.
{ Contoh 58. Program Animasi Layar
}
uses crt; var i : byte; begin textbackground(0); clrscr; textbackground(9); for i:=1 to 40 do begin window(41-i,1,41-i,25); clrscr; window(40+i,1,40+i,25); clrscr; delay(10000); end; textbackground(14); for i:=40 downto 0 do begin window(41-i,1,41-i,25); clrscr; window(40+i,1,40+i,25); clrscr; delay(10000); end; textmode(3); textbackground(0); clrscr; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
49
{ Contoh 59. Program Grafik } uses crt, graph3; procedure gambar(warna : byte); var i : integer; begin i := 0; repeat circle(20+i,99,20,warna); circle(250-i,99,20,warna); circle(250-i,99,20,warna); circle(20+i,99,20,warna); delay(10000); i := i + 5; until i >=105; end; begin graphcolormode; gotoxy(1,25);write('Tekan Enter ...!!!'); gambar(1); gambar(2); gambar(3); gambar(0); repeat until readkey=#13; textmode(C80); end. { Contoh 60. Program Grafik } uses crt, graph3; var i : integer; begin graphcolormode; graphwindow(0,0,639,199); fillscreen(0); i:=0; gotoxy(10,24);write('Tekan Enter .... Exit !!'); repeat arc(80+i,30+i,360,20,3); arc(200-i,30+i,360,20,2); arc(140,30+i,360,20,1); arc(80+i,90,360,20,1); delay(10000); i:=i+5 until i >= 130; repeat until readkey=#13; textmode(C80); end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
50
CONTOH-CONTOH PROGRAM BERBASIS FILE/DATABASE (1 FILE s/d MULTI FILE) { Contoh 61. Program Entry 1 File } uses crt; type pasien=record { defenisi variabel yang akan disimpan dalam file/database } kd_pas : string[4]; nm_pas : string[20]; jekel : char; alt : string[25]; end; var file_pas : file of pasien; r_pas : pasien; ketemu : boolean; i,j,jml : byte; vkode : string[4]; mad, dsb : char; begin assign(file_pas,'pasien.dat'); { membuka file database } {$i-} { untuk menghindari kesalahan I/O dalam program } reset(file_pas); { membuka file yang aktif } {$i+} if ioresult <> 0 then rewrite(file_pas); mad := 'Y'; repeat clrscr; gotoxy(10,10);write('>> ENTRY DATA PASIEN <<'); gotoxy(10,11);write('------------------------------------'); gotoxy(10,13);write('Kode Pasien : '); gotoxy(10,14);write('Nama Pasien : '); gotoxy(10,15);write('Jenis Kelamin : '); gotoxy(10,16);write('Alamat : '); gotoxy(10,18);write('Data Sudah Benar [Y/T] : '); gotoxy(10,19);write('Masih Ada Data [Y/T] : '); gotoxy(27,13);readln(vkode); with r_pas do begin jml:=filesize(file_pas); { menghitung jumlah record yang ada dalam database } ketemu:=false; for i:=1 to jml do begin seek(file_pas,i-1); { mengarahkan kursor/pointer ke awal record } read(file_pas,r_pas); { membaca data yang ada dalam database } if vkode=kd_pas then { jika data (kode pasien) yang diinputkan sudah ada maka data akan langsung ditampilkan jika tidak inputkan data baru } begin gotoxy(27,14);write(nm_pas); gotoxy(27,15);write(jekel); gotoxy(27,16);write(alt); ketemu:=true; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
51
end; end; if ketemu then begin gotoxy(10,21);write('Kode pasien sudah terdaftar ....!'); end else begin with r_pas do begin dsb:='T'; repeat gotoxy(27,14);readln(nm_pas); gotoxy(27,15);readln(jekel); gotoxy(27,16);readln(alt); gotoxy(35,18);readln(dsb); until upcase(dsb)='Y'; kd_pas:=vkode; seek(file_pas,filesize(file_pas)); { mengarahkan kursor/pointer ke akhir record } write(file_pas,r_pas); { menyimpan data ke dalam file/database } end; end; gotoxy(35,19);readln(mad); until upcase(mad)='T'; close(file_pas); end.
{ Contoh 62. Program entry 1 (satu) File } uses crt; type pasien=record kd_pas : string[4]; nm_pas : string[20]; jekel : char; alt : string[25]; end; var file_pas : file of pasien; r_pas : pasien; ketemu : boolean; i,j,jml,m,n : byte; vkode : string[4]; pil,mad,dsb : char; vnm_pas : string[20]; vjekel : char; valt : string[25]; procedure bayangan(x,y : integer); var i : integer; begin textcolor(14);textbackground(1); for i:=1 to x do begin gotoxy(10,3+i);write(' ':y); end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
52
textcolor(14);textbackground(0); for i:=1 to x do begin gotoxy(y+10,4+i);write(' '); end; gotoxy(11,4+i);write(' ':y); end; begin assign(file_pas,'pasien.dat'); {$i-} reset(file_pas); {$i+} if ioresult <> 0 then rewrite(file_pas); mad := 'Y'; repeat textcolor(14);textbackground(3); clrscr; bayangan(12,50); textcolor(14);textbackground(1); gotoxy(15,05);write(' >> ENTRY DATA PASIEN <<'); gotoxy(15,06);write(' ------------------------------------'); gotoxy(15,08);write('Kode Pasien : '); gotoxy(15,09);write('Nama Pasien : '); gotoxy(15,10);write('Jenis Kelamin : '); gotoxy(15,11);write('Alamat : '); gotoxy(18,13);write('Data Sudah Benar [Y/T] : '); gotoxy(18,14);write('Masih Ada Data [Y/T] : '); gotoxy(32,08);readln(vkode); with r_pas do begin jml:=filesize(file_pas); ketemu:=false; for i:=1 to jml do begin seek(file_pas,i-1); read(file_pas,r_pas); if vkode=kd_pas then begin ketemu:=true; vnm_pas:=nm_pas; vjekel:=jekel;valt :=alt; end; end; end; if ketemu then begin with r_pas do begin gotoxy(32,09);write(vnm_pas); gotoxy(32,10);write(vjekel); gotoxy(32,11);write(valt); end; gotoxy(15,18);write('Kode pasien sudah terdaftar ....!'); readkey; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
53
textcolor(14);textbackground(3); gotoxy(15,18);write(' ':60); end; if not ketemu then begin with r_pas do begin dsb:='T'; gotoxy(32,09);readln(nm_pas); gotoxy(32,10);readln(jekel); gotoxy(32,11);readln(alt); gotoxy(43,13);dsb:=readkey; if upcase(dsb)='Y' then begin seek(file_pas,filesize(file_pas)); kd_pas:=vkode; write(file_pas,r_pas); end; end; end; gotoxy(43,14);mad:=readkey; until upcase(mad)='T'; close(file_pas); end. { Contoh 63. Program Edit/Koreksi 1 (Satu) File } uses crt; type pasien=record kd_pas : string[4]; nm_pas : string[20]; jekel : char; alt : string[25]; end; var file_pas : file of pasien; r_pas : pasien; ketemu : boolean; i,j,jml : byte; vkode : string[4]; pil,mad,dsb : char; k : integer; vnm_pas : string[20]; vjekel : char; valt : string[25]; procedure bayangan(x,y : integer); var i : integer; begin textcolor(14);textbackground(1); for i:=1 to x do begin gotoxy(10,3+i);write(' ':y); end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
54
textcolor(14);textbackground(0); for i:=1 to x do begin gotoxy(y+10,4+i);write(' '); end; gotoxy(11,4+i);write(' ':y); end; begin assign(file_pas,'pasien.dat'); {$i-} reset(file_pas); {$i+} if ioresult <> 0 then rewrite(file_pas); mad := 'Y'; repeat textcolor(14);textbackground(3); clrscr; k:=0; bayangan(12,50); textcolor(14);textbackground(1); gotoxy(15,05);write(' >> EDIT DATA PASIEN <<'); gotoxy(15,06);write(' ---------------------------------'); gotoxy(15,08);write('Kode Pasien : '); gotoxy(15,09);write('Nama Pasien : '); gotoxy(15,10);write('Jenis Kelamin : '); gotoxy(15,11);write('Alamat : '); gotoxy(18,13);write('Data Sudah Benar [Y/T] : '); gotoxy(18,14);write('Masih Ada Data [Y/T] : '); gotoxy(32,08);readln(vkode); with r_pas do begin jml:=filesize(file_pas); ketemu:=false; for i:=1 to jml do begin seek(file_pas,i-1); read(file_pas,r_pas); if vkode=kd_pas then begin ketemu:=true; vnm_pas:=nm_pas; vjekel:=jekel;valt :=alt; k:=i; end; end; end; if not ketemu then begin gotoxy(10,21);write('Pasien tidak terdaftar ....!'); readkey; textcolor(14);textbackground(3); gotoxy(15,18);write(' ':60); end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
55
if ketemu then begin with r_pas do begin dsb:='T'; gotoxy(32,09);write(vnm_pas); gotoxy(32,10);write(vjekel); gotoxy(32,11);write(valt); gotoxy(32,09);readln(vnm_pas); gotoxy(32,10);readln(vjekel); gotoxy(32,11);readln(valt); gotoxy(43,13);dsb:=readkey; if upcase(dsb)='Y' then begin seek(file_pas,k-1); kd_pas:=vkode; nm_pas:=vnm_pas; jekel:=vjekel; alt:=valt; write(file_pas,r_pas); end; end; end; gotoxy(43,14);mad:=readkey; until upcase(mad)='T'; close(file_pas); end.
{ Contoh 64. Program entry dan edit 1 (satu) file } uses crt; type pasien=record kd_pas : string[4]; nm_pas : string[20]; jekel : char; alt : string[25]; end; var file_pas : file of pasien; r_pas : pasien; ketemu : boolean; i,j,jml,m,n : byte; vkode : string[4]; pil,mad,dsb : char; procedure bayangan(x,y : integer); var i : integer; begin textcolor(14);textbackground(1); for i:=1 to x do begin gotoxy(10,3+i);write(' ':y); end; textcolor(14);textbackground(0); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
56
for i:=1 to x do begin gotoxy(y+10,4+i);write(' '); end; gotoxy(11,4+i);write(' ':y); end; procedure entry; begin assign(file_pas,'pasien.dat'); {$i-} reset(file_pas); {$i+} if ioresult <> 0 then rewrite(file_pas); mad := 'Y'; repeat textcolor(14);textbackground(3); clrscr; bayangan(12,50); textcolor(14);textbackground(1); gotoxy(15,05);write(' >> ENTRY DATA PASIEN <<'); gotoxy(15,06);write(' ------------------------------------'); gotoxy(15,08);write('Kode Pasien : '); gotoxy(15,09);write('Nama Pasien : '); gotoxy(15,10);write('Jenis Kelamin : '); gotoxy(15,11);write('Alamat : '); gotoxy(18,13);write('Data Sudah Benar [Y/T] : '); gotoxy(18,14);write('Masih Ada Data [Y/T] : '); gotoxy(32,08);readln(vkode); with r_pas do begin jml:=filesize(file_pas); ketemu:=false; for i:=1 to jml do begin seek(file_pas,i-1); read(file_pas,r_pas); if vkode=kd_pas then begin ketemu:=true; end; end; end; if ketemu then begin gotoxy(15,18);write('Kode pasien sudah terdaftar ....!'); readkey; textcolor(14);textbackground(3); gotoxy(15,18);write(' ':60); end; if not ketemu then begin with r_pas do Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
57
begin dsb:='T'; gotoxy(32,09);readln(nm_pas); gotoxy(32,10);readln(jekel); gotoxy(32,11);readln(alt); gotoxy(43,13);dsb:=readkey; if upcase(dsb)='Y' then begin seek(file_pas,filesize(file_pas)); kd_pas:=vkode; write(file_pas,r_pas); end; end; end; gotoxy(43,14);mad:=readkey; until upcase(mad)='T'; close(file_pas); end; procedure edit; var k : integer; begin assign(file_pas,'pasien.dat'); {$i-} reset(file_pas); {$i+} if ioresult <> 0 then rewrite(file_pas); mad := 'Y'; repeat textcolor(14);textbackground(3); clrscr; k:=0; bayangan(12,50); textcolor(14);textbackground(1); gotoxy(15,05);write(' >> EDIT DATA PASIEN <<'); gotoxy(15,06);write(' ---------------------------------'); gotoxy(15,08);write('Kode Pasien : '); gotoxy(15,09);write('Nama Pasien : '); gotoxy(15,10);write('Jenis Kelamin : '); gotoxy(15,11);write('Alamat : '); gotoxy(18,13);write('Data Sudah Benar [Y/T] : '); gotoxy(18,14);write('Masih Ada Data [Y/T] : '); gotoxy(32,08);readln(vkode); with r_pas do begin jml:=filesize(file_pas); ketemu:=false; for i:=1 to jml do begin seek(file_pas,i-1); read(file_pas,r_pas); if vkode=kd_pas then begin ketemu:=true; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
58
k:=i; end; end; end; if not ketemu then begin gotoxy(10,21);write('Pasien tidak terdaftar ....!'); readkey; textcolor(14);textbackground(3); gotoxy(15,18);write(' ':60); end; if ketemu then begin with r_pas do begin dsb:='T'; gotoxy(32,09);readln(nm_pas); gotoxy(32,10);readln(jekel); gotoxy(32,11);readln(alt); gotoxy(43,13);dsb:=readkey; if upcase(dsb)='Y' then begin seek(file_pas,k-1); kd_pas:=vkode; write(file_pas,r_pas); end; end; end; gotoxy(43,14);mad:=readkey; until upcase(mad)='T'; close(file_pas); end; begin repeat textcolor(14);textbackground(3); clrscr; bayangan(9,36); textcolor(14);textbackground(1); gotoxy(15,05);write('> M E N U P I L I H A N <'); gotoxy(15,06);write('---------------------------------'); gotoxy(15,07);write(' [1]. Entry Data'); gotoxy(15,08);write(' [2]. Edit Data'); gotoxy(15,09);write(' [0]. Exit '); gotoxy(15,11);write(' Pilihan [ ]'); gotoxy(39,11);pil:=readkey; case pil of '1' : entry; '2' : edit; '0' : exit; end; until pil='0'; end. Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
59
{ Contoh 65. Program 2 (dua) file } uses crt, dos, printer; type barang = record kd_brg : string[4]; nm_brg : string[50]; end; trans2 = record no_fak : string[4]; kd_brg : string[4]; nm_sup : string[25]; fthn,fbln,ftgl : word; harga,qty : real; end; const namabulan : array [1..12] of string[8] = ('Januari','Februari', 'Maret','April','Mei','Juni','Juli', 'Agustus','September','Oktober', 'November','Desember'); namahari : array [0..6] of string[8] =('Minggu','Senin','Selasa', 'Rabu','Kamis','Jumat','Sabtu'); var f_barang : file of barang; f_trans2 : file of trans2; r_barang : barang; r_trans2 : trans2; tahun,bulan,tanggal,hari : word; jam,menit,detik,perdetik : word; procedure animasi(x,y : byte); var i : byte; begin textcolor(14);textbackground(3); for i:=1 to x do begin gotoxy(2,2+i);write(' ':78); end; textbackground(1); for i:=1 to y do begin gotoxy(10,03+i);write(' ':65); end; for i:=0 to 65 do begin gotoxy(10+i,05);write('=='); end; textbackground(0); for i:=1 to y do begin gotoxy(75,04+i);write(' '); end; gotoxy(11,04+i);write(' ':65); end;
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
60
procedure tampilmenu(x,y,brs,kol,warna : byte); var i : byte; begin textcolor(14);textbackground(warna); for i:=1 to x do begin gotoxy(kol,brs+i);write(' ':y); end; textbackground(0); inc(brs); for i:=1 to x do begin gotoxy(y+kol,brs+i);write(' '); end; gotoxy(kol+1,brs+i);write(' ':y); end; procedure entry2; var vnama : string[50]; mad, dsb : char; vkode : string[4]; ketemu : boolean; jml,i : integer; begin {$i-} reset(f_barang); repeat animasi(21,8); textcolor(14);textbackground(1); gotoxy(28,04);write('>> ENTRY DATA BARANG <<'); gotoxy(21,07);write('Kode Barang : '); gotoxy(21,08);write('Nama Barang : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Simpan Data [ ] (Y/T)'); gotoxy(42,10);write('»» Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(37,07);readln(vkode); if vkode = '' then exit; jml := filesize(f_barang); ketemu := false; for i:=1 to jml do begin seek(f_barang,i-1); read(f_barang,r_barang); with r_barang do if kd_brg=vkode then begin ketemu := true; vnama :=nm_brg; end; end; if not ketemu then begin with r_barang do begin gotoxy(37,08);readln(nm_brg); gotoxy(33,10);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_barang,filesize(f_barang)); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
61
kd_brg := vkode; write(f_barang,r_barang); end; end; end; if ketemu then begin gotoxy(37,08);write(vnama); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Data Barang Sudah Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_barang); end; procedure edit2; var vkode : string[4]; ketemu : boolean; jml,i,j : integer; mad, dsb : char; begin {$i-} reset(f_barang); repeat animasi(21,8); textcolor(14);textbackground(1); gotoxy(28,04);write('>> EDIT DATA BARANG <<'); gotoxy(21,07);write('Kode Barang : '); gotoxy(21,08);write('Nama Barang : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Simpan Data [ ] (Y/T)'); gotoxy(42,10);write('»» Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(37,07);readln(vkode); if vkode = '' then exit; jml := filesize(f_barang); ketemu := false; for i:=1 to jml do begin seek(f_barang,i-1); read(f_barang,r_barang); with r_barang do if kd_brg=vkode then begin ketemu := true; gotoxy(37,08);write(nm_brg); j:=i; end; end; if ketemu then begin with r_barang do begin gotoxy(37,08);readln(nm_brg); gotoxy(33,10);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_barang,j-1); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
62
kd_brg := vkode; write(f_barang,r_barang); end; end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Data Barang Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_barang); end; procedure cari2; var vkode : string[4]; ketemu : boolean; jml,i,j : integer; mad, dsb : char; begin {$i-} reset(f_barang); repeat animasi(21,8); textcolor(14);textbackground(1); gotoxy(28,04);write('>> CARI DATA BARANG <<'); gotoxy(21,07);write('Kode Barang : '); gotoxy(21,08);write('Nama Barang : '); textcolor(14);textbackground(1); gotoxy(42,10);write('»» Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(37,07);readln(vkode); if vkode = '' then exit; jml := filesize(f_barang); ketemu := false; for i:=1 to jml do begin seek(f_barang,i-1); read(f_barang,r_barang); with r_barang do if kd_brg=vkode then begin ketemu := true; gotoxy(37,08);write(nm_brg); end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Data Barang Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_barang); end; procedure hapus2; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
63
var vkode,kode_cari : string[4]; ketemu : boolean; jml,i,j : integer; mad, dsb : char; vnama : string[50]; begin {$i-} reset(f_barang); repeat animasi(21,8); textcolor(14);textbackground(1); gotoxy(28,04);write('>> HAPUS DATA BARANG <<'); gotoxy(21,07);write('Kode Barang : '); gotoxy(21,08);write('Nama Barang : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Hapus Data [ ] (Y/T)'); gotoxy(42,10);write('»» Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(37,07);readln(kode_cari); if kode_cari = '' then exit; jml := filesize(f_barang); ketemu := false; for i:=1 to jml do begin seek(f_barang,i-1); read(f_barang,r_barang); with r_barang do if kd_brg=kode_cari then begin ketemu := true; gotoxy(37,08);write(nm_brg); j:=i; end; end; if ketemu then begin with r_barang do begin gotoxy(33,10);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_barang,j-1); nm_brg := ' '; kd_brg :=' '; write(f_barang,r_barang); end; end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Data Barang Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_barang); end;
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
64
procedure infobrg; var k,jml1,i,j,l : integer; mad : char; begin {$i-} reset(f_barang); jml1 := filesize(f_barang); i:=1; textcolor(14);textbackground(1); for i:=1 to 18 do begin gotoxy(2,2+i);write(' ':78); end; gotoxy(15,04);write(' DAFTAR NAMA-NAMA BARANG '); gotoxy(15,06);write('-----------------------------------------------------------'); gotoxy(15,07);write('| No | K o d e | Nama Barang |'); gotoxy(15,08);write('-----------------------------------------------------------'); l:=1;j:=1; for i:=1 to jml1 do begin seek(f_barang,i-1); read(f_barang,r_barang); with r_barang do begin if kd_brg <> ' ' then begin gotoxy(15,08+j);write('|'); gotoxy(17,08+j);write(l:2); gotoxy(20,08+j);write('|'); gotoxy(23,08+j);write(kd_brg); gotoxy(30,08+j);write('|'); gotoxy(32,08+j);write(nm_brg); gotoxy(62,08+j);write('|'); inc(j);inc(l); end; end; if j > 10 then begin gotoxy(15,08+j);write('-----------------------------------------------------------'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Press Enter to continue...!');mad:=readkey; if mad = #27 then exit; textcolor(14);textbackground(1); for k:=1 to 18 do begin gotoxy(2,2+k);write(' ':78); end; gotoxy(15,04);write(' DAFTAR NAMA-NAMA BARANG '); gotoxy(15,06);write('-----------------------------------------------------------'); gotoxy(15,07);write('| No | K o d e | Nama Barang |'); gotoxy(15,08);write('-----------------------------------------------------------'); j:=1; end; end; gotoxy(15,08+j);write('-----------------------------------------------------------'); textcolor(14+blink);textbackground(0); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
65
gotoxy(33,22);write(' ':45); gotoxy(42,22);write('Press anykey to exit...!');mad:=readkey; close(f_barang); end; procedure entry4; var vnamas : string[25]; adl,mad,dsb : char; vnamab : string[50]; vfak,vkodes,vkodeb : string[4]; ketemu1, ketemu2, ketemu3 : boolean; jml,jml1,i,j : integer; vfthn,vfbln,vftgl,vfhari : word; vtthn,vtbln,vttgl : word; begin repeat {$i-} reset(f_trans2); animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> ENTRY TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : '); gotoxy(21,08);write('Nama Supplier : '); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : - - '); gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Simpan Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(40,07);readln(vfak); if vfak = '' then exit; jml := filesize(f_trans2); ketemu1 := false; for i:=1 to jml do begin seek(f_trans2,i-1); read(f_trans2,r_trans2); with r_trans2 do if no_fak=vfak then begin ketemu1 := true; end; end; close(f_trans2); if not ketemu1 then begin adl:='Y'; gotoxy(40,08);readln(vnamas); repeat gotoxy(40,09);readln(vkodeb); {$i-} reset(f_barang); ketemu2:=false; jml1:=filesize(f_barang); with r_barang do Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
66
for i:=1 to jml1 do begin seek(f_barang,i-1); read(f_barang,r_barang); if vkodeb = kd_brg then begin gotoxy(40,10);write(nm_brg); ketemu2:=true; end; end; close(f_barang); if not ketemu2 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Barang Tidak Ada ...!'); end; if ketemu2 then begin {$i-} reset(f_trans2); jml1:=filesize(f_trans2); ketemu3:=false; with r_trans2 do begin for i:=1 to jml1 do begin seek(f_trans2,i-1); read(f_trans2,r_trans2); if (vfak = no_fak) and (vkodeb = kd_brg) then ketemu3 := true; end; if ketemu3 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Terjadi 2 kali transaksi barang...!'); end; if not ketemu3 then begin getdate(vfthn,vfbln,vftgl,vfhari); gotoxy(40,11);write(vftgl,' ',namabulan[vfbln],' ',vfthn); gotoxy(40,12);readln(qty); gotoxy(40,13);readln(harga); gotoxy(33,15);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_trans2,filesize(f_trans2)); kd_brg := vkodeb; nm_sup := vnamas; no_fak := vfak; ftgl := vftgl; fbln := vfbln; fthn := vfthn; write(f_trans2,r_trans2); end; end; end; close(f_trans2); end; gotoxy(58,15);adl:=readkey; if upcase(adl)='Y' then begin Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
67
animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> ENTRY TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : ',vfak); gotoxy(21,08);write('Nama Supplier : ',vnamas); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : ',vftgl,' ',namabulan[vfbln],' ',vfthn); gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Simpan Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); end; until upcase(adl)='T'; end; gotoxy(30,16);mad:=readkey; until (upcase(mad)='T') or (mad=#27); end; procedure edit4; var vnamas : string[30]; adl,mad,dsb : char; vnamab : string[50]; vfak,vkodes,vkodeb : string[4]; vharga,vqty : real; ketemu1, ketemu2, ketemu3 : boolean; jml,jml1,i,j,k : integer; vfthn,vfbln,vftgl,vfhari : word; vtthn,vtbln,vttgl : word; begin repeat {$i-} reset(f_trans2); animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> EDIT TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : '); gotoxy(21,08);write('Nama Supplier : '); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : - - '); gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Simpan Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(40,07);readln(vfak); if vfak = '' then exit; adl:='Y'; jml := filesize(f_trans2); ketemu1 := false; for i:=1 to jml do begin seek(f_trans2,i-1); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
68
read(f_trans2,r_trans2); with r_trans2 do if no_fak=vfak then begin ketemu1 := true; vfthn:=fthn;vfbln:=fbln;vftgl:=ftgl; end; end; repeat gotoxy(40,09);readln(vkodeb); {$i-} reset(f_barang); ketemu2:=false; jml1:=filesize(f_barang); with r_barang do for i:=1 to jml1 do begin seek(f_barang,i-1); read(f_barang,r_barang); if vkodeb = kd_brg then begin gotoxy(40,10);write(nm_brg); ketemu2:=true; end; end; close(f_barang); if not ketemu2 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Barang Tidak Ada ...!'); end; if ketemu2 then begin {$i-} reset(f_trans2); jml1:=filesize(f_trans2); ketemu3:=false; with r_trans2 do begin for i:=1 to jml1 do begin seek(f_trans2,i-1); read(f_trans2,r_trans2); if (vfak = no_fak) and (vkodeb = kd_brg) then begin ketemu3:=true; k:=i; gotoxy(40,12);write(qty); gotoxy(40,13);write(harga); end; end; if not ketemu3 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Tidak ada transaksi barang...!'); end; if ketemu3 then begin gotoxy(40,11);write(vftgl,' ',namabulan[vfbln],' ',vfthn); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
69
gotoxy(40,12);readln(vqty); gotoxy(40,13);readln(vharga); gotoxy(33,15);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_trans2,k-1); kd_brg := vkodeb; no_fak := vfak; harga :=vharga; qty := vqty; write(f_trans2,r_trans2); end; end; end; close(f_trans2); end; gotoxy(58,15);adl:=readkey; if upcase(adl)='Y' then begin animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> EDIT TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : ',vfak); gotoxy(21,08);write('Nama Supplier : ',vnamas); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : ',vftgl,' ',namabulan[vfbln],' ',vfthn); gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Simpan Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); end; until upcase(adl)='T'; gotoxy(30,16);mad:=readkey; until (upcase(mad)='T') or (mad=#27); end; procedure hapus4; var vnamas : string[30]; adl,mad,dsb : char; vnamab : string[50]; vfak,vkodes,vkodeb : string[4]; vharga,vqty : real; ketemu1, ketemu2, ketemu3 : boolean; jml,jml1,i,j,k : integer; vfthn,vfbln,vftgl,vfhari : word; vtthn,vtbln,vttgl : word; begin repeat {$i-} reset(f_trans2); animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> HAPUS TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : '); gotoxy(21,08);write('Nama Supplier : '); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : - - '); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
70
gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Hapus Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); gotoxy(40,07);readln(vfak); if vfak = '' then exit; jml := filesize(f_trans2); ketemu1 := false; for i:=1 to jml do begin seek(f_trans2,i-1); read(f_trans2,r_trans2); with r_trans2 do if no_fak=vfak then begin ketemu1 := true; vfthn:=fthn;vfbln:=fbln;vftgl:=ftgl; end; end; close(f_trans2); if ketemu1 then begin adl:='Y'; repeat gotoxy(40,09);readln(vkodeb); {$i-} reset(f_barang); ketemu2:=false; jml1:=filesize(f_barang); with r_barang do for i:=1 to jml1 do begin seek(f_barang,i-1); read(f_barang,r_barang); if vkodeb = kd_brg then begin gotoxy(40,10);write(nm_brg); ketemu2:=true; end; end; close(f_barang); if not ketemu2 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Barang Tidak Ada ...!'); end; if ketemu2 then begin {$i-} reset(f_trans2); jml1:=filesize(f_trans2); ketemu3:=false; with r_trans2 do begin for i:=1 to jml1 do Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
71
begin seek(f_trans2,i-1); read(f_trans2,r_trans2); if (vfak = no_fak) and (vkodeb = kd_brg) then begin ketemu3:=true; k:=i; gotoxy(40,12);write(qty); gotoxy(40,13);write(harga); end; end; if not ketemu3 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Tidak ada transaksi barang...!'); end; if ketemu3 then begin gotoxy(33,15);dsb:=readkey; if upcase(dsb)='Y'then begin seek(f_trans2,k-1); kd_brg := ''; no_fak := ''; harga := 0; qty := 0; write(f_trans2,r_trans2); end; end; end; close(f_trans2); end; gotoxy(58,15);adl:=readkey; if upcase(adl)='Y' then begin animasi(21,14); textcolor(14);textbackground(1); gotoxy(28,04);write('>> HAPUS TRANSAKSI PEMBELIAN BARANG <<'); gotoxy(21,07);write('Nomor Faktur : ',vfak); gotoxy(21,08);write('Nama Supplier : ',vnamas); gotoxy(21,09);write('Kode Barang : '); gotoxy(21,10);write('Nama Barang : '); gotoxy(21,11);write('Tgl. Faktur : ',vftgl,' ',namabulan[vfbln],' ',vfthn); gotoxy(21,12);write('Jml. Pembelian : '); gotoxy(21,13);write('Harga Barang : '); textcolor(14);textbackground(1); gotoxy(20,15);write('Hapus Data [ ] (Y/T)'); gotoxy(42,15);write('Barang Lain [ ] (Y/T)'); gotoxy(20,16);write('Ada Lagi [ ] (Y/T)'); textbackground(1); end; until upcase(adl)='T'; end; gotoxy(30,16);mad:=readkey; until (upcase(mad)='T') or (mad=#27); end; procedure infohari; var k,jml1,jml2,jml3,i,j,l : integer; mad : char; vtgl,vthn,vbln : word; vkd_sup,vkd_brg,vno_fak : string[4]; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
72
vnm_sup : string[30]; vnm_brg : string[50]; ketemu1,ketemu2,ketemu3 : boolean; vharga,vqty : real; begin repeat {$i-} reset(f_trans2); jml1 := filesize(f_trans2); i:=1; textcolor(14);textbackground(1); for i:=1 to 18 do begin gotoxy(1,2+i);write(' ':79); end; gotoxy(01,04);write(' DAFTAR PEMBELIAN BARANG PERHARI '); gotoxy(01,05);write('Tanggal : - - '); gotoxy(01,06);write('------------------------------------------------------------------------------------------'); gotoxy(01,07);write('|No.| Nama Supplier | Nama Barang | Jml | Harga |Ttl Harga|'); gotoxy(01,08);write('------------------------------------------------------------------------------------------'); gotoxy(11,05);readln(vtgl); gotoxy(13,05);write('-'); gotoxy(14,05);readln(vtgl); gotoxy(16,05);write('-'); gotoxy(17,05);readln(vtgl); l:=1; for i:=1 to jml1 do begin ketemu1 := false; seek(f_trans2,i-1); read(f_trans2,r_trans2); with r_trans2 do if (vtgl = ftgl) and (vbln = fbln) and (vthn = fthn) then begin vno_fak := no_fak; write(ftgl,'-',fbln,'-',fthn); readkey;exit; ketemu1 := true; end; close(f_trans2); if ketemu1 then begin {$i-} reset(f_trans2); jml2:=filesize(f_trans2); ketemu2:=false; for k:=1 to jml2 do begin seek(f_trans2,k-1); read(f_trans2,r_trans2); with r_trans2 do if vno_fak = no_fak then begin vharga := harga; vqty := qty; vkd_brg := kd_brg; ketemu2:=true; end; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
73
if ketemu2 then begin {$i-} reset(f_barang); jml3:=filesize(f_barang); for j:=1 to jml3 do begin seek(f_barang,j-1); read(f_barang,r_barang); with r_barang do if vkd_brg = kd_brg then vnm_brg := nm_brg; end; close(f_barang); gotoxy(1,9+l);write('|'); gotoxy(3,9+l);write(l:2); gotoxy(5,9+l);write('|'); gotoxy(6,9+l);write(vnm_sup); gotoxy(27,9+l);write('|'); gotoxy(28,9+l);write(vnm_brg); gotoxy(53,9+l);write('|'); gotoxy(55,9+l);write(vqty); gotoxy(59,9+l);write('|'); gotoxy(60,9+l);write(vharga); gotoxy(67,9+l);write('|'); gotoxy(68,9+l);write(vharga); gotoxy(77,9+l);write('|'); inc(l); end; end; if l > 10 then begin gotoxy(15,08);write('------------------------------------------------------------------------------------------'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Press Enter to continue...!');mad:=readkey; if mad = #27 then exit; textcolor(14);textbackground(1); for k:=1 to 18 do begin gotoxy(2,2+k);write(' ':78); end; gotoxy(1,04);write(' DAFTAR PEMBELIAN BARANG PERHARI '); gotoxy(1,05);write('Tanggal : - - '); gotoxy(1,06);write('------------------------------------------------------------------------------------------'); gotoxy(1,07);write('|No.| Nama Supplier | Nama Barang | Jml | Harga |Ttl Harga|'); gotoxy(1,08);write('------------------------------------------------------------------------------------------'); l:=1; end; {$i-} reset(f_trans2); end; mad:=readkey; until upcase(mad)='T'; close(f_trans2); gotoxy(1,11+l);write('------------------------------------------------------------------------------------------'); gotoxy(1,12+l);write('| Total Harga Pembelian Barang | |'); gotoxy(1,13+l);write('------------------------------------------------------------------------------------------'); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
74
textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(42,22);write('Press anykey to exit...!');mad:=readkey; close(f_trans2); end; procedure keluar; var i,j,k,l : byte; m,n,o : byte; begin textcolor(14);textbackground(0); for m:=1 to 13 do begin window(1,1,80,12); gotoxy(1,1);insline; window(1,13,80,25); gotoxy(1,1);delline; delay(20000); end; end; procedure menuutama; begin textbackground(3); clrscr; tampilmenu(11,23,3,3,1); textcolor(14);textbackground(1); gotoxy(05,05);write(' M E N U U T A M A '); gotoxy(04,06);write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(05,07);write('[1]. B a r a n g '); gotoxy(05,08);write('[2]. Transaksi '); gotoxy(05,09);write('[3]. Info/Report '); gotoxy(05,10);write('[0]. E x i t '); gotoxy(05,12);write('[ ]. Pilihan '); end; procedure menubarang; var pilih : char; i : integer; begin repeat tampilmenu(8,17,7,13,5); textcolor(14);textbackground(5); gotoxy(13,08);write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); for i:=1 to 6 do begin gotoxy(13,08+i);write('| |'); end; gotoxy(13,15); write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(15,09);write('[1]. Entry '); gotoxy(15,10);write('[2]. E d i t '); gotoxy(15,11);write('[3]. C a r i '); gotoxy(15,12);write('[4]. Hapus '); gotoxy(15,13);write('[5]. I n f o '); gotoxy(15,14);write('[0]. ke Menu '); gotoxy(16,14);pilih:=readkey; case pilih of '1' : entry2; '2' : edit2; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
75
'3' : cari2; '4' : hapus2; '5' : infobrg; end; menuutama; until (pilih='0') or (pilih=#27); end; procedure menutrans; var pilih : char; i : integer; begin repeat tampilmenu(6,18,9,12,5); textcolor(14);textbackground(5); gotoxy(13,10);write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); for i:=1 to 4 do begin gotoxy(13,10+i);write('| |'); end; gotoxy(13,15); write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(15,11);write('[1]. Entry '); gotoxy(15,12);write('[2]. E d i t '); gotoxy(15,13);write('[3]. Hapus '); gotoxy(15,14);write('[0]. ke Menu '); gotoxy(16,14);pilih:=readkey; case pilih of '1' : entry4; '2' : edit4; '3' : hapus4; end; menuutama; until (pilih='0') or (pilih=#27); end; procedure menureport; var pilih : char; i : integer; begin repeat tampilmenu(7,27,10,13,6); textcolor(14);textbackground(5); gotoxy(13,11);write('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀'); for i:=1 to 5 do begin gotoxy(13,11+i);write('| |'); end; gotoxy(13,17); write('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(15,12);write('[1]. Pembelian Per Hari '); gotoxy(15,13);write('[2]. Pembelian Per Bulan'); gotoxy(15,14);write('[3]. Pemb. Per Supplier '); gotoxy(15,15);write('[4]. Faktur Pembelian '); gotoxy(15,16);write('[0]. ke Menu '); gotoxy(16,16);pilih:=readkey; case pilih of '1' : infohari; '2' : edit2; '3' : cari2; '4' : cari2; end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
76
menuutama; until (pilih='0') or (pilih=#27); end; var i : byte; pil : char; begin assign(f_barang,'barang.dat'); {$i-} reset(f_barang); {$i+} if ioresult <> 0 then rewrite(f_barang); assign(f_trans2,'trans2.dat'); {$i-} reset(f_trans2); {$i+} if ioresult <> 0 then rewrite(f_trans2); repeat textbackground(3); clrscr; tampilmenu(11,23,3,3,1); textcolor(14);textbackground(1); gotoxy(03,04);write('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀'); for i:=1 to 9 do begin gotoxy(03,04+i);write('| |'); end; gotoxy(03,14);write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(05,05);write(' M E N U U T A M A '); gotoxy(04,06);write('▀▀▀▀▀▀▀▀▀▀▀▀▀'); gotoxy(05,07);write('[1]. B a r a n g '); gotoxy(05,08);write('[2]. Transaksi '); gotoxy(05,09);write('[3]. Info/Report '); gotoxy(05,10);write('[0]. E x i t '); gotoxy(05,12);write('[ ]. Pilihan '); gotoxy(06,12);pil:=readkey; case pil of '1' : menubarang; '2' : menutrans; '3' : menureport; '0',#27 : begin keluar; exit; end; end; until (pil='0') or (pil=#27); end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
77
{ Contoh 66. Program Aplikasi 2 (dua) file } uses crt, dos, printer; type menu = record jml_menu : array [1..4] of integer; d_menu : array [1..4] of string[15]; end; menu1 = record jml_menu1 : array [1..4] of integer; d_menu1 : array [1..4] of string[11]; end; menu3 = record jml_menu3 : array [1..4] of integer; d_menu3 : array [1..4] of string[11]; end; menu2 = record jml_menu2 : array [1..3] of integer; d_menu2 : array [1..3] of string[18]; end; mahasiswa = record bp : string[8]; nama : string[25]; end; magang = record bp : string[8]; status : char; jml : integer; thnm,blnm,tglm : word; thns,blns,tgls : word; end; const datamenu : menu =(jml_menu : (4,6,8,10); d_menu : (' Mahasiswa ', ' Data Magang ', ' Info / Report ', 'Exit ')); datamenu3 : menu3 =(jml_menu3 : (8,9,10,11); d_menu3 : (' E n t r y ', ' E d i t ', ' Delete ', ' C l o s e ')); datamenu1 : menu1=(jml_menu1 : (6,7,8,9); d_menu1 : (' E n t r y ', ' E d i t ', ' Delete ', ' C l o s e ')); datamenu2 : menu2=(jml_menu2 : (10,11,12); d_menu2 : (' Daftar Mahasiswa ', ' Data Mhs Magang ', 'Close '));
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
gotoxy(31,21);write('┌────────────────────────────────┐'); gotoxy(31,22);write('│ .........Kotak Pesan........... │'); gotoxy(31,23);write('└────────────────────────────────┘'); end; procedure tabel; var i : byte; begin textcolor(14);textbackground(3); gotoxy(1,1);write('╔'); gotoxy(80,1);write('╗'); for i:=1 to 78 do begin gotoxy(1+i,1);write('═'); gotoxy(1+i,24);write('═'); end; for i:=1 to 22 do begin gotoxy(1,1+i);write('║'); gotoxy(80,1+i);write('║'); end; gotoxy(1,24);write('╚'); gotoxy(80,24);write('╝'); tabel1; end; procedure animasi(x,y : byte); var i : byte; begin textcolor(14);textbackground(3); for i:=1 to x do begin gotoxy(2,1+i);write(' ':78); end; textbackground(1); for i:=1 to y do begin gotoxy(10,03+i);write(' ':65); end; for i:=0 to 65 do begin gotoxy(10+i,05);write('▀'); end; textbackground(0); for i:=1 to y do begin gotoxy(75,04+i);write(' '); end; gotoxy(11,04+i);write(' ':65); end; procedure entry1; var vnama : string[25]; mad, dsb : char; bp_cari : string[8]; ketemu : boolean; jml,i : integer; begin {$i-} Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
80
reset(f_mahasiswa); repeat animasi(21,8); tabel1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> ENTRY DATA MAHASISWA <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Simpan Data [ ] (Y/T)'); gotoxy(42,10);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; jml := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; vnama :=nama; end; end; if not ketemu then begin with r_mahasiswa do begin gotoxy(37,08);readln(nama); gotoxy(33,10);dsb:=readkey; if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_mahasiswa,filesize(f_mahasiswa)); bp := bp_cari; write(f_mahasiswa,r_mahasiswa); end; end; end; if ketemu then begin gotoxy(37,08);write(vnama); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Sudah Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_mahasiswa); kursor(7,0); end; procedure edit1; var bp_cari : string[8]; ketemu : boolean; jml,i,j : integer; mad, dsb : char; begin Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
81
{$i-} reset(f_mahasiswa); repeat animasi(21,8); tabel1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> EDIT DATA MAHASISWA <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Simpan Data [ ] (Y/T)'); gotoxy(42,10);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; jml := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; gotoxy(37,08);write(nama); j:=i; end; end; if ketemu then begin with r_mahasiswa do begin gotoxy(37,08);readln(nama); gotoxy(33,10);dsb:=readkey; if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_mahasiswa,j-1); bp := bp_cari; write(f_mahasiswa,r_mahasiswa); end; end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_mahasiswa); kursor(7,0); end; procedure cari1; var bp_cari : string[8]; ketemu : boolean; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
82
jml,i,j : integer; mad, dsb : char; begin {$i-} reset(f_mahasiswa); repeat animasi(21,8); tabel1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> CARI DATA MAHASISWA <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); textcolor(14);textbackground(1); gotoxy(42,10);write('»» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; jml := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; gotoxy(37,08);write(nama); end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_mahasiswa); kursor(7,0); end; procedure hapus1; var vbp,bp_cari : string[8]; ketemu : boolean; jml,i,j : integer; mad, dsb : char; vnama : string[25]; begin {$i-} reset(f_mahasiswa); repeat animasi(21,8); tabel1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> HAPUS DATA MAHASISWA <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); textcolor(14);textbackground(1); gotoxy(20,10);write('Hapus Data [ ] (Y/T)'); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
83
gotoxy(42,10);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; jml := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; gotoxy(37,08);write(nama); j:=i; end; end; if ketemu then begin with r_mahasiswa do begin gotoxy(33,10);dsb:=readkey; if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_mahasiswa,j-1); nama := ' '; bp :=' '; write(f_mahasiswa,r_mahasiswa); end; end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,10);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_mahasiswa); kursor(7,0); end; procedure e_aktif; var vnama : string[25]; mad, dsb : char; bp_cari : string[8]; ketemu,ketemu1 : boolean; vst : char; vjml : integer; vthnm,vblnm,vtglm : word; vthns,vblns,vtgls : word; jml_1,jml_2,i,j : integer; begin {$i-} reset(f_mahasiswa); repeat animasi(21,11); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
84
tabel1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> DATA MAHASISWA MAGANG <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); gotoxy(21,09);write('Status [A/S] : '); gotoxy(21,10);write('Tgl. Mulai : - - '); gotoxy(21,11);write('Tgl. Selesai : - - '); textcolor(14);textbackground(1); gotoxy(20,13);write('Simpan Data [ ] (Y/T)'); gotoxy(42,13);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; {$i-} reset(f_mahasiswa); jml_1 := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml_1 do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; vnama :=nama; end; end; close(f_mahasiswa); {$i-} reset(f_magang); jml_2 := filesize(f_magang); if ketemu then begin ketemu1 := false; with r_magang do for j:=1 to jml_2 do begin seek(f_magang,j-1); read(f_magang, r_magang); if bp = bp_cari then begin ketemu1 := true; vst:=status;vthnm:=thnm;vtglm:=tglm;vblnm:=blnm; vthns:=thns;vtgls:=tgls;vblns:=blns; end; end; if ketemu1 then begin gotoxy(37,08);write(vnama); if vst = 'A' then begin gotoxy(37,09);write('[A]ktif Magang'); end else if vst = 'S' then begin gotoxy(37,09);write('[S]elesai Magang'); end; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
85
gotoxy(37,10);write(vtglm:2,'-',vblnm:2,'-',vthnm:4); gotoxy(37,11);write(vtgls:2,'-',vblns:2,'-',vthns:4); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); if vst = 'A' then begin gotoxy(39,22);write('Mahasiswa Sudah Terdaftar ...!'); end else if vst = 'S' then begin gotoxy(36,22);write('Mahasiswa Telah Selesai Magang...!'); end end; if not ketemu1 then begin gotoxy(37,08);write(vnama); gotoxy(37,09);write('[A]ktif'); gotoxy(37,10);readln(vtglm); gotoxy(39,10);write('-'); gotoxy(40,10);readln(vblnm); gotoxy(42,10);write('-'); gotoxy(43,10);readln(vthnm); gotoxy(33,13);dsb:=readkey; with r_magang do if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_magang,filesize(f_magang)); bp := bp_cari;status := 'A'; thnm:=vthnm;tglm:=vtglm;blnm:=vblnm; thns:=0;tgls:=0;blns:=0;jml:=0; write(f_magang,r_magang); end; end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,13);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_magang); kursor(7,0); end; procedure k_aktif; var vnama : string[25]; mad, dsb : char; bp_cari : string[8]; ketemu,ketemu1 : boolean; vst : char; vjml : integer; vthnm,vblnm,vtglm : word; vthns,vblns,vtgls : word; jml_1,jml_2,i,j,k : integer; begin {$i-} reset(f_mahasiswa); repeat animasi(21,11); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
86
tabel1; k:=1; textcolor(14);textbackground(1); gotoxy(28,04);write('>> EDIT MAHASISWA MAGANG <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); gotoxy(21,09);write('Status [A/S] : '); gotoxy(21,10);write('Tgl. Mulai : - - '); gotoxy(21,11);write('Tgl. Selesai : - - '); textcolor(14);textbackground(1); gotoxy(20,13);write('Simpan Data [ ] (Y/T)'); gotoxy(42,13);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; {$i-} reset(f_mahasiswa); jml_1 := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml_1 do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; vnama :=nama; end; end; close(f_mahasiswa); {$i-} reset(f_magang); jml_2 := filesize(f_magang); if ketemu then begin ketemu1 := false; with r_magang do for j:=1 to jml_2 do begin seek(f_magang,j-1); read(f_magang, r_magang); if bp = bp_cari then begin ketemu1 := true; k:=j;vjml:=jml; vst:=status;vthnm:=thnm;vtglm:=tglm;vblnm:=blnm; vthns:=thns;vtgls:=tgls;vblns:=blns; end; end; if ketemu1 then begin gotoxy(37,08);write(vnama); gotoxy(37,09);write(vst); gotoxy(37,09);readln(vst); if vst = 'A' then begin gotoxy(37,09);write('[A]ktif Magang'); end else if vst = 'S' then begin Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
87
gotoxy(37,09);write('[S]elesai Magang'); end; gotoxy(37,10);write(vtglm:2,'-',vblnm:2,'-',vthnm:4); gotoxy(37,11);write(vtgls:2,'-',vblns:2,'-',vthns:4); gotoxy(37,10);readln(vtglm); gotoxy(39,10);write('-'); gotoxy(40,10);readln(vblnm); gotoxy(42,10);write('-'); gotoxy(43,10);readln(vthnm); gotoxy(37,11);readln(vtgls); gotoxy(39,11);write('-'); gotoxy(40,11);readln(vblns); gotoxy(42,11);write('-'); gotoxy(43,11);readln(vthns); gotoxy(33,13);dsb:=readkey; with r_magang do if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_magang,k-1); bp := bp_cari;status := vst; thnm:=vthnm;tglm:=vtglm;blnm:=vblnm; thns:=vthns;tgls:=vtgls;blns:=vblns;jml:=0; write(f_magang,r_magang); end; end; if not ketemu1 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,13);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_magang); kursor(7,0); end; procedure h_aktif; var vnama : string[25]; mad, dsb : char; bp_cari : string[8]; ketemu,ketemu1 : boolean; vst : char; vjml : integer; vthnm,vblnm,vtglm : word; vthns,vblns,vtgls : word; jml_1,jml_2,i,j,k : integer; begin {$i-} reset(f_mahasiswa); repeat animasi(21,11); tabel1; k:=1; textcolor(14);textbackground(1); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
88
gotoxy(25,04);write('>> PEMBATALAN MAHASISWA MAGANG <<'); gotoxy(21,07);write('Nomor Bp. : '); gotoxy(21,08);write('Nama : '); gotoxy(21,09);write('Status [A/S] : '); gotoxy(21,10);write('Tgl. Mulai : - - '); gotoxy(21,11);write('Tgl. Selesai : - - '); textcolor(14);textbackground(1); gotoxy(20,13);write('Hapus Data [ ] (Y/T)'); gotoxy(42,13);write('«» Ada Lagi [ ] (Y/T)'); kursor(0,7); textbackground(1); gotoxy(37,07);readln(bp_cari); if bp_cari = '' then exit; {$i-} reset(f_mahasiswa); jml_1 := filesize(f_mahasiswa); ketemu := false; for i:=1 to jml_1 do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp=bp_cari then begin ketemu := true; vnama :=nama; end; end; close(f_mahasiswa); {$i-} reset(f_magang); jml_2 := filesize(f_magang); if ketemu then begin ketemu1 := false; with r_magang do for j:=1 to jml_2 do begin seek(f_magang,j-1); read(f_magang, r_magang); if bp = bp_cari then begin ketemu1 := true; k:=j;vjml:=jml; vst:=status;vthnm:=thnm;vtglm:=tglm;vblnm:=blnm; vthns:=thns;vtgls:=tgls;vblns:=blns; end; end; if ketemu1 then begin gotoxy(37,08);write(vnama); if vst = 'A' then begin gotoxy(37,09);write('[A]ktif Magang'); end else if vst = 'S' then begin gotoxy(37,09);write('[S]elesai Magang'); end; gotoxy(37,10);write(vtglm:2,'-',vblnm:2,'-',vthnm:4); gotoxy(37,11);write(vtgls:2,'-',vblns:2,'-',vthns:4); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
89
gotoxy(33,13);dsb:=readkey; with r_magang do if (upcase(dsb)='Y') or (dsb=#13) then begin seek(f_magang,k-1); bp := '';status :=' '; thnm:=0;tglm:=0;blnm:=0; thns:=0;tgls:=0;blns:=0;jml:=0; write(f_magang,r_magang); end; end; if not ketemu1 then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; end; if not ketemu then begin textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Mahasiswa Tidak Terdaftar ...!'); end; gotoxy(55,13);mad:=readkey; until (upcase(mad)='T') or (mad=#27); close(f_magang); kursor(7,0); end; procedure infomhs; var k,jml1,i,j,l : integer; mad : char; begin {$i-} reset(f_mahasiswa); jml1 := filesize(f_mahasiswa); i:=1; textcolor(0);textbackground(3); for i:=1 to 19 do begin gotoxy(2,1+i);write(' ':78); end; gotoxy(15,03);write(' DAFTAR NAMA-NAMA MAHASISWA '); gotoxy(15,05);write('╒═══╤════════╤══════════════════════╕'); gotoxy(15,06);write('│ No │ Nomor Bp. │ Nama Mahasiswa │'); gotoxy(15,07);write('├───┼────────┼──────────────────────┤ '); l:=1;j:=1; for i:=1 to jml1 do begin seek(f_mahasiswa,i-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do begin if bp <> ' ' then begin gotoxy(15,07+j);write('│'); gotoxy(17,07+j);write(l:2); gotoxy(20,07+j);write('│'); gotoxy(23,07+j);write(bp); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
90
gotoxy(35,07+j);write('│'); gotoxy(37,07+j);write(nama); gotoxy(63,07+j);write('│'); inc(j);inc(l); end; end; if j > 11 then begin gotoxy(15,07+j);write('╘═══╧════════╧══════════════════════╛'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Press Enter to continue...!');mad:=readkey; if mad = #27 then exit; textcolor(0);textbackground(3); for k:=1 to 18 do begin gotoxy(2,2+k);write(' ':78); end; gotoxy(15,03);write(' DAFTAR NAMA-NAMA MAHASISWA '); gotoxy(15,05);write('╒═══╤════════╤══════════════════════╕'); gotoxy(15,06);write('│ No │ Nomor Bp. │ Nama Mahasiswa │'); gotoxy(15,07);write('├───┼────────┼──────────────────────┤ '); j:=1; end; end; gotoxy(15,07+j);write('╘═══╧════════╧══════════════════════╛'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(42,22);write('Press anykey to exit...!');mad:=readkey; close(f_mahasiswa); kursor(7,0); end; procedure infoaktif; var k,jml1,jml2,i,j,l,a : integer; ketemu1: boolean;mad,vst : char; vbp:string[8];vnama:string[25]; vthnm,vblnm,vtglm : word; vthns,vblns,vtgls : word; begin {$i-} reset(f_magang); jml1 := filesize(f_magang); i:=1;a:=1; textcolor(0);textbackground(3); for i:=1 to 19 do begin gotoxy(2,1+i);write(' ':78); end; gotoxy(3,03);write(' DAFTAR MAHASISWA MAGANG '); gotoxy(3,05);write('╒══╤═══════╤════════════════╤═════╤══════╤═══════╕'); gotoxy(3,06);write('│ No │Nomor Bp.│ Nama Mahasiswa │Status │Tgl. Mulai│Tgl.Selesai │'); gotoxy(3,07);write('├──┼───────┼────────────────┼─────┼──────┼───────┤'); l:=1;k:=1; for i:=1 to jml1 do begin seek(f_magang,i-1); read(f_magang,r_magang); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
91
with r_magang do begin if bp <> '' then begin ketemu1:=false; vbp:=bp;vst:=status; vthnm:=thnm;vblnm:=blnm;vtglm:=tglm; vthns:=thns;vblns:=blns;vtgls:=tgls; close(f_magang); {$i-} reset(f_mahasiswa); jml2:=filesize(f_mahasiswa); for j:=1 to jml2 do begin seek(f_mahasiswa,j-1); read(f_mahasiswa,r_mahasiswa); with r_mahasiswa do if bp = vbp then begin vnama := nama; ketemu1 := true; end; end; close(f_mahasiswa); if ketemu1 then begin gotoxy(3,07+l);write('│'); gotoxy(5,07+l);write(a:2); gotoxy(8,07+l);write('│'); gotoxy(9,07+l);write(vbp); gotoxy(18,07+l);write('│'); gotoxy(19,07+l);write(vnama); gotoxy(45,07+l);write('│'); if vst = 'A' then begin gotoxy(46,07+l);write('Aktif'); end else if vst = 'S' then begin gotoxy(46,07+j);write('Selesai'); end; gotoxy(54,07+l);write('│'); gotoxy(56,07+l);write(vtglm,'-',vblnm,'-',vthnm); gotoxy(66,07+l);write('│'); gotoxy(68,07+l);write(vtgls,'-',vblns,'-',vthns); gotoxy(78,07+l);write('│'); inc(l);inc(a); end; end; {$i-} reset(f_magang); end; if l > 11 then begin gotoxy(3,07+l);write('╘══╧═══════╧════════════════╧═════╧══════╧═══════╛'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(39,22);write('Press Enter to continue...!');mad:=readkey; if mad = #27 then exit; Kumpulan Contoh Program Pascal 92 Created by FERDINAL. R, S.KOM
textcolor(0);textbackground(3); for k:=1 to 18 do begin gotoxy(2,2+k);write(' ':78); end; gotoxy(3,03);write(' DAFTAR MAHASISWA MAGANG '); gotoxy(3,05);write('╒══╤═══════╤════════════════╤═════╤══════╤═══════╕'); gotoxy(3,06);write('│ No │Nomor Bp.│ Nama Mahasiswa │Status │Tgl. Mulai│Tgl.Selesai │'); gotoxy(3,07);write('├──┼───────┼────────────────┼─────┼──────┼───────┤'); l:=1; end; end; gotoxy(3,07+l); write('╘══╧═══════╧════════════════╧═════╧══════╧═══════╛'); textcolor(14+blink);textbackground(0); gotoxy(33,22);write(' ':45); gotoxy(42,22);write('Press anykey to exit...!');mad:=readkey; close(f_magang); kursor(7,0); end; procedure tampil1; type simpan = record kar : char; atri: byte; end; var layar_simpan : array [1..25,1..80] of simpan absolute $b800:$0000; layar_pindah : array [1..25,1..80] of simpan; tombol1, tombol2,i : byte; tombol : char; begin textcolor(14);textbackground(1); for i:=1 to 6 do begin gotoxy(27,5+i);write(' '); end; gotoxy(16,5+i);write('':13); textcolor(14);textbackground(0); kursor(7,0); gotoxy(14,5);write('╒═════════════╕'); for i:=1 to 4 do begin with datamenu1 do begin gotoxy(14,jml_menu1[i]);write('│',d_menu1[i],'│'); end; end; gotoxy(14,10);write('╘═════════════╛'); textcolor(14);textbackground(5); tombol1:=0; tombol2:=1; gotoxy(15,datamenu1.jml_menu1[tombol2]);write(datamenu1.d_menu1[tombol2]); repeat textcolor(14);textbackground(5); gotoxy(15,datamenu1.jml_menu1[tombol2]); write(datamenu1.d_menu1[tombol2]); repeat tombol1:=tombol2; tombol:=readkey; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
93
case tombol of #72 : tombol2 := tombol2 - 1; #80 : tombol2 := tombol2 + 1; #27,#75 : exit; #13,#77 : begin move (layar_simpan,layar_pindah,4000); case tombol2 of 1 : entry1; 2 : edit1; 3 : hapus1; 4 : exit; end; move (layar_pindah,layar_simpan,4000); kursor(7,0); end; end; if tombol2 > 4 then tombol2 := 1; if tombol2 < 1 then tombol2 := 4; textcolor(14);textbackground(0); gotoxy(15,datamenu1.jml_menu1[tombol1]); write(datamenu1.d_menu1[tombol1]); textcolor(14);textbackground(5); gotoxy(15,datamenu1.jml_menu1[tombol2]); write(datamenu1.d_menu1[tombol2]); until tombol = #13; until false; end; procedure tampil2; type simpan = record kar : char; atri: byte; end; var layar_simpan : array [1..25,1..80] of simpan absolute $b800:$0000; layar_pindah : array [1..25,1..80] of simpan; tombol1, tombol2,i : byte; tombol : char; begin textcolor(14);textbackground(1); for i:=1 to 6 do begin gotoxy(27,7+i);write(' '); end; gotoxy(16,7+i);write(' ':13); textcolor(14);textbackground(0); kursor(7,0); gotoxy(14,7);write('╒═════════════╕'); for i:=1 to 4 do begin with datamenu3 do begin gotoxy(14,jml_menu3[i]);write('│',d_menu3[i],'│'); end; end; gotoxy(14,12);write('╘═════════════╛'); textcolor(14);textbackground(5); tombol1:=0; tombol2:=1; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
94
gotoxy(15,datamenu3.jml_menu3[tombol2]);write(datamenu3.d_menu3[tombol2]); repeat textcolor(14);textbackground(5); gotoxy(15,datamenu3.jml_menu3[tombol2]); write(datamenu3.d_menu3[tombol2]); repeat tombol1:=tombol2; tombol:=readkey; case tombol of #72 : tombol2 := tombol2 - 1; #80 : tombol2 := tombol2 + 1; #27,#75 : exit; #13,#77 : begin move (layar_simpan,layar_pindah,4000); case tombol2 of 1 : e_aktif; 2 : k_aktif; 3 : h_aktif; 4 : exit; end; move (layar_pindah,layar_simpan,4000); kursor(7,0); end; end; if tombol2 > 4 then tombol2 := 1; if tombol2 < 1 then tombol2 := 4; textcolor(14);textbackground(0); gotoxy(15,datamenu3.jml_menu3[tombol1]); write(datamenu3.d_menu3[tombol1]); textcolor(14);textbackground(5); gotoxy(15,datamenu3.jml_menu3[tombol2]); write(datamenu3.d_menu3[tombol2]); until tombol = #13; until false; end; procedure tampil3; type simpan = record kar : char; atri: byte; end; var layar_simpan : array [1..25,1..80] of simpan absolute $b800:$0000; layar_pindah : array [1..25,1..80] of simpan; tombol1, tombol2,i : byte; tombol : char; begin textcolor(14);textbackground(1); for i:=1 to 5 do begin gotoxy(34,09+i);write(' '); end; gotoxy(16,09+i);write(' ':20); textcolor(14);textbackground(0); kursor(7,0); gotoxy(14,09);write('╒═════════════════╕'); for i:=1 to 3 do begin with datamenu2 do Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
95
begin gotoxy(14,jml_menu2[i]);write('│',d_menu2[i],'│'); end; end; gotoxy(14,13);write('╘═════════════════╛'); textcolor(14);textbackground(5); tombol1:=0; tombol2:=1; gotoxy(15,datamenu2.jml_menu2[tombol2]);write(datamenu2.d_menu2[tombol2]); repeat textcolor(14);textbackground(5); gotoxy(15,datamenu2.jml_menu2[tombol2]); write(datamenu2.d_menu2[tombol2]); repeat tombol1:=tombol2; tombol:=readkey; case tombol of #72 : tombol2 := tombol2 - 1; #80 : tombol2 := tombol2 + 1; #27,#75 : exit; #13,#77 : begin move (layar_simpan,layar_pindah,4000); case tombol2 of 1 : infomhs; 2 : infoaktif; 3 : exit; end; move (layar_pindah,layar_simpan,4000); kursor(7,0); end; end; if tombol2 > 3 then tombol2 := 1; if tombol2 < 1 then tombol2 := 3; textcolor(14);textbackground(0); gotoxy(15,datamenu2.jml_menu2[tombol1]); write(datamenu2.d_menu2[tombol1]); textcolor(14);textbackground(5); gotoxy(15,datamenu2.jml_menu2[tombol2]); write(datamenu2.d_menu2[tombol2]); until tombol = #13; until false; end; procedure p_menu; type simpan = record kar : char; atri: byte; end; var layar_simpan : array [1..25,1..80] of simpan absolute $b800:$0000; layar_pindah : array [1..25,1..80] of simpan; tombol1, tombol2,i,j: byte; tombol : char; begin move (layar_simpan,layar_pindah,4000); kursor(7,0); textcolor(14);textbackground(5); gotoxy(2,3);write('╒═════════════╕'); j:=1; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
96
for i:=1 to 4 do begin with datamenu do begin inc(j); gotoxy(2,jml_menu[i]);write('│',d_menu[i],'│'); gotoxy(2,j+3);write('│ │'); inc(j); end; end; gotoxy(2,11);write('╘═════════════╛'); textcolor(2);textbackground(1); gotoxy(3,datamenu.jml_menu[tombol2]);write(datamenu.d_menu[tombol2]); tombol1:=0; tombol2:=1; repeat textcolor(14);textbackground(1); gotoxy(3,datamenu.jml_menu[tombol2]); write(datamenu.d_menu[tombol2]); repeat tombol1:=tombol2; tombol:=readkey; move (layar_pindah,layar_simpan,4000); case tombol of #72 : tombol2 := tombol2 - 1; #80 : tombol2 := tombol2 + 1; #13,#077 : begin case tombol2 of 1 : tampil1; 2 : tampil2; 3 : tampil3; 4 : exit; end; kursor(7,0); end; end; if tombol2 > 4 then tombol2 := 1; if tombol2 < 1 then tombol2 := 4; textcolor(14);textbackground(5); gotoxy(3,datamenu.jml_menu[tombol1]); write(datamenu.d_menu[tombol1]); textcolor(14);textbackground(1); gotoxy(3,datamenu.jml_menu[tombol2]); write(datamenu.d_menu[tombol2]); until tombol = #13; until false; end; procedure keluar; var i,j,k,l : byte; m,n,o : byte; begin textcolor(14);textbackground(0); for m:=1 to 13 do begin window(1,1,80,12); gotoxy(1,1);insline; window(1,13,80,25); gotoxy(1,1);delline; Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
97
delay(20000); end; end; var i,m,n,x,y,k,l : byte; paswor : boolean; adl : char; pas : array[1..4] of char; thn_lama,bln_lama,tgl_lama : word; begin textbackground(black); clrscr; textcolor(white);textbackground(blue); gotoxy(15,07);write(' ':51); for i:=1 to 5 do begin gotoxy(15,08+i);write(' ':51); end; textbackground(5); for i:=1 to 4 do begin gotoxy(66,09+i);write(' '); gotoxy(14,09+i);write(' '); end; gotoxy(14,09+i);write(' ':53); textcolor(white);textbackground(blue); gotoxy(20,07);write(' ....... Warning ....... '); gotoxy(20,10);write(' Sebelum menjalankan program '); gotoxy(20,11);write(' Periksa tanggal di Komputer anda '); gotoxy(20,12);write('Apakah sudah sesuai dengan tanggal hari ini'); gotoxy(15,16);write(' ':51); gotoxy(15,17);write(' ':51); textbackground(5); for i:=1 to 2 do begin gotoxy(66,16+i);write(' '); gotoxy(14,16+i);write(' '); end; gotoxy(14,16+i);write(' ':53); textcolor(white);textbackground(blue); gotoxy(20,16);writeln(' Enter -> Jika Tanggal Sudah Sesuai'); gotoxy(20,17);writeln(' Esc -> Keluar'); gotoxy(60,17);adl := readkey; if adl = #27 then exit; l:=1; repeat assign(f_mahasiswa,'mhs.dat'); {$i-} reset(f_mahasiswa); {$i+} if ioresult <> 0 then rewrite(f_mahasiswa); assign(f_magang,'magang.dat'); {$i-} reset(f_magang); {$i+} if ioresult <> 0 then rewrite(f_magang); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
98
textbackground(3); clrscr; tabel; textcolor(1);textbackground(3); getdate(tahun,bulan,tanggal,hari); gettime(jam,menit,detik,perdetik); gotoxy(4,24);write(' »»',namahari[hari],', ',tanggal, ' ',namabulan[bulan],' ',tahun,' '); gotoxy(65,24);write(' ',jam,':',menit,':',detik,' «« '); textcolor(0);textbackground(3); m:=1; for n:=length(t1) downto 1 do begin x:=24;y:=75; while x < (26+n-1) do begin gotoxy(x,2);write(t1[n]);gotoxy(y,3);write(t2[49-n]); gotoxy(x,4);write(t3[n]);gotoxy(y,5);write(t4[49-n]); gotoxy(x,6);write(t5[n]);gotoxy(y,7);write(t6[49-n]); gotoxy(x,8);write(t7[n]);gotoxy(y,9);write(t8[49-n]); gotoxy(x,10);write(t9[n]);gotoxy(y,11);write(t10[49-n]); gotoxy(x,12);write(t11[n]);gotoxy(y,13);write(t12[49-n]); gotoxy(x,14);write(t13[n]);gotoxy(y,15);write(t14[49-n]); gotoxy(x,16);write(t15[n]);gotoxy(y,17);write(t16[49-n]); gotoxy(x,18);write(t17[n]);gotoxy(y,19);write(t18[49-n]); delay(50); gotoxy(x,2);write(' ');gotoxy(y,3);write(' '); gotoxy(x,4);write(' ');gotoxy(y,5);write(' '); gotoxy(x,6);write(' ');gotoxy(y,7);write(' '); gotoxy(x,8);write(' ');gotoxy(y,9);write(' '); gotoxy(x,10);write(' ');gotoxy(y,11);write(' '); gotoxy(x,12);write(' ');gotoxy(y,13);write(' '); gotoxy(x,14);write(' ');gotoxy(y,15);write(' '); gotoxy(x,16);write(' ');gotoxy(y,17);write(' '); gotoxy(x,18);write(' ');gotoxy(y,19);write(' '); y:=y-1;x:=x+1; end; gotoxy(26+n-1,2);write(t1[n]); gotoxy(74-n,3);write(t2[49-n]); gotoxy(26+n-1,4);write(t3[n]); gotoxy(74-n,5);write(t4[49-n]); gotoxy(26+n-1,6);write(t5[n]); gotoxy(74-n,7);write(t6[49-n]); gotoxy(26+n-1,8);write(t7[n]); gotoxy(74-n,9);write(t8[49-n]); gotoxy(26+n-1,10);write(t9[n]); gotoxy(74-n,11);write(t10[49-n]); gotoxy(26+n-1,12);write(t11[n]); gotoxy(74-n,13);write(t12[49-n]); gotoxy(26+n-1,14);write(t13[n]); gotoxy(74-n,15);write(t14[49-n]); gotoxy(26+n-1,16);write(t15[n]); gotoxy(74-n,17);write(t16[49-n]); gotoxy(26+n-1,18);write(t17[n]); gotoxy(74-n,19);write(t18[49-n]); end; textcolor(14);textbackground(3); gotoxy(2,15);write(t20); gotoxy(2,16);write(t21); gotoxy(2,17);write(t22); Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
99
gotoxy(2,18);write(t23); gotoxy(2,19);write(t24); textcolor(14);textbackground(5); for i:=1 to 9 do begin gotoxy(2,2+i);write(' ':16); end; textcolor(14);textbackground(black); for i:=1 to 9 do begin gotoxy(19,3+i);write(' '); end; gotoxy(3,3+i);write(‘ ’:16); textcolor(14);textbackground(5); gotoxy(2,3);write('╒═════════════╕'); x:=1; for i:=1 to 4 do begin with datamenu do begin inc(x); gotoxy(2,jml_menu[i]);write('│',d_menu[i],'│'); gotoxy(2,x+3);write('│ │'); inc(x); end; end; gotoxy(2,11);write('╘═════════════╛'); textcolor(14); if (tahun > 2009) then begin i:=1; textcolor(14);textbackground(0); for i:=1 to 8 do begin gotoxy(18,6+i);write(' ':45); end; textbackground(blue); for i:=1 to 8 do begin gotoxy(63,7+i);write(' '); end; gotoxy(19,7+i);write(' ':45); textcolor(14);textbackground(0); gotoxy(23,09);write('Maaf ...!!!'); gotoxy(23,11);write('Program tidak bisa dijalankan lagi'); gotoxy(23,12);write('Karena masa pemakaian sudah habis'); repeat until keypressed; keluar;l:=4; end else begin p_menu; kursor(0,7);keluar; l:=4; end; until l=4; end.
Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
100
Jika Program Aplikasi diatas dijalankan maka dapat dilihat hasilnya seperti berikut :
Gambar 1. Tampilan Menu Pembuka Tekan Enter untuk melanjutkan proses atau Esc untuk keluar.
Gambar 2. Tampilan Menu Utama Anda dapat memilih salah satu pilihan yang disediakan seperti menu Mahasiswa, Data Magang, Info / Report dan Exit.
Gambar 3. Tampilan Sub Menu Mahasiswa Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
101
Gambar 4. Tampilan Entry Data Mahasiswa
Gambar 5. Tampilan Entry Data Mahasiswa Magang
Gambar 6. Tampilan Informasi Daftar Mahasiswa Kumpulan Contoh Program Pascal Created by FERDINAL. R, S.KOM
