Pascal örnek arşivi

Aradığınız Programı ctrl+f tuşu ile aratıp bulabilirsiniz
1)Klavyeden girilen iki sayının toplamını bulan program
Çöz:1)uses crt;
   var
   sayi1,sayi2,toplam:integer;
   begin
   write(‘Birinci sayıyı gir:’);readln(sayi1);
   write(‘İkinci sayıyı gir:’);readln(sayi2);
   toplam:=sayi1+sayi2;
   writeln(‘toplam=’,toplam);
   readln;
   end.

2)Klavyeden girilen üç sayının ortalamasını bulan program.
Çöz:2)uses crt;

   var
   a,b,c,ort:integer;
   begin
   write(‘Birinci sayıyı gir:’);readln(a);
   write(‘İkinci sayıyı gir:’);readln(b);
   write(‘Üçüncü sayıyı gir:’);readln(c);
   ort:=(a+b+c) div 3;
   write(‘sonuç:’,ort);
readln;
end.

3)Klavyeden bir kenarı girilen karenin çevresini bulan program.
Çöz:3) uses crt;
   var
   a,cevre:integer;
   begin
   write('bir kenarı gir');readln(a);
   cevre:=4*a;
   writeln('sonuç:',cevre);
   readln;
   end.

4)Klavyeden yarı çapı girilen dairenin çevresini ve alanını bulan program.
Çöz:4)uses crt;
   var
   cevre,alan,pisayisi,r:integer;
   begin
   write(‘yarıçapı giriniz:’);readln(r);
   pisayisi:=3;
   cevre:=2*pisayisi*r;
   alan:=pisayisi*r*r;
   writeln(‘cevre:’,cevre);
   writeln(‘alan:’,alan);
   readln; end.
5)Klavyeden taban uzunluğu ve yüksekliği girilen üçgenin alanını bulan program.
Çöz:5)uses crt;
   var
   t,y:integer;
   alan:real;
   begin
   write(‘tabanını girin:’);readln(t);
   write(‘yüksekliğini girin:’);readln(y);
   alan:=(t*y)/2;
   writeln(‘sonuc:’,alan);
   readln;
   end.

6)Klavyeden girilen fiyat değerine KDV ekleyen program.
Çöz:6)uses crt;
   var
   f:integer;  a:real;
   begin
   write(‘Fiyatı girin:’);readln(f);
   a:=(f*0.18)+f;
   writeln(‘sonuc:’,a:10:2);
   readln;
   end.

7)Klavyeden girilen sayının karesini, küpünü ve iki katını ekrana yazan program.
Çöz:7)uses crt;
   var
   kare,kup,ikikati,a:integer;
   begin
   write(‘sayıyı girin:’);readln(a);
   kare:=a*a;
   writeln(‘kare:’,kare);
   kup:=a*a*a;
   writeln(‘kup:’,kup);
   ikikati:=2*a;
   writeln(‘iki katı:’,ikikati);
   readln;
   end.

8)Klavyeden girilen anakart, ekran kartı ve laptopların fiyatlarının KDV’ sini alan program.
Çöz:8)uses crt;
   var
   a,e,l,t:real;
   begin
   write(‘anakarın fiyatını gir:’);readln(a);
   a:=a*1.538;
   a:=a*0.18+a;
   writeln(‘anakartın fiyatı:’,a);
   write(‘ekran kartının fiyatı gir:’);readln(e);
   e:=e*1.538;
   e:=e*0.18+e;
   writeln(‘ekran kartı fiyatı:’,e);
   write(‘laptopun fiyatını giri:’);readln(l);
   l:=l*2.050;
   l:=l*0.18+l;
   writeln(‘laptopun fiyatı:’,l);
   t:=a+e+l;
   writeln(‘toplam fiyat:’,t);
   readln;
   end.

9) Klavyeden çalışma saati, saatlik ücreti, çalışılan gün sayısı ve avans miktarının girildiği bir işçinin aylık maaşını hesaplayan program.
Çöz:9)uses crt;
   var
   csaat,cgun,avans,ucret,toplamucret:real;
   begin
   write(‘Çalıştığı saati giriniz:’);readln(csaat);
   write(‘Çalıştığı gün sayısı:’);readln(cgun);
   write(‘Saat ücreti giriniz:’);readln(ucret);
   write(‘avansı gir:’);readln(avans);
   toplamucret:=avans+(csaat*cgun*ucret);
   writeln(‘alacağı ucret:’,toplamucret);
   readkey;
   end.

10)Klavyeden girilen iki sayının yerini değiştiren program.
Çöz:10)uses crt;
   var
   a,b,degistirme:integer;
   begin
   write(‘1. sayıyı gir:’);readln(a);
   write(‘2. sayıyı gir:’);readln(b);
   degistir:=b;
   b:=a;
   a:=degistir;
   writeln(‘1.sayı:’,a);
   writeln(‘2.sayı:’,b);
   readkey;
   end.

11)Klavyeden girilen sayının çift mi tek mi olduğunu bulan program.
Çöz:11)uses crt;
   var
   sayi:integer;
   begin
   write(‘sayıyı giriniz:’);readln(sayi);
   if(sayi mod 2=0) then
   writeln(‘çift sayı’)
   else
   writeln(‘tek sayı’);
   readln;
   end.

12)Klavyeden notu girilen öğrencinin dersden geçti veya kaldı hesaplamasını yapan program.
Çöz:12)uses crt;
   var
   sayi:integer;
   write(‘notunuzu girin:’);readln(sayi);
   if(sayi<0) then
   writeln(‘eksi sayı girdiniz’)
   else
   if (sayi<=25)then
   writeln(‘0 Kaldınız’);
   else if(sayi<=44) then
   writeln(‘1 Kaldınız’)
   else if(sayi<=54) then
   writeln(‘2 Geçtiniz’)
   else if(sayi<=69) then
   writeln(‘3 Geçtiniz’)
   else if(sayi<=84) then
   writeln(‘3 Geçtiniz’)
   else if(sayi<=100) then
   writeln(‘5 Geçtiniz’)
   else writeln(‘fazla sayı girdiniz’);
   readln;
   end.

13)Klavyeden kenarlar sayıları girilen üçgenin çeşidini yazan program.
Çöz:13)uses crt;
var
a,b,c:integer;
begin
writeln('1.kenari_giriniz:');readln(a); writeln('2.kenari_giriniz:');readln(b); writeln('3.kenari_giriniz:');readln(c); if(a=b)and(b=c)then
writeln('eskenar')
else if(a<>b)and(b<>c)and(a<>c)then
writeln('cesitkenar')
else
writeln('ikizkenar');
readln;
end.

14)Klavyeden çocuk sayısı ve maas miktarı girilen işçinin toplam maaşı yazan program
1 çocuğu varsa maaş+ %5
2 çocuğu varsa maaş+ %10
3 çocuğu varsa maaş+ %15
Çöz:14)uses crt;
   var
   cocuk,maas:real;
   begin
   write(‘çocuk sayısını gir:’);readln(cocuk);
   write(‘maaş miktarını gir’);readln(maas);
   if(cocuk=1) then
   maas:=maas+(maas*0.5);
   if(cocuk=2) then
   maas:=maas+(maas*0.10);
   if(cocuk=3) then
   maas:=maas(maas*0.15);
   writeln(‘maas’,maas:10:2);
   readln;
   end.

15) Klavyeden kenarlar sayıları girilen üçgenin çeşidini yazan program.
Çöz:15)uses crt;
   var
   a,b,c:integer;
   begin
   write(‘1. kenarı gir:’);readln(a);
   write(‘2. kenarı gir:’);readln(b);
   write(‘3. kenarı gir:’);readln(c);
   if(a=b) and (b<>c) then
   writeln(‘ikiz kenar’);
   else if(a=c) and (a<>b) then
   writeln(‘ikiz kenar’)
   else if(b=c) and (b<>a) then
   writeln(‘ilikz kenar’)
   else if(a=b) and (b=c) then
   writeln(‘eş kenar’)
   else writeln(‘Çeşit kenar’);
   readln;
   end.

