Приложение (код программы)

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

Наши рекомендации