Студенты-Программеры

program affto;

Type

car=record

marka: string;

moshnost: integer;

mesta: integer;

end;

Till Death Us Do Part video

var

cr: car;

f: file of car;

i:integer;

{Тут процедура начинается}

procedure createfile;

begin

assign (F, ‘cars.dat’);

rewrite (F);

For I:=1 TO 20 DO

begin

writeln (’Vvedite marku’);

readln (cr.marka);

writeln (’Vvedite moshnost (v loshadinyh silah)’);

readln (cr.moshnost);

writeln (’Vvedite kolichestvo mest’);

readln (cr.mesta);

write (f, cr);

end;

close (f);

end;

Program puzirek;
uses crt;
var
a:array[1..10] of integer;
i:integer;

Procedure sort;
var
i,j,k,rab:integer;
begin
for i:=1 to 10 do
for j:=1 to 10-i do
if a[j]>a[j+1] then
begin
rab:=a[j+1];
a[j+1]:=a[j];
a[j]:=rab;
writeln;
for k:=1 to 10 do
write(a[k],’.')
end;
end;

begin
clrscr;
randomize;
For i:=1 to 10 do
begin
a[i]:=random(5);
write(a[i]);write(’,');
end;
writeln;
sort;
readln;
end.

pRogRam Zdn_4;
Uses crt;
Const n=5; m=3;
Type arr= array [1..n,1..m] of byte;
Var massiv: arr;

Procedure Add(var mas: arr); (** zapolnenie massiva **)
Var i,j:byte;
Begin
Randomize;
For i:=1 to n do
For j:=1 to m do mas[i,j]:=random(50);
End;

Procedure Shw(var mas: arr); (** vivod massiva **)
Var i,j:byte;
Begin
For i:=1 to n do
For j:=1 to m do writeln(’ Mas[',i,'.',j,'] = ‘,mas[i,j]);
End;

BEGIN
ClrScr;Add(massiv);Shw(massiv);Readkey;
END.

pRogram Zdn_3;
var Fct:byte;

Function Factor(F:byte):longint;
Begin
If f=0 Then Factor:=1
Else Factor:=Factor(F-1)*F
End;

BEGIN
Write(’F! (0<=F<=255) / F= ‘);
Readln(Fct);
Writeln(’Factorial ‘,Fct,’! = ‘,Factor(Fct));
Readln;
END.

pRogram Zdn_2;
Uses crt;
Const n=10;
Var massiv: array [1..n] of byte;

Procedure Add(var mas: array of byte); (** zapolnenie massiva **)
Var i:byte;
Begin
i:=0;
Randomize;
For i:=1 to n do mas[i]:=random(20);
End;

Procedure Shw(var mas: array of byte); (** vivod massiva **)
Var i:byte;
Begin
i:=0;
For i:=1 to n do writeln(’ Mas[',i,'] = ‘,mas[i]);
End;

Procedure Obnl(var mas: array of byte); (** poisk dublikatov **)
Var i,j:byte;
Begin
i:=0; j:=0;
For i:=1 to n-1 do
For j:=i+1 to n do
If i<>j Then
If (mas[i]=mas[j]) and (mas[i]>0) Then
begin
writeln(’–> Mas[',i,'] & Mas [',j,'] = ‘,mas[j]);
Mas[j]:=0; (** dublikat obnulyaetsya **)
end;
End;

BEGIN
ClrScr;Add(massiv);Shw(massiv);Obnl(massiv);Shw(massiv);
(** massiv posle izmeneniya **)
Readkey;
END.