16)Klavyeden seçime bağlı olarak bilgisayar, matematik, elektronik kitabı seçimleri girilerek sayısına göre indirim uygulayan program.

Bilgisayar Kitabı:%10 indirim
50:%20 indirim
100:%25 indirim

Matematik Kitabı:%5 indirim
50:%15 indirim
100:%20 indirim

Elektronik Kitabı:%8 indirim
50:%18 indirim
100:%22 indirim

Çöz:16)uses crt;
   var
   sec,sayisi:integer;
   fiyat:real;
   begin
   writeln(‘MENU’);
   writeln(‘1-Bilgisayar Kitabı’);
   writeln(‘2-Matematik Kitabı’);
   writeln(‘3-Elektronik Kitabı’);
   writeln(‘seçiminizi yapınız:’);readln(sec);
   writeln(‘fiyatını giriniz:’);readln(fiyat);
   writeln(‘sayısını giriniz:’9;readln(sayisi);
   if (sec=1) then
   fiyat:=fiyat-(fiyat*0.10);
   if (sayisi=50) then
   fiyat:=fiyat-(fiyat*0.20);
   if (sayisi=100) then
   fiyat:=fiyat-(fiyat*0.25);
   if (sec=2) then
   fiyat:=fiyat-(fiyat*0.05);
   if (sayisi=50) then
   fiyat:=fiyat-(fiyat*15);
   if (sayisi=100) then
   fiyat:=fiyat-(fiyat*0.20);
   if (sec=3) then
   fiyat:=fiyat-(fiyat*0.08);
   if (sayisi=50) then
   fiyat:=fiyat-(fiyat*0.18);
   if (sayisi=100) then
   fiyat:=fiyat-(fiyat*0.22);
   if (sec>3) and (sec<1) then
   writeln(‘yanlış seçim’);
   writeln(‘fiyatı:’,fiyat:0:2);
   readln;
   end.

17)Klavyeden girilen üç adet sayının en büyük, ortada, en küçük olmak üzere sıraya koyan program.
Çöz:17);uses crt;
var
sayi1,sayi2,sayi3:integer;
begin
write('1.sayıyı giriniz:');readln(sayi1);
write('2.sayıyı giriniz:');readln(sayi2);
write('3.sayıyı giriniz:');readln(sayi3); if(sayi1>sayi2)and(sayi1>sayi3)and(sayi2>sayi3)then
begin
writeln('1.büyük sayı:',sayi1);
writeln('2.büyük sayı:',sayi2);
writeln('3.büyük sayı:',sayi3);
end;
if(sayi1>sayi2)and(sayi1>sayi3)and(sayi3>sayi2)then
begin
writeln('1.büyük sayı:',sayi1);
writeln('2.büyük sayı:',sayi3);
writeln('3.büyük sayı:',sayi2);
end;
if(sayi2>sayi1)and(sayi2>sayi3)and(sayi1>sayi3)then
begin
writeln('1.büyük sayı:',sayi2);
writeln('2.büyük say:',sayi1);
writeln('3.büyük sayı:',sayi3)
end;
if(sayi2>sayi1)and(sayi2>sayi3)and(sayi3>sayi1)then
begin
writeln('1.büyük sayı:',sayi2);
writeln('2.büyük sayı:',sayi3);
writeln('3.büyük sayı:',sayi1);
end;
if(sayi3>sayi1)and(sayi3>sayi2)and(sayi2>sayi1)then    begin
writeln('1.büyük sayı:',sayi3);
writeln('2.büyük sayı:',sayi2);
writeln('3.büyük sayı:',sayi1);
end;
if(sayi3>sayi1)and(sayi3>sayi2)and(sayi1>sayi2)then
begin
writeln('1.büyük sayı:',sayi3);
writeln('2.büyük sayı:',sayi1);
writeln('3.büyük sayı:',sayi2);
end;
readln;
end.

18)Klavyeden girilen ilk ve son sayacın hesaplayan program.
Çöz:18)uses crt;
   var
   sonsayac,ilksayac:integer;
   elk:real;
   begin
   write(‘ilk sayacı giriniz:’);readln(ilksayac);
   write(‘son saycı giriniz:’);readln(sonsayac);
   elk:=sonsayac-ilksayac;
   if (elk>150) then begin
   elk:=elk-15;
   elk:=elk*1.5;
   elk:=elk+150;
   elk:=elk*1.18*15;
   writeln(‘Fatura tutarı:’,elk);
   end
   else if (elk<=150) then begin
   elk:=elk*1.18*15;
   writeln(‘Fatura tutarı:’,elk);
   end;
   readln;
   end.

19)Bir öğrencinin bir ders olarak Birinci dönem notu ve İkinci dönem notu girilerek ortalamasıyla yapılan Kaldı, Geçti durumunu yapan program.
Çöz:19)uses crt;
   var
   ilkdonem,ikincidonem:integer;
   ortalama:real;
   begin
   write(‘ilk dönem notunuzu giriniz:’);readln(ilkdonem);
   write(‘ikinci döenm notunuzu giriniz:’);readln(ikincidonem);
   ortalama:=(ilkdonem+ikincidonem)/2;
   writeln(‘ortalama:’,ortalama);
   if (ikincidonem<2) then
   writeln(‘kaldınız’)
   else
   if (ortalama>1.5) then
   writeln(‘geçtiniz’);
   if (ortalama<1.5) then
   writeln(‘kaldınız’);
   readln;
   end.

20)Klavyeden kitap fiyatı girilip sayısına göre indirim yapan program.
Çöz:20) uses crt;
var
sayisi:integer;
fiyat:real;
begin
writeln('kitabin_sayisini_giriniz:');readln(sayisi); writeln('kitabin_fiyatini_giriniz:');readln(fiyat); if(sayisi<10)then
begin
fiyat:=sayisi*fiyat;
writeln('fiyati:',fiyat,'YTL');
end
else
if(sayisi>=10)and(sayisi<50)then
begin
fiyat:=fiyat-(fiyat*0.10);
writeln('fiyati:',fiyat);
end
else
if(sayisi>=50)then
begin
fiyat:=fiyat-(fiyat*0.20);
writeln('fiyati:',fiyat,'YTL');
end;
readln;
end.
 
21)Klavyeden girilen dört kenara göre dikdörtgen mi? Kare mi? Paralel kenar mı? Yamuk mu? olduğunu bulan program.
Çöz:21)uses crt;
   var
   a,b,c,d,aci:integer;
   begin
   write(‘birinci kenarı giriniz:’);readln(a);
   write(‘ikinci kenarı giriniz:’);readln(b);
   write(‘üçüncü kenarı giriniz:’);readln(c);
   write(‘dördüncü kenarı giriniz:’);readln(d);
   if (a=b) and (b=c) and (c=d) then
   writeln(‘kare’)
   else if (a<>b) and (a<>c) and (a<>d) and (b<>c) and (b<>d) and (c<>d) then
   writeln(‘yamuk’)
   else if (a=c) and (b=d) then
   begin
   writeln(‘bu dikdörtgen yada paralel kenar olabilir bir iç açı giriniz:’);
   readln(aci);
   if (aci=90) then
   writeln(‘dikdörtgen’)
   else
   writeln(‘paralel kenardır’);end
   else
   write(‘öyle bir dörtgen yoktur’);
   readln;
   end.

22)Klavyeden girilen notu beşlik sisteme çeviren program.
Çöz:22)uses crt;
   var
   sayi:integer;
   begin
   write(‘notunuzu girin:’);readln(sayi);
   case sayi of
   0..24:writeln(‘0 ile kaldınız’);
   25..44:writeln(‘1 ile kaldınız’);
   45..54:writeln(‘2 ile geçtiniz’);
   55..69:writeln(‘3 ile geçtiniz’);
   70..84:writeln(‘4 ile geçtiniz’);
   85..100:writeln(‘5 ile geçtiniz’)
   else
   writeln(‘notunuzu 0-100 arasında giriniz’);
   end;
   readln;
   end.


