program pascal deklarasi data

program masing_masing_deklarasi_data;
uses wincrt;
var a,b,c:string;
    x,y,rumusnya:integer;
    r,s,t,hasilnya:real;
    senang:char;
begin
clrscr;
writeln ('identitas ku');
writeln ('nama saya:');readln (a);
writeln ('alamat saya:');readln (b);
c:=a+b ;
writeln ('jadi identitasqu adalah',c);
writeln;
writeln ('penjumlahan');
writeln ('masukkan angka= ');readln (x);
writeln ('ditambah dengan= ');readln (y);
rumusnya:=x+y;                                                               
writeln ('hasilnya adalah= ',rumusnya:0);
writeln;
writeln ('perkalian');
writeln ('masukkan angka=');readln (r);
writeln ('masukkan angka=');readln (s);
t:=r*s;
writeln ('hasilnya real=',t:0:2);

writeln;                                      
writeln ('perasaan');
writeln ('jika mendapat nilai A akan merasa=');readln (senang);
writeln ('aku merasa senang=');
writeln (',,,,,,,,,,,,,mator sakalangkong,,,,,,,,,,,,,,,');
write;
end.

program pascal mencari bilangan kelipatan 5

program kelipatan_5;
Uses wincrt;

var
x,y:longint;

begin
    clrscr;
    write('Berapa kelipatan 5 yang ingin ditampilkan = ');
    readln(x);
    writeln('============================================================================');
    write('Hasil dari ',x,' kelipatan 5  = ');
    for x:=1 to x do
        begin
             y :=5*x;
         write(y,' ');
        end;
end.

program pascal penghitung rangkaian

program penghitung_rangkaian;

Uses wincrt;

var

r1, r2, r3, st, pt: real;

pil:integer;

begin

     clrscr;

write(‘Masukkan R1 =’);readln(r1);

write(‘Masukkan R2 =’);readln(r2);

write(‘Masukkan R3 =’);readln(r3);

write(‘Tekan 1 untuk seri atau tekan 2 untuk pararel ?’);

readln(pil);

if pil=1 then

begin

             st:=r1+r2+r3;

             writeln(‘Total Rangkaian Serinya = ’,st:0:2);

end;

else

begin

             pt:= (r1*r2*r3)/(r1*r2+r1*r3+r2*r3);

             writeln(‘Total Rangkaian Pararelnya = ’,pt:0:2);

end;

readln(pil);

                       end.

program deret berbahasa pascal

