Pascal Örnekleri 11 ( Karma örnekler)

85)Procedure ile kullanılan klavyeden girilen koordinatlara göre şekli çizen pogram.
Çöz:85)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.
Çöz:86)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.
Çöz:87)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.
Çöz:88) 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.
Çöz:89) 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.
Çöz:91)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.
Çöz:92)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.
Çöz:93)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 sayii:=2*exp(i*Ln(16));
if (b=’3′) then sayii:=3*exp(i*Ln(16));
if (b=’4′) then sayii:=4*exp(i*Ln(16));
if (b=’5′) then sayii:=5*exp(i*Ln(16));
if (b=’6′) then sayii:=6*exp(i*Ln(16));
if (b=’7′) then sayii:=7*exp(i*Ln(16));
if (b=’8′) then sayii:=8*exp(i*Ln(16));
if (b=’9′) then sayii:=9*exp(i*Ln(16));
if (b=’A’) then sayii:=10*exp(i*Ln(16));
if (b=’B’) then sayii:=11*exp(i*Ln(16));
if (b=’C’) then sayii:=12*exp(i*Ln(16));
if (b=’D’) then sayii:=13*exp(i*Ln(16));
if (b=’E’) then sayii:=14*exp(i*Ln(16));
if (b=’F’) then sayii:=15*exp(i*Ln(16));
end;
write(sayii:0:0);
readln;
end.

94)Onluk Sayı sistemini ikilik sayı sistemine çevirip sondan başlayarak yazan program.
Çöz:94)uses crt;
var
i,sayi,sayi1:integer;
son:string;
begin
clrscr;
write(‘sayıyı gir:’);readln(sayi);
for i:=1 to sayi do begin
sayi1:=sayi mod 2;
if (sayi1=0) then
son:=’0’+son
else son:=’1’+son;
sayi:=sayi div 2;
if (sayi=1) then begin
son:=’1’+son;
break;end;end;
writeln(son);
readln;
end.

95)Klavyeden saat ve dakika girildiğinde toplam dakikayı bulan program.
Çöz:95)uses crt;
var
saat,dakika,islem,islem2:integer;
begin
clrscr;
write(‘saati gir:’);readln(saat);
write(‘dakikayı gir:’);readln(dakika);
islem:=saat*60;
islem2:=islem+dakika;
writeln(‘islem2’);
readln;
end.

96) -20 ile +20 arası celcius ve fahrenheit’e dönüştürüp ekrana yazdıran program.
Çöz:96)uses crt;
var
a,fahrenheit:real; x:integer;
begin
clrscr;
x:=1;
a:=-21;
while a<1 do begin
a:=a+1;
x:=x+1;
gotoxy(1,1); writeln(‘celcius’);
gotoxy(15,1); writeln(‘fahrenheit’);
gotoxy(1,x); write(a:3:0);
gotoxy(15,x); fahrenheit:=(9/5*a)+32; writeln(fahrenheit:3:1); end;
readln;
end.

97)3 kere yanlış şifre girilince devam etmek ister msiniz? diye soran program.
Çöz:97)uses crt;
var
i,sifre:integer;
devam:string;
begin
clrscr;
i:=1;
devam:=’e’;
while (devam=’e’) do begin
i:=i+1;
writeln(‘şifreyi girin:’);readln(sifre);
if(sifre=123)then  begin
write(‘Hoşgeldin’);break;end
else
writeln(‘tekrar dene’);
if(i>3)then begin
writeln(‘devam etmek istermisiniz:e/h’);
devam:=readkey;
if(devam=’h’)then halt; i:=1; end;
end;
readln;
end.

