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. (b₁=a_n, b₂=a_n-1 … b_n=a₁)

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.