Program deret
uses wincrt;
var
i,t :integer;
a :real;
begin
i:=1; t:=-2; a:=0;
while i<= 10 do
begin
if i mod 2 = 1 then
begin
t:=t+3;
write('+1/',t);
a:=a+(1/t);
end
else
if i mod 2 = 0 then
begin
t:=t+2;
write('-1/',t);
a:=a-(1/t);
end;
i:=i+1;
end;
write(a);
end.
program krs_mahasiswa;
uses wincrt;
type
siswa=record
nim:string[5];
nama:string[15];
krs:array[1..4,1..5] of integer;
end;
type kuliah=array[1..20] of siswa;
var kul:kuliah;
{--------------------------------------------------------------------}
function huruf(bobot:integer):char;
begin
case bobot of
0:huruf:='E';
1:huruf:='D';
2:huruf:='C';
3:huruf:='B';
4:huruf:='A';
end;
end;
{--------------------------------------------------------------------}
procedure khs(n:integer;kul:kuliah);
var jumsks,usaha,i,j:integer;
ipnya:real;
begin
for i:=1 to n do
begin
Writeln('Nim : ',kul[i].nim);
Writeln('Nama : ',kul[i].nama);
writeln;
writeln('Kode sks nilai');
jumsks:=0;usaha:=0;
for j:=1 to 2 do
begin
writeln(kul[i].krs[1,j]:3,' ',kul[i].krs[2,j]:3,'
',huruf(kul[i].krs[4,j]):5);
jumsks:=jumsks+kul[i].krs[2,j];
usaha:=usaha + kul[i].krs[2,j]*kul[i].krs[4,j];
end;
if jumsks<>0 then
ipnya:=usaha/jumsks;
writeln;
writeln('IP = ',ipnya:0:2);
readkey;
end;
end;
{--------------------------------------------------------------------}
function bobot(nilai:integer):integer;
begin
if nilai<40 bobot:="0</p" then="then">else
if (nilai>=40) and (nilai<55 bobot:="1</p" then="then">else
if (nilai>=55) and (nilai<65 bobot:="2</p" then="then">else
if (nilai>=65) and (nilai<76 bobot:="3</p" then="then">else
bobot:=4;
end;
{--------------------------------------------------------------------}
procedure masukdata(var kul:kuliah;var n:integer);
var i,j:integer;
begin
clrscr;
write('Banyak mahasiswa = ');readln(n);
for i:=1 to n do
begin
write('Nim : ');readln(kul[i].nim);
write('Nama : ');readln(kul[i].nama);
writeln;
for j:=1 to 2 do
begin
write('Kode : ');readln(kul[i].krs[1,j]);
write('Sks : ');readln(kul[i].krs[2,j]);
write('Nilai : ');readln(kul[i].krs[3,j]);
writeln('Bobot : ',bobot(kul[i].krs[3,j]));
kul[i].krs[4,j]:=bobot(kul[i].krs[3,j]);
writeln('huruf : ',huruf(bobot(kul[i].krs[3,j])));
writeln;
end;
end;
end;
var n:integer;
begin
masukdata(kul,n);
readkey;
khs(n,kul);
end.

contoh program kasir dengan bahasa pascal

program nota_toko;
uses wincrt;
type
  data = record
  kode : string[5];
  nama : string[10];
  harga : real;
  jumlah : integer;
  total : real;
end;
        
var
  t,n,a:string;
  jumlahbrg,i,j:byte;
  totalpembelian,tot,kembali:real;
  nama:string[20];
  barang:array [1..100] of data;

begin
writeln('               NOTA BELANJA              ');
writeln('               Toko  Indah Kurnia              ');
writeln('Jl. Tanah Merah 4 no : 3a');
writeln('-----------------------------------------');
writeln;
write('Tanggal Pembelian : ');readln(t);
write('Nama Pembeli      : ');readln(n);
write('Alamat            : ');readln(a);
writeln;
write('Jumlah Pembelian  : ');readln(jumlahbrg);
for i := 1 to jumlahbrg do
begin
  writeln('Masukkan data ke-',i:2);

  begin
  write('Kode Barang : ');readln(barang[i].kode);
  write('Nama Barang : ');readln(barang[i].nama);
  write('Harga Satuan: ');readln(barang[i].harga);
  write('Jumlah      : ');readln(barang[i].jumlah);
end;
end;
writeln;
writeln('Nama Pembeli : ',n);

writeln('==================================================');
writeln('|No|Nama Barang|Harga Satuan|Jumlah|    Total    |');
writeln('==================================================');
begin
barang[i].total:=0;
for i := 1 to jumlahbrg do
begin
barang[i].total:=barang[i].harga*barang[i].jumlah;
write(i:2);
write(barang[i].nama:12);
write(barang[i].harga:14:2);
write(barang[i].jumlah:5);
writeln(barang[i].total:15:2);
end;
writeln('--------------------------------------------------');
for j:= 1 to jumlahbrg do
tot:= tot+barang[j].total;
writeln('       Total Keseluruhan  : ',tot:20:2);
write('       Total  Pembayaran  : ');read(totalpembelian);
kembali:= totalpembelian-tot;
writeln('       Jumlah Kembalian   : ',kembali:20:2);
writeln('==================================================');
writeln('TERIMA KASIH')
end;     

end.

selamat mencoba semoga sukses :)

Program pascal pengurutan nilai terkecil ke terbesar

program pengurut_angka;
uses wincrt;
var
a,b,c : integer;
begin
writeln('                 ======= PROGRAM PENGURUT NILAI =======');
writeln('                 =======     created by : Misbach Surury      =======');
writeln;
write('masukan angka Pertama = ');readln(a);
write('masukan angka Kedua = ');readln(b);
write('masukan angka Ketiga = ');readln(c);
writeln;

begin
if (c>b) and (b>a) then write('    >< Urutan Bilangan= ',a,' ' ,b,' ',c)
else
if (a>b) and (c>a) then write('    >< Urutan Bilangan= ',b,' ' ,a,' ',c)
else
if (b>a) and (a>c) then write('    >< Urutan Bilangan= ',c,' ' ,a,' ',b)
else
if (c>a) and (b>c) then write('    >< Urutan Bilangan= ',a,' ' ,c,' ',b)
else
if (a>c) and (c>b) then write('    >< Urutan Bilangan= ',b,' ' ,c,' ',a)
else
if (b>c) and (a>b) then write('    >< Urutan Bilangan= ',c,' ' ,b,' ',a)
end;

end.

CONTOH PROGRAM PASCAL DENGAN PEMAKAIAN CASE OF

berikut saya akan memposting contoh program berbahasa pascal dengan pemakaian case of , silahkan di coba semoga bermanfaat :)

uses wincrt;
var pil :integer;
    p,l,t,kll,lu,vol:real;
begin
clrscr;
  writeln('selamat datang ');
  writeln('-------------- ');
  writeln('1-->Mencari keliling persegi panjang');
  writeln('2-->Mencari luas persegi panjang    ');
  writeln('3-->Mencari volume balok            ');
  write('input pilihan anda [1..3] : ');readln(pil);
  case pil of
  1 : begin
  write('panjang = ');readln(p);
  write('lebar   = ');readln(l);
  kll:=2*(p+l);
  writeln('keliling = ',kll:0:2);
  end;
  2 : begin
  write('panjang = ');readln(p);
  write('lebar   = ');readln(l);
  lu:=p*l;
  writeln('luas = ',lu:0:2);
  end;
  3 : begin
  write('panjang = ');readln(p);
  write('lebar   = ');readln(l);
  write('tinggi  = ');readln(t);
  vol:=p*l*t;
  writeln('volume = ',vol:0:2);
  end;
  else writeln('maaf pilihan anda tidak ada ');
end;
end.

program mencari akar persamaan kuadrat

Program mencari_akar_persamaan_kuadrad_dengan_rumus_abc;

uses wincrt;

var

a,b,c,d,x1,x2 :real;

begin

writeln('Menghitung akar-akar persamaan kuadrat');

write('masukkan nilai a : ');readln(a);

write('masukkan nilai b : ');readln(b);

write('masukkan nilai c : ');readln(c);

d:=(b*b) - (4*a*c);

if d < 0 then writeln('karena D < 0, akar tidak real dan tidak dapat dicari')

else

begin

x1:=(-b + (sqrt(d)))/(2*a);

x2:=(-b - (sqrt(d)))/(2*a);

writeln;

writeln('nilai X1 = ',x1:0:2);

writeln('nilai x2 = ',x2:0:2);

write('Terimakasih');

end;

end.