program bulan dengan pascal

program bulan;
uses wincrt;
var
   no:integer;
      function nama_bulan(no:integer):string;
      begin
         case (no) of
         1:nama_bulan:='Januari';
         2:nama_bulan:='Februari';
         3:nama_bulan:='Maret';
         4:nama_bulan:='April';
         5:nama_bulan:='Mei';
         6:nama_bulan:='Juni';
         7:nama_bulan:='Juli';
         8:nama_bulan:='Agustus';
         9:nama_bulan:='September';
         10:nama_bulan:='Oktober';
         11:nama_bulan:='November';
         12:nama_bulan:='Desember';
      end;
   end;
begin
   clrscr;
   writeln('Input Nomor Bulan : ');
   readln(no);
   writeln('Nama Bulan:',nama_bulan(no));
   readln;
end.

PROGRAM pascal penjualan buah

Program Penjualan_Buah_Segar_;

Uses wincrt;

Var napem,nb:string[15] ;

hrg,jb,jh,disc,tot:real;

Ul:char;

begin

Repeat

clrscr;

writeln;

writeln('----------------------------------------');

writeln(' DATA PENJUALAN BUAH SEGAR /KG');

writeln('----------------------------------------');

writeln;

write('Nama Pembeli     =  '); readln(napem);

writeln;

write('Buah Yang Dibeli =  '); readln(nb);

writeln('.............................'); 

if nb='jeruk' then hrg:=5000 else

if nb='mangga' then hrg:=7000 else  

if nb='apel' then hrg:=9000 else

if nb='duren' then hrg:=11000;

begin

end;

writeln;

write('HargaBuah       =','Rp',hrg:6:0,'/Kg');

writeln;

writeln;

write('JumlahBeli      =  '); readln(jb);

writeln;

jh:= hrg*jb;

write('JumlahHarga     =','Rp',jh:10:0);

writeln;

writeln('.............................');

writeln;

if jb> 3 then disc:=0.2*jh;

begin

end;

write('Anda Dapat Diskon=','Rp',disc:10:0);

writeln;

writeln('.............................');

writeln;                                          

writeln;

write('Total Bayar      =','Rp',hrg*jb-disc:10:0);

writeln;

writeln('----------------------------------------');writeln;

write('Terima kasih atas Kunjungannya#Ricky#');

readln;

Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);

Until Upcase(Ul)<>'Y';

end.

CONTOH PROGRAM DERET KELIPATAN PASCAL

turbo pascal 1.5 - deret kelipatan x yang kurang dari y

program deretkelipatanxyangkurangdariy;
uses wincrt;

var
     x,y,i:integer;

begin

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

writeln('');

writeln('                  PROGRAM DERET KELIPATAN                       ');

writeln('                    Dibuat oleh ricky coebra                          ');

writeln('                       @copyright 2013                                ');

writeln('');

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

     write('X     = ');readln(x);
     write('Y     = ');readln(y);
     write('Deret = ');
     i:=x;
     while x<y do
     begin
          write(x,' ');
          x:=x+i;
     end;
end.

contoh PRogram Faktorial menggunakan PASCAL

program faktorial; {program menghitung nilai faktorial dari inputan N}
uses wincrt;

var
     i,N,jumlah :integer;

begin
writeln('            =================================================         ');
writeln('');
writeln('                  PROGRAM MENGHITUNG FAKTORIAL                        ');
writeln('                    Dibuat oleh ricky coebra                          ');
writeln('                       @copyright 2013                                ');
writeln('');
writeln('            =================================================         ');

jumlah:=1;
     write('inputkan suatu nilai    : '); readln(N);
     write('faktorial dari ',N,' adalah : ');
     write('1');
     for i:=2 to N do
     begin
          write(' x ',i);
          jumlah:=jumlah*i;
     end;
     write(' = ',jumlah);

end.

CONTOH PROGRAM PASCAL PERULANGAN BERSARANG

program segitigabintang;  {program menampilkan karakter bintang sebanyak N baris}

uses wincrt;

var

     i,j,N :integer;

begin

