Pascal örnek arşivi

tarantula90115.11.2008 - 21:28
Birçok Örnek Mevcuttur İstediğiniz örneği ctrl+f tuşu ile aratıp bulabilirsiniz
1)Klavyeden girilen iki sayının toplamını bulan program
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.
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.
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.
   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.
   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.
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.
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.
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.
   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.
   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.
   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.
   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.
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
   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.
   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

   

   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.
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.
   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.
   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.
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.
   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.
   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.
   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.
   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.
   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.
   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.
   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.
   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.
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.
   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.
   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.
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.
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.
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.
   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.
   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.
   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.
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.
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!
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)!
   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.
   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.
   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.
 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.
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.
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ı
   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.
   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ı
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.
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.
   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.
         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.
      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.
      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.
      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.
      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.
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.
            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.
            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.
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.
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.
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.
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.
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.
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.
      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.
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.

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.

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.
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.
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.
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.
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.
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.
   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ı.
   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ı.

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.


 



Linkback: https://www.buyuknet.com/pascal-ornek-arsivi-t8206.0.html

tarantula90115.11.2008 - 21:39
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

tarantula90115.11.2008 - 21:42
Aradığınız programı ctrl + f tuşu ile aratıp bulabilirsiniz

Ascii Karakter Tablosu

uses crt;
var
a:integer;
i:byte;
begin clrscr;
for i:=1 to 255 do begin
a:=(i div 24);
if (i>=24*a) then begin
gotoxy(a*5,i-24*a);
write(chr(i));
end else


writeln(chr(i));
end;
readln;
end.

Fakröriyel

uses crt;
var
faki,fakk,fakj,i,j,k,l,sonuc:longint;
begin
for i:=1 to 9 do
for j:=0 to 9 do
for k:=0 to 9 do
 begin
faki:=1;
for l:=1 to i do
faki:=faki*l;
fakj:=1;
if j<>0 then
for l:=1 to j do
fakj:=fakj*l;
fakk:=1;
if k<>0 then
for l:=1 to k do






fakk:=fakk*l;
sonuc:=faki+fakj+fakk;
if sonuc=(i*100+j*10+k) then
writeln(sonuc);
end;
readln;
end.

Faktöriyel2

uses crt;
var
i,a,b,c,d,j,faka,fakb,fakc,sonuc:longint;
begin clrscr;
for i:=100 to 999 do
 begin
 a:=i div 100;
 d:=i mod 100;
 b:=d div 10;
 c:=d mod 10;
 faka:=1;
 for j:=1 to a do
 faka:=faka*j;
 fakb:=1;
 if b<>0 then
 for j:=1 to b do
 fakb:=fakb*j;
 fakc:=1;
 if c<>0 then
 for j:=1 to c do
 fakc:=fakc*j;
 sonuc:=faka+fakb+fakc;
 writeln(sonuc);
 end;
 readln;
 end.

LENGTH

Girilen bir kelimeyi alfabetik sıraya göre yazan program

uses crt;
var
deg,cumle:string[30];
i,j:integer;
begin
clrscr;
write('Cümleyi gir:'); readln(cumle);
for i:=0 to length(cumle)-1 do
for j:=i+1 to length(cumle) do begin
if(cumle>cumle[j]) then begin
deg[1]:=cumle;
cumle:=cumle[j];
cumle[j]:=deg[1];
end;
end;
write(cumle);
readln;
end.

Girilen cümlede kaç tane kelime olduğunu sayan program