98)100-150 arasındaki
a)Tek sayıların toplamını
b)Çift sayıların toplamını
c)Asal sayıların toplamını
d)Tüm sayıların toplamını bulan program.
Çöz:98)uses crt;
var
asal,k,a,b,c,i,j:integer;
begin
clrscr;
for i:=100 to 150 do begin
a:=a+i;
if (i mod 2 =0) then
b:=b+i
else
c:=c+i;
for j:=1 to i do begin
if (i mod j=0) then
asal:=asal+1;
if asal=3 then
break;
end;
if asal=2 then    begin
k:=k+1;
gotoxy(54,k+5);
writeln(i);
end;
asal:=0;
end;
gotoxy(5,1);
writeln( ‘Tek sayıların toplamı : ‘,c);
gotoxy(5,3);
writeln( ‘Çift sayıların toplamı: ‘,b);
gotoxy(5,5);
writeln( ‘Tüm sayıların toplamı : ‘,a);
gotoxy(40,5);
writeln(‘ *********Asal Sayılar******** ‘);
readkey;
end.
99)Direnç değeri girilip rengini veren program.
Çöz:99)uses crt;
var
x,c:integer;
a,b,kod:string;
begin
clrscr;
writeln(‘direnç kodunu gir:’);readln(kod);
x:=length(kod);
a:=copy(kod,1,1);
b:=copy(kod,2,1);
c:=length(kod)-2;
if(a=’0′)then write(‘siyah’);
if(a=’1′)then write(‘kahverengi’);
if(a=’2′)then write(‘kırmızı’);
if(a=’3′)then write(‘turuncu’);
if(a=’4′)then write(‘sarı’);
if(a=’5′)then write(‘yeşil’);
if(a=’6′)then write(‘mavi’);
if(a=’7′)then write(‘mor’);
if(a=’8′)then write(‘gri’);
if(a=’9′)then write(‘beyaz’);
if(b=’0′)then write(‘ siyah’);
if(b=’1′)then write(‘ kahverengi’);
if(b=’2′)then write(‘ kırmızı’);
if(b=’3′)then write(‘ turuncu’);
if(b=’4′)then write(‘ sarı’);
if(b=’5′)then write(‘ yeşil’);
if(b=’6′)then write(‘ mavi’);
if(b=’7′)then write(‘ mor’);
if(b=’8′)then write(‘ gri’);
if(b=’9′)then write(‘ beyaz’);
if(c=0)then write(‘ siyah’);
if(c=1)then write(‘ kahverengi’);
if(c=2)then write(‘ kırmızı’);
if(c=3)then write(‘ turuncu’);
if(c=4)then write(‘ sarı’);
if(c=5)then write(‘ yeşil’);
if(c=6)then write(‘ mavi’);
if(c=7)then write(‘ mor’);
if(c=8)then write(‘  gri’);
if(c=9)then write(‘ beyaz’)
else
writeln(”);
textcolor(yellow);
write(‘ <<<9 adet sıfırdan fazla değer giremezsiniz>>>’); readln;
end.

100)Direnç koduna göre rengini veren program(kısaltılmış).
Çöz:100)uses crt;
var
y,i:integer;
x,renk,r1,r2,r3:string;
begin
clrscr;
writeln(‘direnç kodunu gir:’);readln(x);
r1:=copy(x,1,1);
r2:=copy(x,2,1);
str(length(x)-2,r3);
i:=0;
while i<3 do begin
i:=i+1;
case i of
1:renk:=r1;
2:renk:=r2;
3:renk:=r3;
end;
if(renk=’0′)then write(‘ siyah’);
if(renk=’1′)then write(‘ kahverengi’);
if(renk=’2′)then write(‘ kırmızı’);
if(renk=’3′)then write(‘ turuncu’);
if(renk=’4′)then write(‘ sarı’);
if(renk=’5′)then write(‘ yeşil’);
if(renk=’6′)then write(‘ mavi’);
if(renk=’7′)then write(‘ mor’);
if(renk=’8′)then write(‘ gri’);
if(renk=’9′)then write(‘ beyaz’);
end;
readln;
end.

101) 4’e bölünemeyen iki basamaklı en küçük 38. sayı kaç olduğunu yazan program.
Çöz:101)uses crt;
var
x,y:integer;
begin
clrscr;
for x:=10 to 99 do begin
if ((x mod 4)<>0)then
y:=y+1;
if y=38 then begin
writeln(x);break;end;    end;
readln;
end.

102) 4’e bölünemeyen kaç tane iki basamaklı sayı olduğunu yazan program.
Çöz:102)uses crt;
var
x,y:integer;
begin
clrscr;
for x:=10 to 99 do begin
if ((x mod 4)<>0) then
y:=y+1;
end;
write(y);
readln;
end.

103) 4’e bölünemeyen iki basamaklı tüm sayıları yan yana aralarında ikişer boşluk bırakarak yazan program.
Çöz:103)uses crt;
var
x,y:integer;
begin
for x:=10 to 99 do begin
if ((x mod 4)<>0) then
write(x,’  ‘);
end;
readln;
end.

104)Klavyeden girilecek şekilde n basamaklı x’e bölünemeyen y. sayıyı yazan program.
Çöz:104)uses crt;
var
son,ilk,i,b:real;
sayac,n,x,y:integer;
begin
clrscr;
write(‘basamak sayısını gir:’);readln(n);
write(‘bölüm sayısını gir:’);readln(x);
write(‘kaçıncı sayı:’);readln(y);
son:=exp(n*ln(10)-1);
ilk:=exp((n-1)*ln(10));
sayac:=0;
i:=ilk;
while i<son do begin
b:=i;
while b>=x do
b:=b-x;
if (b>=1) then
sayac:=sayac+1;
if (sayac=y) then begin
writeln(i:0:0);break;end;
i:=i+1;end;
readln;
end.

Yazar: kacarozgur

Özgür Kaçar sitemizde 38 yazı eklemiş...

• Tüm yazıları-> kacarozgur →
• Kişisel Sayfası