writeln('            =================================================         ');
writeln('');
writeln('                  PROGRAM KARAKTER BINTANG                        ');
writeln('                    Dibuat oleh ricky coebra                          ');
writeln('                       @copyright 2013                                ');
writeln('');
writeln('            =================================================         ');

     write(' berapa jumlah baris bintang : '); readln(N);

     writeln;

     for i:=n downto 1 do

     begin

          for j:=1 to i do

          begin

               write(' ');

          end;

          for j:=i to N do

          begin

               write('*');

          end;

          writeln;

     end;

end.

Contoh Program Bahasa Pascal Perpustakaan

program pinjam_buku_perpus;
uses wincrt;
type buku=record
     judul,pengarang:string;
     stok:byte;
     end;
     larik_buku=array[1..20] of buku;

type pinjam=record
     nama,judulb:string;
     end;
     larik_pinjam=array[1..20] of pinjam;
var buk:larik_buku;
    pinj:larik_pinjam;
     m,n,i,j,pil:byte;
     ketemu:boolean;

procedure tambah_buku(var x:larik_buku);
var baru1,baru2:string;

begin
ketemu:=false;
write('masukkan judul buku baru : ');readln(baru1);
write('masukkan pengarangnya    : ');readln(baru2);
{cek judul sudah ada/belum}
for i:=1 to n do
     begin
      if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
      begin
      ketemu:=true;
      writeln('Judul tersebut sudah ada di perpus, lakukan proses no 2');
      end;
     end;
if not ketemu then
begin
     inc(n);
     x[n].judul:=baru1;
     x[n].pengarang:=baru2;
     write('berapa exemplar    ');readln(x[n].stok);
end;
end;

procedure tambah_stok(var x:larik_buku);
var baru1,baru2:string;
    ts,pos:byte;
    oke:boolean;

begin
{cek judul di stok}
ketemu:=false;oke:=false;
write('masukkan judul buku yang akan ditambah stok : ');readln(baru1);
{cetak buku dengan judul tsb}
for i:=1 to n do
if x[i].judul=baru1  then
   begin writeln(x[i].judul:15,'   ',x[i].pengarang:15);oke:=true;end;
writeln;
if oke then
begin
write('masukkan pengarang yang anda maksud dr judul diatas : ');
readln(baru2);
end;
for i:=1 to n do
     if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
     begin ketemu:=true;pos:=i;end;
if ketemu then
begin
     write('berapa tambahan stok ? ');readln(ts);
     x[pos].stok:=x[pos].stok+ts;
end
else
    writeln('maaf buku tersebut belum ada, lakukan proses no 1');
end;


procedure cetak_buku(var x:larik_buku);
begin
writeln('DAFTAR BUKU YANG ADA DI PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No    Judul             Pengarang       Stok');
writeln('------------------------------------------------');
for i:=1 to n do
writeln(i:3,'  ',x[i].judul:15,'  ',x[i].pengarang:15,'  ',x[i].stok:3);
writeln('------------------------------------------------');
end;

procedure cetak_pinjam(var x:larik_pinjam);
begin
writeln('DAFTAR PEMINJAM BUKU YANG PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No    Peminjam                Judul Buku');
writeln('------------------------------------------------');
for i:=1 to m do
writeln(i:3,'  ',x[i].nama:10,'    ',x[i].judulb:20);
writeln('------------------------------------------------');
end;

procedure urut_judul(var x:larik_buku);
var dum:buku;

begin
for i:=1 to n-1 do
begin
     for j:=i+1 to n do
     begin
     if x[i].judul>x[j].judul then
     begin
          dum:=x[i];
          x[i]:=x[j];
          x[j]:=dum;
     end;
     end;
end;
end;

procedure urut_pengarang(var x:larik_buku);
var dum:buku;

begin
for i:=1 to n-1 do
begin
     for j:=i+1 to n do
     begin
     if x[i].pengarang>x[j].pengarang then
     begin
          dum:=x[i];
          x[i]:=x[j];
          x[j]:=dum;
     end;
     end;
end;
end;

procedure pinjam_buku(var x:larik_buku);
var cari:string;
    nb,ya:string;
    pos:byte;
label lagi;

