Program Pascal Konversi suhu

program konversisuhu;
uses wincrt;
type konversi_suhu=record
F : real;
C : real;
end;
var konversi:array [1..10] of konversi_suhu;
ulang : char;
m,n: integer;
begin
m :=0;
repeat
clrscr;
for n:=1 to 1 do
with konversi[n] do
begin
m :=m+1;
writeln('Program Konversi Fareinheit ke Celcius');
writeln('======================================');
writeln;
writeln('Masukan Suhu Dalam Fareinheit: ');readln(F);
C:=5/9*(F-32);
writeln;
writeln('Jadi Suhu Dalam Celcius Adalah : ',C:4:2);
end;
writeln('Mau Ulang Lagi ?y/t');readln(ulang);
until upcase (ulang) <> 'Y';
end.

Program Pascal Konversi suhu

program konversisuhu;
uses wincrt;
type konversi_suhu=record
F : real;
C : real;
end;
var konversi:array [1..10] of konversi_suhu;
ulang : char;
m,n: integer;
begin
m :=0;
repeat
clrscr;
for n:=1 to 1 do
with konversi[n] do
begin
m :=m+1;
writeln('Program Konversi Fareinheit ke Celcius');
writeln('======================================');
writeln;
writeln('Masukan Suhu Dalam Fareinheit: ');readln(F);
C:=5/9*(F-32);
writeln;
writeln('Jadi Suhu Dalam Celcius Adalah : ',C:4:2);
end;
writeln('Mau Ulang Lagi ?y/t');readln(ulang);
until upcase (ulang) <> 'Y';
end.

Program Segitiga

uses wincrt;
var
m,y,my: integer;
begin
m:=5;
for y:=m downto 1 do
begin
for my:=1 to m do
write('*');
writeln;
m:=m-1;
end;
end.

Program Pascal Rumus Matematika

program lat;
uses wincrt;
procedure segitiga;
var
l:real;
a,t:real;
begin
write('alas :');readln(a);
write('tinggi :');readln(t);
l:=a*t/2;
end;
procedure p_panjang;
var
luas:real;
p,l:byte;
begin
write('panjang :');readln(p);
write('lebar :');readln(l);
luas:= p*l;
writeln('Luas =',luas:2:2);
end;
procedure persegi;
var
l:real;
s:byte;
begin
write('sisi :');readln(s);
l:=s*s;
writeln('luas =',l:2:2);
end;
var
pilih:byte;
lagi:char;
begin
repeat
clrscr;
writeln (' MENU UTAMA ');
writeln ('- - - - - - - - - - - - - - - - - - - ');
writeln (' 1. Hitung Luas segitiga ');
writeln (' 2. Hitung Persegi panjang ');
writeln ('- - - - - - - - - - - - - - - - - - - ');
write ('Masukan nomor pilihan (1-2) :');readln(pilih);
case pilih of
1:segitiga;
2:p_panjang;
end;
write('Menghitung lagi???(Y/N) :');readln(lagi);
until upcase (lagi)<> 'Y';
end.

Program Pascal Menggunakan IF

Uses wincrt;
var
pilih:integer; ulang:char;
begin
repeat clrscr;
write('Silahkan pilih Angka favorit anda (1-15) :');readln(pilih);
if pilih=1
then
begin
writeln('jujur dan gemar bersodakoh');
end;
if pilih=2
then
begin
writeln('berjiwa sosial tinggi');
end;
if pilih=3
then
begin
writeln('pelit..kalo bahasa sundanya buntut kasirann');
end;
if pilih=4
then
begin
writeln('suka menabung');
end;
if pilih=5
then
begin
writeln('maaf anda kurang beruntung mohon coba lagi');
end;
if pilih=6
then
begin
writeln('rendah hati');
end;
if pilih=7
then
begin
writeln('pekerja keras');
end;
if pilih=8
then
begin
writeln('pemarahh');
end;
if pilih=9
then
begin
writeln('jarang mandi…pasti bau yah');
end;
if pilih=10
then
begin
writeln('sering beruntung');
end;
if pilih=11
then
begin
writeln('ramah pada semua orang');
end;
if pilih=12
then
begin
writeln('jujur dan adil');
end;
if pilih=13
then
begin
writeln('gigi kuning karena jarang gosok gigi');
end;
if pilih=14
then
begin
writeln('sering main');
end;
if pilih=15
then
begin
writeln('suka melawan orang tua');
end;
write('Ulangi Lagi [Y/T] ??? : '); read(ulang);
until upcase(ulang)<> 'Y';
donewincrt;
end.

