program membalikan kalimat mengunakan pascal

uses crt;
const elemen=100;
type stack = string[elemen];
tumpukan = record
isi :stack;
atas : 0..elemen;
end;
var t : tumpukan;
i, k, l, m : integer;
kalimat,word : stack;
procedure awalan(var t:tumpukan);
begin
t.atas := 0;
end;
procedure push(var t:tumpukan; x:char);
begin
t.atas := t.atas + 1;
t.isi[t.atas] := x;
end;
function pop(var t:tumpukan):char;
begin
pop := t.isi[t.atas];
t.atas := t.atas - 1;
end;
{program utama}
begin
clrscr;
awalan(t);
write('Ketik Kalimat : '); readln(kalimat);
writeln('=======================================');
writeln('Kalimat Yang Diinput : ',kalimat);
writeln;
write('Setelah Proses, Perubahannya adalah : ');
for i := 1 to length(kalimat) do
begin
if(kalimat[i]=' ') then
begin
for k:=(i-1) downto 1 do
word := word + kalimat[k];
word := word + kalimat[i];
end;
i := length(word);
if i= length(kalimat) then
begin
for i := length(kalimat) downto 1 do
word := word + kalimat[i];
end;
end;
for i := 1 to (length(kalimat)+ 1) do
push(t,word[i]);
for i:= 1 to (length(kalimat)+ 1) do
write(pop(t));
readln;
end.

program balikan kalimat

uses crt;
const elemen=100;
type s100 = string[elemen];
tumpukan = record
isi :s100;
atas : 0..elemen;
end;
var t : tumpukan;
i : integer;
kalimat :s100;
procedure awalan(var t:tumpukan);
begin
t.atas := 0;
end;
procedure push(var t:tumpukan; x:char);
begin
t.atas := t.atas + 1;
t.isi[t.atas] := x;
end;
function pop(var t:tumpukan):char;
begin
pop := t.isi[t.atas];
t.atas := t.atas - 1;
end;
{program utama}
begin
clrscr;
awalan(t);
write('===> Ketik Kalimat :'); readln(kalimat);
writeln('******=====================================******');
writeln('===> Kalimat Yang Diinput : ',kalimat);
writeln;
write('===> Setelah Proses, Perubahannya adalah : ');
for i := 1 to length(kalimat) do
push(t,kalimat[i]);
for i := 1 to length (kalimat) do
write(pop(t));
readln;
end.

program mencari bilangan prima

uses crt;
var
a,b,c,d : integer;
begin
clrscr;

for a := 1 to 17 do
begin
if 2 mod a = 0 then

write(' ',a)

else
if a mod 2 = 1 then

write(' ',a)
else
if 2 mod a = a then
write(' ',a)

end;
readln;

end.
end.

program menghitung mengunakan prosedur dalam pascal

Program Hitung_Pajak;
uses crt;
var kls_brg : byte;
nm_brg : string[20];
hrg_brg : longint;
pjk, hasil : real;
procedure input;
begin
writeln;
writeln(' ***_MENGHITUNG PAJAK PENDAPATAN PENJUALAN_*** ');
writeln('$===============================================$');
write(' Masukkan Kelas Barang : ');readln(kls_brg);
write(' Masukkan Harga Barang : Rp. ');readln(hrg_brg);
end;
procedure hitung;
begin
if kls_brg = 1 then
begin
nm_brg :='Makanan';
pjk :=0.05;
end
else if kls_brg = 2 then
begin
nm_brg :='Pakaian';
pjk :=0.1;
end
else if kls_brg = 3 then
begin
nm_brg :='Mesin-mesin';
pjk :=0.2;
end;
hasil := pjk * hrg_brg;
end;
procedure cetak;
begin
writeln;
writeln('$===============================================$');
writeln(' Besar Pajak = Rp. ',hasil:0:0);
writeln(' Nama Barang = ',nm_brg);
writeln;
writeln(' Terima Kasih . . . ! ! ! ');
end;
begin
clrscr;
input;
hitung;
cetak;
writeln(' charles demon');
readln;
end.

Program Tampilkan_Angka;

uses crt;
var x, y, z : byte;
begin
clrscr;
z:=8;
writeln;
for x:= 0 to 1 do
write(' Bilangan Genap : ');
begin
for y:= 0 to 3 do
begin
write(z:4);
z:=z-2;
end;
z:=z+7;
writeln;
end;
readln;
end.

kode program faktorial

uses crt;
var fak,m,n,t : real;
i,nn,mm,tt : integer;
begin
clrscr;
writeln('.:: menghitung faktorial ::. ');
writeln(' n! ');
writeln(' = ----------');
writeln(' m!(n!-m!) ');
writeln;
write('masukkan nilai n : '); readln(nn);
write('masukkan nilai m : '); readln(mm);
n := nn;
m := mm;
t := nn-mm;
for i := nn-1 downto 1 do
begin
n := n*i;
end;
for i := mm-1 downto 1 do
begin
m := m*i;
end;
for i := (nn-mm) - 1 downto 1 do
begin
t := t*i;
end;
fak := n / ( m * t );
writeln;
writeln('faktorial n! : ',n:5:0);
writeln('faktorial m! : ',m:5:0);
writeln('faktorial ( n! - m! ) : ',t:5:0);
writeln;
writeln('nilai faktorial : ',fak:5:0);
writeln(' create by : charles demon');
readln;
end.

kode program segitiga_angka

Uses crt;

Var a,b,c,d : byte;

Begin

Clrscr;

For a:= 1 to 6 do

Begin

For b:=6 downto a do

Begin

Write(‘ ‘);

End;

D :=a;

For c :=1 to a do

Begin

Write(d);

D:=d-1;

End;

Writeln;

End;

Readln;

End.

outputnya : lihat sendiri yach