begin
lagi:
write('masukkan judul buku yang akan dipinjam ');readln(cari);
{cek}
ketemu:=false;
for i:=1 to n do
if x[i].judul=cari then begin pos:=i;ketemu:=true;end;
{jika judul ditemukan}
if (ketemu) and (x[pos].stok>0) then
begin
     write('buku tersedia, masukkan nama anda ');readln(nb);
     {memasukkan ke array pinjam}
     inc(m); dec(x[pos].stok);
     pinj[m].nama:=nb;
     pinj[m].judulb:=cari;
end
else
begin
      writeln('maaf buku yang anda cari tidak ada');
      write('apakah akan meminjam buku lain ?<y/t> ');readln(ya);
      if ya='y' then goto lagi;
end;
end;

procedure kembali_buku(var x:larik_buku);
var kembali,nm:string;
pos:byte;
label selesai;
 
begin
if m=0 then
begin writeln('Maaf tidak ada yang meminjam buku');goto selesai;end;
pos:=0;
writeln('Selamat datang di pengembalian buku ');
write('masukkan nama peminjam ');readln(nm);
write('masukkan judul buku yg kembali '); readln(kembali);
{menambahkan stok buku dg judul tsb}
for i:=1 to n do
begin
     if (x[i].judul)=kembali then inc(x[i].stok);
end;
{menghapus record di daftar peminjam buku}
for i:=1 to m do
     if (pinj[i].judulb=kembali) and (pinj[i].nama=nm) then pos:=i;
if pos<>0 then
begin
  writeln('judul ',kembali ,' dipinjam oleh ',nm,' sudah dikembalikan');
  {hapus dan geser}
  for j:=pos to m-1 do  pinj[j]:=pinj[j+1];
  dec(m);
end
else writeln('maaf nama peminjam atau buku yang dikembalikan tidak benar');

selesai: end;

                       
begin{utama}
repeat
begin
     clrscr;
     writeln('Pengelolaan buku Perpustakaan Cerdas');
     writeln('1.Tambah judul buku');
     writeln('2.Tambah stok buku');
     writeln('3. Cetak buku');
     writeln('4. Cetak urut judul');
     writeln('5. Cetak urut pengarang');
     writeln('6. Pinjam buku');
     writeln('7. Cetak peminjaman');
     writeln('8. Pengembalian buku');
     writeln('9. Selesai');
     write('Pilihan anda ==> ');readln(pil);
     case pil of
     1: tambah_buku(buk);
     2: tambah_stok(buk);
     3: cetak_buku(buk);
     4: begin
        urut_judul(buk);cetak_buku(buk);
        end;
     5: begin
        urut_pengarang(buk);cetak_buku(buk);
        end;
     6: pinjam_buku(buk);
     7: if m=0 then writeln('tidak ada yang meminjam') else cetak_pinjam(pinj);
     8: if m>0 then kembali_buku(buk) else
        writeln('maaf saat ini tidak ada yang sedang meminjam buku') ;
     9: writeln('Terimakasih ');
     end;
     readln;
     end
     until(pil=9);
end.

CONTOH Program pascal program matriks

program matrik;
uses wincrt;
type data = array[1..5,1..5] of integer;
var
matrikI,matrikII : data;
baris,kolom,pil : integer;procedure isi;
var i,j :integer;
begin
writeln('Penentuan ORDO MATRIK I');
write('Masukan banyak baris matrik I : ');readln(baris);
write('Masukan banyak kolom matrik I : ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikI[i,j]);
end;
clrscr;
writeln('Penentuan ORDO MATRIK II');
write('Masukan banyak baris matrik II : ');
readln(baris);
write('Masukan banyak kolom matrik II : ');
readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikII[i,j]);
end;
end;procedure gagal;
begin
writeln('Program Dibatalkan');
end;procedure kali(a1,a2 : data);
var
hasil:data;
i,j,z:integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=0;
for z:=1 to baris do
hasil[i,j]:=hasil[i,j]+matrikI[i,z]*matrikII[z,j];
end;
clrscr;
writeln('Hasil perkalian');
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
begin
writeln('MENU');            
writeln('Ketik(1) Perkalian Matrik');
writeln('ketik(2) Batal Program');
write('Pilihan = ');
readln(pil);
clrscr;
case pil of
1:begin
isi;
kali(matrikI,matrikII);
end;
2:begin
gagal;
end;
end;
end.