uses crt;
var
cumle:string;
i,s:integer;
begin
clrscr;
write('Cümleyi girin - >');readln(cumle);
writeln;
s:=0;
for i:=1 to length(cumle) do
if cumle in [#32,#9,',',',',';']
then s:=s+1;
writeln('Cümlede ',s+1,' tane kelime war');
readln;
end.



TYPE

Type bloğunda dizi kullanarak girilen ad-soyad bilgilerini listeleme

uses crt;
type
isimkay=record
 isim:string;
 soyad:string;
 end;
 var
 i:integer;
  ogr:array[1..3] of isimkay;
 begin
 clrscr;
 for i:=1 to 2 do begin
 write(i,'. Öğrencinin adını giriniz:'); readln(ogr.isim);
 write(i,'. Öğrencinin soyadını giriniz:'); readln(ogr.soyad);
 end;
 for i:=1 to 2 do begin
 writeln;
 write(i,'.inci öğrencinin adı - soyadı ==>',ogr.isim,' ');
 write(ogr.soyad);
 end;
 readln;
 end.

WHİLE

“While” ile resim çizme

uses crt;
var
a,b:integer;
tus:char;
begin clrscr;
a:=35; b:=12;
tus:='a';
while tus in ['w','a','s','d'] do begin
tus:=readkey;
case (tus) of
'w':b:=b-1;
'a':a:=a-1;
'd':a:=a+1;
's':b:=b+1;
end;
gotoxy(a,b);
write('*');
end;
 end.


DİZİ (ARRAY)

Girilen 4 sayıdan büyük olanı ve küçük olanı bulan program

Uses Crt;
Var
i,buyuk,kucuk:integer;
sayi:array[0..15] of integer;
Begin clrscr;
for i:=0 to 3 do
 Begin
 write(i+1,'. Sayıyı giriniz:'); readln(sayi);
 end;
 buyuk:=sayi[0]; kucuk:=sayi[0];
for i:=1 to 3 do
 Begin
 if buyuk<sayi then
  buyuk:=sayi;
 if kucuk>sayi then
  kucuk:=sayi;
  end;
writeln('Büyük sayı ==>',buyuk);
writeln('Küçük sayı ==>',kucuk);
readln;
end.

Random olarak 10 farklı sayıyı dizi ye atamak

uses crt;
var
sayi:array[1..10] of integer;
i:integer;
begin
randomize;
clrscr;
for i:=1 to 10 do begin
sayi:=random(100);
write(sayi:5);
end;
readln;
end.

Girilen 10 ismi 10. kayıttan 1. kayda doru sıralama

uses crt;
var
i:integer;
ilk:array[1..10] of string;
son:array[1..10] of string;
begin
clrscr;
for i:=1 to 10 do
 begin
 textcolor(white);
  Write(i,'.','İsmi giriniz:');readln(ilk);
  son[10+1-i]:=ilk;
 end;
clrscr;
textcolor(green);
Writeln('*****Normal_Dizi*****');
for i:=1 to 10 do
 begin
  Writeln(i,':',ilk);
 end;
 textcolor(red);
Writeln('*****Ters_Dizi*****');
for i:=1 to 10 do
 begin
  Writeln(i,':',son);
 end;
readln;
end.

Öğrencinin ad, soyad, no, 1. 2. 3. yazılı ve temrin notları girilerek; ortalaması, sınıf not ortalaması, en yüksek ve en düşük ortalaması ve geçen öğrenci sayısını belirleyen program.
uses crt;
type
ogrenci=record
isim:string[20];
soyad:string[20];
numara:string[4];
sinav1:byte;
sinav2:byte;
sinav3:byte;
temrin:byte;
ort:byte;
durum:string;
end;
var
b,tort,i,toplam,enyuk,endus,sayac:integer;
ogr:array[1..3] of ogrenci;
begin
clrscr;
for i:=1 to 3 do
begin
clrscr;
write('Adını giriniz:');readln(ogr.isim);
write('Soyadını giriniz:');readln(ogr.soyad);
write('Numarasını giriniz:');readln(ogr.numara);
write('1. Sınav notunu giriniz:');readln(ogr.sinav1);
write('2. Sınav notunu giriniz:');readln(ogr.sinav2);
write('3. Sınav notunu giriniz:');readln(ogr.sinav3);
write('Temrin notunu giriniz:');readln(ogr.temrin);
end; clrscr;
for i:=1 to 3 do
begin
toplam:=ogr.sinav1+ogr.sinav2+ogr.sinav3+ogr.temrin;
ogr.ort:=toplam div 4;
end;
for i:=1 to 3 do
begin
if ogr.ort<45 then
ogr.durum:='kaldı'
else if ogr.ort>45 then begin
sayac:=sayac+1;
ogr.durum:='geçti';
end;
end;
writeln('NUMARA     ADI     SOYADI     1.SINAV 2.SINAV 3.SINAV TEMRİN ORTALAMA  SONUÇ');
write('****************************************************************************');
for i:=1 to 3 do begin
gotoxy(11,i+2);
writeln(ogr.isim);
gotoxy(20,i+2);
writeln(ogr.soyad);
gotoxy(3,i+2);
writeln(ogr.numara);
gotoxy(33,i+2);
writeln(ogr.sinav1);
gotoxy(43,i+2);
writeln(ogr.sinav2);
gotoxy(51,i+2);
writeln(ogr.sinav3);
gotoxy(58,i+2);
writeln(ogr.temrin);
gotoxy(65,i+2);
writeln(ogr.ort);
gotoxy(72,i+2);
writeln(ogr.durum);
end;
writeln;
enyuk:=1;
endus:=1;
for i:=1 to 16 do
begin
if ogr.ort>enyuk then begin
enyuk:=ogr.ort;
end;
if ogr.ort<endus then begin
endus:=ogr.ort;
end;
b:=b+ogr.ort;
end;
tort:=b div 16;
writeln('Sınıf not ortalaması:',tort);
writeln('En yüksek ortalama:',enyuk);
writeln('En düşük ortalama:',endus);
writeln('Geçen öğrenci sayısı:',sayac);
readln;
end.

Rastgele 10 sayıyı büyükten küçüğe doğru sıralayan program

uses crt;
var
sayilar:array[1..10] of integer;
degisken,i,j:integer;
begin clrscr;
randomize;
for i:=1 to 10 do
sayilar:=random(100);
for i:=1 to 9 do
for j:=i+1 to 10 do
 begin
if sayilar<sayilar[j] then begin
degisken:=sayilar;
sayilar:=sayilar[j];
sayilar[j]:=degisken;
end;
end;
for i:=1 to 10 do
write('  >   ',sayilar);
gotoxy(25,3);
writeln('Büyükten küçüğe doğru sayılar');
readln;
end.

Sayısal loto programı

uses crt;
var
loto:array[1..8,1..6] of integer;
i,j:byte;
begin clrscr;
randomize;
for i:=1 to 8 do begin
for j:=1 to 6 do begin
loto[i,j]:=random(48);
write(loto[i,j]:5);
end;
writeln('');
end;
readln;
end.

Makine adı ve fiyatı giriliyo sonra bunları büyükten küçüğe doğru sıralıyo.

uses crt;
type
makine=record
madi:string;
fyt:byte;
end;
var
i,j:integer;
kayit:array[1..20] of makine;
deg:array[1..20] of makine;
begin clrscr;
for i:=1 to 3 do
begin
 write('Makina adını giriniz:');readln(kayit.madi);
 write('Fiyatı gir:');readln(kayit.fyt);
end;
for i:=1 to 15 do
for j:=i+1 to 16 do
if kayit.fyt<kayit[j].fyt then
begin
deg:=kayit;
kayit:=kayit[j];
kayit[j]:=deg;
end;
for i:=1 to 3 do begin
writeln('Makinanın adı ==>',kayit.madi);
writeln('Fiyatı ==>',kayit.fyt);
end;
readln;
end.











Şehir adı ve nüfusu girildikten sonra bunlardan en büyük ve en küçük nüfuslu olan şehirleri ekrana yazdıran program.

uses crt;
var
buyuk,kucuk:string;
enaz,enfazla:integer;
i:integer;
nufus:array[0..9] of integer;
sehir:array[0..9] of string;
begin
clrscr;
for i:=0 to 4 do
 begin
 write('Şehir adını giriniz:'); readln(sehir);
 write(sehir,'nin nüfusunu giriniz:'); readln(nufus);
  end;
   buyuk:=sehir[0]; kucuk:=sehir[0];
   enaz:=nufus[0]; enfazla:=nufus[0];

   for i:=1 to 4 do
   begin

 if (enfazla<nufus) then
  begin
  buyuk:=sehir;
  enfazla:=nufus;
  end;
 if (enaz>nufus) then
  begin
  kucuk:=sehir;
  enaz:=nufus;
  end;
  end;
writeln('En fazla ',buyuk,' nüfuslu il ',enfazla);
writeln('En az ',kucuk,' nüfuslu il ',enaz);

readln;
end.




Rasgele tutulan sayılar ve bunların; ortalaması, ortalamadan büyük sayılar ve ortalamadan küçük sayıları ekrana yazdıran program.

uses crt;
var
sayilar:array[1..10] of integer;
a,buyuk,kucuk,i:integer;
ort:real;
begin clrscr;
randomize;
a:=0;
writeln('Ratgele tutulan sayılar');
for i:=1 to 10 do begin
sayilar:=random(100);
write(' ',sayilar);
a:=a+sayilar;
end;
writeln;
ort:=a div 10;
writeln('Sayıların ortalaması:',ort:0:0);
buyuk:=sayilar[1];
kucuk:=sayilar[1];
for i:=2 to 10 do begin
if sayilar>buyuk then
buyuk:=sayilar;
if sayilar<kucuk then
kucuk:=sayilar;
end;
writeln('Ortalamadan büyük sayılar');
for i:=1 to 10 do begin
if sayilar>ort then
writeln(' ',sayilar);
end;
writeln('Ortalamadan küçük sayılar');
for i:=1 to 10 do begin
if sayilar<ort then
writeln(' ',sayilar);
end;
readln;
end.

Öğrencinin adı soyadı, vize ve final notları girilen öğrencinin ortalamasını ve sınıf ortalamasını hesaplayan program

uses crt;
type
isimkay=record
isim:string[15];
soyad:string[15];
vize,final:byte;
end;
var
i:integeR;
ortalama:real;
org:array[1..10] of isimkay;
begin     clrscr;
for i:=1 to 10 do
begin
write(i,' inci öğrencinin adını ve soyadını giriniz:');readln(org.isim);
write(i,' inci öğrencinin vize notunu giriniz:');readln(org.vize);
write(i,' inci öğrencinin final notunu giriniz:');readln(org.final);
ortalama:=(org.vize* 0.4 + org.final*0.6);
if ortalama<60 then begin
writeln('kaldı');
writeln(org.isim,' ortalaması ',ortalama:0:2);
end
else if ortalama>60 then begin
writeln('geçti');
writeln(org.isim,' ortalaması ',ortalama:0:2);
end;
end;
readln;
end.







ÇİFT BOYUTLU DİZİLER (MATRİS)

Matris1

uses crt;
var
sayi1:array[1..5,1..6] of integer;
sayi2:array[1..5,1..6] of integer;
toplam:array[1..5,1..6] of integer;
i,j:byte;
begin clrscr;
randomize;
for i:=1 to 5 do begin
for j:=1 to 6 do begin
sayi1[i,j]:=random(100);
sayi2[i,j]:=random(100);
toplam[i,j]:=sayi1[i,j]+sayi2[i,j];
write(toplam[i,j]:5);
end;
writeln('');
end;
readln;
end.

Matris2

uses crt;
var
sayi:array[1..3,1..3] of integer;
sayi1:array[1..3,1..3] of integer;
carpim:array[1..3,1..3] of integer;
sonuc:integer;
a,i,j,k:byte;
begin randomize; clrscr;
writeln('');
for i:=1 to 3 do begin
for j:=1 to 3 do begin
sayi[i,j]:=random(10);
write(sayi[i,j]:6);end;write('');end;
writeln('');
for i:=1 to 3 do begin
for j:=1 to 3 do begin
sayi1[i,j]:=random(10);
write(sayi1[i,j]:6); end;
writeln(''); end;
writeln('');
for i:=1 to 3 do begin
for j:=1 to 3 do begin
for k:=1 to 3 do begin
carpim[j,i]:=sayi[j,k]*sayi1[k,i]+carpim[j,i];
end;
write(carpim[j,i]:6);
end;
writeln('');
end;
readln;
end.

Küçükten büyüğe doğru loto programı


uses crt;
var
loto:array[1..8,1..6] of integer;
k,l,i,j,m:byte;
degisken:integer;
begin clrscr;
randomize;
for i:=1 to 8 do begin
for j:=1 to 6 do
loto[i,j]:=random(48);
for k:=1 to  5 do
for l:=k+1 to 6 do
if loto[i,k]>loto[i,l] then begin
degisken:=loto[i,k];
loto[i,k]:=loto[i,l];
loto[i,l]:=degisken;
end;
for m:=1 to 6 do
write('  <',loto[i,m]:10);
writeln('');
end;
readln;
end.




Transpoz
uses crt;
var
sayi:array[1..3,1..3] of integer;
i,j:byte;
begin clrscr; randomize;
writeln('');
for i:=1 to 3 do begin
for j:=1 to 3 do begin
sayi[i,j]:=random(100);
write(sayi[i,j]:6);
writeln(''); end;
writeln(''); end;
for i:=1 to 3 do begin
for j:=1 to 3 do begin
write(sayi[j,i]:6); end;
writeln(''); end;
readln;
end.
PROCEDURE

Faktöriyel
uses crt;
var
sonuc,i:integer;
fakr,fakn,faknr,n,r:integer;
procedure kombi(sayi1,sayi2:integer);
begin
fakr:=1; fakn:=1; faknr:=1;
for i:=1 to sayi1 do
begin
fakn:=fakn*i;
if (i<=(sayi1-sayi2)) then faknr:=faknr*i;
if (i<=sayi2) then fakr:=fakr*i; sonuc:=fakn div faknr*fakr;end;
end;
begin clrscr;
write('1. Sayı gir:'); readln(n);
write('2. Sayı gir:'); readln(r);
kombi(n,r);
writeln('Faktöriyel =>',sonuc);
readln;
end.

Kombinasyon

    uses crt;
    var
    n,r,nr,i,j,sonuc:integer;
    procedure kombinasyon(a,b:integer);
    begin
    n:=1;
    r:=1;
    nr:=1;

    for i:=1 to a do
    begin
    n:=n*i;
    if (i<=(a-b)) then nr:=nr*i;
    if (i<=b) then r:=r*i;
    sonuc:=(n div (nr*r));
    end;
    end;
    begin
    clrscr;
    for i:=0 to 5 do begin
    for j:=0 to i do
    begin
    kombinasyon(i,j);
    write(sonuc:5);
    end;
    writeln(' ');
    end;
    readln;
    end.

1. dik kenar ve 2. dik kenarı girilen bir üçgenin hipotenüsünü bulan program.

uses crt;
var
x,y:integer;
z:real;
function pisagor(a,b:integer):real;
begin
pisagor:=sqrt(a*a+b*b);
end;
begin     clrscr;
write('Birinci dik kenar = ');readln(x);
write('İkinci dik kenar = ');readln(y);
z:=pisagor(x,y);
write('Hipotenüs = ',z:0:2);
readln;
end.

Procedure ile yapılmış menü ile seçime göre 4 işlem yapan program.

uses crt;
var
a,b,toplam,sec:integer;
procedure topla(sayi1,sayi2:integer); begin
toplam:=sayi1+sayi2; end;
procedure cikarma(sayi1,sayi2:integer); begin
toplam:=sayi1-sayi2; end;
procedure carpma(sayi1,sayi2:integer); begin
toplam:=sayi1*sayi2; end;
procedure bolme(sayi1,sayi2:integer); begin
toplam:=sayi1 div sayi2;
end;
begin
writeln('MENÜ');
writeln('Toplama işlemi için 1 e basınız');
writeln('Çıkarma işlemi için 2 e basınız');
writeln('Çarpma işlemi için 3 e basınız');
writeln('Bölme işlemi için 4 e basınız');
writeln('Seçiminizi yapınız'); readln(sec);

writeln('1. Sayıyı giriniz:'); readln(a);
writeln('2. Sayıyı giriniz:'); readln(b);
topla(a,b);
if (sec=1) then begin writeln(toplam);
writeln('Sonuç toplam:',a+b); end;
if (sec=2) then begin writeln(toplam);
writeln('Sonuç çıkarma:',a-b); end;
if (sec=3) then begin writeln(toplam);
writeln('Sonuç çarpma:',a*b); end;
if (sec=4) then begin writeln(toplam);
writeln('Sonuç bölme:',a/b); end;
readln;
end.
CASE OF

Case of yapısı kullanılarak yapılan bir menü programı isteğimize göre tuşlara görev atayabiliyoruz.

uses crt;
var
tus:char;
begin clrscr;
repeat
 repeat
writeln('****MENÜ****');
writeln('1. Nolu menü:');
writeln('2. Nolu menü:');
writeln('3. Nolu menü:'); tus:=readkey;
 Until tus in ['1','2','3',#27];
 clrscr;
 case (tus) of
 '1':begin writeln('1. Nolu menü'); end;
 '2':begin writeln('2. Nolu menü'); end;
 '3':begin writeln('3. Nolu menü'); end;
 end;
 until (tus=#27);
 readln;
 end.


DOSYALAMA

Menü programı kullanılarak ad, soyad girişleri yapıldıktan sonra bunları listeleme, arama..

uses crt;
var
isim,ad,soy:string;
dosya:text;
tus:char;
procedure kayit;
begin
{$i-} append(dosya); {$i+}
if ioresult<>0 then rewrite(dosya);
repeat
write('Ad gir:');
readln(ad);
write('Soyad gir:');
readln(soy);
writeln(dosya,ad);
writeln(dosya,soy);
writeln('Başka kayıt yapılsınmı:(E,H,ESC)');
repeat
tus:=readkey;
until tus in['H','h','E','e',#27];
until tus in['H','h',#27];
close(dosya);
end;

procedure listeleme;
begin
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin
while not eof(dosya) do begin
write('Ad:'); readln(dosya,ad); write(ad:10);
write('      Soyad:'); readln(dosya,soy); write(soy:10);
writeln;
end;
close(dosya);
end;

end;

procedure arama;
begin
{$i-}reset(dosya);{$i+}

writeln('Aranan isim:'); readln(isim);
while not eof(dosya) do begin
readln(dosya,ad);
readln(dosya,soy);
if isim=ad then begin
write('Adı:',ad:15);
write('    Soyadı:',soy:15);
break;
end;
end;
close(dosya);
end;


begin
clrscr;
assign(dosya,'d:\deneme.txt');
repeat
 repeat
writeln('****MENÜ****');
writeln('1. Kayıt');
writeln('2. Listeleme');
writeln('3. Çıkış');
writeln('4. Arama');
tus:=Readkey;
 Until tus in ['1','2','3','4',#27];
 clrscr;
 case (tus) of
 '1':kayit;
 '2':listeleme;
 '3':halt;
 '4':arama;
  end;
 until (tus=#27);

readln;
end.


Ad, soyad, maaş ve telefon bilgilerini dosyaya yazmak ve listeleyebilme, arama, düzeltme, silme ve çıkış menüleri..

uses crt;
type
kay=record
tele:string[11];
maas:integer;
ad,soy,ara:string;
end;
var
sec:char;
tus:char;
i,x,y:byte;
dosya:file of kay;
 dos:kay;
procedure ciz1;
 begin
 for i:=1 to 77 do begin
 gotoxy(i,1); write(chr(205));
 gotoxy(i,24); write(chr(205));
 end;
 for i:=1 to 24 do begin
 gotoxy(1,i); write(chr(186));
 gotoxy(77,i); writeln(chr(186));
 end;
 gotoxy(1,1); write(chr(201));
 gotoxy(1,24); write(chr(200));
 gotoxy(77,1); write(chr(187));
 gotoxy(77,24); write(chr(188));
  end;


 procedure ciz;
 begin
 for i:=20 to 60 do begin
 gotoxy(i,8); write(chr(205));
 gotoxy(i,20); write(chr(205));
 end;
 for i:=8 to 20 do begin
 gotoxy(20,i); write(chr(186));
 gotoxy(60,i); writeln(chr(186));
 end;
 gotoxy(20,8); write(chr(201));
 gotoxy(20,20); write(chr(200));
 gotoxy(60,8); write(chr(187));
 gotoxy(60,20); write(chr(188));
  end;




procedure bilgi_girisi;
begin
assign(dosya,'d:\deneme.dat' );
{$i-} reset (dosya); {$i+}
if ioresult<>0 then rewrite(dosya);
repeat
seek(dosya,filesize(dosya));
gotoxy(2,2);
write('Adınızı giriniz ==>');readln(dos.ad);
gotoxy(2,3);
write('Soyadınızı giriniz ==>');readln(dos.soy);
gotoxy(2,4);
write('Maasını giriniz ==>');readln(dos.maas);
gotoxy(2,5);
write('Telefon numarasını giriniz ==>');readln(dos.tele);
gotoxy(2,6);
write(dosya,dos);
writeln;
gotoxy(2,6);
writeln('Başka işlem yapılsın mı?:(E,H,ESC)');
repeat
tus:=readkey;
until tus in['H','h','E','e',#27];
until tus in ['H','h',#27];  clrscr;
close(dosya);          ciz;
end;



procedure listele;
var
j:integer;
begin
assign(dosya,'d:\deneme.dat' );
{$i-} reset(dosya); {$i+}
if(ioresult=0) then begin
repeat
{while not eof(dosya) do begin}
gotoxy(1,2);
for j:=0 to filesize(dosya)-1 do
begin
seek(dosya,j);
read(dosya,dos);
gotoxy(2,2+j);
write('  Ad =>');
gotoxy(9,2+j);
write(dos.ad);
gotoxy(17,2+j);
write('  Soyad =>');
gotoxy(28,2+j);
write(dos.soy);
gotoxy(36,2+j);
write('  Maas =>');
gotoxy(46,2+j);
write(dos.maas);
gotoxy(52,2+j);
write('  Telefon =>');
gotoxy(65,2+j);
write(dos.tele);
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;

end;


procedure arama;
var
ara:string;

begin
{$i-} reset(dosya) {$i+};
if(ioresult=0) then begin
repeat
gotoxy(2,2);
write('Aramak istediğiniz adı giriniz:');readln(ara);
{while not eof(dosya) do begin}
for i:=0 to filesize(dosya)-1 do
begin

seek(dosya,i);
read(dosya,dos);
if ara=dos.ad then begin
gotoxy(2,3);
write('   Ad:'); write(dos.ad:5);
write('   Soyad:'); write(dos.soy:5);
write('   Maaşı:'); write(dos.maas:5);
write('   Telefon:'); write(dos.tele:5);
break;
end;
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;
end;


procedure telif;
begin
repeat
gotoxy(25,2);
writeln('KERİM KORKMAZ');
gotoxy(25,3);
writeln('kerim_korkmaz_53@hotmail.com');
gotoxy(25,5);
writeln('H.KEMAL ANADOLU MESLEK LİSESİ     RİZE');
gotoxy(25,7);
writeln('DERS ÖĞRETMENİ ÖZGÜR KUYUCU');
gotoxy(25,8);
writeln('yakmoz@hotmail.com');
for i:=1 to 10 do
begin
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
ciz;
end;

procedure kayit_silme;
var
ara:string;
j:integer;
begin
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin   repeat
if filesize(dosya)>0 then
begin
gotoxy(2,2);
write('Silinecek kişinin adı ==>'); readln(ara);
gotoxy(2,3);
write('Adı ==>'); write(dos.ad);
gotoxy(2,4);
write('Soyadı ==>'); write(dos.soy);
gotoxy(2,5);
write('Maaşı ==>'); write(dos.maas);
gotoxy(2,6);
write('Telefonu ==>'); writeln(dos.tele);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,dos);
j:=1;
if ara=dos.ad then
break;  end;
if ara=dos.ad then begin
for j:=i+1 to filesize(dosya)-1 do
begin
seek(dosya,j); read(dosya,dos);
seek(dosya,j-1);
write(dosya,dos);
end;
seek(dosya,filesize(dosya)-1);
truncate(dosya);
gotoxy(2,7);
writeln('Kayıt silindi');


end;
end else     begin
gotoxy(5,5) ;write('Dosyada kayıt yok');end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;

end;

procedure duzeltme;
var
ara:string;
begin
repeat
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin
gotoxy(2,2);
write('Düzeltilecek ismi gir ==>'); readln(ara);
for i:=0 to filesize(dosya)-1 do begin
seek(dosya,i); read(dosya,dos);
if (ara=dos.ad) then
break;
end;
if (ara=dos.ad) then begin
seek(dosya,i);
gotoxy(2,3);
write('Yeni ismi gir ==>'); readln(dos.ad);
gotoxy(2,4);
write('Yeni soyad gir ==>'); readln(dos.soy);
gotoxy(2,5);
write('Yeni maaşı gir ==>'); readln(dos.maas);
gotoxy(2,6);
write('Yeni telefonu gir ==>'); readln(dos.tele);
gotoxy(2,7);
write(dosya,dos);
end
else begin
gotoxy(24,2);
write('Dosyada kayıt yok');
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
end;
until tus in ['E','e'];
clrscr;
ciz;
end;


begin  clrscr;
assign(dosya,'d:\deneme.dat');
ciz;
x:=30;y:=11;
repeat
repeat
gotoxy(23,9);
textcolor(15);
writeln('<===========M E N Ü============>');
gotoxy(30,11);
writeln('1-Bilgi girişi');
gotoxy(30,12);
writeln('2-Listeleme');
gotoxy(30,13);
writeln('3-Arama');
gotoxy(30,14);
writeln('4-Kayıt Silme');
gotoxy(30,15);
writeln('5-Kayıt Düzeltme');
gotoxy(30,16);
writeln('6-Çıkış');
gotoxy(30,17);
writeln('7-Telif Hakkı');
gotoxy(x,y);
sec:=readkey;
if sec='s' then
y:=y+1;
if y=18 then
y:=11;
if sec='w' then
y:=y-1;
if y=10 then
y:=17;
until sec in['1','2','3','4','5','6','7',#27,#13];
clrscr;
if sec=#13 then  begin ciz1;
if y=11 then bilgi_girisi
else if y=12 then  listele
else if y=13 then  arama
else if y=14 then  kayit_silme
else if y=15 then  duzeltme
else if y=16 then  exit
else if y=17 then  telif;  end;

case sec of
'1': begin ciz1;bilgi_girisi; end;
'2': begin ciz1;listele; end;
'3': begin ciz1;arama; end;
'4': begin ciz1;kayit_silme; end;
'5': begin ciz1;duzeltme; end;
'6': begin exit; end;
'7': begin ciz1;telif end;
end;
until tus=#27;
readln;
end.


Öğrenci takip (öğrenci bilgilerini dosyaya yazma) programı

uses crt;
type
notlar=record
not1:byte;
not2:byte;
ort:byte;
end;
dersnotu=record
mat:notlar;
fizik:notlar;
kimya:notlar;
end;
ogrenci=record
ad:string[15];
soy:string[15];
numara:string[15];
dersler:dersnotu;
end;
var
dosya:file of ogrenci;
sinif:ogrenci;
sec:char;
tus:char;
i,x,y:byte;

procedure ciz1;
 begin
 for i:=1 to 77 do begin
 gotoxy(i,1); write(chr(205));
 gotoxy(i,24); write(chr(205));
 end;
 for i:=1 to 24 do begin
 gotoxy(1,i); write(chr(186));
 gotoxy(77,i); writeln(chr(186));
 end;
 gotoxy(1,1); write(chr(201));
 gotoxy(1,24); write(chr(200));
 gotoxy(77,1); write(chr(187));
 gotoxy(77,24); write(chr(188));
  end;

 procedure ciz;
 begin
 for i:=20 to 60 do begin
 gotoxy(i,8); write(chr(205));
 gotoxy(i,20); write(chr(205));
 end;
 for i:=8 to 20 do begin
 gotoxy(20,i); write(chr(186));
 gotoxy(60,i); writeln(chr(186));
 end;
 gotoxy(20,8); write(chr(201));
 gotoxy(20,20); write(chr(200));
 gotoxy(60,8); write(chr(187));
 gotoxy(60,20); write(chr(188));
  end;


procedure ogrenci_girisi;
begin
assign(dosya,'d:\deneme.dat' );
{$i-} reset (dosya); {$i+}
if ioresult<>0 then rewrite(dosya);
repeat
seek(dosya,filesize(dosya));

gotoxy(2,2);
write('Adınızı giriniz ==>');readln(sinif.ad);
gotoxy(2,3);
write('Soyadınızı giriniz ==>');readln(sinif.soy);
gotoxy(2,4);
write('Numarasını giriniz ==>');readln(sinif.numara);
gotoxy(2,5);
write('1. Matematik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not1);
gotoxy(2,6);
write('2. Matematik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not2);
sinif.dersler.mat.ort:=(sinif.dersler.mat.not1+sinif.dersler.mat.not2) div 2;
gotoxy(2,7);
write('1. Fizik Ders notunu giriniz ==>');readln(sinif.dersler.fizik.not1);
gotoxy(2,8);
write('2. Fizik Ders notunu giriniz ==>');readln(sinif.dersler.fizik.not2);
sinif.dersler.fizik.ort:=(sinif.dersler.fizik.not1+sinif.dersler.fizik.not2) div 2;
gotoxy(2,9);
write('1. Kimya ders notunu giriniz ==>');readln(sinif.dersler.kimya.not1);
gotoxy(2,10);
write('2. Kimya ders notunu giriniz ==>');readln(sinif.dersler.kimya.not2);
sinif.dersler.kimya.ort:=(sinif.dersler.kimya.not1+sinif.dersler.kimya.not2) div 2;
gotoxy(2,11);
write(dosya,sinif);
writeln;
gotoxy(3,23);
writeln('Başka işlem yapılsın mı?:(E,H,ESC)');
repeat
tus:=readkey;
until tus in['H','h','E','e',#27];
until tus in ['H','h',#27];  clrscr;
close(dosya);          ciz;
end;

procedure listele;
var
j:integer;
begin
assign(dosya,'d:\deneme.dat' );
{$i-} reset(dosya); {$i+}
if(ioresult=0) then begin
repeat
{while not eof(dosya) do begin}
gotoxy(2,2);
for j:=0 to filesize(dosya)-1 do
begin
seek(dosya,j);
read(dosya,sinif);
gotoxy(2,2+j);
write('  Ad ==>');
gotoxy(9,2+j);
write(sinif.ad);
gotoxy(17,2+j);
write('  Soyad ==>');
gotoxy(28,2+j);
write(sinif.soy);
gotoxy(36,2+j);
write('  Numarası ==>');
write(sinif.numara);
gotoxy(46,2+j);
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;
end;


procedure arama;
var
ara:string;

begin
{$i-} reset(dosya) {$i+};
if(ioresult=0) then begin
repeat
gotoxy(2,2);
write('Aramak istediğiniz adı giriniz:');readln(ara);
{while not eof(dosya) do begin}
for i:=0 to filesize(dosya)-1 do
begin

seek(dosya,i);
read(dosya,sinif);
if ara=sinif.ad then begin
gotoxy(2,3);
write('   Ad:'); write(sinif.ad:5);
write('   Soyad:'); write(sinif.soy:5);
write('   Numarası:'); write(sinif.numara:5);
write('  Ders notları =>');
gotoxy(2,4);
write('   Matematik 1. notu ==>');
write(sinif.dersler.mat.not1);
gotoxy(2,5);
write('   Matematik 2. notu ==>');
writeln(sinif.dersler.mat.not2);
gotoxy(29,5);
write('   Ortalaması ==>');
write(sinif.dersler.mat.ort);
gotoxy(2,6);
write('   Fizik 1. notu ==>');
writeln(sinif.dersler.fizik.not1);
gotoxy(2,7);
write('   Fizik 2. notu ==>');
writeln(sinif.dersler.fizik.not2);
gotoxy(29,7);
write('   Ortalaması ==>');
write(sinif.dersler.fizik.ort);
gotoxy(2,8);
write('   Kimya 1. notu ==>');
writeln(sinif.dersler.kimya.not1);
gotoxy(2,9);
write('   Kimya 2. notu ==>');
writeln(sinif.dersler.kimya.not2);
gotoxy(29,9);
write('   Ortalaması ==>');
write(sinif.dersler.kimya.ort);

break;
end;
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;
end;

procedure kayit_silme;
var
ara:string;
j:integer;
begin
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin   repeat
if filesize(dosya)>0 then
begin
gotoxy(2,2);
write('Silinecek kişinin adı ==>'); readln(ara);
gotoxy(2,3);
write('Adı ==>'); write(sinif.ad);
gotoxy(2,4);
write('Soyadı ==>'); write(sinif.soy);
gotoxy(2,5);
write('Numarası ==>'); write(sinif.numara);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,sinif);
j:=1;
if ara=sinif.ad then
break;  end;
if ara=sinif.ad then begin
for j:=i+1 to filesize(dosya)-1 do
begin
seek(dosya,j); read(dosya,sinif);
seek(dosya,j-1);
write(dosya,sinif);
end;
seek(dosya,filesize(dosya)-1);
truncate(dosya);
gotoxy(2,7);
writeln('Kayıt silindi');


end;
end else     begin
gotoxy(5,5) ;write('Dosyada kayıt yok');end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
close(dosya);
ciz;
end;

end;

procedure telif;
begin
repeat
gotoxy(25,2);
writeln('KERİM KORKMAZ');
gotoxy(25,3);
writeln('kerim_korkmaz_53@hotmail.com');
gotoxy(25,5);
writeln('H.KEMAL ANADOLU MESLEK LİSESİ     RİZE');
for i:=1 to 10 do
begin
writeln;
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
until tus in ['E','e'];  clrscr;
ciz;
end;

procedure duzeltme;
var
ara:string;
begin
repeat
{$i-} reset(dosya); {$i+}
if ioresult=0 then begin
gotoxy(2,2);
write('Düzeltilecek ismi gir ==>'); readln(ara);
for i:=0 to filesize(dosya)-1 do begin
seek(dosya,i); read(dosya,sinif);
if (ara=sinif.ad) then
break;
end;
if (ara=sinif.ad) then begin
seek(dosya,i);
gotoxy(2,3);
write('Yeni ismi gir ==>'); readln(sinif.ad);
gotoxy(2,4);
write('Yeni soyad gir ==>'); readln(sinif.soy);
gotoxy(2,5);
write('Yeni numarayı gir ==>'); readln(sinif.numara);
gotoxy(2,6);
write('1. Matematik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not1);
gotoxy(2,7);
write('2. Matematik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not2);
gotoxy(2,8);
write('1. Fizik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not1);
gotoxy(2,9);
write('2. Fizik Ders notunu giriniz ==>');readln(sinif.dersler.mat.not2);
gotoxy(2,10);
write('1. Kimya Ders notunu giriniz ==>');readln(sinif.dersler.mat.not1);
gotoxy(2,11);
write('2. Kimya Ders notunu giriniz ==>');readln(sinif.dersler.mat.not2);
gotoxy(2,7);
write(dosya,sinif);
end
else begin
gotoxy(24,2);
write('Dosyada kayıt yok');
end;
gotoxy(2,23);
writeln('ANA MENÜ:(E,H)');
repeat
tus:=readkey;
until tus in['H','h','E','e'];
end;
until tus in ['E','e'];
clrscr;
ciz;
end;


begin  clrscr;
assign(dosya,'d:\deneme.dat');
ciz;
x:=30;y:=11;
repeat
repeat
gotoxy(23,9);
textcolor(15);
writeln('<===========M E N Ü============>');
gotoxy(30,11);
writeln('1-Öğrenci girişi');
gotoxy(30,12);
writeln('2-Listeleme');
gotoxy(30,13);
writeln('3-Arama');
gotoxy(30,14);
writeln('4-Kayıt Silme');
gotoxy(30,15);
writeln('5-Kayıt Düzeltme');
gotoxy(30,16);
writeln('6-Çıkış');
gotoxy(30,17);
writeln('7-Telif Hakkı');
gotoxy(x,y);
sec:=readkey;
if sec='s' then
y:=y+1;
if y=18 then
y:=11;
if sec='w' then
y:=y-1;
if y=10 then
y:=17;
until sec in['1','2','3','4','5','6','7',#27,#13];
clrscr;
if sec=#13 then  begin ciz1;
if y=11 then ogrenci_girisi
else if y=12 then listele
else if y=13 then arama
else if y=14 then kayit_silme
else if y=15 then duzeltme
else if y=16 then exit
else if y=17 then telif;   end;

case sec of
'1': begin ciz1;ogrenci_girisi; end;
'2': begin ciz1;listele end;
'3': begin ciz1;arama; end;
'4': begin ciz1;kayit_silme; end;
'5': begin ciz1;duzeltme; end;
'6': begin exit; end;
'7': begin ciz1;telif; end;
end;
until tus=#27;
readln;
end.



Etiket:

Bu bilgi size yardimci oldu mu?

EvetHayır
Pascal örnek arşivi
Pascal örnek arşivi
(Ortalama: 5 üzerinden 3.3 - 3 Oy)
3