Yazılım Adası

Kod: Tümünü seç

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[i]);
    end;
  for i:=1 to n-1 do
   for j:=i+1 to n do
     begin
       if matris[i]>matris[j] then
         begin
           yedek    :=matris[i];
           matris[i]:=matris[j];
           matris[j]:=yedek;
         end;
     end;
  clrscr;
  writeln('Küçükten büyüğe sıralama :');
  for i:=1 to n do
    writeln(matris[i]);
  readkey;
end.

Kod: Tümünü seç

Program buyuk_kucuk;
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[i]);
    end;
  for i:=1 to n-1 do
   for j:=i+1 to n do
     begin
       if matris[i]<matris[j] then
         begin
           yedek    :=matris[i];
           matris[i]:=matris[j];
           matris[j]:=yedek;
         end;
     end;
  clrscr;
  writeln('Büyükten küçüğe sıralama :');
  for i:=1 to n do
    writeln(matris[i]);
  readkey;
end.

Kod: Tümünü seç

program d6palindromik;
uses crt;
var
  i:longint;
  istr, a,b,c,d,e,f :string;
begin
  clrscr;
  writeln('Altı haneli palindromik sayıların listesi :');
  for i:=100000 to 999999 do
    begin
      Str(i,istr);
      a:= copy(istr, 1, 1);
      b:= copy(istr, 2, 1);
      c:= copy(istr, 3, 1);
      d:= copy(istr, 4, 1);
      e:= copy(istr, 5, 1);
      f:= copy(istr, 6, 1);
      if (a=f) and (b=e) and (c=d) then
        write(' '+istr+' ');
    end;
    readkey;
end.

Kod: Tümünü seç

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

Kod: Tümünü seç

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.

Kod: Tümünü seç

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[i]);
    if (matris[i]/2) = int(matris[i]/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.

Kod: Tümünü seç

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.

Kod: Tümünü seç

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[i]);
      write('Cinsiyeti              :');
      readln(cinsiyet[i]);
      write('Yaşı                   :');
      readln(yas[i]);
      write('Sigara Tercihi (0/1/2) :');
start:tercih[i]:=readkey;
      if tercih[i]='0' then 
         writeln(' ',tercih[i],'- içmiyor  ');
      if tercih[i]='1' then 
         writeln(' ',tercih[i],'- az içiyor');
      if tercih[i]='2' then 
         writeln(' ',tercih[i],'- tiryaki  ');
      if (tercih[i]<>'0') and (tercih[i]<>'1') and
         (tercih[i]<>'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[i]);
      gotoxy(37,i+2); write(cinsiyet[i]);
      gotoxy(51,i+2); write(yas[i]);

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

Kod: Tümünü seç

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.

Kod: Tümünü seç

program dovizcev;
uses crt;
var
 kur,miktar,tl:longint;
begin
  clrscr;
  write('Döviz kurunu giriniz :');
  readln(kur);
  write('Döviz miktarını giriniz :');
  readln(miktar);
  tl:=kur*miktar;
  write(miktar,' birim döviz karşılığı Türk Lirası :',tl);
  readkey;
end.

Kod: Tümünü seç

Program uc_notun_ortalamasini_bulur;
uses crt;
Var {degisken tanimlama blogu}

    not1,not2,not3 : integer;
    ortalama       : real;
Begin {Ana Program Bloğu}
  textcolor(1);
  write('Notlari girmek icin enter a basin   ***********(en fazla 10 basamak)************');
  ReadLn;
  textcolor(3);
  write('1. notu giriniz (rakamla)---------------->:');ReadLn(not1);
  textcolor(3);
  write('2. notu giriniz (rakamla)---------------->:');ReadLn(not2);
  textcolor(3);
  write('3. notu giriniz (rakamla)---------------->:');ReadLn(not3);
  ortalama:=(not1+not2+not3)/3;
  WriteLn('******************************************************************************');
  textcolor(9);
  WriteLn('Ortalama Bulundu gormek icin enter a basin');
  WriteLn('******************************************************************************');
  ReadLn;
  textcolor(3);
  WriteLn('uc notun ortalamasi   =',ortalama:5:2);
  textcolor(12);
  WriteLn('------------------------------------------------------------------------------');
  textcolor(12);
  WriteLn('------------------------------------------------------------------------------');
  WriteLn('yazilimadasi.com                                                     ');
  WriteLn('------------------------------------------------------------------------------');
  textcolor(3);
  WriteLn('uc notun ortalamasi   =',ortalama:5:2);
  textcolor(12);
  WriteLn('programi sonlandirmak icin Entera basin---yazilimadasi.com---');
  ReadLn;
end.