Pascala yeni başlayanlar için Örnekler

[kadem83]

Kod Seç Genişlet

• {Kürenin alanını bulan program}
program kure_alan;
uses crt;
var
  r,alan:real;
begin
  clrscr;
  write('Kürenin yarıçapını giriniz :');
  readln(r);
  alan:=4*((22 / 7)*(r*r));
  write(r:12:4,' yarıçaplı kürenin alanı ',alan:12:4,' dır.');
  readkey;
end. 
•
{Kürenin hacmini bulan program}
program kup_hacim;
uses crt;
var
  r:real;
begin
  clrscr;
  write('Kürenin yarıçapını giriniz :');
  readln(r);
  hacim:=4/3*pi*r*r*r;
  writeln(r,'Yarıçaplı kürenin hacmi ',hacim,' dır.');
  readln
end.

{Girilen N sayi içinde pozitif negatif ve sıfır adedini bulan program}
program npsbul;
uses crt;
var
  sayilar:array[1..100] of integer;
  n,i,poz,neg,sif:integer;
begin
  clrscr;
  write('Girilecek sayı adedini giriniz :');
  readln(n);
  for i:=1 to n do
    begin
      write(I,'. Sayıyı giriniz :');
      readln(sayilar[i]);
      if sayilar[i] > 0 then poz:=poz+1;
      if sayilar[i] = 0 then sif:=sif+1;
      if sayilar[i] < 0 then neg:=neg+1;
    end;
  writeln('Pozitif sayı adedi :',poz);
  writeln('Negatif sayı adedi :',neg);
  writeln('Sıfır adedi        :',sif);
  readkey;
end. 


{Bir kelimede kaç "a" harfi olduğunu bulan program}
program asayisi;
uses crt;
var
  kelime:string;
  uzunluk,i,asayi:integer;
begin
  clrscr;
  write('Kelimeyi giriniz :');
  readln(kelime);
  uzunluk:=length(kelime);
  for i:=1 to uzunluk do
    if (kelime='A')or(kelime='a') then
      asayi:=asayi+1;
  write('Kelimedeki a harfi adedi :',asayi);
  readkey;
end.

{Bir cümlede kaç adet kelime olduğunu bulan program}
program kelimesay;
uses crt;
var
  cumle:string;
  uzunluk,i,kelimesayi:integer;
begin
  clrscr;
  write('Cümleyi giriniz :');
  readln(cumle);
  uzunluk:=length(cumle);
  for i:=1 to uzunluk do
    if (cumle=' ')and(cumle[i+1]<>' ') then
       kelimesayi:=kelimesayi+1;
  write('Cümledeki kelime sayısı :',kelimesayi+1);
  readkey;
end.
program faktoriyel_hesabi;
uses crt;
var
n,f,i:longint;
Begin
f:=1;
Write('Faktoriyel Hesabi Icin Sayi Giriniz(n!) : ');
readln(n);
for i:=1 to n do
begin
F:=f*i;
end;
writeln('Girilen Sayi(n!)..:',n);
writeln('Sonuc.............:',f);
readln;
end.

{Ikinci dereceden denklemin köklerini bulan program}
program poli_kok;
uses crt;
var
  a,b,c,delta:real;
begin
  clrscr;
  writeln('Denklemin katsayılarını giriniz ax² + bx + c = 0');
  write('a = ');
  readln(a);
  write('b = ');
  readln(b);
  write('c = ');
  readln(c);
  delta:=((b*b)-(4*a*c));
  if delta<0 then
     write('Bu denklemin gerçek kökü yoktur.');
  if delta=0 then
     write('Bu denklemin bir adet gerçek kökü vardır :',
            -B/(2*A));
  if delta>0 then
    begin
      writeln('Bu denklemin iki adet gerçek kökü vardır :');
      write(((-b+sqr(delta))/(2*a)):12:2,' ve ',((-b-     
            sqr(delta))/(2*A)):12:2);
    end;
  readkey;
end. 


{300 öğrencinin sınav ortalamasını bulan program}
program sinav_ortalama;
uses crt;
var
  sinavnotu:array[1..300] of integer;
  i:integer;
  toplam:longint;
  ortalama:real;
begin
  clrscr;
  for i:=1 to 300 do
    begin
      write(i,'. öğrencinin sınav notunu giriniz :');
      readln(sinavnotu);
      toplam:=toplam+sinavnotu;
    end;
  ortalama:=toplam/300;