Program Pascal Dalam Bentuk Rumus Fisika

program perhitungan_fisika;
uses wincrt;
type emay = RECORD
jarak : real;
kecepatan: real;
selang : real;
percepatan:real;
kcptn_akhir:real;
kcptn_awal:real;
g :real;
h:real;
end;
var
data : array [1..10] of emay;
m,may,my,mutzz:integer;
ulang:char;
pilih:byte;
procedure main_menu (var pil:byte);
begin
clrscr;
writeln('================================');
writeln('|| MENU UTAMA ||');
writeln('|| 1. Menghitung GLB ||');
writeln('|| 2. Menghitung GLBB ||');
writeln('|| 3. Menghitung GJB ||');
writeln('|| 4. Keluar Program ||');
writeln('================================');
writeln;
write('Masukan Pilihan [1-4] :');readln(pil)
end;
procedure glb ;
begin
writeln (' Menghitung GLB (Gerak Lurus Beraturan (GLB) :');
with data[m] do
begin
clrscr;
writeln('================================');
writeln('|| MENU GLB ||');
writeln('|| 1. Menghitung Jarak ||');
writeln('|| 2. Menghitung Kecepatan ||');
writeln('|| 3. Menghitung Selang Waktu ||');
writeln('================================');
writeln;
write('Masukan pilihan [1-3] :');readln(may);
case may of
1 : begin
repeat
clrscr;
writeln (' Menghitung Jarak :');
writeln (' Contoh Soal: ');
writeln (' Sebuah Mobil Melaju Dengan Kecepatan 40 m/s dengan waktu 2detik');
writeln ('Hitunglah berapa jarak yang ditempuh Mobil Tersebut');
writeln ('Dik : v=40 m/s t=2s Dit: s???? ');
writeln;
write('Masukan kecepatan(v)=meter/sekon :');readln(kecepatan);
write('Masukan selang waktu(t) =sekon :');readln(selang);
jarak:=kecepatan*selang;
writeln('Jadi Jarak(s)= meter :',jarak:0:0);
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
2 : begin
repeat
clrscr;
writeln (' Menghitung Kecepatan :');
writeln ('Contoh Soal:');
writeln ('Sebuah sepedah melaju kencang jarak tempuh yang dilalui sepedah tersebut 50meter');
writeln ('Waktu yang dibutuhkan adalah 10sekon berapa kecepatan sepedah tersebut????');
writeln ('Dik: s=50m t=10s Dit: v??? ');
writeln;
write('Masukan Jarak(s)= meter :');readln(jarak);
write('Masukan selang waktu(t) =sekon :');readln(selang);
kecepatan:=jarak/selang;
writeln('Jadi Kecepatan(v)= meter/sekon :',kecepatan:0:0);
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
3 : begin
repeat
clrscr;
writeln (' Menghitung Selang Waktu :');
writeln ('Contoh Soal:');
writeln ('Sebuah sepedah motor melaju dengan kecepatan 40 m/s dan jarak yang ditempuh 80 m');
writeln ('Hitunglah berapa waktu yang dibutuhkan untuk menempuh jarak tersebut');
writeln ('Dik : v=40m/s s=80 m Dit: t?? ');
writeln;
write('Masukan Jarak(s)= meter :');readln(jarak);
write('Masukan Kecepatan(v) = meter/sekon :');readln(kecepatan);
selang:=jarak/kecepatan;
writeln('Jadi Selang Waktu(t)= sekon :',selang:0:0);
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
end;
end;
end;
procedure glbb ;
begin
writeln (' Menghitung Gerak Lurus Berubah Beraturan (GLBB) :');
with data[m] do
begin
clrscr;
writeln('=======================================================');
writeln('|| Menu GLBB ||');
writeln('|| 1. Menghitung Kecepatan Akhir ||');
writeln('|| 2. Menghitung Jarak Yang Ditempuh Setelah t sekon ||');
writeln('|| 3. Menghitung Kecepatan sesaat/saat t sekon ||');
writeln('|| 4. Menghitung Percepatan ||');
writeln('=======================================================');
writeln;
write('Masukan pilihan [1-3] :');readln(my);
case my of
1 : begin
repeat
clrscr; writeln (' Menghitung Kecepatan Akhir ');
writeln;
write('Masukan kecepatan awal(v0)=meter/sekon :');readln(kcptn_awal);
write('Masukan Percepatan (a) =meter/sekon2 :');readln(percepatan);
write('Masukan selang waktu(t) =sekon :');readln(selang);
kcptn_akhir:=kcptn_awal+(percepatan*selang);
writeln('Jadi Kecepatan Akhir (Vt)= meter/sekon :',kcptn_akhir:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
2 : begin
repeat
clrscr;
writeln (' Menghitung Jarak Yang Ditempuh Setelah t sekon :');
writeln;
write('Masukan kecepatan awal(v0)=meter/sekon :');readln(kcptn_awal);
write('Masukan Percepatan (a) =meter/sekon2 :');readln(percepatan);
write('Masukan selang waktu(t) =sekon :');readln(selang);
jarak:=(kcptn_awal*selang)+((0.5*percepatan)*(selang*selang));
writeln('Jadi Jarak Yang ditempuh setelah t sekon (St)= meter :',jarak:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
3 : begin
repeat
clrscr;
writeln (' Menghitung Kecepatan sesaat/saat t sekon :');
writeln;
write('Masukan kecepatan awal(v0)=meter/sekon :');readln(kcptn_awal);
write('Masukan Percepatan (a) =meter/sekon2 :');readln(percepatan);
write('Masukan Jarak (s) =meter :');readln(jarak);
kcptn_akhir:=(kcptn_awal*kcptn_awal)+(2*(percepatan*jarak));
writeln('Jadi Kecepatan sesaat/saat t sekon (m/s)= meter/sekon :',kcptn_akhir:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
4 : begin
repeat
clrscr;
writeln (' Menghitung Percepatan :');
writeln;
write('Masukan Kecepatan akhir (Vt) =meter/sekon :');readln(kcptn_akhir);
write('Masukan kecepatan awal(v0)=meter/sekon :');readln(kcptn_awal);
write('Masukan selang waktu (t) =sekon :');readln(selang);
percepatan:=(kcptn_akhir-kcptn_awal)/selang;
writeln('Jadi Percepatan (m/s2)= meter/sekon2 :',percepatan:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
end;
end;
end;
procedure gjb ;
begin
writeln (' Menghitung Gerak Jatuh Bebas (GJB) :');
with data[m] do
begin
clrscr;
writeln('=======================================================');
writeln('|| Menu GJB ||');
writeln('|| 1. Menghitung Kecepatan sesaat/saat t sekon ||');
writeln('|| 2. Menghitung Jarak Yang Ditempuh ||');
writeln('|| 3. Menghitung Waktu Gerak ||');
writeln('|| 4. Menghitung Kecepatan Benda ||');
writeln('=======================================================');
writeln;
write('Masukan pilihan [1-4] :');readln(mutzz);
case mutzz of
1 : begin
repeat
clrscr;
writeln (' Menghitung Kecepatan Sesaat/saat t sekon ');
writeln;
write('Masukan grafitasi bumi(g)=meter/sekon2 :');readln(g);
write('Masukan selang waktu(t) =sekon :');readln(selang);
kcptn_akhir:=g*selang;
writeln('Jadi Kecepatan Akhir (Vt)= meter/sekon :',kcptn_akhir:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
2 : begin
repeat
clrscr;
writeln (' Menghitung Jarak Yang Ditempuh ');
writeln;
write('Masukan grafitasi bumi(g)=meter/sekon2 :');readln(g);
write('Masukan selang waktu(t) =sekon :');readln(selang);
h:=(0.5*g)*(selang*selang);
writeln('Jadi Jarak Yang Ditempuh (h)= meter :',h:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
3 : begin
repeat
clrscr;
writeln (' Menghitung Waktu Gerak ');
writeln;
write('Masukan grafitasi bumi(g)=meter/sekon2 :');readln(g);
write('Masukan Jarak Yang Ditempuh (h)=meter :');readln(h);
selang:=sqrt((2*h)/g);
writeln('Jadi Waktu Gerak (t)= sekon :',selang:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
4 : begin
repeat
clrscr;
writeln (' Menghitung Kecepatan benda ');
writeln;
write('Masukan grafitasi bumi(g)=meter/sekon2 :');readln(g);
write('Masukan Jarak Yang Ditempuh (h)=meter :');readln(h);
kcptn_akhir:=(2*g)*h;
writeln('Jadi Kecepatan Benda (Vt2)= meter/sekon2 :',kcptn_akhir:0:0);
writeln;
write('Apakah Mau Tambah Lagi Perhitungan???? Y/T :');readln(ulang);
until upcase (ulang) <> 'Y';
end;
end;
end;
end;
procedure keluar;
begin
donewincrt;
end;
begin
repeat
main_menu(pilih);
case pilih of
1: glb;
2: glbb;
3: gjb;
4 : keluar;
end;
until pilih =4;
end.

Program Menggunakan Prosedure

program contoh_procedure;
uses wincrt;
procedure judul;
begin
writeln ('====================================================================');
writeln ('| DATA PENDAFTARAN ANAK DI POSYANDU | ');
Writeln ('| Kp.kaum Indihiang kota Tasikmalaya |');
writeln ('====================================================================');
writeln;
end;
procedure laporan;
begin
gotoxy (1,1);write('======================================================================');
gotoxy (1,2);write('|| LAPORAN DATA PENDAFTARAN POSYANDU ||');
gotoxy (1,3);write('|| Kp, kaum Indihiang Kota Tasikmalaya ||');
gotoxy (1,4);write('======================================================================');
gotoxy (1,5);write(' Tanggal 08 Januari 2012 ');
gotoxy (1,6);write('======================================================================');
gotoxy (1,7);write('|| NO | NAMA | UMUR | ALAMAT | ORANG TUA ||');
gotoxy (1,8);write('======================================================================');
end;
type emay = RECORD
no_daftar :integer;
nm_anak :string;
umur:string;
alamat :string;
org_tua :string;
end;
var
data :array [1..10] of emay;
e,m,y:integer;
ulang:char;
pilih:byte;
procedure main_menu (var pil:byte);
begin
clrscr;
writeln(' MENU DATA POSYANDU ');
writeln('1.Tambah Data POSYANDU');
writeln('2.Lihat Data POSYANDU');
Writeln('3.keluar');
writeln;
write('Masukan Pilihan [1-3] :');readln(pil);
end;
procedure tambah_data;
begin
clrscr;
writeln(' TAMBAH DATA ');
Writeln;
write('BERAPA DATA YANG AKAN DI INPUTKAN???? :');read(y);
writeln;
for m:=1 to y do
begin
with data[m] do
begin
clrscr;
judul;
write('Masukan Nomor Daftar :');readln(no_daftar);
write('Masukan Nama Anak :');readln(nm_anak);
write('Masukan Umur Anak :');readln(umur);
write('Masukan alamat anak :');readln(alamat);
write('Masukan nama Orang tua :');readln(org_tua);
end;
end;
end;
procedure tampil_data;
begin
clrscr;
laporan;
writeln;
for m:=1 to y do
begin
with data[m] do
begin
gotoxy (1,8+m);writeln('||',no_daftar);
gotoxy (11,8+m);writeln('|',nm_anak);
gotoxy (25,8+m);writeln('|',umur);
gotoxy (36,8+m);writeln ('|',alamat);
gotoxy (56,8+m);writeln('|',org_tua);
gotoxy (69,8+m);writeln('||');
gotoxy (1,20);writeln('TERIMA KASIH');
end;
end;
readln;
end;
begin
repeat
main_menu(pilih);
case pilih of
1: tambah_data;
2: tampil_data;
end;
until pilih = 3;
end.

Program Bilangan Ganjil

program bil_ganjil;
uses wincrt;
var
a,b,c:integer;
begin
write('Masukan Nilai : '); readln(a);
for b:=1 to a do
begin
if b mod 2=1 then
begin
c:=c+b;
write(b,' ');
end;
end;
writeln;
write('Hasil Penjumlahan : ',c);
end.