23)Klavyeden girilen kenar uzunluğuna göre üçgen olup olmadığını bulan program.
Çöz:23)uses crt;
   var
   a,b,c:integer;
   begin
   write(‘birinci kenarı gir:’);readln(a);
   write(‘ikinci kenarı gir:’);readln(b);
   write(‘üçüncü kenarı gir:’);readln(c);
   if((a+b)>c) and ((a+c)>b) and ((b+c)>a) then
   writeln(‘bu bir üçgendir’)
   else
   writeln(‘üçgen değildir’);
   readln;
   end.

24)1’den 10’a kadar olan sayıların  toplamını bulan program.
Çöz:24)uses crt;
   var
   i,b:integer;
   begin
   for i:=1 to 10 do begin
   b:=b+i;
   end;
   writeln(b);
   readln;
   end.

25)1’den 20’ye kadar olan çift sayıların toplamını veren program.
Çöz:25)uses crt;
   var
   i,b:integer;
   begin
   for i:=1 to 20 do begin
   i:=i+1;
   b:=b+i;
   end;
   writeln(b);
   readln;
   end.

26)Ekrana 10 kere isim yazan program.
Çöz:26)uses crt;
   var
   i:integer;
   begin
   for i:=1 to 10 do begin
   writeln(‘sonnur’);
   end;
   readln;
   end.

27)Klavyeden girilen sayının faktöriyelini hesaplayan program.
Çöz:27)uses crt;
   var
   i,a,fak:integer;
   begin
   fak:=1;
   write(‘sayıyı gir:’);readln(a);
   for i:=1 to a do begin
   fak:=fak*i;
   end;
   writeln(fak);
   readln;
   end.

28)Klavyeden girilen sayıya kadar olan sayıların karelerini toplayan program.
çöz:28)uses crt;
   var
   i,a,b:integer;
   begin
   write(‘sayıyı gir:’);readln(a);
   for i:=1 to a do begin
   b:=b+(i*i);
   end;
   writeln(b);
   readln;
   end.

29)Klavyeden girilen ismi alt alta birerli atlayarak yazan program.
Çöz:29)uses crt;
var
isim:string;
i:integer;
begin
clrscr;
writeln('isminizi_giriniz:');readln(isim);
for i:=1 to 15 do
begin
gotoxy(i,i);
writeln(isim);
end;
readln;
end.

30)Ekranın iki yanına ismi alt alta 5 kere yazan program.
Çöz:30)uses crt;
   var
   i:integer;
   begin
   clrscr;
   for i:=1 to 5 do begin
   gotoxy(1,i);
   writeln(‘isim’);
   gotoxy(70,i);
   writeln(‘isim’);
   end;
   readln;
   end.

31)Klavyeden 5 adet isim girilecek iki tarafta alt alta yazan program.
Çöz:31)uses crt;
   var
   a:integer;
   ad:string;
   begin
   clrscr;
   for a:=1 to 5 do begin
   gotoxy(1,1);
   write(‘adınızı girin:’);readln(ad);
   gotoxy(1,2);
   writeln(‘’);
   gotoxy(1,a+6);
   writeln(ad);
   gotoxy(60,a+6);
   writeln(ad);
   end;
   readln;
   end.

32)Klavyeden girilen 5 adet ismin iki tarafta birer birer atlayarak yazan program.
Çöz:32)uses crt;
var
a,x,y:integer;
ad:string;
begin
clrscr;
x:=1;y:=60;
for a:=1 to 5 do
begin
gotoxy(1,1);
writeln('adınızı giriniz');readln(ad);
gotoxy(1,2);
writeln('               ');
gotoxy(x,a+7);
x:=x+2;
writeln(ad);
gotoxy(y,a+7);
y:=y-2;
writeln(ad);
end;
readln;
end.

33)Klavyeden girilen adın v şeklinde yazan program.
Çöz:33)uses crt;
var
i,x:integer;
isim:string;
begin
clrscr;
x:=70;
write(‘isim giriniz:’);readln(isim);
for i:=1 to 20 do begin
gotoxy(i,i);
writeln(isim);
x:=x-1;
gotoxy(x,i);
writeln(isim);
end;
readln;
end.

34)Klavyeden girilen ismi x şeklinde yazan program.
Çöz:34)uses crt;
var
i,x:integer;
isim:string;
begin
clrscr;
x:=70;
readln(isim);
for i:=1 to 20 do begin
gotoxy(i*3,i);
writeln(isim);
x:=x-1;
gotoxy(66-3*i,i);
writeln(isim);
end;
readln;
end.

35)Klavyeden girilen 5 kişiye ait yaşların toplamını bulan program.
Çöz:35)uses crt;
   var
   toplam,i,yas:integer;
   isim:string;
   begin
   clrscr;
   for i:=1 to 5 do begin
   write(‘yaşı gir:’);readln(yas);
   toplam:=toplam+yas;
   end;
   writeln(‘toplam:’,toplam);
   readln;
   end.

36)Klavyeden girilen 10 adet sayının pozitif ve negatif sayılarını bulan program.
Çöz:36)uses crt;
   var
   a,i,negatif,pozitif:integer;
   begin
   for i:=1 to 10 do begin
   write(‘sayıyı gir:’);readln(a);
   if (a>0) then
   pozitif:=pozitif+1
   else
   if (0>a) then
   negatif:=negatif+1;
   end;
   writeln(‘pozitif sayılar:’,pozitif);
   writeln(‘negatif sayılaar:’,negatif);
   readln;
   end.

37)Klavyeden girilen sayıların çift veya tek olduğunu bulan program.
Çöz:37)uses crt;
   var
   i,a,kalan,cift,tek:integer;
   begin
   for i:=1 to 10 do begin
   write(‘sayıyı gir:’);readln(a);
   kalan:a mod 2;
   if (kalan=0) then
   cift:=cift+1
   else if (kalan=1) then
   tek:=tek+1;
   end;
   writeln(‘çift sayıların adedi:’cift);
   writeln(‘tek sayılarınadei:’,tek);
   readln;
   end.

38)n!/(n-r)!r! işlemini yapan program.
Çöz:38)uses crt;
var
fak,i,n,r,fakt,fakr,faktnr:integer;
sonuc:real;
begin
writeln('r sayısını giriniz');readln(r);
writeln('n sayısını giriniz');readln(n);
fak:=1; fakr:=1; faktnr:=1;
 
for i:=2 to n  do begin
fak:=fak*i;
if(i<=r)then
fakr:=fakr*i;
if(i<=(n-r))then
faktnr:=faktnr*i;
end;
sonuc:=fak/(faktnr*fakr);
writeln('sonuc',sonuc);
readln;
end.

39) n∑i=1/n!-(n-r)!  ilemini yapan program.
Çöz:39)uses crt;
var
toplam,i,fak,n,r,fakr,faknr:integer;
sonuc:real;
begin
fak:=1; faknr:=1;
writeln('r sayısını giriniz');readln(r);
writeln('n sayısını giriniz');readln(n);
for i:=1 to n  do begin
toplam:=toplam+i;
fak:=fak*i;
if(i<=(n-r))then
faknr:=faknr*i;
end;
sonuc:=toplam/(faknr*fak);
writeln('sonuc:',sonuc:6:2);
readln;
end.

40) 1+3+5+...+n
             n!
Ç7öz:40)uses crt;
var
toplam,i,fak,n:integer;
sonuc:real;
begin
clrscr;
fak:=1;
writeln('n sayısını giriniz');readln(n);
for i:=1 to n  do begin
if odd(i)then
toplam:=toplam+i;
fak:=fak*i;
end;
sonuc:=toplam/fak;
writeln('sonuc:',sonuc:6:2);
readln;
end.

41)1.r+2.(r-1)+3.2+4.1+5.0+6(-1)......n.(r-1)
                            n!(n-r)!