writeln('Öğrencilerin sınav ortalaması :',ortalama:3:2);
readkey;
end.

{Bir işçinin vergi iadesini hesaplayan program}
program vergi_iade;
uses crt;
var
  maas,toplamfatura:longint;
  iade:real;
begin
  clrscr;
  write('İşçinin maaşı :');
  readln(maas);
  write('Fatura toplamı :');
  readln(toplamfatura);
  if toplamfatura>maas then toplamfatura:=maas;
  if (toplamfatura>0) and (toplamfatura<=30000)  then
    iade:=toplamfatura*0.2;
  if (toplamfatura>30000) and (toplamfatura<=60000)  then
    iade:=30000*0.2+(toplamfatura-30000)*0.15;
  if (toplamfatura>60000) and (toplamfatura<=100000) then
    iade:=30000*0.2+30000*0.15+(toplamfatura-40000)*0.1;
  if (toplamfatura>100000) then
    iade:=30000*0.2+30000*0.15+40000*0.1+
          (toplamfatura-10000)*0.05;
  writeln('Toplam iade :',iade:12:2);
  readkey;
end. 

katsayıları istediğiniz gibi değiştirebilirsiniz

{N adet sayıyı küçükten büyüğe sıralayan program}
Program kucuk_buyuk;
uses crt;
var
  n, i, j, yedek :integer;
  matris :array[1..100] of integer;
begin
  clrscr;
  write('Sıralanacak sayı adedini giriniz :');
  readln(N);
  for i:=1 to n do
    begin
      write(i);
      write('. sayıyı giriniz :');
      readln(matris);
    end;
  for i:=1 to n-1 do
   for j:=i+1 to n do
     begin
       if matris>matris[j] then
         begin
           yedek    :=matris;
           matris:=matris[j];
           matris[j]:=yedek;
         end;
     end;
  clrscr;
  writeln('Küçükten büyüğe sıralama :');
  for i:=1 to n do
    writeln(matris);
  readkey;
end.

{Beş adet vize ve bir adet final notunun ortalamasını alan program}
program vize_final;
uses crt;
var
  vize: array [1..5] of integer;
  i,toplam,final:integer;
  ortalama,toplam2,ortalama2:real;
begin
  clrscr;
  for i:=1 to 5 do
    begin
      write(I,'. vize notunu giriniz :');
      readln(vize);
      toplam:=toplam+vize;
    end;
  ortalama:=toplam/5;
  writeln('Vize ortalaması :',ortalama:3:2);
  write('Final notunu giriniz :');
  readln(final);
  toplam2:=ortalama+final;
  ortalama2:=toplam2/2;
  write('Başarı notu :',ortalama2:3:2);
  readkey;
end.

{Girilen N adet ismi alfabedik sıralayan program}
Program alfabedik;
uses crt;
var
  n, i, j :integer;
  matris :array[1..100] of string;
  yedek :string;
begin
  clrscr;
  write('Alfabedik sıralanacak isim adedini giriniz :');
  readln(N);
  for i:=1 to n do
    begin
      write(i);
      write('. ismi giriniz :');
      readln(matris);
    end;
  for i:=1 to n-1 do
   for j:=i+1 to n do
     begin
       if matris>matris[j] then
         begin
           yedek    :=matris;
           matris:=matris[j];
           matris[j]:=yedek;
         end;
     end;
  clrscr;
  writeln('İsimlerin alfabedik sırası :');
  for i:=1 to n do
    writeln(matris);
  readkey;
end.

{Girilen NxM ve ZxK matrislerini toplayan program}
program mat_top;
uses crt;
var
  matris1,matris2,toplamatris:array[1..10,1..10] of integer;
  x,y,i,j:integer;
