Пояснения к алгоритму

В переменную S вводится с клавиатуры название страны, среднюю плотность населения которой необходимо определить.

Из файла tip1.dat считывается очередной элемент файла (запись о стране) и помещается в переменную Z. При совпадении названия страны (поле country) в записи Z со значением S переменной b присваивается значение true. Начальное значение b было false. Это сделано для того, чтобы не просматривать остальные элементы файла до конца файла. Условие (not eof(f)) and (b=false) будет иметь значение false при b= true даже если не достигнут конец файла, что позволит досрочно выйти из цикла.

После выхода из цикла проверяется значение флажка b, если b=true то производится расчет средней плотности населения для страны заданной в переменной S. Если записи о стране с название S в файле нет, то выводится на экран текст «Неверно задано название страны или в файле нет информации об этой стране» ('INVALID NAME OR NAME WITH NO INFORMATION!').

Пользователь имеет возможность повторить заново выполнение процедуры не выходя в меню (ans<>0) или закончить выполнение процедуры и выйти в меню (ans=0).

Программа процедуры

procedure plotnst;

var s:string; b:boolean;

ans:byte; r:real;

begin

repeat

clrscr;

b:=false; textcolor (lightcyan);

gotoXY (3,2);

write ('Input name of the country ');

textcolor (white);

repeat readln (s) until s<>'';

reset (f);

while (not eof (f)) and (b=false) do

begin

read (f,z);

if z.country=s then b:=true

end;

if b=true then

begin r:=z.population/z.area;

gotoXY (3,4); textcolor (yellow);

writeln (z.country,' - ',r:8:2,' thousand men for 1 square kilometer')

end

else

begin gotoXY (3,4);

textcolor (lightred);

