uses crt, MASMAS;
var k:integer;
label
ll;
procedure zadacha1;
var
d,m:integer;
Label lb;
Begin
clrscr;
lb:
writeln('Vvedite Mesyac');
readln(m);
writeln('Vvedite Den');
readln(d);
if (m>=13) or (d>=32) then
begin
writeln('oshibka');
goto lb;
end;
case m of
10,11:writeln('Osen');
12:if d<3 then
writeln('Osen')
else writeln('Zima');
1,2:writeln('Zima');
3:if d<3 then
writeln('Zima')
else writeln('Vesna');
4,5:writeln('Vesna');
6:if d<3 then
writeln('Vesna')
else writeln('Leto');
7,8:writeln('Leto');
9:if d<3 then
writeln('Leto')
else writeln('Osen');
end;
readln
end;
procedure zadacha2;
var m: array [1..45] of integer;
i,imax,imin,buf,max,min: integer;
begin
clrscr;
randomize;
min:=50;
max:=-50;
writeln('Ishodniy massiv M');
for i:=1 to 45 do
begin
m[i]:=random(101)-50;
write(m[i],' ');
end;
writeln;
writeln;
for i:=45 downto 1 do
begin
if m[i]>max then
begin
imax:=i;
max:=m[i];
end;
if m[i]<min then
begin
imin:=i;
min:=m[i];
end;
end;
writeln('MunumalnbIi element =',m[imin]:4,' pod undekcom ',imin);
writeln;
writeln('MakcumalnbIi element =',m[imax]:4,' pod undekcom ',imax);
writeln;
m[imin]:=max;
m[imax]:=min;
writeln('PreobrazovannbIi maccuv M');
for i:=1 to 45 do
write(m[i],' ');
readln;
end;
procedure zadacha3;
var a,a1,a2: string;
i,k: integer;
begin
clrscr;
write('a=');
readln(a);
a1:='';
a2:='';
for i:=1 to length(a) do
if (a[i]='k') or (a[i]='K') then k:=k+1;
i:=1;
while a[i]<>' ' do
begin
a1:=a1+a[i];
i:=i+1;
end;
i:=length(a);
while a[i]<>' ' do
begin
a2:=a[i]+a2;
i:=i-1;
end;
delete(a,length(a)-length(a2)+1,length(a2));
delete(a,1,length(a1));
a:=a2+a+a1;
writeln('a=',a);
write('K=',k);
readkey;
end;
procedure zadacha4;
type
color=record
naz:string;
col:string;
d:byte;
m:byte;
y:word;
sost:string;
end;
Const x:array[1..10] of color =
((naz:'laka';col:'KpacnbIi';d:2;m:6;y:1998;sost:'lak'),
(naz:'colorit';col:'gelt';d:3;m:9;y:1999;sost:'Maclenai'),
(naz:'gold';col:'KpacnbIi';d:6;m:9;y:2000;sost:'Maclenai'),
(naz:'log';col:'zelen';d:12;m:9;y:2000;sost:'lak'),
(naz:'dog';col:'gelt';d:15;m:6;y:1997;sost:'lak'),
(naz:'lord';col:'KpacnbIi';d:3;m:9;y:1999;sost:'lak'),
(naz:'rod';col:'gelt';d:23;m:2;y:2000;sost:'Maclenai'),
(naz:'pop';col:'gelt';d:22;m:3;y:1999;sost:'lak'),
(naz:'tot';col:'KpacnbIi';d:23;m:12;y:2003;sost:'lak'),
(naz:'kot';col:'zelen';d:26;m:11;y:2001;sost:'Maclenai'));
var i,p,k,k2:integer;
Begin
clrscr;
p:=2;
for i:=1 to 10 do
begin
with x[i] do
begin
gotoxy(2,1);
write('Nazvanie');
gotoxy(2,p);
write(naz);
gotoxy(15,1);
writeln('Cvet');
gotoxy(15,p);
write(col);
gotoxy(29,1);
writeln('Data izgotovleniya');
gotoxy(29,p);
write(d,'.',m,'.',y);
gotoxy(45,1);
writeln('Sostav');
gotoxy(45,p);
write(sost);
p:=p+2;
end;
end;
gotoxy(1,p);
for i:=1 to 10 do
if (x[i].sost='Maclenai') and (x[i].d>1) and (x[i].m>4) and (x[i].y>=1998) then
begin
writeln(x[i].naz);
writeln(x[i].col);
writeln(x[i].d,'.',x[i].m,'.',x[i].y);
writeln('---------');
end;
k:=0;
k2:=0;
for i:=1 to 10 do
if (x[i].sost='Maclenai') then inc(k);
writeln('Koli4estvo maclenoi kpacku: ',k);
for i:=1 to 10 do
if (x[i].col='KpacnbIi') then inc(k2);
writeln('Koli4estvo kpacnoi kpacku: ',k2);
readln
end;
procedure zadacha5;
var f:file of real;
n,i,k:integer;
a,s:real;
begin
clrscr;
{cozdadim file}
randomize;
assign(f,'file');
rewrite(f);
write('ckolko 4isel zapisat v file n=');
readln(n);
for i:=1 to n do
begin
a:=-5+10*random;
write(f,a);
end;
writeln('soderganue ucxodnogo file:');
{prosmotrim, poschitaem otricatelnbIe u okryglim ux}
reset(f);
k:=0;
for i:=0 to filesize(f)-1 do
begin
seek(f,i);
read(f,a);
write(a:0:2,' ');
if a<0 then
begin
k:=k+1;
seek(f,i);
a:=round(a);
write(f,a);
end;
end;
if k=0 then
begin
writeln('v file net otricatelnbIx 4isel, file ne preobrazovbIvaetsaiя');
readln;
close(f);
exit;
end;
writeln;
writeln;
{prosmotrim promegytocnbIi rezyltat, poschitaem crednee okryglennbIx otrucatelnbIx}
writeln('zamena otrucatelnbIx ux okryglennbImu:');
s:=0;
for i:=0 to filesize(f)-1 do
begin
seek(f,i);
read(f,a);
write(a:0:2,' ');
if a<0 then s:=s+a;
end;
writeln;
writeln;
s:=s/k;
writeln('crednee arufmetucheckoe okryglennbIx otrucatelnbIx =',s:0:2);
writeln;
{dopishem modyli otricatelnbIx v konec}
i:=0;
while i<=filesize(f)-k do
begin
seek(f,i);
read(f,a);
if a<0 then
begin
a:=abs(a);
seek(f,filesize(f));
write(f,a);
end;
i:=i+1;
end;
seek(f,filesize(f));{dopushem crednee}
write(f,s);
writeln('preobrazovannbIi file:');
seek(f,0);
while not eof(f) do
begin
read(f,a);
write(a:0:2,' ');
end;
close(f);
readln
end;
begin
LL:
textbackground(7);
textcolor(0);
clrscr;
gotoxy(39,1);
writeln('MENU');
writeln;
gotoxy(30,3);
writeln('1 - Zadacha1');
gotoxy(30,4);
writeln('2 - Zadacha2');
gotoxy(30,5);
writeln('3 - Zadacha3');
gotoxy(30,6);
writeln('4 - Zadacha4');
gotoxy(30,7);
writeln('5 - Zadacha5');
gotoxy(30,8);
writeln('6 - Exit ');
writeln;
textcolor(1);
write('Dlya vyibora programmyi vvedite nomer:');
readln(k);
case k of
1:begin
clrscr; textbackground(0);textcolor(10);zadacha1;goto LL;
{1}end;
2:begin
clrscr; textbackground(0);textcolor(3);zadacha2;goto LL;
{2}end;
3:begin
clrscr; textbackground(0);textcolor(2);zadacha3;goto LL;
{3}end;
4:begin
clrscr; textbackground(0);textcolor(5);zadacha4;goto LL;
{4}end;
5:begin
clrscr; textbackground(0);textcolor(8);zadacha5;goto LL;
{5}end;
6:exit;
else write('':40,'Povtorite vvod');delay(65000);goto LL;
end;
end.
(Текст модуля MASMAS)
Unit MASMAS;
Interface
Uses CRT;
Procedure zadacha1;
Implementation
procedure zadacha1;
var
d,m:integer;
Label lb;
Begin
clrscr;
lb:
writeln('Vvedite Mesyac');
readln(m);
writeln('Vvedite Den');
readln(d);
if (m>=13) or (d>=32) then
begin
writeln('oshibka');
goto lb;
end;
case m of
10,11:writeln('Osen');
12:if d<3 then
writeln('Osen')
else writeln('Zima');
1,2:writeln('Zima');
3:if d<3 then
writeln('Zima')
else writeln('Vesna');
4,5:writeln('Vesna');
6:if d<3 then
writeln('Vesna')
else writeln('Leto');
7,8:writeln('Leto');
9:if d<3 then
writeln('Leto')
else writeln('Osen');
end;
readln
end;
Begin
writeln;
End.
Тестирование. Предотвращение ошибок
В первой задаче предусмотрена защита от неправильного ввода. При вводе не существующего кода месяца или дня программа выдает ошибку. В основной программе предусмотрена ошибка от неправильного ввода номера задания.
Созданный файл: KYRSACH.PAS; MASMAS.TPU
