12 xil bo’yash usulini namoyish etuvchi 40×40 o’lchamli 12 ta kvadrat chizing.
uses wincrt, graph, crt; var i,gd,gm,x1,x2,y1,y2: integer; begin gd:=0; clrscr; initgraph(gd,gm,»);
x1:=1; x2:=40; y1:=1; y2:=40; for i:=1 to 12 do begin setfillstyle(i,i+3); bar(x1,y1,x2,y2); x1:=x1+42; x2:=x2+42; end; readln; closegraph; end.
Hafta kunlarining nomlarini kiritib, ularni «HAFTA.TXT» faylida saqlab qo’yadigan dastur tuzing.
uses crt; var kun: string; f: text; i: integer;begin clrscr; assign(f,’hafta.txt’); rewrite(f);
for i:=1 to 7 do begin write(i,’-kun nomini kiriting=’);readln(kun); writeln(f,kun);
end; close(f); readln; end.
Ekran o’rtasidan bo’luvchi gorizontal chiziq chizuvchi dastur tuzing.
Uses graph; Var gd,gm,i,marx,:integer;y:char; Begin gd:=0; InitGraph(gd,gm,»); marx:=trunc(getmaxx/2); line(1,marx,getmaxy,marx); readln; closegraph; end.
Random funksiyasidan foydalanib, turli rangli nuqtalarni hosil qiling.
Uses wincrt, crt; graph; Var Gd,gm,x,y: integer; Begin Gd:=0; InitGraph(gd,gm,’’); Randomize;
Repeat X:=round(random(15)); y:=round(random(15)); Putpixel(50*x,50*y, x); Until x=y+1;
Readln; Closegraph; End.
Random funksiyasidan foydalanib, «yulduzli osmon» manzarasini hosil qiling.
uses graph; var gd,gm,x,y,k,i: integer; begin gd:=0; initgraph(gd,gm,»); randomize; repeat
for i:=1 to 15 do begin x:=25*k*round(random(15)); y:=20*k*round(random(15));
putpixel(x,y,i); end; k:=k+1; until k>10; readln;closegraph; end.
Uchta sondan kattasini topish dasturini tuzing. Buning uchun ikkita sondan kattasini topish funksiyasini tuzib, undan foydalaning.
uses crt; var i,max,a,b,c: integer;
function IKT(a,b:integer):integer; var c:integer;
begin if a>b then c:=a else c:=b; IKT:=c; end;
begin write(‘1-sonni kiriting=’); readln(a);
write(‘2-sonni kiriting=’); readln(b); write(‘3-sonni kiriting=’); readln(c); a:=IKT(a,b); b:=c;
max:=IKT(a,b); writeln(‘Kattasi=’,max); readln; end.
a,b,c sonlar berilgan. Ularning eng kattasi max(a,b,c) ni toping.
var a,b,c,nax: real; begin write(‘a sonni kiriting: ‘) readln(a); write(‘b sonni kiriting: ‘) readln(b); write(‘c sonni kiriting: ‘) readln(c); if a>b then max:=a else max:=b if c>max then max:=c writeln(‘Berilgan uchta sondan kattasi = ‘,max); readln; end.
Ekranning to’rtta burchagida sariq rangli nuqta hosil qiluvchi dastur tuzing.
Uses graph; Var gd,gm: integer; Begin gd:=0; InitGraph(gd,gm,»); PutPixel(1,1,14); PutPixel(1,getmaxY,14); PutPixel(getmaxX,1,14);PutPixel(getmaxX,getmaxY,14); readln;
closegraph; end.
Uchburchakning berilgan tomonlari bo’yicha uning balandliklarini aniqlovchi dastur tuzing.
Var a,b,c,ha,hb,hc:real; function h_ub(a,b,c:real); var yp,s:real; begin yp:=(a+b+c)/2;
s:=sqrt(yp*(yp-a)*(yp-b)*(yp-c)); H_UB:=2*s/a; end; begin write(‘Uchburchak tomonlari (a,b,c) kiriting: ‘); readln(a,b,c); ha:=h_ub(a,b,c); hb:=h_ub(b,a,c); hc:=h_ub(c,b,a); writeln(‘uchburchakning balandliklari: ‘); writeln(‘ha=’,ha,’hb=’,hb,’hc=’,hc); readln; end.
y=sin2x funksiyasining [-π;π] oraliqdagi qiymatlarini 0,01 qadam bilan hisoblang. Natijalarni «sinus.out» faylida saqlab qo’ying.
uses crt; var ism: string; f: text; i: integer; begin clrscr; assign(f,’c:sinf.txt’); rewrite(f);
for i:=1 to 7 do begin write(i,’-oquvchining familiyasini va ismini kiriting=’); readln(ism); writeln(f,ism); end; close(f); readln; end.
Ekranning o’rtasida radiusi 100 ga teng sariq rangli aylana chizing.
Uses wincrt, graph; label 1; Var gd,gm,i: integer; y: char; Begin gd:=0; InitGraph(gd,gm,»);
Setcolor(14); Circle(500,350,100); readln; closegraph; end.
Istagan butun sonni 17 ga qoldiqsiz bo’linishi yoki bo’linmasligini aniqlovchi dastur tuzing.
Uses crt; Var a: integer; Begin ClrScr; Write(‘a sonnni kiriting=’); readln(a); If trunc(a/17)*17=a then writeln(‘bo`linadi.’) else writeln(‘bo`linmaydi.’);Readln; End.
Kvadratlari berilgan natural N sondan katta bo’lmagan natural sonlarni chiqaruvchi dastur tuzing.
1-usul
Uses crt; Var I,N: integer; Begin ClrScr; Write(‘N ning qiymatini kiriting=’); readln(N); I:=1;
While I*I<=N do Begin writeln(I); I:=I+1; end; Readln; End.
2-usul
uses crt; var n,_n:real; begin textcolor(14); textbackground(1); clrscr; write(‘N sonini kiritng:’); readln(n); _n:=1; while n>sqr(_n) do begin _n:=_n+1; writeln(_n-1); end; readln; end.
Berilgan N natural sonning raqamlari yig’indisini topish dasturini tuzing.
1-usul
var n,raqam,len,i,c,natija: integer; _n,_raqam:string; begin write(‘Natural sonni kiriting:‘);readln(n);
str(n,_n); len:=length(_n); natija:=0; for:=1 to len do begin _raqam:=copy(n,i,1); val(_raqam,raqam,c); natija:=natija+raqam; end; writeln(n,’ sonining raqamlari yig’indisi=’,natija); readln; end.
2-usul
uses crt; var a,len,s,b,n:real; begin clrscr; readln(a); n:=0; while exp(n*ln(10))<a do n:=n+1; repeat
len:=exp((n-1)*ln(10)); b:=trunc(a/len); s:=s+b; a:=a-b*len; n:=n-1; until a<9; write(‘Raqamlari yig`indisi: ‘,s+a:1:0); readln; end.
A(N) butun qiymatli massiv elementlari ichida eng ko’p takrorlanadigan elementlar sonini va o’sha elementni chop etuvchi dastur tuzing.
uses crt; const n1=100; var a:array[1..n1] of integer; max,maxn,sum:integer; I,j,n: integer; begin
writeln(‘Massiv elementlari sonini kiriting: ‘); readln(n); write(‘massiv elementlarini kiriting: ‘);
for i:=1 to n do begin write(‘a(‘,i,’)=’); readln(a[i]); end; max:=1; maxn:=1; for i:=1 to n-1 do begin sum:=0; for j:=i+1 to n do begin if a[i]=a[j] then inc(sum); end; if sum>max then
begin max:=sum; maxn:=i; end; end; writeln; writeln(‘a(‘,maxn,’)=’,a[maxn],’ elementi eng ko`p takrorlanadi’); writeln(max+1,’ marta ‘); readln; end.
Berilgan kesmalardan uchburchakni hosil qilish mumkinligini tekshirish dasturini tuzing.
uses crt; label 1; var a,b,c:real; begin write(‘1-kesma uzunligini kiriting: ‘); readln(a);
write(‘2-kesma uzunligini kiriting: ‘); readln(b);write(‘3-kesma uzunligini kiriting: ‘); readln(c);
if (a+b>c) and (a+c>b) and (b+c>a) then begin writeln(‘Berilgan kesmalardan uchburchak hosil qilish mumkin’); goto 1; end else writeln(‘Berilgan kesmalardan uchburchak hosil qilib bo`lmaydi’);
1: readln; end.
Kvadrat tenglamaning yechilishi dasturini tuzing.
uses crt; label 1; var a,b,c,x1,x2,d:real; begin ClrScr; write(‘Bosh koeffitsentni kiriting а= ‘); readln(a); write(‘Ikkinchi koeffitsentni kiriting b= ‘); readln(b); write(‘Ozod hadni kiriting c= ‘); read(c); d:=sqr(b)-4*a*c; if d<0 then begin writeln(‘Haqiqiy ildizlari yo`q.’); goto 1; end;
if d=0 then begin writeln(‘x1=x2= ‘,-b/2*a); goto 1; end; x1:=(-b+sqrt(d))/(2*a); x2:=(-b-sqrt(d))/(2*a); writeln(‘x1=’,x1); writeln(‘x2=’,x2); 1: readln; end.
Berilgan besh raqamli sonning polindram bo’lganligini aniqlang.
uses crt; var a1,b:string; i,a,len:longint; begin clrscr; write(‘Sonni kiriting: ‘); readln(a);
str(a,a1); len:=length(a1); for i:=1 to len do b:=a1[i]+b; if a1=b then write(‘bo`ladi’)
else write(‘bo`lmaydi’); readln; end.
Berilgan natural sonni teskari tartibda yozish dasturini tuzing.
uses crt; var a,i,len:integer; b,c,teskari:string; begin write(‘Sonni kiriting: ‘); readln(a); str(a,c); len:=length(c); for i:=1 to len do begin b:=copy(c,i,1); teskari:=b+teskari; end; write(teskari); readln; ;end.
N natural sonni barcha bo’luvchilarini topuvchi dastur tuzing.
1-usul
var i,n:real; begin write(‘n=’); readln(n); writeln(n,’ sonining bo`luvchilari: ‘);
i:=0; repeat i:=i+1; if trunc(n/i)*i=n then writeln(i); until i>n; readln; end.
2-usul
uses crt; var i,n:longint; begin textcolor(14); textbackground(1); clrscr; write(‘n=’); readln(n); writeln(n,’ sonining bo`luvchilari: ‘); for i:=1 to n do begin if trunc(n/i)*i=n then writeln(i); end; readln; end.
Hafta kunlari raqamlar bilan kiritilsa, so’zlar orqali natijaga chiqarish dasturi tuzilsin.
uses crt; label 1; var a:real; b:string; begin write(‘Raqamni kiriting: ‘); readln(a); if not((a=1) or (a=2) or(a=3) or(a=4)or(a=5)or(a=6)or(a=7)) then begin write(‘XATO’); goto 1; end; if a=1 then writeln(‘Dushanba’) else if a=2 then writeln(‘Seshanba’)else if a=3 then writeln(‘Chorshanba’) else if a=4 then writeln(‘Payshanba’) else if a=5 then writeln(‘Juma’)else if a=6 then writeln(‘Shanba’) else if a=7 then writeln(‘Yakshanba’); 1: readln; end.
A[1..15] massiv berilgan. Massivning toq indeksli elementlarining yig’indisidan juft elementlarini ayirib chiqaruvchi dastur tuzing.
program dars34_mashq7; uses crt; var a:array[1..15] of real; toq,juft,s:real; i:integer; begin textcolor(14); textbackground(1); clrscr; for i:=1 to 15 do begin write(i,’-elementni kiriting:’); readln(a[i]); end; for i:=1 to 15 do begin if odd(i) then toq:=toq+a[i] else juft:=juft+a[i]; end; s:=toq-juft; write(‘Ayirma: ‘,s); readln; end.
yig’indining hisoblash dasturini tuzing.
program dars34_mashq4; uses crt; var s:real; i:integer; begin for i:=7 to 2007 do if (i mod 10)=7 then s:=s+i/(i+4);writeln(‘Yig`indi: ‘,s); readln; end.
y=x*sin x funksiyaning qiymatlarini [ ] oraliqda 0,3 qadam bilan sonlarni chiqaruvchi dastur tuzing.
uses crt; var x,y:real; begin x:=-pi; while x<=pi do begin y:=x*sin(x);writeln(‘x=’,x:1:2,’ bo`lganda y=’,y:1:2); x:=x+0.3; end; readln; end.
Ikki xonali natural sonlar ichida raqamlari yig’indisi juft bo’lgan sonlarni chiqaruvchi dastur tuzing.
1-usul
uses crt; var k,k1,k10,s:integer; begin k:=10; while k<=99 do begin k1:= k mod 10; k10:=k div 10; s:=k1+k10; if not(odd(s)) then writeln(k);k:=k+1; end; readln; end.
2-usul
uses crt; var k,k1,k10,s:integer; begin k:=10; repeat k1:= k mod 10; k10:=k div 10; s:=k1+k10; if not(odd(s)) then writeln(k);k:=k+1; until k>=99; end.
Berilgan butun N son musbat 6 ga karrali bo’lsa, shu sonning kvadrat ildizini, aks holda kvadratini hisoblash dasturini tuzing.
uses crt; var n:integer; begin write(‘N sonni kiriting: ‘); readln(n); if trunc(n/6)*6=n then write(sqrt(n)) else write(sqr(n)); readln; end.
A(N) sonlar massivi elementlarini yangi B(N) massivga teskari tartibda ko’chiring. (b1=an, b2=an-1 … bn=a1)
uses crt; const n1=100; var a,b:array[1..n1] of real; n,i:integer;
begin clrscr; write(‘n ni kiriting: ‘); readln(n); for i:=1 to n do
begin write(‘a(‘,i,’)=’); readln(a[i]); end; for i:=1 to n do begin
b[i]:=a[n+1-i]; writeln(‘b(‘,i,’)=’,b[i]); end; readln; end.
Ikkita x,y sonlar berilgan (x≠y). Ular ichida eng kichik sonni bu ikki son yig’indisining yarmi bilan almashtiruvchi, eng kattasini esa bu sonlarning ko’paytmasi bilan almashtiring.
var x,y:real; begin write(‘x=’); readln(x); write(‘y=’); readln(y);
if x>y then begin x:=x*y; y:=(x+y)/2; end; else begin y:=x*y; x:=(x+y)/2; end; writeln(‘x=’,x,’ y=’,y); readln; end.
N natural son berilgan. ko’paytmani toping
var n,i:integer; p:real; begin write(‘n=’); readln(n); p:=1; i:=-1;
repeat i:=i+2; p:=p*i/(2*i); until i=n+2; writeln(‘p=’,p); readln; end.
1 dan 1000 gacha bo’lgan sonlardan 2 ga karralilarini yig’indisini hisoblash dasturini tuzing.
uses crt; var i,s:integer; begin clrscr;s:=0; for i:=1 to 1000 do beginif not(odd(i)) then s:=s+i; end; write(‘Yig`indi:’,s);readln; end.
Butun sonli to’rtburchakli A(1:N;1:K) jadval berilgan. Bu jadvalning hamma elementlarining ishorasini teskarisiga o’zgartirish dasturini tuzing.
uses crt; const n1=100; k1=100; var a,b:array[1..n1,1..k1] of real;
k,n,i,j:integer;begin clrscr; write(‘n ni kiriting: ‘); readln(n);
write(‘k ni kiriting: ‘); readln(k); for i:=1 to n do begin
for j:=1 to k do begin write(‘a(‘,i,’,’,j,’)=’); readln(a[i,j]); end; end;clrscr; for i:=1 to n do begin for j:=1 to k do begin
b[i,j]:=-a[i,j]; writeln(‘b(‘,i,’,’,j,’)=’,b[i,j]); end; end; end.
Kvadrat tomonlariga urunuvchi aylana chizish dasturini tuzing.
uses graph; var gd,gm,a,r,x,y:integer; begin
gd:=0; write(‘Aylanani radiusini kiriting:’); readln(r); a:=2*r; x:=320; y:=240; initgraph(gd,gm,’’); circle(x,y,r);
rectangle(x-r,y-r,x+r,y+r); readln; closegraph; end;
Berilgan N ta so’zda ishtirok etadigan harflar yordamida berilgan so’zni hosil qilish mumkinligini aniqlovchi dasturni tuzing. Agar hosil qilib bo’lmasa, bu haqda ma’lumot berilsin.
uses crt; var suzs:array[1..100] of string; suz:string; i,j,n:integer; ch:char; bor:Boolean; begin textcolor(14); textbackground(1); clrscr; write(‘So`zlar sonini kiriting: ‘); readln(n);write(‘So`zlarni kiriting:’);for i:=1 to n do begin write(i,’-so`z:’); readln(suz[i]); end;write(‘Hosil qilmoqchi bo`lgan so`zni kiriting:’); readln(suz);i:=0;repeatinc(i); j:=0; bor:=false; ch:=suz[i]; repeatinc(j); if pos(ch,suzs[j])>0 then bor:=true;
until bor or(j=n);if not(bor) and (j<n) then i:=length(suz);
until i=length(suz); if bor then Writeln(‘Berilgan so`zlardan ‘,suz,’ so`zini hosil qilib bo`ladi’) else write(‘Berilgan so`zlardan ‘,suz,’ so`zini hosil qilib bo`lmaydi’); end.
ax+b=0 chiziqli tenglamani yechish dasturini tuzing.
uses crt; label 5; var a,b,x: real; begin write(‘a ni kiriting=’); readln(a); write(‘b ni kiriting=’); readln(b); if (a=0) and (b=0) then begin writeln(’ x – istalgan son.’); goto 5; end; if a=0 then begin writeln(’yechimga ega emas’); goto 5; end; writeln(‘x=’,b/a); 5: readln; end.
Tug’ilganingizdan beri necha kun yashaganingizni aniqiang.
Uses crt; Var a,b,c,a1,b1,c1,s,s1,s2: integer; Begin
ClrScr; Write(‘Tug`ilgan yilingizni kiriting=’); readln(a);
Write(‘Tug`ilgan oyingizning tartib raqamini kiriting=’); readln(b);
Write(‘Tug`ilgan kuningizni kiriting=’); readln(c); Write(‘Joriy yilini kiriting=’); readln(a1); Write(‘Joriy oyning tartib raqamini kiriting=’); readln(b1); Write(‘Joriy kunni kiriting=’); readln(c1);
S:=a1-a; s:=s*365; S1:=b1-b; s:=s+30*s1; s2:=c1-c; s:=s+s2;
Writein(s,’ kun’ ); Readln; End.
a 1 , a 2 , …, a N butun sonlar ketma-ketligi berilgan. Ularni ketma-ket qo’shib borib, yig’indi berilgan N butun sondan ortishi bilan ekranga chiqaruvchi dastur tuzing. Agar barcha sonlar yig’indisi N dan ortmasa, bu haqda xabar chiqaring.
Uses crt; Var i, S: integer; A:array[1..10] of integer; Const N=10;
Begin ClrScr; For i:=1 to N do begin Write(i,‘-hadni kiriting=’); readln(a[i]); end; S:=0; I:=1; While S<=N do Begin S:=S+a[i]; I:=I+1; end; Writeln(‘S=’,S); Readln; End.
Quyidagi yig’indining qiymati berilgan M natural sondan ortiq bo`lguncha hisoblash dasturini tuzing:
uses crt; var n: integer; m,y: real; begin clrscr; write(‘M ning qiymatini kiriting = ‘); readln(m); n:=1; repeat begin if n/2=int(n/2) then y:=y-(1/(n*(2*n+1))) else y:=y+(1/(n*(2*n+1))); n:=n+1;end;
until y>m; write(‘y=’,y); readln; end.
Sinfdoshlaringizning familiya va ismlaridan tashkil topgan «SINF.TXT» nomli matnli fayl hosil qiluvchi dastur tuzing.
uses crt; var ism: string; f: text; i: integer; begin clrscr; assign(f,’c:sinf.txt’); rewrite(f); for i:=1 to 7 do begin
write(i,’-oquvchining familiyasini va ismini kiriting=’); readln(ism);
writeln(f,ism); end; close(f); readln; end.
«massiv.in» fayli 12 ta satrdan iborat. Uning har bir satrida 9 tadan son o’zaro probel bilan ajratib yozilgan. A(12;9) – ikki o’lchamli massiv elementlarining qiymatlarini «massiv.in» faylidan o’qib oluvchi dastur tuzing.
Uses crt; Var i,j,x,y,k: integer; f: text; s: string; a: array [0..12,0..9] of string; Begin clrscr; k:=1; assign(f,’c:\massiv.in’); reset(f); j:=1;
repeat k:=1; readln(f,s); for i:=2 to length(s) do if s[i]=’ ‘ then begin a[j,k]:=copy(s,1,i-1); delete(s,1,i-1); k:=k+1;end; a[j,k]:=s; j:=j+1; until eof(f); close(f); for i:=1 to 12 do begin for j:=1 to 9 do write(a[i,j],’ ‘); writeln; end; readln; end.
Tekislikda uchta nuqta berilgan. Ulardan qaysi biri koordinatalar boshiga yaqinroq joylashganligini aniqlovchi dastur tuzing.
Uses Crt; Var xA, yA, xB, yB, xC, yC, mA, mB, mC : Real;
BEGIN ClrScr; WriteLn(‘A nuqtaning koordinatalarini kiriting:’);
Write(‘x = ‘); ReadLn(xA); Write(‘y = ‘); ReadLn(yA); WriteLn(‘B nuqtaning koordinatalarini kiriting:’); Write(‘x = ‘); ReadLn(xB); Write(‘y = ‘); ReadLn(yB); WriteLn(‘C nuqtaning koordinatalarini kiriting:’); Write(‘x = ‘); ReadLn(xC); Write(‘y = ‘); ReadLn(yC);
mA := sqrt(sqr(xA) + sqr(yA)); mB := sqrt(sqr(xB) + sqr(yB));
mC := sqrt(sqr(xC) + sqr(yC)); WriteLn; Write(‘Javob: ‘);
If (mA < mB) and (mA < mC) then WriteLn( ‘A nuqta.’) else
If (mB < mC) then WriteLn(‘B nuqta.’) else WriteLn(‘C nuqta.’);
ReadLn; END.
Berilgan matndagi so`zlar sonini aniqlang.
uses crt; var matn: string; i,n: integer; m: boolean; belgi: char;
begin clrscr; writeln(‘matnni kiriting:’); readln(matn);
n:=0; m:=true; for i:=1 to length(matn) do begin
belgi:=matn[i]; if (belgi<>’ ‘) and m then n:=n+1; m:=(belgi=’ ‘) end; writeln;writeln(‘javob:matndai so`zlar soni: ‘,n); readln; end.
A[1..10] sonli massiv elementlarini o`sish tartibida saralovchi dastur tuzing.
uses crt; Label 5,10; var i,k,m:integer; b,c:real; a:array[1..10] of real; begin clrscr; for i:=1 to 10 do begin writeln(i,’-elementni kiriting=> ‘); readln(a[i]);end; 5: m:=0; for i:=1 to 9 do
if a[i]>a[i+1] then begin b:=a[i]; a[i]:=a[i+1]; a[i+1]:=b; m:=1; end; if m=1 then goto 5; for i:=1 to 10 do writeln(a[i]:3:0);
readln; end.