Pascal Örnekleri 10 (Fibonacci sayıları, Asal sayılar, Basamaklara ayırma)

79)Fibonacci sayılarını yazan program.
Çöz:79)uses crt;
var
i,s:integer;
n,a,t1,t2,t3:longint;
begin clrscr;
t1:=1; t2:=1;
a:=32-3*n;
gotoxy(a,(n+1));
write(t1);
write(t2:4);
for n:=1  to 5 do begin
a:=32-3*n;
gotoxy(a,(n+1));
for i:=0 to n do
begin
t3:=t1+t2;
t1:=t2;
t2:=t3;
write(t3:5);
a:=a+6;
gotoxy(a,(n+1));
end;       end;
readln;
end.

80)Sayi tahmin oyunu bizim aklımızdan tuttuğumuz sayıyı bilgisayarın bulan program.
Çöz:80)Program Tahmin_et_bakalim;
uses crt;
label en_bas;
var
tahmin, ts : integer;
alt,ust:integer;
tus:char;
begin
clrscr;
writeln(‘Simdi aklinizdan bir sayi tutun ve eger
benim söyledigim sayi’);
writeln(‘sizin tuttugunuz sayidan küçükse çik anlaminda “ç” harfine, büyükse’);
writeln(‘in anlamindaki “i” harfine bir defa basin.’);
writeln;
writeln(‘Not: Sayi 1 ile 100 arasinda olmali!’);
writeln;
writeln(‘Hazirsaniz Enter”a basin..’);
readln;
clrscr;
alt:=1;
ust:=1001;
ts:=0;
gotoxy(1,1);write(‘Benim Tahminim…: ‘);
gotoxy(1,3);write(‘Ne yapiyim (i/ç).: ‘);
tahmin:=500;
while ((tus <>’d’)and(tus<>’D’)) do begin
gotoxy(20,1);write(tahmin,’  ‘);
gotoxy(20,3);
tus:=readkey;
while ((tus<>’i’)and (tus<>’I’) and(tus<>’ç’)
and(tus<>’Ç’)and(tus<>’D’)and(tus<>’d’)) do
tus:=readkey;
if tus in[‘i’,’I’] then begin
ust:=tahmin;
tahmin:=(alt+ust) div 2;
end;
if tus in[‘Ç’,’ç’] then begin
alt:=tahmin;
tahmin:=(alt+ust) div 2;
end;
ts:=ts+1;
if (tus in[‘d’,’D’]) then begin
gotoxy(1,5);write(‘Aferin Bana!’,’         ‘);
gotoxy(1,6);write(‘Tahmin Sayim: ‘,ts);
break;
end;
if ts=10 then begin
gotoxy(1,5); write(‘benimle dalgamı geçiyorsun!!!’);
break; end; end;
readkey;
end.

81)while döngüsü ile 15 tane tek sayının toplamını yapan program.
Çöz:81)uses crt;
var
sayi,sayi1,kalan,teksayi:integer;
begin
sayi1:=0;
sayi:=1;
while sayi<=15 do begin
sayi1:=sayi1+1;
kalan:=sayi1 div 2;
if (kalan=1) then begin
teksayi:=teksayi+sayi1;
sayi:=sayi+1;
end;
readln;
end.

82)15. asal sayıya kadar yazan program.
Çöz:82)uses crt;
var
asallar,j,i,b,c,sayac:integer;
begin
clrscr;
sayac:=0;asallar:=0;
i:=1;
while (asallar<=15) do
begin
i:=i+1;
for j:=1 to i do
begin
if i mod j=0 then
begin
sayac:=sayac+1;
if sayac>2 then break;
end;
end;
if sayac<=2 then
begin
asallar:=asallar+1;
if asallar<25 then
writeln(i)
else if asallar<49 then
begin gotoxy(10,asallar-24);writeln(i);
end
else if asallar<73 then
begin gotoxy(20,asallar-48);writeln(i); end;
end;
sayac:=0;
if asallar>72 then break;
end;
readkey;
end.

83)Kullanıcının dısardan girdiği kaçıncı asaldan kaç adet asalı yazmasını isteyen program.
Çöz:83)uses crt;
var
asallar,j,i,b,c,sayac,k,a:longint;
begin
clrscr;
sayac:=0;asallar:=0;
writeln(‘kaç tane asal yazdırmak istiyorsunuz:’);
readln(k);
writeln(‘kaçdan sonraki asal sayılar olsun:’);
readln(a);
i:=a;
while (asallar<k) do
begin
i:=i+1;
for j:=1 to i do
begin
if i mod j=0 then
begin
sayac:=sayac+1;
if sayac>2 then break;
end;
end;
if sayac<=2 then
begin
asallar:=asallar+1;
if asallar<25 then
writeln(i)
else if asallar<49 then
begin
gotoxy(10,asallar-24);writeln(i);
end
else if asallar<73 then
begin
gotoxy(20,asallar-48);writeln(i); end;
end;
sayac:=0;
if asallar>72 then break;
end;
readkey;
end.

84)Girilen sayının her birini ayırıp alt alta yazan program.
Çöz:84)uses crt;
var
a,b,c,d,e,f,sayi:integer;
devam:char;
begin
clrscr;
devam:=’e’ do begin
write(‘4 basamaklı sayıyı girin:’);readln(sayi);
a:=sayi div 1000;
b:=sayi mod 1000;
c:=b div 100;
d:=b mod 100;
e:=d div 10;
f:=d mod 10;
writeln(a);
writeln(c);
writeln(e);
writeln(f);
writeln(‘devam mı?e/h’); devam:=readkey;
if (devam=’h’)then halt; end;
readln;
end.

Yazar: kacarozgur

Özgür Kaçar sitemizde 38 yazı eklemiş...

• Tüm yazıları-> kacarozgur →
• Kişisel Sayfası