Çöz:41)uses  crt;
   var
   n,i,r1,r,fakn,faknr,toplam:integer;
   sonuc:real;
   write(‘n değerini giriniz:’);readln(n);
   write(‘r değerine giriniz:’);readln(r);
   r1:=r;
   faknr:=1; fakn:=1;
   for i:=1 to n do begin
   toplam:=i*r1+toplam;
   r1:=r1,1;
   fakn:=fakn*i;
   end;
   sonuc:=toplam/(faknr*fakn);
   readln;
   end.

42)Rasgele sayı üreten ve ekrana yazan progam.
Çöz:42)uses crt;
   var
   a:integer;
   begin
   randomize;
   a:=random(10);
   writeln(a);
   readln;
   end.

43)Rasgele üretilen sayı ile bizim girdiğimiz sayının aynı olup olmadığını bulan program.
Çöz:43)uses crt;
   var
   a,b,i:integer;
   begin
   randomize;
   a:=random(10);
   for i:=1 to 3 do begin
   write(‘sayıyı giriniz:’);readln(b);
   if (a=b) then begin
   writeln(‘doğru’); break; end
   else
   writeln(‘yanlış’);end;
   readln;
   end.

44)Rasgele üretilen sayının bizim girdiğimiz sayı ile karşılaştırarak aynı olup olmadığını bulan program. Yanlışsa kullanıcıya 9 kere daha girme hakkı verilecek.
Çöz:44) uses crt;
var
i,a,b:integer;
begin
randomize;
a:=random(100);
for i:=1 to 10 do
begin
writeln('sayı girin:');readln(b);
if(a=b)then
begin
writeln('doğru');break;end
else if(a<>b)and(a>b)then
writeln('yanlış! yukarıda değer gir')
else if(a<>b)and(b>a)then
writeln('yanlış! aşağıda bir değer gir');
end;
readln;
end.

45)Kaçıncı denemede doğru sayıyı bulduğunu yazan program.
Çöz:45)uses crt;
var
i,a,b:integer;
begin
randomize;
a:=random(100);
for i:=1 to 10 do
begin
writeln('1-100 arasında sayı girin:');readln(b); if(a=b)then
begin
writeln('doğru',i,'denemede değeri buldun');break;end
else if(a<>b)and(a>b)then
writeln('yanlış! deneme yukarıda bir değer gir')
else if(a<>b)and(b>a)then
writeln('yanlış! deneme aşağıda bir değer gir');
end;
readln;
end.

46)Koordinatları bilgisayarın belirlediği, ismi ekrana renkli ve yanıp sönerek yazan program.
Çöz:46)uses crt;
var
i,x,y:integer;
begin
clrscr;
randomize;
for i:=1 to 1000 do begin
x:=random(70);
y:=random(24);
textcolor(x);
gotoxy(x,y);
textbackground(82);
writeln('sonnur');
end;
readln;
end.

47)Sayısal loto programı
Çöz:47)uses crt;
   var
   i,a:integer;
   begin
   clrscr;
   randomize;
   for i:=1 to 6 do
   begin
   a:=random(49);
   writeln(a+1);
   end;
   readln;
   end.

48)Sayısal lotonun 8 kolonunun bilgisayarın rasgele ürettiği sayılara göre yazan program.
Çöz:48)uses crt;
   var
   i,a,b:integer;
   begin
   clrscr;
   randomize;
   for b:=1 to 8 do begin
   for i:=1 to 6 do begin
   a:=random(49);
   writeln(a+1);end;
   end;
   readln;
   end.

49)Saat programı
Çöz:49)uses crt;
var
saat,dakika,saniye,salise:integer;
begin
clrscr;
writeln('13.11.2006');
for saat:=15 to 23 do
for dakika:=45 to 59 do
for saniye:=0 to 59 do
for salise:=0 to 59 do
begin
gotoxy(5,10);
delay(10);
writeln(saat,':',dakika,':',saniye,':',salise,':');
end;
readln;
end.

50)İsmi ekrana 3 blok halinde ortalı yazan program.
Çöz:50)uses crt;
var
x,y:integer;
begin
clrscr;
for x:=1 to 3 do
for y:=1 to 10 do begin
gotoxy(30*x-25,2*y);
writeln('sonnur');
end;
readln;
end.

51)İsmi ekranda yarısında yazmaya başlayan program.
Çöz:51)uses crt;
   var
   x,y:integer;
   begin
   clrscr;
   for x:=1 to 3 do
   for y:=1 to 5 do
   begin
   gotoxy(30*x-25,2*y+14);
   writeln(‘sonnur’);
   end;
   readln;
   end.

52)İsmi ekranda sekiz bloklu yazan program.
Çöz:52)uses crt;
   var
         x,y:integer;
         begin
         clrscr;
      for x:=1 to 8 do
      for y:=1 to 10 do
         begin
         gotoxy (9*x-3,2*y);
         writeln('sonnur'); end;
         readln;
         end.

53)Ekrandaki isimin ortasını kare şeklinde yazmayan program.
Çöz:53)uses crt;
      var
      x,ad,a,i:integer;
      begin
      clrscr;
      for i:=1 to 8 do
      for a:=1 to 8 do
      begin
      gotoxy(9*i-3,3*a);
      if (i>=3) and  (i<=6) and (a>=3) and  (a<=6) then
      writeln('')
      else
      writeln('sonnur');
      end;
      readln;
      end.

54)L harfi şeklinde yazan program.
Çöz:54) uses crt;
      var
      x,y:integer;
      begin
      clrscr;
      for x:=1 to 8 do
      for y:=1 to 8 do
      begin
      gotoxy(9*x-3,3*y);
      if (x>=3) and  (y<=6) then
      writeln('')
      else
      writeln('sonnur');
      end;
      readln;
      end.

55)Kare şeklinde ismi ekranda yazan program.
Çöz:55)uses crt;
      var
      x,y:integer;
      begin
      clrscr;
      for x:=1 to 8 do
      for y:=1 to 8 do
      begin
      gotoxy(9*x-3,3*y);
      if (x>=2) and  (y<=7) and (y>=2) and  (x<=7) then
      writeln('')
      else
      writeln('sonnur');
      end;
      readln;
      end.

56)U şeklinde ismi ekrana yazan program.
Çöz:56)uses crt;
      var
      x,y:integer;
      begin
      clrscr;
      for x:=1 to 8 do
      for y:=5 to 8 do
      begin
      gotoxy(9*x-3,3*y);
      if (x>=2) and  (y<=7) and (y>=2) and  (x<=7) then
      writeln('')
      else
      writeln('sonnur');
      end;
      readln;
      end.

57)Klavyeden girilen ismin azalrak yazan program.
Çöz:57)uses crt;
var
x,i:integer;
ad,isim:string;
begin
clrscr;
readln(isim);
x:=length(isim);
for i:=1 to x do begin
ad:=copy(isim,1,i);
writeln(ad);
end;
readln;
end.

58)İsmi kelebek şeklinde yazan program.
Çöz:58)uses crt;
   var
   i,x:integer;
   ad,isim:string;
   begin
   clrscr;
   readln(isim);
   x:=length(isim);
   for i:=1 to x do
   begin
   gotoxy(30,5+i);
   ad:=copy(isim,1,i);
   write(ad,'  ':14-i*2);
   ad:=copy(isim,7-i,i);
   write(ad,'  ');
   gotoxy(30,10+i);
   ad:=copy(isim,i,9-i);
   write(ad,'  ':i*2);
   ad:=copy(isim,1,7-i);
   write(ad,'  ');
   end;
   readln;
   end.

59)Dört köşeden azalan isimi ekrana yazan program.
Çöz:59)uses crt;
   var
   i,x:integer;
   ad,isim:string;
   begin
   clrscr;
   readln(isim);
   x:=length(isim);
   for i:=1 to x do
   begin
   gotoxy(30,5+i);
   ad:=copy(isim,1,7-i);
   write(ad,'  ':i*2);
   ad:=copy(isim,i,9-i);
   write(ad,'  ');
   gotoxy(30,11+i);
   ad:=copy(isim,1,i);
   write(ad,'  ':14-i*2);
   ad:=copy(isim,7-i,i);
   write(ad,'  ');
   end;
   readln;
   end.

