Оцените пожалуйста решение, укажите на ошибки. Мне не совсем нравится частое использование case of end
- Код: Выделить всё
type
TSet = set of byte;
var
i:byte;
Bus, Truck, Car, Red, Yellow, White, Black, Sets:TSet;
function ReadType(aI:byte):TSet;
var
n:byte;
begin
ReadType:=[];
for n:=0 to 255 do
if n mod aI=0 then ReadType:=ReadType+[n];
end;
procedure SetOfType(var aBus, aTruck, aCar:TSet);
var
i, j:byte;
begin
i:=7;
repeat
case i of
7:aBus:=ReadType(i);
5:aTruck:=ReadType(i)-aBus;
else for j:=0 to 255 do
if not (j in aBus+aTruck) then aCar:=aCar+[j];
end;
i:=i-2;
until i<3;
end;
function ReadColor(aI:byte):TSet;
var
n:byte;
begin
ReadColor:=[];
for n:=0 to 255 do
if n mod aI=0 then ReadColor:=ReadColor+[n];
end;
procedure SetOfColor(var aRed, aYellow, aWhite, aBlack:TSet);
var
i, j:byte;
begin
i:=4;
repeat
case i of
4:aRed:=ReadColor(i);
3:aYellow:=ReadColor(i)-aRed;
2:aWhite:=ReadColor(i)-(aRed+aYellow);
else for j:=0 to 255 do
if not (j in aRed+aYellow+aWhite) then aBlack:=aBlack+[j];
end;
dec(i);
until i=0;
end;
procedure WriteSets(aSet:TSet);
var
j, k:byte;
begin
k:=0;
for j:=0 to 255 do begin
if j in aSet then inc(k);
end;
write(k, ' ');
end;
begin
//Множества типов автомобилей
Bus:=[]; Truck:=[]; Car:=[];
//Множество цветов
Red:=[]; Yellow:=[]; White:=[]; Black:=[];
SetOfType(Bus, Truck, Car);
SetOfColor(Red, Yellow, White, Black);
for i:=1 to 7 do begin
case i of
1:Sets:=Bus;
2:Sets:=Truck;
3:Sets:=Car;
4:Sets:=Red;
5:Sets:=Yellow;
6:Sets:=White;
7:Sets:=Black;
end;
WriteSets(Sets);
if (i=3) or (i=7) then writeln;
end;
Sets:=(Red*Car)+(White*Truck)+Bus;
WriteSets(Sets);
readln;
end.