writeln ('INVALID NAME OR NAME

WITH NO INFORMATION!')

end;

writeln; textcolor (white);

write (' 0 - exit, 1 - continue ');

readln (ans)

until ans=0;

close (f)

end;

Примечание: при вводе названия страны в переменную S предусмотрено исключение варианта, когда пользователь может случайно ввести пустую строк, путем повторения ввода в переменную S.

5.7. Текст программы

Program KURSOVIK;

uses crt,graph;

const punkt:array[1..6] of string=

('1 - sozdaniye i dopolneniye',

'2 - display ',

'3 - plotnost naseleniya',

'4 - sum naseleniye kontinenta',

'5 - correction',

'6 - exit');

m='MAIN MENU';

v='Input number of punct ';

type zap=record continent,country:string [13];

area:real;

population:longint

end;

var f:file of zap;

z:zap;

num,i:integer;

procedure zastavka;

const

vspom='Kursovayarabota';

var gd,gm,a,i,x:integer;

begin

gd:=detect; initgraph (gd,gm,'D:\TP\BGI');

{на красном фоне появляется текст КУРСОВАЯ РАБОТА, с использованием эффекта «летящие буквы»}

setfillstyle (1,red); floodfill (1,1,red);

setcolor (blue); settextstyle (0,0,4);

for i:=1 to 9 do

begin

outtextXY(50*i,100,copy(vspom,i,1));

delay (20000)

end;

setcolor (blue); settextstyle (0,0,4);

for i:=10 to 15 do

begin

outtextXY (70*(i-9),250,

copy(vspom,i,1));

delay (20000);

end;

{от центра снизу экран меняет цвет фона,

закрывая надпись}

setcolor (6); setfillstyle (9,6);

x:=getmaxX div 2;

for a:=1 to x-20 do

begin

fillellipse(x,1,a,getmaxY+round(0.5*a));

delay (600)

end;

setfillstyle (9,6); floodfill (30,1,red);

{сверху экрана выводятся данные студента: фамилия, имя, факультет, группа; в центре экрана появляются 5 колец символизирующих 5 континентов, цвет колец изменяется}

repeat

setcolor (random (15));

settextstyle (0,0,2);

outtextXY (115,30,'IVANOW, FAVT-613');

a:=random (15);

setcolor (a); setfillstyle (1,a);

circle (150,180,70);

circle (150,180,55);

floodfill (150,115,a); a:=random (15);

setcolor (a); setfillstyle (1,a);

circle (300,180,70);

circle (300,180,55);

floodfill (300,115,a);

a:=random (15);

setcolor (a); setfillstyle (1,a);

circle (450,180,70);

circle (450,180,55);

floodfill (450,115,a); a:=random (15);

setcolor (a); setfillstyle (1,a);

circle (227,310,70);

circle (227,310,55);

floodfill (227,245,a); a:=random (15);

setcolor (a); setfillstyle (1,a);

circle (375,312,70);

circle (375,312,55);

floodfill (375,245,a);

for i:=1 to 100 do delay (1000);

until keypressed;

{после нажатия клавиши вид экрана изменяется, появляется изображение глобуса и солнца}

setcolor (yellow);

outtextXY (115,30,'IVANOW, FAVT-613');

setfillstyle (0,brown);

bar(0,getmaxY-50,getmaxX,getmaxY);

setlinestyle (0,0,3);

setcolor (0);

for x:=270 to 294 do

line (x,105,x-160,310);

bar (110,310,150,490);

for i:= 110 to 125 do

arc (210,220,230,420,i);

setcolor (lightblue);

for i:=1 to 100 do circle (210,220,i);

setcolor (blue); circle (210,220,100);

setcolor (yellow); circle (515,165,50);

setfillstyle (1,yellow);

floodfill (515,165,yellow);

setlinestyle (0,0,3);

line(435,165,595,165);

x:=440;

repeat

i:=round(sqrt(7000-sqr(x-515)))+165;

line (515,165,x,i);

i:=-round(sqrt(7000-sqr(x-515)))+165;

line (515,165,x,i);

x:=x+10;

until x>=600;

readkey;

{после нажатия клавиши появляется закрывающийся занавес}

a:=random (15); setfillstyle (1,a);

setcolor (a); x:=getmaxX div 2+50;

for a:=1 to x do

begin

fillellipse (1,1,a,3*a);

fillellipse (getmaxX,1,a,3*a);

delay (1500)

end;

closegraph

end;

procedure create;

const

materik:array [1..5] of string [13]=

('Africa','Asia','Europe','North

America','South America');

var s:string [7]; ans,j,n:byte; i:integer;

begin

clrscr; s:='TIP'; textcolor (white);

write('0 - to create baza;

1 - to continue baza');

readln (n); writeln;

case n of

0:begin rewrite (f); i:=0 end;

1:begin reset(f); seek(f,filesize (f));

i:=filepos (f)

end

end;

repeat

clrscr; i:=i+1; textcolor (magenta);

writeln ('Input record number ',i);

with z do

begin

textcolor (yellow);

write('Input name of the country');

textcolor (white);

readln (country); writeln;

textcolor (yellow);

writeln ('Choose your continent');

textcolor (lightblue);

for j:=1 to 5 do

writeln (j,' - ',materik [j]);

read(j); continent:=materik [j];

textcolor (yellow);

writeln('You have chosen', materik

[j]); writeln;

writeln ('Input area, population

and of revision'); textcolor(white);

read (area,population); writeln;

textcolor (yellow); writeln

textcolor (lightred);

writeln ('Dobavleno!')

end;

write (f,z); writeln; textcolor (white);

write ('0 - exit, 1 - continue ');

readln (ans); writeln

until ans=0;

close (f)

end;

procedure display;

const

s:array [1..4] of string=

('continent','country',

'area','population');

var i:integer; ans:byte;

begin

repeat

clrscr; textcolor (yellow);

for i:=1 to 4 do write (s[i],' ');

i:=2;

reset (f); textcolor (white);

while not eof (f) do

begin

read (f,z); i:=i+1;

gotoXY (1,i); write (z.continent);

gotoXY (15,i); write (z.country);

gotoXY (23,i); write (z.area:8:2);

gotoXY (33,i); write(z.population:10);

end;

gotoxy(10,15); textcolor (white);

write ('0 - exit, 1 - continue ');

read (ans); writeln;

until ans=0; close (f)

end;

procedure plotnst;

var s:string; b:boolean;

ans:byte; r:real;

begin

repeat

clrscr; b:=false;

textcolor (lightcyan); gotoXY(3,2);

write('Input name of the country');

textcolor (white);

repeat readln (s) until s<>'';

reset (f);

while (not eof (f)) and (b=false) do

begin

read (f,z);

if z.country=s then b:=true

end;

if b=true then

begin

r:=z.population/z.area;

gotoXY (3,4); textcolor (yellow);

writeln (z.country,' - ',r:8:2,

'thousand men for 1 square kilometer')

end

else

begin

gotoXY (3,4);

textcolor (lightred);

writeln ('INVALID NAME OR

NAME WITH NO INFORMATION!')

end;

writeln; textcolor (white);

write (' 0 - exit, 1 - continue ');

readln (ans)

until ans=0; close (f)

end;

procedure sumpop;

type

zap1=record

cont:string[13];

nas:longint

end;

const

z1:array[1..5] of zap1=

((cont:'Africa';nas:0),

(cont:'Asia';nas:0),

(cont:'Europe';nas:0),

(cont:'North America';nas:0),

(cont:'South America';nas:0));

var z2:zap1; i,j:integer;

begin

clrscr; ;

reset (f);

while not eof (f) do

begin

read (f,z);

for i:=1 to 5 do

if z.continent=z1[i].cont then

z1[i].nas:=z1[i].nas+z.population

end;

for i:=1 to 4 do

for j:=i+1 to 5 do

if z1[i].nas<z1[j].nas then

begin

z2:=z1[i]; z1[i]:=z1[j]; z1[j]:=z2

end;

textcolor(lightred); gotoxy(10,2);

write('SUM population on continents:');

textcolor(yellow);

gotoxy(5,3);write('Continent');

gotoxy(20,3);

write('Population (thousand people)');

for i:=1 to 5 do

with z1[i] do

begin

textcolor (white); gotoXY (5,i+4);

write (cont);

if nas<>0 then

begin

gotoXY (20,i+4); write (nas)

end

else

begin

textcolor(lightred);

gotoxy(20,i+4);

write ('NO INFORMATION')

end

end;

gotoxy(10,15);

Write('Continue. Press on key');

readkey; close (f)

end;

procedure correct;

const

materik:array [1..5] of string [13]=

('Africa','Asia','Europe',

'North America','South America');

var ans,l,i:integer; imya:string; b:boolean;

begin

repeat

clrscr;

write('0 - to correct,

1 - to change numeric information');

read (l); writeln;

reset (f); textcolor (green);

write ('Input name of the country

you want to change ');

textcolor (white);

repeat readln (imya) until imya<>'';

writeln; b:=false;

while (not eof (f)) and (b=false) do

begin

read (f,z);

if z.country=imya then b:=true

end;

if (b=true) and (l=0) then

begin

textcolor (green);

write('Input new name of the country');

textcolor (white); readln (z.country);

writeln; textcolor (green);

writeln ('Choose the continent');

textcolor (lightcyan);

for i:=1 to 5 do

writeln (i,' - ',materik[i]);

writeln; textcolor (white);

read (i); z.continent:=materik [i];

textcolor (green);

writeln('You have chosen',materik [i]);

writeln

end;

if b=true then

begin

textcolor (green);

writeln('Input NEW area, poppulation');

textcolor (white);

read (z.area,z.population);

writeln; textcolor (green);

write ('Input NEW capital population');

textcolor(white);seek (f,filepos(f)-1);

write (f,z); writeln;

textcolor(yellow); write ('Obnovleno!')

end

else begin

textcolor (lightred);

writeln ('INVALID NAME OR

NAME WITH NO INFORMATION !');

writeln

end;

textcolor (white);

write ('0 - exit, 1 - continue ');

readln (ans); writeln;

until ans=0; close (f)

end;

begin

zastavka;

assign(f,'tip1.dat');

repeat

clrscr; gotoXY (20,7); textcolor (red);

write (m); textcolor (yellow);

for i:=1 to 6 do

begin

gotoXY (15,10+i); writeln (punkt[i])

end;

gotoXY (15,21); textcolor (white);

write (v); read (num);

case num of

1: create;

2: display;

3:plotnst;

4:sumpop;

5:correct;

end

until num=6

end.