60)100’den 999’a kadar olan mükemmel sayılar.
Çöz:60)uses crt;
   var
   on,i,a,b,c:integer;
   begin
   clrscr;
   for i:=100 to 999 do begin
   a:=i div 100;
   a:=a*a*a;
   on:=i mod 100;
   b:=on div 10;
   b:=b*b*b;
c:=on mod 10;
c:=on mod 10;
c:=c*c*c;
if(a+b+c=i)then
writeln(‘mükemmel sayi:’,i);
end;
readln;
end.

61)1 ile 100 arasındaki asal syıları bulan program.
Çöz:61)uses crt;
var
i,a:integer;
begin
clrscr;
for i:=3 to 100 do
for a:=2 to i-1 do begin
if((i mod a)=0)then
break
else if(a=i-1)then
writeln('asal sayılar',i); end;
readln;
end.

62)2’den   başlayarak i<72 asal sayıyı ekrana 3 sütun halinde yazdıran program.
Çöz:62)uses crt;
var
i,a,sayac:integer;
begin
clrscr;
for i:=3 to 500 do
for a:=2 to i-1 do begin
if((i mod a)=0)then
break
else if(a=(i-1))then begin
sayac:=sayac+1;
if(sayac<=24)then
writeln(i)
else if(sayac<=48)then begin
gotoxy(40,sayac-24);
writeln(i);end
else if(sayac<=72)then begin
gotoxy(75,sayac-48);
writeln(i);end;
end;
end;
readln;
end.

63)Kullanıcının kaç kere oynamak istediğe bağlı olan program.
Çöz:63)uses crt;
var
tahmin,g,a,no:integer;
begin clrscr;
randomize;
a:=random(100);
writeln('Kaç kere tahmin etmek istiyorsun ');readln(tahmin);
for g:=1 to tahmin do begin
writeln('tahmini giriniz');readln(no);
if(a=no) then begin
writeln('doğru bildiniz tebrikler'); break; end
else
writeln('yanlış');
end;
readln;
end.

64)Kullanıcının isteğine göre menude bulunan tahmin oyunu, sayısal loto programlarından istediğini çalıştıran program.
Çöz:64)uses crt;
   var
   t,secenek,x,b,i,no,a,c:integer;
   begin
   clrscr;
   randomize;
   writeln(‘MENU’);
   writeln(‘1-Tahmin oyunu’);
   writeln(‘2-Sayısal loto’);
   writeln(‘3-Tariçe’);
   writeln(‘secenek seçiniz’);readln(secenek);
   if (secenek=!) then begin
   a:=random(100);
   x:=random(10);
   writeln(‘kaç kere oynayacaksınız:’);readln(c);
   writeln(‘tahmin hakkınız’,x);readln;
   for b:=1 to c do begin
   clrscr;
   for i:=1 to x do begin
   writeln(‘tahmini sayıyı giriniz:’);readln(no);
   if (a=no) then begin
   writeln(‘doğru bildin’);break;end
   else writeln(‘yalnış girdiniz’);
   if (no>a) then
writeln(‘aşağı in’);
   if (no<a) then
   writen(‘yukarı çık’);
   end;end;end
   else if (secenek=2) then begin
   for t:=1 to 8 do begin
   writeln(‘’);
   writeln(‘’);
   for i:=1 to 6 do begin
   x:=random(49);
   gotoxy(5*i,2*t);
   write(‘ ‘,x+1);end;
   end; end
   else if (secenek=3) then
   writeln(‘kullanıcının tüm hakları saklıdır’);
   readln;
   end.

65) 3 blok halinde 12*42=21*24 şeklindeki eşitliği yazan  program.
Çöz:65)uses crt;
   var
   i,j,a,b,c,d,e,f,sayac:integer;
   begin
   clrscr;
   for i:=11 to 99 do
   for j:=11 to 99 do begin
   a:=j div 10;
   b:=j mod 10;
   e:=b*10+a;
   c:=i div 10;
   d:=i mod 10;
   f:=d*10+c;
   if(i*j=e*f)and((i<>j)and(a<>b)and(c<>d))and(a<>d)then
   begin
   sayac:=sayac+1;
   if(sayac<=24)then
   writeln('  ',i,'*',j,'=',e,'*',f)
   else if(sayac<=48)then begin
   gotoxy(20,sayac-24);
   writeln('  ',i,'*',j,'=',e,'*',f);end
   else if(sayac<=72)then begin
   gotoxy(40,sayac-48);
   writeln('  ',i,'*',j,'=',e,'*',f);end;end;
   end;
   readln;
   end.

66)3 bloklu olup istediğimiz blokta kırılan 12*42=24*21 eşitliğini yazan program.
Çöz:66)uses crt;
   var
   i,j,a,b,c,d,e,f,sayac:integer;
   begin
      clrscr;
      for i:=11 to 99 do begin
      if(sayac>24)then break;
      for j:=11 to 99 do
      begin
      a:=j div 10;
      b:=j mod 10;
      e:=b*10+a;
      c:=i div 10;
      d:=i mod 10;
      f:=d*10+c;
if(i*j=e*f)and((i<>j)and(a<>b)and(c<>d))and(a<>d)then
begin
      sayac:=sayac+1;
      if(sayac<=24)then
      writeln('  ',i,'*',j,'=',e,'*',f)
      else if(sayac<=48)then begin
      gotoxy(20,sayac-24);
      writeln('  ',i,'*',j,'=',e,'*',f);end
      else if(sayac<=72)then begin
      gotoxy(40,sayac-48);
      writeln('  ',i,'*',j,'=',e,'*',f);end;
      end;
      end;end;
      readln;
      end.

67)Girilen ismin tersini yazan program.
Çöz:67)uses crt;
var
i,x:integer;
ad,isim:string;
begin
clrscr;
readln(isim);
x:=length(isim);
for i:=x downto 1 do
begin
ad:=copy(isim,i,1);
write(ad:5);
end;
readln;
end.

68) İsim
        sim
          im
           m     şeklinde yazan program.
Çöz:68)uses crt;
var
i,x:integer;
ad,isim:string;
begin   
clrscr;     
writeln('İsmi gir:'); readln(isim);
x:=length(isim);
for i:=1 to x do
begin
ad:=copy(isim,i,x);
writeln(ad:5);
end;
readln;
end.
69) misİ
      mis
      mi
      m             şeklinde ters yazan program.
Çöz:69)uses crt;
var
a,ad:string;
z,y,x:integer;
begin
clrscr;
writeln('adınızı giriniz:');readln(a);
clrscr;
x:=length(a);
for y:=1 to x do
begin
gotoxy(x,y);
for z:=x downto y do
begin
ad:=copy(a,z,1);
write(ad:1);
end;
writeln('');
end;
readln;
end.

70)Üçgen şeklinde ismi ve tersini azaltarak yazan program.
Çöz:70)uses crt;
var
a,ad:string;
y,z,x,i:integer;
begin
clrscr;
readln(a);
clrscr;
x:=length(a);
for y:=1 to x do begin
gotoxy(x,y);
for z:=x downto y do begin
ad:=copy(a,z,1);
write(ad:1);
end;
writeln('  ');
end;
gotoxy(1,1);
for i:=1 to x do begin
ad:=copy(a,i,x);
writeln(ad:6);end;
readln;
end.

71)Onluk (decimal) sayı sitemini ikilik (binary) sayı sistemine çeviren program.
Çöz:71)uses crt;
   var
   i,say,sayi1:integer;
   begin
   clrscr;
   writeln(‘sayıyı gir:’);readln(sayi);
   for i:=1 to sayi do begin
   sayi1:=sayi mod 2;
   write(‘sayi1);
   sayi:=sayi div 2;
   if (sayi=1) then break;
   end;
   writeln(sayi);
   readln;
   end.

