Program Pascal Menggunakan Array

Mencari Deret fibonacci dengan Array

1 1 2 3 5 8 ...



program fibonacci;

uses wincrt;

var

i,n: integer;

deret: array[1..100] of integer;

begin

clrscr;

write('banyaknya suku =');

readln(n);

writeln;

for i := 1 to n do

begin

if (i = 1) or (i = 2) then

begin

deret[i]:=1;

write(deret[i],' ');

end

else

begin

deret[i]:=deret[i-2]+deret[i-1];

write(deret[i], ' ');

end;

end;    

end.



Membaca Karakter dari Belakang

program balik_nama;
uses wincrt;
Var
I : word ;
Nama : string [255] ;
Begin
Write ( 'Nama Anda ?' ) ; readln ( Nama ) ;
Writeln ;
Writeln ( 'Nama Anda jika dibaca terbalik adalah : ' );
For I := ord (Nama [0] ) downto 1 do
Write (Nama [I] ) ;
End.


Mencari Deret Segitiga Pascal dengan Array

program deret_segitiga_pascal;
uses wincrt;

var num:array[1..100] of longint;

i,j,n,batas:integer;

begin

writeln('deret segitiga pascal');

write('mencari deret segitiga pascal hingga pangkat ke n=');readln(n);

num[1]:=1;

writeln(1);

for i:=1 to n do

begin

batas:=(i+1) div 2;

if not odd(i) then

num[batas+1]:=num[batas]*2;

for j:=batas downto 2 do

num[j]:=num[j]+num[j-1];

for j:=1 to batas do

write(num[j],' ');

if not odd(i) then write(num[batas+1],' ');

for j:=batas downto 1 do

write(num[j],' ');

writeln;

end;

end.

end;    

end.


Mencari Bilangan Prima hingga bilangan n

Program Bilangan_Prima;

Uses wincrt;

Var

Prima : Array[1..100] of Integer;

i,j,n : Integer;

bil : Integer;

Begin

write ('mencari bilangan prima hingga n =');

readln (n);

ClrScr;

For i := 2 to n Do

Begin

Prima[i]:=i;

For j:= 2 to i-1 Do

Begin

bil := (i mod j);

If bil = 0 then Prima[i]:=0;

End;

If Prima[i]<> 0 Then Write(Prima[i],' ');

End;

End.



Mencari Karakter ke-i

Program mencari_karakter_ke_i;

Uses wincrt;

Var

Nama : string;

i : Integer;

Begin

write ('nama Anda: ');

readln (nama);

For i:= 1 to Length(nama) Do

Writeln('karakter ke-',i,' dari ',Nama,'= ',Nama[i]);

End.

Mencari Banyaknya Karakter

Program Hitung_Huruf;
Uses WinCrt;
Var
Teks : string;
banyak : array['A'..'Z'] of byte;
i : byte;
begin
Write('Masukkan Suatu Kalimat :');
Readln(Teks);
for i:=1 to length(teks) do
banyak[upcase(teks[i])]:=banyak[upcase(teks[i])]+1;
for i:=1 to 26 do
if (banyak[upcase(chr(64+i))]<>0) then
writeln(upcase(chr(64+i)),' banyaknya
=',banyak[upcase(chr(64+i))]);
end.