1 Екі санның қосындасын табу программасын құру керек



бет4/5
Дата08.06.2016
өлшемі458.5 Kb.
#122677
1   2   3   4   5

Setcolor (6);


Circle (400, 350, 20);

Setfillstyle (1, 6);

Floodfill (400, 350, 6);

Setcolor (4); {марсты салу}

Circle (500, 400, 40);

Setfillstyle (1, 4);


Floodfill (500, 400, 4);

Setcolor (3); {жерді салу}

Arc (0, 470, 0, 90, 150);

Line (0, 470, 0, 320);

Line (0, 470, 150, 470);

Setfillstyle (1, 3);

Floodfill (10, 400, 3);

Setlinestyle (0, 1, 3);

Setcolor (10);

For I:=153 downto 110 do

Begin

Arc (0, 470, 0, I-110, I-3);



Arc (0, 470, 0, I-70, I-3);

End;


End;

Procedure raketa;

Begin

Setlinestyle (0, 1, 1); {ракетаныњ корпусын салу}



Setcolor (8);

Line (150, 350, 200, 300);

Line (200, 300, 210, 310);

Line (210, 310, 160, 360);

Line (160, 360, 150, 350);

Setfillstyle (1, 8);

Floodfill (155, 350, 8);

Setcolor (7);

Line (200, 300, 220, 290);

Line (220, 290, 210, 310);

Line (210, 310, 200, 300);

Setfillstyle (1, 7);

Floodfill (210, 305, 7);

Setlinestyle (0, 1, 3); {ракетаныњ ќанаттары}

Setcolor (8);

Rectangle (150, 350, 160, 340);

Rectangle (160, 340, 170, 360);

Setcolor (4); {ракетадан шыќќан жалынды салу}

Line (150, 360, 140, 370);

Line (145, 355, 135, 365);

Setcolor (14);

Line (148, 358, 138, 368);

Line (155, 365, 145, 375);

End;


Begin

Directvideo := false;


A:=detect;

Initgraph (A, U, ‘C:\BP\BGI’);

E:= graphresult;

If E<> GROK then

Writeln (grapherror msg (E))

else


Begin

Clrscr ;


Cleardevice;

Setviewport (0, 0, getmax x, getmax y, clipon);

Planets;

Raketa


Size := imagesize (120, 250, 300, 370);

Getmem (T, SIZE);

Getimage (120, 250, 300, 370, T); {салѓандарды µшіру}

putimage (120, 250, T, XORPUT);

starsky;

X:=120;


Y:=250;

DX:=10;


DY:=10 {ракетаны ќозѓалысќа келтіру}

For I:=1 to 50 do

Begin

X:=X+DX;


Y:=Y-DY;

putmage (X, Y, T, XORPUT);

delay (1000);

putimage (X, Y, T, XORPUT);

end;

end;


if readkey = #0 then X:=ord (readkey);

closegraph;

end.

107 n натурал саны, наќты а12,…,аn сандары берілген. Егер а12,…,аn тізбегі µспеуі бойынша реттелген (а1а2аn) болса, онда оны µзгеріссіз ќалдырып, керісінше жаѓдайда аn,,…, а1 тізбекті шыѓару керек.



Program spisok;

Type TP = ^ POSL;

POSL = record;

A : real;

NEXT : tp;

PRED : tp;

End;

Var F, C, P, B, Q : TP;



N, I : integer;

L: boolean;

Begin

Write(‘введите n:’);



Readln (N);

F := NIL; P := NIL; Q := NIL;

For I:=1to N do

Begin


New(C);

C^ . NEXT := NIL; C^. PRED := NIL;

READLN(C^. A);

IF F=NIL THEN F:=C;

P^. NEXT := C; P := C; C^. PRED := Q; Q := C;

End;


Writeln;

C := F;


While C^. NEXT< >NIL do

Begin


B := C^. NEXT;

If C^. A <= B^. A then

Begin

L := TRUE;



C := B;

End


Else

Begin


L := FALSE;

BREAK;


END;

END;


If L=TRUE then

Begin


C := F;

While C< >NIL do

Begin

Writeln(C^. A : 4 : 4);



C := C^ .NEXT;

End


End

Else


Begin

C := P;


While C< > NIL do

Begin


Writeln(C^. A : 4 : 4);

C :=C^. PRED;

End

End;


C:=F;

While C< > NIL do

Begin

F:=C^ .NEXT;



Dispose( C);

C := F;


End; End.

108

функциясыныњ х аргументіне байланысты нєтижесін есептеу программасын ќ±ру керек.

Программасы мына т‰рде болады:

Program esepteu;

Var x,y: real;

Begin

Writeln (' х енгіз');



Read (x);

If (x>-5) and (x<0) then y:= sqrt (sqr(x)+abs(x))

else

if(x>=0) and (x<2) then y:= 5*sqr(x)*x+cos(x);



Writeln ('нєтижесі');

Writeln ('y=', y); End.

109

program f;

var i,j :integer; s,s1:real;

begin s:=0; s1:=0;

for i:=1 to 6 do

begin for j:=1 to 10 do

s:=s+1/(i+j); s1:=s1+s end;

write(‘s1=’ s1:4:2) end.


n!

110 Ñmn = ---------- òåðó ñàíûí åñåïòå

m!(n-m)!

Program f;

Var n,m,v,c1,c2,c3:integer; c:real;

Procedure teru(q:integer; var r:integer);

Var k: integer;

Begin r:=1;

For k:=1 to q do

R:=r*k


End;

Begin read(n,m); v:=n-m;

teru(n,c1); teru(m, c2); teru(v,c3);

c:=c1/(c2*c3);

write(c:5:2)

end.


111 А(30) массивіндегі элементтерді µсу реті бойынша орналастыру программасын ќ±ру ќажет.
Program sarmass;

Const N=30;

Var A: array [1..N] of integer; I,L,C: integer;

Begin


Writeln (‘берілгендерді енгіз’);

For I:= to N do

Read (A[I]);

For I:=1 to N-1 do

If A[I] > A[L] then

Begin


C : = A[I];

A[I] := A[L];

A[L] := C;

End;


For I := 1 to N do

Writeln (A[I]:3);

End.

112 A[5,5] массиві берілген. Массивті кему реті бойынша реттеудіњ программасын ќ±ру керек.



Program sortmin;

Const N = 5;

Type mas = array [1..N, 1..N] of integer;

Var A : mas;

B : array [1..N] of integer;

I, J, L, S, V, min, C : integer;

Begin

Writeln (‘берілгендерді енгіз’);



For I := 1 to N do

For J := 1 to N do

Read (A[I,J]);

For I := 1 to N do

Begin

Min := A[I, 1];



For J := 1 to N do

If A[I,J] < min then min := A[I, J];

B[I] := min ;

End;


For J := 1 to N-1 do

For L := I+1 to N do




Достарыңызбен бөлісу:
1   2   3   4   5




©dereksiz.org 2024
әкімшілігінің қараңыз

    Басты бет