clrscr; M: = 5; n: = 9; s: = 4;
name [1]: = 'a'; name [2]: = 'b'; name [3]: = 'c'; name [4]: ​​= 'd'; name [5]: = 'e';
many [1]: = 1; many [2]: = 4; many [3]: = 1; many [4]: ​​= 3;
rang [1,1]: = 'a'; rang [1,2]: = 'c'; rang [1,3]: = 'e'; rang [1,4]: = 'e';
rang [2,1]: = 'b'; rang [2,2]: = 'd'; rang [2,3]: = 'a'; rang [2,4]: = 'a';
rang [3,1]: = 'c'; rang [3,2]: = 'b'; rang [3,3]: = 'd'; rang [3,4]: = 'b';
rang [4,1]: = 'd'; rang [4,2]: = 'e'; rang [4,3]: = 'b'; rang [4,4]: = 'd';
rang [5,1]: = 'e'; rang [5,2]: = 'a'; rang [5,3]: = 'c'; rang [5,4]: = 'c';
gotoXY (15,1);
writeln; writeln ('Кількість виборців:', N);
writeln ('Кількість кандидатів: ', M);
writeln ('Профіль переваг: ');
for i: = 1 to 40 do
write ('-');
writeln; write ('Кількість виборців');
gotoXY (19,7);
for i: = 1 to s do
write (many [i] ''); p> writeln; gotoXY (19,9);
for i: = 1 to M do
begin
for j: = 1 to s do
write (rang [і, j] ''); p> gotoXY (19, 9 + i);
end;
gotoXY (1,15);
end;
{---------------------------}
{перевіряє правильність введення варіанту вибору} procedure right;
label l;
begin
l: readln (c);
if (C <> '0 ') and (c <> '1') then
begin
write ('Повторіть спробу: ');
goto l;
end;
end;
{---------------------------}
{виводить список імен кандидатів} p> procedure help;
var x, y, i: byte;
begin
x: = WhereX;
y: = WhereY;
gotoXY (1,24);
write ('Імена кандидатів: ');
for i: = 1 to M do
if i <> M then write (name [i] ',')
else write (name [i]);
gotoXY (x, y);
end;
{---------------------------}
{визначення переможця виборів}
procedure victory (v: ball; s: string);
var max, t: shortint;
hl: array [1 .. 10] of byte;
begin
{визначення максимальної оцінки}
help;
max: = v [1];
for i: = 1 to M do
if max
max: = v [i];
t: = 1;
{визначення кандидатів з максимальною оцінкою}
for i: = 1 to M do
if (V [i]-max) = 0 then
begin
hl [t]: = i;
t: = t +1;
end;
if (T-1) = 1 then
begin
write ('Переможець за ', s' зі збереженням нейтральності: ');
writeln (name [hl [1]]); writeln ('Сума очок - ', Max);
end
else ...
