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.
ajari aq pascal ya dik!!! mas bener2 pengen bisa. q mohon
BalasHapus