72)Onluk (decimal) sayı sistemini onaltılık (hexedecimal) sayı sistemine çeviren program.
Çöz:72)uses crt;
   var
   sayi,sayi1,i:integer;
   begin
   clrscr;
   writeln(‘sayıyı gir’);readln(sayi);
   for i:=1 to sayi do
   begin
   sayi1:=sayi mod 16;
   sayi:=sayi div 16;
   if (sayi1<10) then
   write(sayi1)
   else if (sayi1=10) then
   write(‘A’)
   else if (sayi1=11) then
   write(‘B’)
   else if (sayi1=12) then
   write(‘C’)
   else if (sayi1=13) then
   write(‘D’)
   else if (sayi1=14) then
   write(‘E’)
   else if (sayi1=15) then
   write(‘F’);
   if (sayi<16) then break;
   end;
   writeln(sayi);
   readln;
   end.

73)Programın girişinde şifre sorulacak eğer kullanıcı şifreyi üç kez yanlış girerse program sonlanacak.
Çöz:73)uses crt;
   var
   a,sayi,sayi1,i:integer;
   sifre:string;
   begin
   clrscr;
   a:=1;
   while a<4 do begin
   a:=a+1;
   write(‘Hoşgeldiniz...Programa girmek için şifreyi gir:’);readln(sifre);
   if (sifre=’123a’) then begin
   writeln(‘şifreniz doğru programı kullanabilirsiniz’);break;end
   else writeln(‘şifreniz yanlış lütfen doğru şifreyi giriniz:’);end;
   if (sifre<>’123a’)then
   halt;
   writeln(‘sayıyı gir:’);readln(sayi);
for i:=1 to sayi do
   begin
   sayi1:=sayi mod 16;
   sayi:=sayi div 16;
   if (sayi1<10) then
   write(sayi1)
   else if (sayi1=10) then
   write(‘A’)
   else if (sayi1=11) then
   write(‘B’)
   else if (sayi1=12) then
   write(‘C’)
   else if (sayi1=13) then
   write(‘D’)
   else if (sayi1=14) then
   write(‘E’)
   else if (sayi1=15) then
   write(‘F’);
   if (sayi<16) then break;
   end;
   writeln(sayi);
   readln;
   end.

74)Sayısal loto programını kullanıcının belirlediği kolon sayısına göre yapan program.
Çöz:74)uses crt;
var
i,a,x,kolon:integer;
begin
clrscr;
randomize;
writeln('kaçkez oynamak istersiniz:');readln(kolon);
for x:=1 to kolon do
begin
i:=1;
while i<7 do begin
i:=i+1;
a:=random(49);
write(a:6); end;
writeln('   ');
end;
readln;
end.

75)Pascal Üçgeni düz sıralanmış hali.
Çöz:75)uses crt;
      var n,r,i,faktn,faktnr,faktr:longint;
   sonuc:real;
            begin
            clrscr;
            for n:=0 to 12 do
            begin
            faktn:=1;
            faktnr:=1;
            faktr:=1;
            for r:=0 to n do
            begin
            for i:=0 to n do
            begin
if (i=0) then faktn:=1
else faktn:=faktn*i;
            if ((n-r)>=i) then
            faktnr:=faktnr*i;
            if (faktnr=0) then
            faktnr:=1;
          if (r>=i) then
            faktr:=faktr*i;
            if (faktr=0) then
            faktr:=1;
            end;
            sonuc:=(faktn/(faktnr*faktr));
            write(sonuc:5:0);
            end;
write(' ');
writeln('');
            end;
            readln;
            end.

76)Pascal Üçgeni programı.
Çöz:76)uses crt;
   var a,n,i,r,fakn,faknr,fakr:longint;
   sonuc:real;
   begin
   clrscr;
   for n:=0 to 12 do
      begin
   fakn:=1;
      faknr:=1;
      fakr:=1;
      a:=32-3*n;
      gotoxy(a,(n+1));
      for r:=0 to n do begin
      for i:=0 to n do
      begin
      if (i=0) then fakn:=1
      else fakn:=fakn*i;
   if ((n-r)>=i) then faknr:=faknr*i;
if (faknr=0) then
faknr:=1;
if (r>=i) then
fakr:=fakr*i;
if (fakr=0) then
fakr:=1;
      end;
      sonuc:=(fakn/(faknr*fakr));
      a:=a+6;
      gotoxy(a,(n+1));
      write(sonuc:5:0);
      end;
      writeln('');
      end;
      readln;
      end.





77)Hesap makinesi programı.
Çöz:77)uses crt;
var
a,b,i:integer;
c:real;
devam,sec:char;
begin
clrscr;
i:=1;
while i<10 do begin
i:=i+1;
writeln('+');
writeln('-');
writeln('*');
writeln('/');
sec:=readkey;
if(sec='+')then begin
writeln('1.sayıyı gir');readln(a);
writeln('2.sayıyı gir');readln(b);
c:=a+b;
writeln(c);end;
if(sec='-')then begin
writeln('1.sayıyı gir');readln(a);
writeln('2.sayıyı gir');readln(b);
c:=a-b;
writeln(c);end;
if(sec='*')then begin
writeln('1.sayıyı gir');readln(a);
writeln('2.sayıyı gir');readln(b);
c:=a*b;
writeln(c);end;
if(sec='/')then begin
writeln('1.sayıyı gir');readln(a);
writeln('2.sayıyı gir');readln(b);
c:=a/b;
writeln(c:1:1);end;
writeln('devam etmek ister misiniz?');
devam:=readkey;
if(devam='H')or(devam='h')then halt; end;
readln;
end.

