Код:
uses GraphWPF;
const
w = 45; //ширина ячейки
h = 55; //отступ над полем
n = 9; //поле 9 на 9
var
Pole: array[,] of integer; //пусто, красный,желтый, зеленый, голубой, синий.фиолетовый. коричневый
BallClick, //выбран шар для хода
EndGame: boolean; //0 - игра 9 - конец игры
BallClickIndex: (integer, integer); //индекс выбранного шара
Dollar: integer; //очки, кол-во шаров
Ball3NextColor: list<integer>; //три следующих случайных шара
DeleteBall: Function:boolean; //указатель либо на Линии, либо на Квадраты
//вывод изображений по индексу
procedure DrawXY(i,j: integer);
const ColorN: array of Color = (Colors.Black, Colors.Red, Colors.Gold, Colors.ForestGreen,
Colors.DarkCyan, Colors.Blue, Colors.Fuchsia, Colors.Brown);
begin
var (x, y) := (j*w+3, i*w+h-1);
if i > 9 then begin
if i = 20 then
begin //вывод кол-ва очков
FillRectangle(165,24,80,23,Colors.Black);
DrawText(165,25,80,25,'0'*(5 - j.toString.Length)+j.ToString);
end
else FillCircle(180 + (i-10) * 25, 14 , 9, ColorN[j]); // один из 3х минишаров над полем
exit;
end;
case Pole[i,j] of
0: //очистка клетки серой заливкой
FillRectangle(x+2,y+2,w-5, w-5, RGB(192,192,192));
1..7: //вывод шара на поле
FillCircle(x+w div 2, y+w div 2, 18, ColorN[Pole[i,j]]);
11..17: //выделение шара для хода
DrawCircle(x+w div 2, y+w div 2, 17, Colors.White);
-7..-1: //вывод на поле одного из 3х минишаров
begin
FillRectangle(x+2,y+2,w-5, w-5, RGB(192,192,192));
FillCircle(x+w div 2, y+w div 2, 6, ColorN[abs(Pole[i,j])]);
end
end
end;
//все клетки заняты, конец игры
Procedure TheEnd;
begin
endgame := true;
FillRectangle(140, 5 , 130, 20, Colors.Black);
Font.Color := Colors.Yellow;
DrawText(144, 3 , 128, 20, 'Повторим?');
end;
//удаление квадратов из 4х шаров
Function DeleteBallSquares: boolean;
begin
Result := false;
var metka := new boolean[n,n]; //помечаем к удалению
//метка шаров к удалению
for var i:=0 to 7 do
for var j:=0 to 7 do
if (Pole[i,j]=Pole[i+1,j]) and (Pole[i,j]=Pole[i,j+1]) and (Pole[i,j]=Pole[i+1,j+1])
and (Pole[i,j]>0) then
begin
Result := true;
metka[i,j]:=true;
metka[i+1,j]:=true;
metka[i,j+1]:=true;
metka[i+1,j+1]:=true;
end;
If Result then sleep(200);
//удаление
for var i:=0 to 8 do
for var j:=0 to 8 do
if metka[i,j] then
begin
Dollar:=Dollar + 1;
Pole[i,j]:=0;
DrawXY(i,j);
metka[i,j] := false;
end;
DrawXY(20, Dollar); //вывод очков
end;
//удаление линий из 5 шаров
Function DeleteBallLine: boolean;
begin
Result := false;
var metka := new boolean[n,n]; //помечаем к удалению
//метка шаров к удалению по горизонталям
for var i:=0 to 4 do
for var j:=0 to 8 do
if (Pole[i,j]=Pole[i+1,j]) and (Pole[i,j]=Pole[i+2,j]) and (Pole[i,j]=Pole[i+3,j])
and (Pole[i,j]=Pole[i+4,j]) and (Pole[i,j]>0) then
begin
Result := true;
metka[i,j]:=true;
metka[i+1,j]:=true;
metka[i+2,j]:=true;
metka[i+3,j]:=true;
metka[i+4,j]:=true;
end;
//метка шаров к удалению по вертикалям
for var i:=0 to 8 do
for var j:=0 to 4 do
if (Pole[i,j]=Pole[i,j+1]) and (Pole[i,j]=Pole[i,j+2]) and (Pole[i,j]=Pole[i,j+3])
and (Pole[i,j]=Pole[i,j+4]) and (Pole[i,j]>0) then
begin
Result := true;
metka[i,j]:=true;
metka[i,j+1]:=true;
metka[i,j+2]:=true;
metka[i,j+3]:=true;
metka[i,j+4]:=true;
end;
//метка шаров к удалению по диагоналям
for var i:=0 to 4 do
for var j:=0 to 4 do
if (Pole[i,j]>0) and (Pole[i,j]=Pole[i+1,j+1]) and (Pole[i,j]=Pole[i+2,j+2])
and (Pole[i,j]=Pole[i+3,j+3]) and (Pole[i,j]=Pole[i+4,j+4]) then
begin
Result := true;
metka[i,j]:=true;
metka[i+1,j+1]:=true;
metka[i+2,j+2]:=true;
metka[i+3,j+3]:=true;
metka[i+4,j+4]:=true;
end;
for var i:=8 downto 4 do
for var j:=0 to 4 do
if (Pole[i,j]>0) and (Pole[i,j]=Pole[i-1,j+1]) and (Pole[i,j]=Pole[i-2,j+2])
and (Pole[i,j]=Pole[i-3,j+3]) and (Pole[i,j]=Pole[i-4,j+4]) then
begin
Result := true;
metka[i,j]:=true;
metka[i-1,j+1]:=true;
metka[i-2,j+2]:=true;
metka[i-3,j+3]:=true;
metka[i-4,j+4]:=true;
end;
If Result then sleep(200);
//удаление
for var i:=0 to 8 do
for var j:=0 to 8 do
if metka[i,j] then
begin
Dollar:=Dollar + 1;
Pole[i,j]:=0;
DrawXY(i,j);
metka[i,j] := false;
end;
DrawXY(20, Dollar); //вывод очков
end;
//Генерация трех случайных шаров в случайных позициях
procedure RandomBallGen;
begin
Ball3NextColor.Clear; //чистый список для 3х шаров
Loop 3 do Ball3NextColor.Add( - Random(1,7)); // наполнили список
var Zero := Pole.Indices(t-> t=0).toList; //список индексов пустых клеток
for var c := 0 to (Zero.Count-1).ClampTop(2) do
begin
var RndIndex := Random(0, Zero.Count-1); //рандомно выбираем индекс для минишара
Pole[Zero[RndIndex].Item1, Zero[RndIndex].Item2] := Ball3NextColor[c];
DrawXY(10+c, -Ball3NextColor[c]); //вывод над полем предросмотра 3х цветов
Zero.RemoveAt(RndIndex); //исключаем для рандома повторный выбор индекса
end;
end;
//выводим три новых шара
Procedure RandomBall;
begin
if DeleteBall then exit; //после удаления собранного комплекта новые шары не выводим
var miniball := Pole.Indices(t-> t<0); //сканируем поле на наличие минишаров
miniball.ForEach(t-> //увеличить минишары на поле
begin
Ball3NextColor.RemoveAt(Ball3NextColor.FindIndex(g-> g = Pole[t[0],t[1]]));
Pole[t[0],t[1]] := - Pole[t[0],t[1]];
DrawXY(t[0],t[1])
end);
//если было увеличино меньше 3х минишаров генерируем и выводим недостающие
While Ball3NextColor.Any do
begin
var Zero := Pole.Indices(t-> t=0).toList;; //сканируем поле на наличие пустых клеток
if Zero.Count = 0 then begin theEnd; exit end; //поле заполнено - конец игры
var r := Random(0, Zero.Count-1); //из имеющихся пустых клеток выбираем рандомный
Pole[Zero[r].Item1, Zero[r].Item2] := - Ball3NextColor[0];
DrawXY(Zero[r].Item1, Zero[r].Item2); //и выводим шар с цветом заранее запланированном
Ball3NextColor.RemoveAt(0); //удаляем выставленный цвет из списка "цвета для трех шаров"
end;
DeleteBall; //проверка на возможность удаления собранной линии/квадрата
if Pole.Indices(t-> t<1).Count = 0 then begin theEnd; exit; end; //все клетки заняты, конец
RandomBallGen; //генерация и
Pole.Indices(t-> t<0).ForEach(t-> DrawXY(t[0],t[1])); //вывод трех новых минишаров
end;