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

pRogRam Zdn_8;
Var
txt:String[100];
i,k:Byte;

Begin
i:=0; k:=0;
Writeln(’–> Vash text:’);
Readln(txt);
For i:=1 To Length(txt) Do
If txt[i]=’ ‘ Then k:=k+1;
Writeln(’–> Znakov probela v stroke ‘,k);
Readln;
End.

const n=5;
type
sved=record
marka:string[10];
l_sil:integer;
P_mest:integer;
end;
var
F:File of sved;
avto:sved;
i,kol:integer;

Procedure marka;
begin
assign(F,’avto.dat’);
reset(f);
writeln(’vvedite marku’);
readln(marka);
kol:=0;
while not (eof(f)) do
begin
read(F,avto);
if avto.marka=marka then
kol:=kol+1;
end;
close(f);
end;

Procedure zapolnenie;
begin
assign(F,’avto.dat’);
rewrite(F);
for i:=1 to n do
begin
writeln(’vvedite marku avto’);
readln(avto.marka);
writeln(’vvedite kol-vo loshd sil’);
readln(avto.l_sil);
writeln(’vvedite kol-vo posad mest’);
readln(avto.p_mest);
writeln(F,avto);
end;
end;

begin
zapolnenie;marka;
writeln(kol-vo mashin zadannoi marki -,kol);
readln;
end.

program affto;

Type

car=record

marka: string;

moshnost: integer;

mesta: integer;

end;

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.