begin
  clrscr;
  write('Toplanacak matrislerin boyutlarını giriniz(X,Y)');
  readln(x,y);

  for i:=1 to x do
    for j:=1 to y do
      begin
        write('Birinci matrisin ',i,'-',j,' nolu hücresine 
               sayı girin :');
        readln(matris1[i,j]);
      end;

  for i:=1 to x do
    for j:=1 to y do
      begin
        write('İkinci matrisin ',i,'-',j,' nolu hücresine sayı 
               girin :');
        readln(matris2[i,j]);
      end;


  for i:=1 to x do
    for j:=1 to y do
      begin
        toplamatris[i,j]:=matris1[i,j]+matris2[i,j];
        writeln('Toplam matris :', i, '-', j, 
                '. eleman :', toplamatris[i,j]);
      end;
  readkey;
end. 


{Girilen N adet sayının çift-tek kontrolünü yapan program}
program cift_tek;
uses crt;
var
  n, i, cift, tek :integer;
  matris: array [1..100] of integer;
begin
  clrscr;
  write('Girilecek sayı adedini giriniz :');
  readln(n);
  for i:= 1 to n do
    begin
      write(i,'. sayıyı girin :');
      readln(matris);
      if (matris/2) = int(matris/2) then cift:=cift+1
                                          else tek :=tek +1
    end;

  writeln('Çift sayıların adedi :',cift);
  writeln('Tek sayıların adedi  :',tek);
  readkey;
end. 

{Girilen sayının asal olup olmadığını kontrol eden program}
program asalmi;
uses crt;
var
  sayi,i,tam,onda:integer;
begin
  clrscr;
  write('Kontrol edilecek sayıyı giriniz :');
  readln(sayi);
  for i:=1 to sayi do
    if (sayi/i)=int(sayi/i) then tam:=tam+1
                            else onda:=onda+1;
  if tam>2 then writeln('Sayı asal değildir')
         else writeln('Sayı asaldır');
  readkey;
end. 


{Girilen mesajı tersten yazan program}
program ters_yazi;
uses crt;
var
  mesaj, tersmesaj:string;
  i, l:integer;
begin
  clrscr;
  write('Tersten yazılacak yazıyı giriniz :');
  readln(mesaj);
  l:=length(mesaj);
  for i:= l downto 1 do 
    tersmesaj:=tersmesaj+copy(mesaj, i, 1);
  writeln('Girilen yazının tersten yazılışı :');
  write(tersmesaj);
  readkey;
end.

{1den 10a kadar sayıların çarpım tablosu}
program carpim;
uses crt;
var
i,j:integer;
begin
  clrscr;
  for i:=1 to 10 do
    begin
      for j:=1 to 10 do writeln(i,'x',j,'=',i*j);
      writeln('Devam etmek için Enter''a basın');
      readkey;
    end;
end.

{Girilen N adet öğrenciden kız ve erkek olanların sayısını bulan
program kiz_erkek_sayi;
uses crt;
label soru;
var
  n, i, erkek, kiz:integer;
  cinsiyet:char;
begin
  clrscr;
  write('Öğrenci sayısını giriniz :');
  readln(n);
  for i:=1 to n do
    begin
soru: write(i,'. öğrencinin cinsiyeti (E/K) :');
      cinsiyet:=readkey;
      writeln(cinsiyet);
      if (cinsiyet='E') or (cinsiyet='e') then erkek:=erkek+1;
      if (cinsiyet='K') or (cinsiyet='k') then kiz  :=kiz  +1;
      if (cinsiyet<>'K') and (cinsiyet<>'k') and
         (cinsiyet<>'E') and (cinsiyet<>'e') then goto soru;
    end;
  writeln('Erkek öğrenci sayısı :',erkek);
  write('Kız   öğrenci sayısı :',kiz);
  readkey;
end.

{N adet sayının minumumunu bulan program}
program minbul;
uses crt;
var
  matris:array [1..100] of integer;
  n, i, j, yedek:integer;
begin
  clrscr;
  write('Girilecek sayı adedini giriniz :');
  readln(n);
  for i:=1 to n do
    begin
      write(i,'. sayıyı giriniz :');
      readln(matris);
    end;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      begin
        if matris>matris[j] then
          begin
            yedek    :=matris;
            matris:=matris[j];
            matris[j]:=yedek;
          end;
      end;
  write('Girilen sayıların en küçüğü :',matris[1]);
  readkey;
end.

{1-100 arasındaki çift ve tek sayıların toplamlarını bulan program}
program te_cift_toplam;
uses crt;
var
  i, cift, tek:integer;
begin
  clrscr;
  for i:=1 to 100 do
    if (i/2)=int(i/2) then cift:=cift+i
                      else tek :=tek +i;
  writeln('1-100 arası tek sayılar toplamı : ',tek);
  writeln('1-100 arası çift sayılar toplamı: ',cift);
  readkey;
end.

{N adet sayının maksimumunu bulan program}
program maksbul;
uses crt;
var
  matris:array [1..100] of integer;
  n, i, j, yedek:integer;
begin
  clrscr;
  write('Girilecek sayı adedini giriniz :');
  readln(n);
  for i:=1 to n do
    begin
      write(i,'. sayıyı giriniz :');
      readln(matris);
    end;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      begin
        if matris<matris[j] then
          begin
            yedek    :=matris;
            matris:=matris[j];
            matris[j]:=yedek;
          end;
      end;
  write('Girilen sayıların en büyüğü :',matris[1]);
  readkey;
end.

{N sayıda işçinin ücretlerini okuyup ortalamasını bulan program}
program isci_ortalama;
uses crt;
var
  i, n :integer;
  maas : array [1..100] of longint;
  toplam :longint;
  ortalama :real;
begin
  clrscr;
  write('İşçi sayısını giriniz :');
  readln(n);

  for i:=1 to n do
    begin
      write(i,'. işçinin ücretini giriniz :');
      readln(maas);
      toplam:=toplam+maas;
    end;
  ortalama:=toplam/n;
  write('İşçilerin maaş ortalaması :',ortalama:9:2);
  readkey;
end.

{Sayının faktöriyelini alan program}
program faktoriyelbul;
uses crt;
var
  i, sayi:integer;
  faktoriyel:real;
begin
  clrscr;
  write('Faktoriyeli alınacak sayıyı giriniz :');
  readln(sayi);
  faktoriyel:=1;

  for i:=1 to sayi do faktoriyel:=faktoriyel*i;
  write(sayi,' sayısının faktoriyeli:',faktoriyel:42:0);
  readkey;
end.

{İşçilerin net ücretlerini hesaplayan program}
program net_ucret;
uses crt;
var
  n, i:integer;
  saatucreti  :longint;
  iscimesai, iscimaas:array [1..100] of real;
begin
  clrscr;
  write('İşçi sayısını giriniz :');
  readln(n);
  write('Saat ücretini giriniz :');
  readln(saatucreti);


  for i:=1 to n do
    begin
      write(i,'. işçinin mesai saatini giriniz :');
      readln(iscimesai);
      iscimaas:=iscimesai*saatucreti;
      iscimaas:=iscimaas-(iscimaas*0.14);
      iscimaas:=iscimaas-(iscimaas*0.3);
    end;
  for i:=1 to n do 
    writeln(i,'. işçinin net ücreti :',iscimaas:15:2);
  readkey;
end.

{Üç basamaklı ve rakamlarının küpleri toplamı kendine eşit} {olan sayıları bulan program}
program kuptop;
uses crt;
var
istr:string;
i, a, b, c, code, toplam:integer;
begin
  clrscr;
  for i:=100 to 999 do
    begin
      str(i,istr);
      val(copy(istr,1,1),a,code);
      val(copy(istr,2,1),b,code);
      val(copy(istr,3,1),c,code);
      toplam:= (a*a*a)+(b*b*b)+(c*c*c);
      if toplam=i then writeln('Sayı bulundu: ',i);
    end;
  readkey;
end.

{Sigara anketi sonuç programı}
program sigara_anket;
uses crt;
label
  start;
var
isim     :array [1..100] of string[20];
cinsiyet :array [1..100] of string[5];
yas      :array [1..100] of string[2];
tercih   :array [1..100] of char;
i, ii, ksayi  :integer;
begin
  clrscr;
  write('Ankete katılan kişi sayısını giriniz :');
  readln(ksayi);
  clrscr;
  for i:=1 to ksayi do
    begin
      writeln('Sıra No                :',i);
      write('Adı Soyadı             :');
      readln(isim);
      write('Cinsiyeti              :');
      readln(cinsiyet);
      write('Yaşı                   :');
      readln(yas);
      write('Sigara Tercihi (0/1/2) :');
start:tercih:=readkey;
      if tercih='0' then 
         writeln(' ',tercih,'- içmiyor  ');
      if tercih='1' then 
         writeln(' ',tercih,'- az içiyor');
      if tercih='2' then 
         writeln(' ',tercih,'- tiryaki  ');
      if (tercih<>'0') and (tercih<>'1') and
         (tercih<>'2') then goto start;
      writeln('-------------------------------------');
    end;
  clrscr;
  for i:=1 to ksayi do
    begin
      gotoxy(1,1);  write('Sıra No');
      gotoxy(13,1); write('Adı Soyadı');
      gotoxy(35,1); write('Cinsiyeti');
      gotoxy(50,1); write('Yaşı');
      gotoxy(60,1); write('Sigara Tercihi');
      for ii:=1 to 70 do
        begin
          gotoxy(ii,2);
          write('-');
        end;
      gotoxy(3 ,i+2); write(i);
      gotoxy(13,i+2); write(isim);
      gotoxy(37,i+2); write(cinsiyet);
      gotoxy(51,i+2); write(yas);

      if tercih='0' then
        begin
          gotoxy(59,i+2);
          write(' ',tercih,'-İçmiyor');
        end;
      if tercih='1' then
        begin
          gotoxy(59,i+2);
          write(' ',tercih,'-Az İçiyor');
        end;
      if tercih='2' then
        begin
          gotoxy(59,i+2);
          write(' ',tercih,'-Tiryaki');
        end;
    end;
  readkey;
end.


[command]

Kod Seç Genişlet


program oyun;
uses crt;

const
prog = 'iyi günler';

var
i,sayi,tahmin,seviye:integer;
cev:char;

label basla,byebye;

procedure yonver;
begin
if sayi>tahmin then
begin
textcolor(green);
writeln('yüksek değer girin...');
end
else if sayi<tahmin then
begin
textcolor(cyan);
writeln('düşük değer girin...');
end
else
begin
textcolor(yellow);
writeln('tebrikler...');
end
end;

procedure son;
begin
textcolor(red);
writeln('oyun bitti keybettiniz...');
end;

begin
highvideo();
sayi:=0;
tahmin:=0;
basla:
write('seviye seçin 1:kolay,2:orta,3:zor,4:çık : ');
readln(seviye);
case seviye of
1 : begin
seviye:=25;
end;
2 : begin
seviye:=50;
end;
3 : begin
seviye:=100;
end;
4 : begin
goto byebye;
end;
else writeln('hatali seçim seviye 2 öntanımlı');
seviye:=50;
end;
writeln('0 ila ',seviye,' arasi tahin yapın.');
randomize;
sayi:=random(seviye);
for i:=1 to 10 do
begin
textcolor(white);
write('kalan tahmin ',11-i,' : ');
readln(tahmin);
if sayi=tahmin then
begin
clrscr;
writeln('dogru tahmin');
yonver;
break;
end
else
begin
clrscr;
if i=10 then
begin
son;
end
else
begin
writeln('yanlış tahmin');
yonver;
end;
end;
end;
textcolor(white);
write('tekrar denemek istermisiniz ? : ');
readln(cev);
if cev in ['E' , 'e' ] then
begin
goto basla;
end
else
byebye:
begin
textcolor(white);
clrscr;
gotoxy(15,15);writeln('Teşekkür ederiz... '+prog);
end;
normvideo();
end.



[command]

Kod Seç Genişlet


program saat;

uses crt,sysutils;
var
timestamp:string;

BEGIN
repeat
clrscr;
timestamp:=FormatDateTime('hh:nn:ss',Time());
writeln('saat : ',timestamp:1);
delay(1000);
until keypressed;
halt(0);
END.


devamı gelecek !

[command]

Dizeye girdi ekleme ve girdiyi gösterme

Kod Seç Genişlet


program sayisal;
uses crt,sysutils;

var say,numara : integer;
sira : array [0..5] of integer;


BEGIN
for say:=1 to 6 do
begin
randomize;
numara:=random(48)+1;
sira[say]:=numara;
writeln(say,'. Numara : ',numara,' dizge: ',sira[say]);
delay(999);
end;
writeln;
writeln('dizgedeki 2. numara. ',sira[2]);
END.


[erginemr]

Elinize sağlık.

Pascal'in İngilizce'ye yakın olan söz düzenini seviyorum; koda baktığınız zaman yaptığı işlemi çok rahat anlayabiliyorsunuz.

[command]

bende pascal sevenlerdenim
evde kendi kendime çalışarak birşeyler yapmaya çalışıyorum inşallah dahda geliştirip işe yarar bir kaç şey yapabiliriz.

[nazim]

Bede bazı günlerde takıntı oluyor  kod bulup derlemek, yada  okumak.
Şu programlama dilini öğrenmek için gaz veriyorum, sora  binlerce yazılmış programı görünce öğrenme hevesi kalmıyor.
Bir de İngilizce olunca işler daha çok sarpa sarıyor.

[command]

Bende ingilizce bilmiyorum ama bunu sorun etmiyorum

[command]

Ürettiği sayıyı tekrar üretmeyen örnek

Kod Seç Genişlet


uses crt;

var say,numara,i : integer;
sira : array [0..5] of integer;
label tekrar;

procedure uretec;
begin
randomize;
numara:=random(48)+1;
end;

BEGIN
textcolor(red);
writeln('Üretiliyor. Lütfen bekleyin...');
for say:=1 to 6 do
begin
tekrar:
uretec;
sira[say]:=numara;
if numara=sira[say-6] then
begin
goto tekrar;
end
else if numara=sira[say-5] then
begin
goto tekrar;
end
else if numara=sira[say-4] then
begin
goto tekrar;
end
else if numara=sira[say-3] then
begin
goto tekrar;
end
else if numara=sira[say-2] then
begin
goto tekrar;
end
else if numara=sira[say-1] then
begin
goto tekrar;
end
else
write(say:02,'. ');
end;
clrscr;
textcolor(white);
writeln('Bulunan sayılar : ');
for i:=1 to 6 do
begin
write(sira[i]:03,'. ');
end;
writeln;
halt(0);
END.



[command]

Aynı programın daha kısa olan hali

Kod Seç Genişlet


uses crt;

var say,numara : byte;
sira : array [0..5] of byte;
label tekrar;

procedure uretec;
begin
randomize;
numara:=random(48)+1;
end;


BEGIN
highvideo;
clrscr;
textcolor(green);
writeln('Hesaplanıyor, lütfen bekleyin...');
for say:=1 to 6 do
begin
tekrar:
uretec;
sira[say]:=numara;
if (numara=sira[say-1]) or   // dizideki 0
   (numara=sira[say-2]) or   // dizideki 1
   (numara=sira[say-3]) or   // dizideki 2
   (numara=sira[say-4]) or   // dizideki 3
   (numara=sira[say-5]) or   // dizideki 4
   (numara=sira[say-6]) then // dizideki 5
begin
goto tekrar;
end
else
write(sira[say]:02,'. ');
end;
writeln;
textcolor(red);
writeln('Tamamlandı.');
normvideo;
halt(0);
END.


[command]

ürettiği sayıları kolonda gösteren örneği

Kod Seç Genişlet


uses crt,mmx;

var say,numara,i:integer;
sira:array [1..6] of integer;
cevap:char;
sorgu:boolean;
label tekrar,basla;

procedure uretec;
begin
randomize;
numara:=random(49);
if numara=0 then numara:=numara+1;
end;

procedure sort;
var x,y,temp,sat:integer;
begin
for x:=1 to 6 do
for y:=x to 6 do
if sira[y]<sira[x] then
begin
temp:=sira[x];
sira[x]:=sira[y];
sira[y]:=temp;
        end;
        for i:=1 to 6 do
        begin
        textcolor(9);
        write(sira[i]:02,' ');
        end;
        writeln;
        for sat:=1 to 49 do
begin
if (sat=8) or (sat=15) or
(sat=22) or (sat=29) or
(sat=36) or (sat=43) then
writeln;
if (sat=sira[1]) or (sat=sira[2]) or
(sat=sira[3]) or (sat=sira[4]) or
(sat=sira[5]) or (sat=sira[6]) then
textcolor(15)
else
begin
textcolor(8);
end;
write(sat:02,' ');
end;
end;

BEGIN
basla:
highvideo;
clrscr;
writeln('Hazırlanıyor...');
for say:=1 to 6 do
begin
tekrar:
{$mmx+}
uretec;
sira[say]:=numara;
if (numara=sira[say-1]) or   // dizideki 0
   (numara=sira[say-2]) or   // dizideki 1
   (numara=sira[say-3]) or   // dizideki 2
   (numara=sira[say-4]) or   // dizideki 3
   (numara=sira[say-5]) or   // dizideki 4
   (numara=sira[say-6]) then // dizideki 5
goto tekrar;
end;
sort;
{$mmx-}
emms; //clear fpu :)
writeln;
textcolor(15);
writeln;
write('Tekrar E/H ? : ');
cevap:=readkey;
if upcase(cevap)='E' then
begin
sorgu:=true;
end
else
sorgu:=false;
writeln('İyi şanslar.');
if sorgu=true then
goto basla;
normvideo;
halt(0);
END.


çıktısı

Kod Seç Genişlet


Hazırlanıyor...
[glow=red,2,300] 2  7  9 12 24 46 [/glow]
1  2  3  4  5  6  7
8  9 10 11 1213 14
15 16 17 18 19 20 21
22 23 2425 26 27 28
29 30 31 32 33 34 35
36 37 38 39 40 41 42
43 44 45 46 47 48 49

Tekrar E/H ? :


renklendirme çıkmıyor ama derleyip çalıştırırsanız sonucu göreceksiniz.