78) Ad soyad, numara, bölüm girişi yapılarak sınav kağını dolduran program.
uses crt;
var
numa,turdogru,turyanlis,turbos, matdogru,matyanlis,
matbos,j:integer; fendogru,fenyanlis,fenbos,sosdogru,sosyanlis,
sosbos:integer; ad,soyad,bolum:string; turnet,turpuan,matnet,matpuan,fennet,fenpuan,sosnet,sospuan,topnet,toppuan:real; topdogru,topyanlis,topbos:integer;
begin
clrscr;
writeln('adınızı girin');readln(ad);
writeln('soyadını gir'); readln(soyad);
writeln('numaranı gir');readln(numa);
writeln('bölümünü gir');readln(bolum); if(bolum='sayısal')or(bolum='SAYISAL')then begin
turdogru:=30;
while ((turdogru+turyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin');
writeln('türkçe doğru sayısını gir');readln(turdogru); writeln('türkçe yanlış sayısını gir');readln(turyanlis); turbos:=25-(turdogru+turyanlis);
turnet:=turdogru-(turyanlis*0.25);
turpuan:=turdogru*0.02; end;
sosdogru:=30;
while ((sosdogru+sosyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin');
writeln('sosyal doğru sayısını gir');readln(sosdogru); writeln('sosyal yanlış sayısını gir');readln(sosyanlis); sosbos:=25-(sosdogru+sosyanlis);
sosnet:=sosdogru-(sosyanlis*0.25);
sospuan:=sosdogru*0.02; end;
matdogru:=30;
while ((matdogru+matyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('matematik doğru sayısını gir');readln(matdogru); writeln('matematik yanlış sayısını gir');
readln(matyanlis);
matbos:=25-(matdogru+matyanlis);
matnet:=matdogru-(matyanlis*0.25);
matpuan:=matpuan*0.08; end;
fendogru:=30;
while ((fendogru+fenyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin');
writeln('fen doğru sayısını gir');readln(fendogru); writeln('fen yanlış sayısını gir');readln(fenyanlis); fenbos:=25-(fendogru+fenyanlis);
fennet:=fendogru-(fenyanlis*0.25); fenpuan:=fenpuan*0.08;end;end; if(bolum='sözel')or(bolum='SÖZEL')then begin
turdogru:=30;
while ((turdogru+turyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('türkçe doğru sayısını gir');readln(turdogru);
writeln('türkçe yanlış sayısını gir');readln(turyanlis); turbos:=25-(turdogru+turyanlis);
turnet:=turdogru-(turyanlis*0.25);
turpuan:=turdogru*0.08;
end;
sosdogru:=30;
while ((sosdogru+sosyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('sosyal doğru sayısını gir');readln(sosdogru); writeln('sosyal yanlış sayısını gir');readln(sosyanlis); sosbos:=25-(sosdogru+sosyanlis);
sosnet:=sosdogru-(sosyanlis*0.25);
sospuan:=sosdogru*0.08; end;
matdogru:=30;
while ((matdogru+matyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('matematik doğru sayısını gir');
readln(matdogru);
writeln('matematik yanlış sayısını gir');
readln(matyanlis);
matbos:=25-(matdogru+matyanlis);
matnet:=matdogru-(matyanlis*0.25);
matpuan:=matpuan*0.02;
end;
fendogru:=30;
while ((fendogru+fenyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin');
writeln('fen doğru sayısını gir');readln(fendogru); writeln('fen yanlış sayısını gir');readln(fenyanlis); fenbos:=25-(fendogru+fenyanlis);
fennet:=fendogru-(fenyanlis*0.25);
fenpuan:=fenpuan*0.02; end;end; if(bolum='eşitağırlık')or(bolum='EŞİTAĞIRLIK')then
begin
turdogru:=30;
while ((turdogru+turyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('türkçe doğru sayısını gir');readln(turdogru); writeln('türkçe yanlış sayısını gir');readln(turyanlis); turbos:=25-(turdogru+turyanlis);
turnet:=turdogru-(turyanlis*0.25); turpuan:=turdogru*0.08; end;
sosdogru:=30;
while ((sosdogru+sosyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('sosyal doğru sayısını gir');readln(sosdogru); writeln('sosyal yanlış sayısını gir');readln(sosyanlis); sosbos:=25-(sosdogru+sosyanlis);
sosnet:=sosdogru-(sosyanlis*0.25); sospuan:=sosdogru*0.02; end;
matdogru:=30;
while ((matdogru+matyanlis)>25) do begin
writeln('lütfen soru sayısı 25 i geçmesin'); writeln('matematik doğru sayısını gir');
readln(matdogru);
writeln('matematik yanlış sayısını gir');
readln(matyanlis);
matbos:=25-(matdogru+matyanlis);
matnet:=matdogru-(matyanlis*0.25);
matpuan:=matpuan*0.08; end;
fendogru:=30;
while ((fendogru+fenyanlis)>25) do   
begin
writeln('lütfen soru sayısı 25 i geçmesin'); 
writeln('fen doğru sayısını gir');readln(fendogru); writeln('fen yanlış sayısını gir');readln(fenyanlis); fenbos:=25-(fendogru+fenyanlis);
fennet:=fendogru-(fenyanlis*0.25);
fenpuan:=fenpuan*0.02;
end;end;
topdogru:=turdogru+matdogru+sosdogru+fendogru; topyanlis:=turyanlis+matyanlis+sosyanlis+fenyanlis; topbos:=turbos+matbos+sosbos+fenbos; topnet:=turnet+matnet+sosnet+fennet; toppuan:=turpuan+matpuan+sospuan+fenpuan;
clrscr;
write(chr(201));
for j:=2 to 78 do begin
write(chr(205));end;
writeln(chr(187));
for j:=2 to 23 do
writeln(chr(186)); begin write(chr(200));
for j:=1 to 77 do
write(chr(205));
write(chr(188));
for j:=2 to 23 do begin
gotoxy(79,j);
write(chr(186));end;
gotoxy(1,4); write(chr(204));
for j:=2 to 78 do begin
write(chr(205)); end;
gotoxy(79,4); write(chr(185));
gotoxy(20,2);
writeln('Bizim Sınav Sonuç Belgesi');
end;
gotoxy(1,4);write(chr(204));
for j:=2 to 78 do begin
write(chr(205)); end;
gotoxy(79,6); write(chr(185));
gotoxy(5,5);
writeln('Ad Soyad no:',ad,'  ',soyad,'  ',numa); gotoxy(1,8);write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(79,8);write(chr(185));
gotoxy(5,7);writeln('bölüm:','  ',bolum);
gotoxy(1,6);write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(79,10);write(chr(185));
gotoxy(5,9);writeln('dersler:');
gotoxy(1,10);write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(79,12);write(chr(185));
gotoxy(5,11);writeln('türkçe:');
gotoxy(19,11);write(turdogru);
gotoxy(25,11);write(turyanlis);
gotoxy(29,11); write(turbos);
gotoxy(34,11); write(turnet:3:1);
gotoxy(50,11); write(turpuan:3:1);
gotoxy(1,12); write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(79,14); write(chr(185));
gotoxy(5,13); writeln('matamatik');
gotoxy(19,13); write(matdogru);
gotoxy(25,13); write(matyanlis);
gotoxy(29,13); write(matbos);
gotoxy(34,13); write(matnet:3:1);
gotoxy(50,13); write(matpuan:3:1);
gotoxy(1,14); write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(15,8); write(chr(203));
for j:=9 to 23 do begin
gotoxy(15,j); write(chr(186));
end;
gotoxy(15,24); write(chr(202));
gotoxy(15,10); write(chr(206));
gotoxy(15,12); write(chr(206));
gotoxy(15,14); write(chr(206));
gotoxy(5,15);  writeln('sosyal');
gotoxy(19,15); write(sosdogru);
gotoxy(25,15); write(sosyanlis);
gotoxy(29,15); write(sosbos);
gotoxy(34,15); write(sosnet:3:1);
gotoxy(50,15); write(sospuan:3:1);
gotoxy(1,16); write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(15,16); write(chr(206));
gotoxy(79,16); write(chr(185));
gotoxy(5,17); writeln('Fen');
gotoxy(19,17); write(fendogru);
gotoxy(25,17); write(fenyanlis);
gotoxy(29,17); write(fenbos);
gotoxy(34,17); write(fennet:3:1);
gotoxy(50,17); write(fenpuan:3:1);
gotoxy(1,18); write(chr(204));
for j:=2 to 78 do begin
write(chr(205)); end;
gotoxy(15,18); write(chr(206));
gotoxy(79,18); write(chr(185));
gotoxy(5,19); writeln('Toplam');
gotoxy(16,19); write('Doğru');
gotoxy(22,19); write('Yanlış');
gotoxy(29,19); write('Boş');
gotoxy(34,19); write('Net');
gotoxy(41,19); write('Puan');
gotoxy(19,21); write(topdogru);
gotoxy(25,21); write(topyanlis);
gotoxy(29,21); write(topbos);
gotoxy(34,21); write(topnet:3:1);
gotoxy(50,21); write(toppuan:3:1);
gotoxy(1,20); write(chr(204));
for j:=2 to 78 do begin
write(chr(205));end;
gotoxy(15,20); write(chr(206));
gotoxy(79,20); write(chr(185));
gotoxy(21,8); write(chr(203));
for j:=9 to 23 do begin
gotoxy(21,j); write(chr(186)); end;
gotoxy(16,9); writeln('Doğru');
gotoxy(21,24); write(chr(202));
gotoxy(21,10); write(chr(206));
gotoxy(21,12); write(chr(206));
gotoxy(21,14); write(chr(206));
gotoxy(21,16); write(chr(206));
gotoxy(21,18); write(chr(206));
gotoxy(21,20); write(chr(206));
gotoxy(28,8); write(chr(203));
for j:=9 to 23 do begin
gotoxy(28,j); write(chr(186)); end;
gotoxy(22,9); writeln('Yanlış');
gotoxy(28,24); write(chr(202));
gotoxy(28,10); write(chr(206));
gotoxy(28,12); write(chr(206));
gotoxy(28,14); write(chr(206));
gotoxy(28,16); write(chr(206));
gotoxy(28,18); write(chr(206));
gotoxy(28,20); write(chr(206));
gotoxy(33,8); write(chr(203));
for j:=9 to 23 do begin
gotoxy(33,j); write(chr(186)); end;
gotoxy(29,9); writeln('Boş');
gotoxy(33,24); write(chr(202));
gotoxy(33,10); write(chr(206));
gotoxy(33,12); write(chr(206));
gotoxy(33,14); write(chr(206));
gotoxy(33,16); write(chr(206));
gotoxy(33,18); write(chr(206));
gotoxy(33,20); write(chr(206));
gotoxy(39,8); write(chr(203));
for j:=9 to 23 do begin
gotoxy(39,j); write(chr(186)); end;
gotoxy(34,9); writeln('Net');
gotoxy(39,24); write(chr(202));
gotoxy(39,10); write(chr(206));
gotoxy(39,12); write(chr(206));
gotoxy(39,14); write(chr(206));
gotoxy(39,16); write(chr(206));
gotoxy(39,18); write(chr(206));
gotoxy(39,20); write(chr(206));
gotoxy(41,9); writeln('Puan');
readln;
end.
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.
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.
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.
            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.
            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.
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.





85)Procedure ile kullanılan klavyeden girilen koordinatlara göre şekli çizen pogram.
uses crt;
var
a,b,c,d,i:integer;
procedure sekil;
begin
clrscr;
for i:=a to c do
begin
gotoxy(i,b);write('*'); gotoxy(i,d);write('*');
end;
for i:=b to d do
begin
gotoxy(a,i);write('*');
gotoxy(c,i);write('*');
end;
end;
begin
clrscr;
writeln('a sütun koordinatını gir');readln(a);
writeln('b satir koordinatını gir');readln(b);
writeln('c sütun koordinatını gir');readln(c);
writeln('d satır koordinatını gir');readln(d);
sekil;
readln;
end.
86)Ekranda yıldızlı çerçeve yapan program.
uses crt;
   var
   i:integer;
   begin
   clrscr;
   for i:=1 to 79 do
   begin
   gotoxy(i,1);write(‘*’);
   gotoxy(i,24);write(‘*’);
   end;
   for i:=1 to 24 do
   begin
   gotoxy(1,i);write(‘*’);
   gotoxy(79,i);write(‘*’);
   end;
   readln;
   end.

87)Ekranın kenarlarında yıldızdan çerçeve bulunan ve klavyeden girilen sayının tek mi, çift mi, asal mı olduğunu bulan program.
uses crt;
   var
   i,sayi,a,b:integer;
   tus:char;
   begin
   clrscr;
   for i:=1 to 79 do begin
   gotoxy(i,1);write(‘*’);
   gotoxy(i,24);write(‘*’);
   end;
   for i:=1 to 24 do
   begin
   gotoxy(1,i);write(‘*’);
   gotoxy(79,i);write(‘*’);
   end;
   gotoxy(2,2);write(‘sayı    tek    çift    asal’);
   gotoxy(2,3);write(‘*****************’);
   tus:=’e’;
   i:=3;
   while tus=’e’ do begin
   i:=i+1;
   gotoxy(‘2,i);readl(sayi);
   if ((sayi mod 2)=0) then begin
   gotoxy(18,i);write(‘x’);end
   else begin
   gotoxy(10,i);write(‘x’);end;
   for b:=2 to sayi-1 do begin
   if ((sayi mod b)=0) then break
   else if (b=sayi-1) then begin
   gotoxy(25,i);write(‘x’);end;end;
   gotoxy(30,i)write(‘devam etmek istiyor musunuz e/h’);
   tus:=readkey;
   if (tus=’h’) or (tus=’H’) then halt;
   end;
   readln;
   end.

88) n! işlemini hesaplayan programa girmek için kalvyeden şifre girilecektir. Şifre doğru girilene kadar şifre girmesi istenecek. Şifre her 3 kez yanlış girilince programdan çıkmak istiyor musunuz: ‘E’,’e’ şeklinde uyarı verecektir. Kullanıcı ‘e’ yada ‘E’ harfine bastığında programdan çıkacak aksi halde şifreyi girmeye devam eden program.
uses crt;
var
fak,n,a,i,sifre:integer;
devam:char;
begin
clrscr;
fak:=1;
a:=1;
devam:='e';
while (devam='e') do begin
writeln('3 rakamlı şifreyi giriniz:');readln(sifre); if(sifre=123)then begin
writeln('doğru şifre');break;end
else
writeln('şifreniz yanlış lütfen doğru şifreyi giriniz:'); a:=a+1;
if(a>3)then begin
writeln('devam etmek ister misiniz:');
devam:=readkey;
if(devam='h')or(devam='H')then halt;end;end;
writeln('n değerini gir:');readln(n);
for i:=2 to n do
fak:=fak*i;
writeln(fak);
readln;
end.

89)Aşağıdaki gibi 1 ile 99 arasında rastgele sayı bulan programı yazınız. Alt alta kaç satır sayı bulunacağını kullanıcı tarafından girilecektir. Sütunlar arasında 5 er karakterlik boşluk olan program.
 uses crt;
var
sutun,satir,a,i,x:integer;
begin
randomize;
clrscr;
writeln('sütun sayısını gir:');readln(sutun);
writeln('satır sayısını gir:');readln(satir);
clrscr;
for i:=1 to satir do begin
for x:=1 to sutun do begin
gotoxy(5*i,3*x);
a:=random(99);
writeln(a);
end;
end;
readln;
end.

90)Kullanıcın girdiği para birimini Banknotuna çeviren program.
Çöz:90)uses crt;
      var
      a,b,c,d,e,f,g,h,m,para:integer;
      begin clrscr;
writeln('Lütfen bir para birimi giriniz');readln(para); clrscr;
      a:=para div 100;
      b:=para mod 100;
      c:=b div 50;
      e:=b mod 50;
      d:=e div 10;
      f:=e mod 10;
      g:=f div 5;
      h:=f mod 5;
      m:=h div 1;
      writeln(para ,'  YTL',' *** Bu Paranın Banknotu ***!!!');
      writeln(100,' YTL','=',a,' tane var ');
      writeln(50,' YTL','=',c,' tane var ');
   writeln(10,' YTL','=',d,' tane var ');
   writeln(5,' YTL','=',g,' tane var ');
   writeln(1,' YTL','=',m,' tane var ');
   readln;
      end.

91)Kar gibi yağan program.
uses crt;
var
i,x,y:integer;
begin
clrscr;
randomize;
textbackground(0);
for i:=1 to 100 do begin
insline;
x:=random(78);
y:=random(24);
gotoxy(x,y);
textcolor(15);
write('*');
delay(25);
end;
readln;
end.

92)Klavyeden girilen kullanıcı adı ve şifresi doğru oluncaya kadar şifre isteyen program.
uses crt;
var
a,b,sifre:integer;
ad:string;
begin
clrscr;
repeat
gotoxy(25,10);
write('Kullanıcı_adını_girin:');readln(ad);
gotoxy(25,11);
delay(1000);
writeln('!!!Yanlış kullanıcı!!!');
gotoxy(47,10);
until ad='sonnur';
gotoxy(25,11);
delline;
repeat
gotoxy(25,11);
write('sifre:');readln(sifre);
gotoxy(25,12);
delay(1000);
writeln('!!!Yanlış Sifre!!!');
gotoxy(31,11);
until sifre=123;
gotoxy(25,12);
delline;
if(sifre=123)then
gotoxy(27,14);
write('hoşgeldin');
readln;
end.

93)Onaltılık Sayı sistemini onluğa çeviren program.
uses crt;
var
sayi,b:string;
x,i:integer;
sayii:real;
begin
writeln('sayıyı gir');readln(sayi);
x:=length(sayi);
for i:=0 to x-1 do begin
b:=copy(sayi,x-i,1);
write(b,'=');
if (b='0')then
sayii:=0;
if (b='1') then sayii:=1*exp(i*Ln(16));
if (b='2') then say