[gundenaf]

Здравствуйте.

Не могу осилить проверку в игре-головоломке "Черное и белое". Собственно, ее правила:

В каждой ячейке (клетке) игрового поля надо нарисовать один кружок - черный или белый. Черный кружок - это цифра 1, белый - 0. Правильно заполненный квадрат должен содержать одну цепочку белых и одну цепочку черных кружков.
Цепочки могут иметь ответвления, но не должны иметь разрывов. Ячейки цепочки должны соединяться между собой по горизонтали или по вертикали (соединение только углами недопустимо). Кружки одного цвета не должны образовывать квадраты.

Можете помочь, пожалуйста?

Код:

 
var
  Form1: TForm1;
  ACol, ARow, i, j: integer;
  TXT: TextFile;
  flag, flag2, flag3: boolean;
 
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char); //Ограничение на ввод всех чисел и символов кроме 0 и 1
begin
if not (Key in ['0'..'1', #8]) then Key:=#0;
end;
 
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); //Ограничение на ввод, чтобы можно было ввести лишь одно число (0 или 1) в клетку
begin
 if Length(Value)>0 then StringGrid1.Cells[ACol, ARow]:=Value[1];
end;
 
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName); //Загрузка поля из файла
var iTmp: integer;
    strTemp: string;
begin
 AssignFile(TXT,FileName);
 Reset(TXT);
  with StringGrid do
   begin
    Readln(TXT, iTmp);
    ColCount:=iTmp;
    Readln(TXT, iTmp);
    RowCount :=iTmp;
     for ACol:=0 to ColCount - 1 do
      for ARow:=0 to RowCount - 1 do
       begin
        Readln(TXT, strTemp);
        Cells[ACol, ARow]:=strTemp;
       end;
   end;
 CloseFile(TXT);
end;
 
procedure TForm1.N3Click(Sender: TObject); //Загрузить поле из файла
begin
with OpenDialog1 do
 if Execute then
LoadStringGrid(StringGrid1, OpenDialog1.FileName);
end;
 
procedure TForm1.N2Click(Sender: TObject); //Новая игра
begin
StringGrid1.Visible:=false;
BitBtn1.Visible:=true;
BitBtn2.Visible:=true;
BitBtn3.Visible:=true;
end;
 
procedure TForm1.BitBtn1Click(Sender: TObject); //Поле 6х6
begin
for i:=0 to 5 do
 for j:=0 to 5 do
  if (StringGrid1.Cells [i, j] <> '') then
   StringGrid1.Cells [i, j]:='';
StringGrid1.Visible:=true;
BitBtn1.Visible:=false;
BitBtn2.Visible:=false;
BitBtn3.Visible:=false;
N3.Enabled:=true;
N6.Enabled:=true;
 
StringGrid1.RowCount:=6;
StringGrid1.ColCount:=6;
StringGrid1.Height:=(6*39)-2;
StringGrid1.Width:=(6*39)-2;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);  //Поле 8х8
begin
for i:=0 to 7 do
 for j:=0 to 7 do
  if (StringGrid1.Cells [i, j] <> '') then
   StringGrid1.Cells [i, j]:='';
StringGrid1.Visible:=true;
BitBtn1.Visible:=false;
BitBtn2.Visible:=false;
BitBtn3.Visible:=false;
N3.Enabled:=true;
N6.Enabled:=true;
 
StringGrid1.RowCount:=8;
StringGrid1.ColCount:=8;
StringGrid1.Height:=(8*39)-4;
StringGrid1.Width:=(8*39)-4;
end;
 
procedure TForm1.BitBtn3Click(Sender: TObject); //Поле 10х10
begin
for i:=0 to 9 do
 for j:=0 to 9 do
  if (StringGrid1.Cells [i, j] <> '') then
   StringGrid1.Cells [i, j]:='';
StringGrid1.Visible:=true;
BitBtn1.Visible:=false;
BitBtn2.Visible:=false;
BitBtn3.Visible:=false;
N3.Enabled:=true;
N6.Enabled:=true;
 
StringGrid1.RowCount:=10;
StringGrid1.ColCount:=10;
StringGrid1.Height:=(10*38)+3;
StringGrid1.Width:=(10*38)+3;
end;
 
procedure TForm1.N7Click(Sender: TObject); //Выход
begin
Close;
end;
 
procedure TForm1.N6Click(Sender: TObject); //Проверить решение
var ii, m: integer;
begin
{ for ACol:=0 to StringGrid1.ColCount do   //проверка на 3 макс соседних
  for ARow:=0 to StringGrid1.RowCount do
   begin
    with StringGrid1 do
     begin
      if (Cells[ACol,ARow]<>' ') and (Cells[ACol,ARow]<>'') then
       begin
        if ACol<ColCount then
         begin
          if Cells[ACol,ARow]=Cells[ACol+1,ARow] then
          inc(ii);
         end;
        if ACol>0 then
         begin
          if Cells[ACol,ARow]=Cells[ACol-1,ARow] then
          inc(ii);
         end;
        if ARow<RowCount then
         begin
          if Cells[ACol,ARow]=Cells[ACol,ARow+1] then
          inc(ii);
         end;
        if ARow>0 then
         begin
          if Cells[ACol,ARow]=Cells[ACol,ARow-1] then
          inc(ii);
         end;
       end;
      end;
      if ii>3 then
       flag:=false;
     end;}
 for ACol:=0 to StringGrid1.ColCount do    //проверка на квадраты
  for ARow:=0 to StringGrid1.RowCount do
   begin
    for m:=(-1) to 1 do
     begin
      if (ACol>0) and (ACol<StringGrid1.ColCount) and (ARow>0) and (ARow<StringGrid1.RowCount) then
       begin
        if (StringGrid1.Cells[ACol,ARow]=StringGrid1.Cells[ACol+m,ARow]) and
           (StringGrid1.Cells[ACol,ARow]=StringGrid1.Cells[ACol,ARow+m]) and
           (StringGrid1.Cells[ACol,ARow]=StringGrid1.Cells[ACol+m,ARow+m]) and
           (StringGrid1.Cells[ACol,ARow]=StringGrid1.Cells[ACol-m,ARow-m]) then
         begin
          flag2:=False;
         end;
       end;
     end;
   end;
                             //проаерка на изоляцию
 
 for ACol:=0 to StringGrid1.ColCount do
  for ARow:=0 to StringGrid1.RowCount do
   begin
    for m:=(-1) to 1 do
     begin
      if (ACol>0) and (ACol<StringGrid1.ColCount) and (ARow>0) and (ARow<StringGrid1.RowCount) then
       begin
        if (StringGrid1.Cells[ACol,ARow]<>StringGrid1.Cells[ACol+m,ARow]) and
           (StringGrid1.Cells[ACol,ARow]<>StringGrid1.Cells[ACol,ARow+m]) and
           (StringGrid1.Cells[ACol,ARow]<>StringGrid1.Cells[ACol+m,ARow+m]) and
           (StringGrid1.Cells[ACol,ARow]<>StringGrid1.Cells[ACol-m,ARow-m]) then
         begin
          flag3:=False;
         end;
       end;
     end;
   end;
 if (flag2=false) or (flag3=false) then
  ShowMessage('Не верно');
 if (flag2=true) and (flag3=true) then
  ShowMessage('Верно');
 Edit1.Text:=IntToStr(ii);
end;
 
end.

[Alegun]

Неа, так и не понятно что за алгоритм такой у игры - что за "правильно заполненный квадрат" или "цепочки", картинки экзерсисной явно не хватает

З.Ы. Вот пример вставки рисунка c кружками в ячейки "игрового поля"