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.
Örnek 2: Girdiğimiz adet sayısı kadar sayıyı büyükten küçüğe sıralayan program
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.
Örnek 3: Altı haneli Palindromik sayıları bulan program
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.
Örneğin Derlenmiş hali :Not: Palindromik sayı, iki taraftan okunduğu zaman okunuş yönüyle aynı olan sayılardır. Örnek: 1, 4, 8, 99, 101, 363, 4004, 9889, 13531 vb. Asal palindromik sayılar: 2, 3, 5, 7, 11, 101, 131, 151, 181, 191
Örnek 4: Girilen sayı adeti kadar ismi alfabetik olarak sıralayan program
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.
Örnek 5: Girilen mesajı tersten yazan program
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.
Örnek 6: Girilen N adet sayının tek-çift kontrolünü yapan program
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.Örneğin Derlenmiş hali :
Örnek 7: Birden yüze kadar tek ve çift sayıların toplamlarını bulan program
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.
Örnek 8: Sigara anketi sonuç rapor programı
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.
Örnek 9: Girilen sayının faktöriyelini alan program
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.
Örnek 10: Döviz kurunu Türk Lira’sına çeviren program
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.
