Senin, 24 Mei 2010

program mengunakan pointer

uses crt;
type datapnddk = record
noktp : string;
nama : string[30];
alamat : string[40];
goldarah : string[2];
thnklhrn : integer;
umur : integer;
end;

type pointer = ^simpul;
simpul = record
data : datapnddk;
next : pointer;
end;
var p,bantu,baru: pointer;
umur,x,a :byte;
jumlaha,jumlahb,jumlahab,jumlaho:integer;

procedure cetak;
begin
new(bantu);
bantu := p;
while bantu^.next <> nil do
begin
writeln;
writeln('no ktp :',bantu^.next^.data.noktp);
writeln('nama : ',bantu^.next^.data.nama);
writeln('alamat :',bantu^.next^.data.alamat);
writeln('gol darah :',bantu^.next^.data.goldarah);
writeln('thnlahir :',bantu^.next^.data.thnklhrn);
umur := 2010 - bantu^.next^.data.thnklhrn;
writeln('umur :',umur);
bantu := bantu^.next;
end;
writeln;
writeln('no ktp : ',bantu^.next^.data.noktp);
writeln('nama :',bantu^.next^.data.nama);
writeln('alamat :',bantu^.next^.data.alamat);
writeln('goldarah :',bantu^.next^.data.goldarah);
writeln('thnlahir :',bantu^.next^.data.thnklhrn);
umur := 2010 - bantu^.next^.data.thnklhrn;
writeln('umur :',umur);
end;

begin
clrscr;
jumlaha:=0;
jumlahb:=0;
jumlahab:=0;
jumlaho:=0;
new(p); p:=nil;
write('masukkan no.ktp anda(x=selesai) :'); readln(p^.data.noktp);
repeat
write('masukkan nama anda :'); readln(p^.data.nama);
write('masukkan alamat anda :'); readln(p^.data.alamat);
write('masukkan gol darah :'); readln(p^.data.goldarah);
if p^.data.goldarah = 'A' then
begin
jumlaha := jumlaha+ 1;

end;
if p^.data.goldarah = 'B' then
begin
jumlahb := jumlahb + 1;

end;
if p^.data.goldarah = 'AB' then
begin
jumlahab := jumlahab + 1;

end;
if p^.data.goldarah = 'O' then
begin
jumlaho := jumlaho + 1;
end;
write('masukkan thnklhrn :'); readln(p^.data.thnklhrn);
umur := 2010 - p^.data.thnklhrn;
writeln('umur anda :',umur);
new(baru);
baru^.data.noktp := p^.data.noktp;
baru^.data.nama := p^.data.nama;
baru^.data.alamat := p^.data.alamat;
baru^.data.goldarah := p^.data.goldarah;
baru^.data.thnklhrn := p^.data.thnklhrn;
baru^.data.umur := p^.data.umur;
baru^.next := nil;
if p = nil then p := baru
else
begin
if baru^.next^.data.umur < baru^.next^.data.umur then;

baru^.next := p;
p := baru;
end;

write('masukkan no.ktp (x=selesai) :'); readln(p^.data.noktp);
until p^.data.noktp = 'x';

writeln;
writeln('isi linked list sekarang :');
begin
repeat
cetak;
until bantu^.next = nil;
writeln;
writeln('jumlah penduduk gol A : ',jumlaha);
writeln('jumlah penduduk gol B :',jumlahb);
writeln('jumlah penduduk gol AB :',jumlahab);
writeln('jumlah penduduk gol O :',jumlaho);

end;

readln;
end.

program sisip depan

program sisipbelakang;
uses crt;
type pointer = ^simpul;
simpul = record
data : string;
next : pointer;
end;
var p, baru, bantu : pointer;
nama : string;

begin
new(p); p := nil;
write('masukkan nama ( x =selesai ) : '); readln(nama);
repeat
new(baru);
baru^.data := nama;
baru^.next := nil;
if p = nil then p := baru
else
begin
baru^.next := p;
p := baru;

end;
write('masukkan nama ( x = selesai ) : '); readln(nama);
until nama = 'x';

bantu := p;
while bantu^.next <> nil do
begin
write(bantu^.data, ' ');
bantu := bantu^.next;
end;
write(bantu^.data);
readln;
end.

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.

Jumat, 14 Mei 2010

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

kode program sederhana mengunakan pascal

uses crt;
var i, j, k, a, b, c, d : integer;
begin
for i := 1 to 6 do
begin
for j := 1 to i do begin
write(' ');
end;
for k := 7 downto i+1 do
begin
write('* ');
end;
writeln;
Readln;
End;
End.