Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Перезагрузить страницу

Головоломка "Черное и белое"

Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.06.2014, 19:51
gundenaf gundenaf вне форума
Прохожий
  
Регистрация: 17.06.2014
Сообщения: 1
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Головоломка "Черное и белое"
Здравствуйте.

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

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

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

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
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.
Ответить с цитированием
  #2  
Старый 19.06.2014, 08:31
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
  
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию
Неа, так и не понятно что за алгоритм такой у игры - что за "правильно заполненный квадрат" или "цепочки", картинки экзерсисной явно не хватает

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

« Предыдущая тема | Следующая тема »

Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Линейный вид Линейный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:10.

Обратная связь - Главная страница сайта Delphi Sources - Вверх

 

Сайт

Форум

FAQ

Соглашения

Прочее
 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025