Для того чтобы начать решение головоломки необходимо открыть папку, в которой находится данная игра, найти файл «Замкнутая змея.exe» и кликнуть по нему два раза.
После запуска программы на экране отображается главная форма (рис. 1), которая содержит следующие компоненты:
1) кнопки для игры и получения справочной информации;
2) игровое поле.
Рис. 1 – Главная форма
Далее для начала игры пользователю необходимо выбрать готовую головоломку из списка либо ввести свои данные, после чего появится сетка серого цвета, а клетки сверху и справа от сетки заполнятся числами. После этого пользователь может приступать к решению головоломки. Если же пользователь заходит в тупик, он может воспользоваться кнопкой «Авторешения» (Игра-Авторешение). После ее нажатия пользователь увидит окно с правильным решением.
Если пользователь зашел в тупик, но хочет решить головоломку еще раз, ему необходимо нажать на кнопку «Начать заново» и игровое поле очистится.
Пользователь может вводить свои комбинации чисел и размерность сетки, для этого необходимо воспользоваться кнопкой «Свои данные», после чего отобразится новая форма, куда необходимо внести данные (Рис.2).
Рис. 2 Ввод своих данных
Информационная база
Входная информация
Для данной программы входной информацией является
- режим игры;
- вводимая пользователем комбинации чисел.
В программе предусмотрено 2 режима игры: решение головоломки пользователем и авторешение.
Выходная информация
Результатом обработки входных данных является решенная головоломка, которая представлена в виде замкнутой линии салатового цвета толщиной в одну клетку. Режим игры и различные числовые комбинации, которые вводит пользователь так же формируют выходные данные.
Таким образом, выходной информацией является вывод на экран решенной головоломки.
Меню программы
На главной форме находятся следующие кнопки и компоненты:
- Главное меню:
· Начать игру
· Авторешение
· Выход
· Выбор головоломки
· Помощь
· О программе
- Играть/Начать заново
- Свои данные
На форме для ввода пользовательских данных:
- Размер поля
- Числа по горизонтали
- Числа по вертикали
- Ок
Размерность (5<а<10) показывает размерность сетки. Размерность не является фиксированной и пользователь может вводить свои данные.
Числа по горизонтали и числа по вертикали показывают длину змейки (количество закрашенных клеток) в столбце и в строке. Эти числа переносятся в ячейки, расположенные сверху и справа от сетки. В данном случае пользователь так же может вводить свои данные, однако будет очень маленькая вероятность решения такой головоломки.
«Авторешение» показывает правильное решение головоломки пользователю, если оно есть.
«Выбор головоломки» позволяет пользователю выбрать из списка один из тестов, которые имеют решения в отличии от вариантов, которые вводит пользователь.
Кнопка «Играть/Начать заново» используется непосредственно для начала игры или для очистки сетки и начала новой игры, если пользователь зашел в тупик.
При нажатии на кнопку «Помощь» появляется окошко с правилами игры (Рис. 3). Воспользоваться этой кнопкой пользователь может как до решения, так и во время решения.
Кнопка «О программе» выводит окно, которое содержит информацию о разработчике и дату создания программного продукта.
Рис. 3 – «Помощь»
Описание программы
Описание элементов
При создании программы были использованы следующие классы элементов:
- TForm – при создании программного продукта была создано 2 формы, которые содержат кнопки, игровое поле и справочную систему;
- TLabel – этот компонент использовался для надписей;
- TEdit – это строки ввода, в них отображается информация введенная либо пользователем, либо компьютером;
- TButton – при создании головоломки на форме было размещено несколько кнопок, при нажатии на которые программа выполняла определенные действия;
- TImage – данный компонент использовался для прорисовки сетки игрового поля и решения, а также для создания фона в программном продукте;
- TStringGrid – этот элемент использовался при создании игрового поля и используется для ввода чисел пользователем или программой;
- TSpinEdit – данный компонент используется для выбора размерности сетки;
- TMainMenu – используется для создания меню программы.
Разработка алгоритма.
Рассмотрим алгоритмы для поиска решения поставленной задачи.
Зачастую, когда говорят о качестве решения некоторой задачи, для того что бы определить наихудший вариант, приводят пример "полного перебора".
Тем не менее, существуют ситуации, когда перебор - единственный способ найти решение; самым сложным тогда становится ограничить область перебора.
Вообще говоря, перебор имеет смысл в том случае, когда каким-то образом ограничено множество возможных решений задачи и, кроме того, это множество является счетным. Тогда, в принципе, можно взять каждое потенциальное решение из этого множества и просто проверить его, подставив в условие задачи.
Таким образом, выберем рекурсивный обход всех клеток и будем строить путь до тех пор, пока змея не будет замкнута. За начало берем первый столбец, предполагая что там линия длиной 2, прокладываем линию в самый вверх и смотрим есть ли верное решение при таком расположении, если есть то рисуем его, иначе опускаем линию на одну клетку и повторяем операцию до низа. Направлениям, в которых можно двигаться из текущей клетки: вверх, влево, вниз и вправо. Переходов максимум может быть три, а не четыре, поскольку двигаться можно только по горизонтали или вертикали и, соответственно, в текущую клетку можно попасть по одному из этих направлений, а дважды проходить один и тот же путь нельзя. В начальную клетку перехода из другой клетки не существует, но по условию начальная клетка находится на границе поля, следовательно из нее также существует максимум 3 перехода в другие клетки. Если достигнута клетка, которая помечена как конечная, то еще раз проверяем соответствие построенного пути начальным условиям, и если противоречий нет, то выходим из рекурсии.
Программный продукт содержит 3 основные процедуры:
- procedure grafika – процедура выводит графическое решение задачи, закрашивая область по которой проходит линия в салатовый цвет, а также закрашивая всю остальную область серым цветом.
- procedure prov – процедура проводит проверку шагов на противоречие: касание змеи самой себя, выход за пределы поля.
- procedure rek – основная рекурсивная процедура программы, позволяет сделать шаг и вызвать саму себя еще раз
-
Справочная система
Для данного программного продукта предусмотрена справочная система, которая вызывается нажатием на кнопку «Помощь». Появившееся окно содержит информацию о правилах игры. Справочная система была создана при помощи программного продукта HelpCruiser 2.
Нажатие на кнопку «О программе» так же выводит справочную информацию и содержит информацию о разработчике, дате создания программы. Выводится при помощи оператора showmessage.
Заключение
В результате проделанной работы был создан программный продукт под названием «Замкнутая змея». На примеры этой игры-головоломки были рассмотрены свойства и работа основных компонентов страницы Standard языка Delphi.
Таким образом, язык программирования Delphi позволяет быстро создавать качественные приложения с относительно небольшим кодом. Так же этот язык позволяет создавать красочный и понятный интерфейс. Это только способствует освоению игры, а так же других программных продуктов написанных на данном языке.
Список используемых источников:
1. Фаронов В. В. Delphi Программирование на языке высокого уровня: Учебник для ВУЗов – СПб.: Питер, 2008. – 640 с.: ил.
2. А.Я. Архангельский Программирование в Delphi 7. — М.: ООО «Бином-Пресс», 2003 г. — 1152 с.: ил.
Приложение А
Схема программы
Приложение Б
Код программы
Unit1
unit Unit1;
{Головоломка "Замкнутая змея"
Выполнил учащийся группы 93491 Баранкевич И.Г.
последняя редакция 10 июня}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, Spin, Menus, jpeg;
type
mas=array[1..12,1..12] of shortint;
TForm1 = class(TForm)
btn1: TButton;
Image1: TImage;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
btn2: TButton;
mm1: TMainMenu;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N7: TMenuItem;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
N41: TMenuItem;
N51: TMenuItem;
N61: TMenuItem;
N71: TMenuItem;
N81: TMenuItem;
N91: TMenuItem;
N101: TMenuItem;
Image2: TImage;
N8: TMenuItem;
N111: TMenuItem;
N121: TMenuItem;
N131: TMenuItem;
N141: TMenuItem;
N151: TMenuItem;
N161: TMenuItem;
N171: TMenuItem;
N181: TMenuItem;
N191: TMenuItem;
N201: TMenuItem;
procedure btn2Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure N41Click(Sender: TObject);
procedure N51Click(Sender: TObject);
procedure N61Click(Sender: TObject);
procedure N71Click(Sender: TObject);
procedure N81Click(Sender: TObject);
procedure N91Click(Sender: TObject);
procedure N101Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N111Click(Sender: TObject);
procedure N121Click(Sender: TObject);
procedure N131Click(Sender: TObject);
procedure N141Click(Sender: TObject);
procedure N151Click(Sender: TObject);
procedure N161Click(Sender: TObject);
procedure N171Click(Sender: TObject);
procedure N181Click(Sender: TObject);
procedure N191Click(Sender: TObject);
procedure N201Click(Sender: TObject);
procedure N5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
f:integer;
Form1: TForm1;
s: string[1];
act: char;
a: mas;
n: boolean;
driver,mode: integer;
i,r,k,m,m1,x1,x2,y1,y2,act2,j,b,b1,b2,b3,b4,b5,b6,b7,b8,rx,rq: shortint;
q,w,j1: integer;
c: array[1..2,1..12] of shortint;
Tab: array[1..12,1..12]of shortint;
implementation
uses Unit2, shellapi;
{$R *.dfm}
procedure grafika(a:mas); //процедура выводит графическое изображение решенной задачи
var
driver,mode,i,k,x,y: integer;
begin
y:=0;
Form1.Image1.Canvas.Pen.Color:=clWhite; //цвета линий
Form1.Image1.Canvas.Brush.Color:=cllime;
Form1.Image1.Canvas.rectangle(x-1,y-1,x+b*30+1,y+b*30+1);
for i:=1 to b do //b - длина сетки
begin
x:=0;
for k:=1 to b do
begin
if a[i,k]=2 then //a[i,k]=2 - если в этом квадрате есть линия
begin
Form1.Image1.Canvas.Brush.Color:=cllime;
Form1.Image1.Canvas.rectangle(x,y,x+30,y+30);
Form1.Image1.Canvas.MoveTo(x+15,y+15); //далее определяем в какую сторону проводить линию
if (i<>1) and (a[i-1,k]=2) then
Form1.Image1.Canvas.lineTo(x+15,y-15);
Form1.Image1.Canvas.MoveTo(x+15,y+15);
if (i<>8) and (a[i+1,k]=2) then
Form1.Image1.Canvas.lineTo(x+15,y+45);
Form1.Image1.Canvas.MoveTo(x+15,y+15);
if (k<>1) and (a[i,k-1]=2) then
Form1.Image1.Canvas.lineTo(x-15,y+15);
Form1.Image1.Canvas.MoveTo(x+15,y+15);
if (k<>8) and (a[i,k+1]=2) then
Form1.Image1.Canvas.lineTo(x+45,y+15);
Form1.Image1.Canvas.Brush.Color:=clblack;
end
else //иначе если в поле нет линии, то оно закрашивается другим цветом
begin
Form1.Image1.Canvas.Brush.Color:=clSilver;
Form1.Image1.Canvas.Rectangle(x,y,x+30,y+30);
end;
x:=x+30;
end;
y:=y+30
end
end;
procedure prov(a: mas; x1,y1,x2,y2,n,m,r,x3,y3: shortint;var x: boolean);
var //эта процедура проверяет: не приведет ли данный шаг к противоречию(коснётся ли змея сама себя и т.д.)
i,g1,g2,g3,g4,x4,y4,x5,y5,x6,y6,x7,y7: shortint;
begin
g3:=2*x1-x2; //проверяются самые очевидные условия на противоречия (нельзя шагнуть ибо зайдет за край поля)
g4:=2*y1-y2;
x:=true;
g1:=x1+m*abs(y1-y2)*n;
g2:=y1+m*abs(x1-x2)*n;
if (g1<b+1) and (g1>0) and (g2<b+1) and (g2>0) and (a[g2,g1]=0) then
begin
i:=1;
g1:=1;
g2:=1;
if r<>(b*2-2) then //если шаг не относится к исключению, то
begin
while (i<=n+1) and (g1>0) and (g1<b+1) and (g2>0) and (g2<b+1) do
begin //эти циклы проверяют: не коснётся змея сама себя
g1:=x1+m*abs(y1-y2)*i;
g2:=y1+m*abs(x1-x2)*i;
if a[g2,g1]=2 then
begin
x:=false
end;
g1:=x2+m*abs(y1-y2)*i;
g2:=y2+m*abs(x1-x2)*i;
if a[g2,g1]=2 then
if ((r<>(b*2-3)) or (i<>n+1)) then
x:=false;
if (g3>0) and (g3<b+1) and (g4>0) and (g4<b+1) then
begin
g1:=2*x1-x2+m*abs(y1-y2)*i;
g2:=2*y1-y2+m*abs(x1-x2)*i;
if a[g2,g1]=2 then
if ((r<>(b*2-3)) or (i<>n+1)) then
x:=false; //когда x-false - случай ошибочный}
end;
i:=i+1;
g1:=x1+m*abs(y1-y2)*i;
g2:=y1+m*abs(x1-x2)*i
end
end
else {здесь проверяется исключение: вообще в конце
концов змея должна себя коснуться, так что последнее и
предпоследнее условие должно обрабатываться по индивидуальной программе}
begin {4-е if-а - ищем соседнюю клетку второго конца змеи}
if (x3<>1) and (a[y3,x3-1]=2) then
begin
x4:=x3-1;
y4:=y3
end;
if (x3<>b) and (a[y3,x3+1]=2) then
begin
x4:=x3+1;
y4:=y3
end;
if (y3<>1) and (a[y3-1,x3]=2) then
begin
x4:=x3;
y4:=y3-1
end;
if (y3<>b) and (a[y3+1,x3]=2) then
begin
x4:=x3;
y4:=y3+1
end;
x5:=x3+abs(y3-y4); //дальше мы проверяем на истинность условие
y5:=y3+abs(x3-x4);
x6:=x3-abs(y3-y4);
y6:=y3-abs(x3-x4);
g1:=x1+m*abs(y1-y2)*n;
g2:=y1+m*abs(x1-x2)*n;
if ((g1=x5) and (g2=y5)) or ((g1=x6) and (g2=y6)) then
begin
i:=1;
g1:=1;
g2:=2;
while (i<=n+1) and (g1>0) and (g1<b+1) and (g2>0) and (g2<b+1) do
begin
g1:=x1+m*abs(y1-y2)*i;
g2:=y1+m*abs(x1-x2)*i;
if (a[g2,g1]=2) and (a[g2,g1]<>a[y3,x3]) and (a[g2,g1]<>a[y4,x4]) then
x:=false;
g1:=x2+m*abs(y1-y2)*i;
g2:=y2+m*abs(x1-x2)*i;
if (a[g2,g1]=2) and (a[g2,g1]<>a[y3,x3]) and (a[g2,g1]<>a[y4,x4]) then
x:=false;
if (g3>0) and (g3<b+1) and (g4>0) and (g4<b+1) then
begin
g1:=2*x1-x2+m*abs(y1-y2)*i;
g2:=2*y1-y2+m*abs(x1-x2)*i;
if (a[g2,g1]=2) and (a[g2,g1]<>a[y3,x3]) and (a[g2,g1]<>a[y4,x4]) then
x:=false;
end;
i:=i+1;
g1:=x1+m*abs(y1-y2)*i;
g2:=y1+m*abs(x1-x2)*i
end
end
end
end
else
x:=false;
end;
procedure rek(var a: mas; x1,y1,x2,y2,r,q:shortint; var t1,t2,t3,t4: shortint); {основная процедура - выполнение её позволяет сделать один шаг и вызвать саму себя ещё раз(рекурсия)}
var {x1,y1-координаты первого конца змеи,x2,y2-координаты второго конца змеи, r-глубина рекурсии}
x,x3,y3,x4,y4,m,x5,y5,n,h,j,x6,y6,y7,x7,y8,x8,y9,x9,y10,x10,nu,n9: shortint;
f,f1,f2: boolean;
a1: mas;
begin
if q=1 then
begin
nu:=2;
n9:=1
end;
if q=0 then
begin
nu:=1;
n9:=1
end;
if q=2 then
begin
nu:=1;
n9:=-1
end;
t1:=0;
t2:=0;
t3:=0;
t4:=0;
a1:=a;
x3:=x2;
y3:=y2;
x4:=x1;
y4:=y1;
x:=0; {4 if-a - ищем соседнюю клетку 1-го конца}
if (x3<>1) and (a[y3,x3-1]=2) then
begin
x1:=x3-1;
y1:=y3;
x:=x+1
end;
if (x3<>b) and (a[y3,x3+1]=2) then
begin
x1:=x3+1;
y1:=y3;
x:=x+1
end;
if (y3<>1) and (a[y3-1,x3]=2) then
begin
x1:=x3;
x:=x+1;
y1:=y3-1
end;
if (y3<>b) and (a[y3+1,x3]=2) then
begin
x1:=x3;
x:=x+1;
y1:=y3+1
end;
if abs(y3-y1)>abs(x3-x1) then
n:=c[2,y3]
else
n:=c[1,x3];
h:=-1*n9;
for j:=1 to nu do {каждый раз можно идти в двух направлениях вправо/влево, вверх/вниз}
begin
prov(a,x3,y3,x1,y1,n,h,r,x4,y4,f); {проверка на противоречия}
if r=(2*b-1) then {проверка на исключение, когда змея замыкается}
begin
x2:=x3+h*abs(y3-y1)*n;
y2:=y3+h*abs(x3-x1)*n;
if ((x2=x4) and (y2=y4)) or (x=2) then
begin
t1:=x2;
t2:=y2;
for i:=1 to N do
begin
if (x2=x4) or(y2=y4) then
begin
x2:=x3+h*abs(y1-y3)*i;
y2:=y3+h*abs(x1-x3)*i;
a[y2,x2]:=2;
end;
end;
grafika(a); {если все верно то решение нужно нарисовать}
end;
end; {конец исключения}
if f=true then {в общем случае если шаг подходит, то мы изменяем массив}
{вообще в массиве а 2- в клетке есть линия, 1-нет линии но на ней уже ходили, 0 нет линии можно на неё шагать}
begin
x2:=x3-h*abs(y3-y1);
y2:=y3-h*abs(x3-x1);
i:=1; {шагаем на нужное число шагов и заполняем 1 оставшуюся стрку/столбец}
while (x2<>0) and (x2<>b+1) and (y2<>0) and (y2<>b+1) do
begin
if a[y2,x2]<>2 then
a[y2,x2]:=1;
i:=i+1;
x2:=x3-h*abs(y3-y1)*i;
y2:=y3-h*abs(x3-x1)*i
end;
x2:=x3+abs(y3-y1)*h;
y2:=y3+abs(x3-x1)*h;
i:=1;
while i<=n do
begin
a[y2,x2]:=2;
i:=i+1;
x2:=x3+abs(y3-y1)*i*h;
y2:=y3+abs(x3-x1)*i*h
end;
while (x2<>0) and (x2<>b+1) and (y2<>0) and (y2<>b+1) do
begin
if a[y2,x2]<>2 then
a[y2,x2]:=1;
i:=i+1;
x2:=x3+abs(y3-y1)*i*h;
y2:=y3+abs(x3-x1)*i*h
end;
x5:=x3+abs(y3-y1)*n*h; {меняем координаты конца змеи на новые}
y5:=y3+abs(x3-x1)*n*h;
if j=1 then
begin
t1:=x5;
t2:=y5
end;
if j=2 then
begin
t3:=x5;
t4:=y5
end;
if q=1 then
begin
r:=r+1;
rek(a,x5,y5,x4,y4,r,q,t1,t2,t3,t4);{запускаем программу ещё раз}
if (r=b*2-2) or (r=b*2-2) then
rek(a,x4,y4,x5,y5,r,q,t1,t2,t3,t4);
r:=r-1
end;
end;
h:=1;
if q=1 then
a:=a1;
end;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
Form2.show;
btn1.Caption:='Играть';
end;
procedure TForm1.btn1Click(Sender: TObject); {кнопка начать}
var
s,s2: string;
pr,kol,err: integer;
str: string;
begin
str:=Form2.edt2.Text;
if str='' then
ShowMessage('Введите свои данные или выберите номер головоломки из списка')
else
begin
Image1.Picture:=nil;
btn1.Caption:='Начать заново';
b:=StrToInt(Form2.se1.Text);
if b=5 then
begin
StringGrid2.Left:=223;
StringGrid2.Height:=148;
StringGrid1.Width:=153;
Image1.Height:=153;
Image1.Width:=153;
end;
if b=6 then
begin
StringGrid2.Left:=254;
StringGrid2.Height:=178;
StringGrid1.Width:=183;
Image1.Height:=186;
Image1.Width:=186;
end;
if b=7 then
begin
StringGrid2.Left:=286;
StringGrid2.Height:=207;
StringGrid1.Width:=213;
Image1.Height:=212;
Image1.Width:=212;
end;
if b=8 then
begin
StringGrid2.Left:=310;
StringGrid2.Height:=237;
StringGrid1.Width:=244;
Image1.Height:=242;
Image1.Width:=243;
end;
if b=9 then
begin
StringGrid2.Left:=342;
StringGrid2.Height:=265;
StringGrid1.Width:=274;
Image1.Height:=274;
Image1.Width:=274;
end;
if b=10 then
begin
StringGrid2.Left:=374;
StringGrid2.Height:=295;
StringGrid1.Width:=304;
Image1.Height:=304;
Image1.Width:=304;
end;
s:=Form2.edt1.Text;
pr:=1;
kol:=0;
s:=s+' '; {программа преобразует из строки в числа и заносит в массив с}
for i:=1 to length(s) do
begin
If (s[i] =' ')or(i=length(s)) then
begin
If i<>pr then
begin
inc(kol);
s2:=copy(s,pr,i-pr+1);
val(s2,C[1,kol],err);
pr:=i+1;
end;
end;
end;
s:=Form2.edt2.Text; {аналогично со строкой по вертикали}
pr:=1;
kol:=0;
s:=s+' ';
for i:=1 to length(s) do
begin
If (s[i] =' ')or(i=length(s)) then
begin
If i<>pr then
begin
inc(kol);
s2:=copy(s,pr,i-pr+1);
val(s2,C[2,kol],err);
pr:=i+1;
end;
end;
end;
Form1.Image1.Canvas.Pen.Color:=clwhite;
image1.Canvas.Brush.Color:=Clwhite;
image1.Canvas.Rectangle(0,0,1000,1000);
b:=Form2.Se1.Value;
f:=1;
r:=-1;
fillchar(a,sizeof(a),0);
grafika(a);
for i:=0 to 10 do
begin
stringgrid1.Cells[i,0]:=copy(Form2.edt1.Text,2*i+1,2);
stringgrid2.Cells[0,i]:=copy(Form2.edt2.Text,2*i+1,2);
end;
end;
end;
procedure TForm1.N1Click(Sender: TObject); {кнопка авторешение}
var
i,err,pr,kol:integer;
s,s2:string;
begin
image1.Canvas.MoveTo(0,0);
image1.Canvas.Brush.Color:=clwhite;
image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);
b:=Form2.Se1.Value;
s:=Form2.edt1.Text;
pr:=1;
kol:=0;
s:=s+' '; {программа преобразует из строки в числа и заносит в массив с}
for i:=1 to length(s) do
begin
If (s[i] =' ')or(i=length(s)) then
begin
If i<>pr then
begin
inc(kol);
s2:=copy(s,pr,i-pr+1);
val(s2,C[1,kol],err);
pr:=i+1;
end;
end;
end;
s:=Form2.edt2.Text; {аналогично со строкой по вертикали}
pr:=1;
kol:=0;
s:=s+' ';
for i:=1 to length(s) do
begin
If (s[i] =' ')or(i=length(s)) then
begin
If i<>pr then
begin
inc(kol);
s2:=copy(s,pr,i-pr+1);
val(s2,C[2,kol],err);
pr:=i+1;
end;
end;
end;
w:=0;
image1.Canvas.Pen.Color:=clGreen; {отрисовка изображения при отсутствии реше-ния}
image1.Canvas.Brush.Color:=Clwhite;
for i:=1 to b do
begin
q:=0;
for k:=1 to b do
begin
image1.canvas.rectangle(q,w,q+30,w+30);
q:=q+30
end;
w:=w+30
end;
fillchar(a,sizeof(a),0); {задание стартовых параметров}
m1:=b-c[1,1];
for i:=1 to (c[1,1]+1) do
a[i,1]:=2;
for i:=(c[1,1]+2) to b do
a[i,1]:=1;
m:=1;
x1:=1;
x2:=1;
y1:=1;
y2:=c[1,1]+1;
rx:=1;
rq:=1;
b1:=0;
b2:=0;
b3:=0;
b4:=0;
b5:=0;
b6:=0;
b7:=0;
b8:=0;
while (n=false) and (m<=m1) do {основной цикл: берём первый
столбец(предположим там линия длиной 2, прокладываем линию в самый вверх и смотрим есть ли верное решение при таком расположении, если есть то рисуем его, иначе опускаем линию на одну клетку и повторяем операцию и до низа}
begin
rek(a,x1,y1,x2,y2,rx,rq,b1,b2,b3,b4);
a[m,1]:=1;
a[m+c[1,1]+1,1]:=2;
y1:=y1+1;
y2:=y2+1;
m:=m+1
end;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
shellexecute(handle, nil, 'справка.chm', nil, nil, sw_restore);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
x1,y1,x2,y2:integer;
x3,y3,i,j,u1,u2,x4,y4: shortint;
a1: mas;
begin
b:=Form2.se1.Value;
X1:=30*((x div 30));
Y1:=30*((y div 30));
X2:=x1+30;
Y2:=y1+30;
x3:=(x div 30)+1;
y3:=(y div 30)+1;
if (x3<=b) and (y3<=b) and (f=1) then //чтоб клик работал только в сетке
begin
if (r>0) and (r<2*b) then
begin
x4:=0;
y4:=0;
a1:=a;
rek(a,b1,b2,b3,b4,r,0,b5,b6,b7,b8); {проверка входной координаты: если в кликнутую клетку можно переместить, то он это делает}
if (y3=b6) and (x3=b5) then
begin
grafika(a);
b3:=b5;
r:=r+1;
b4:=b6
end
else
a:=a1;
a1:=a;
rek(a,b1,b2,b3,b4,r,2,b5,b6,b7,b8);
if (y3=b6) and (x3=b5) then
begin
grafika(a);
b3:=b5;
r:=r+1;
b4:=b6
end
else a:=a1;
a1:=a;
rek(a,b3,b4,b1,b2,r,0,b5,b6,b7,b8);
if (y3=b6) and (x3=b5) then
begin
grafika(a);
r:=r+1;
b1:=b5;
b2:=b6
end
else a:=a1;
a1:=a;
rek(a,b3,b4,b1,b2,r,2,b5,b6,b7,b8);
if (y3=b6) and (x3=b5) then
begin
grafika(a);
r:=r+1;
b1:=b5;
b2:=b6
end
else a:=a1;
end;
if r=0 then {в 1-м и 2-м клике все иначе}
begin
if ((b2+c[1,b1]=y3) and (b1=x3)) or ((b2-c[1,b1]=y3) and (b1=x3)) or ((b2=y3) and (b1+c[2,b2]=x3)) or ((b2=y3) and (b1-c[2,b2]=x3)) then
begin
a[y3,x3]:=2;
u2:=b2-y3;
u1:=b1-x3;
if u2>0 then
begin
for i:=1 to u2 do
a[y3+i,x3]:=2;
for i:=1 to b do
begin
if a[i,x3]<>2 then
a[i,x3]:=1
end;
end;
if u1>0 then
begin
for i:=1 to u1 do
a[y3,x3+i]:=2;
for i:=1 to b do
begin
if a[y3,i]<>2 then
a[y3,i]:=1
end;
end;
if u2<0 then
begin
u2:=-u2;
for i:=1 to u2 do
a[b2+i,b1]:=2;
for i:=1 to b do
begin
if a[i,b1]<>2 then
a[i,b1]:=1
end;
end;
if u1<0 then
begin
u1:=-u1;
for i:=1 to u1 do
a[b2,b1+i]:=2;
for i:=1 to b do
begin
if a[b2,i]<>2 then
a[b2,i]:=1
end;
end;
r:=r+1;
b3:=x3;
b4:=y3;
grafika(a);
end;
end;
if r=-1 then
begin
a[y3,x3]:=2;
grafika(a);
r:=r+1;
b1:=x3;
b2:=y3
end;
end;
if (r=2*b) or (r<0) then
ShowMessage('Поздравляем, головоломка решена!!!!');
end;
procedure TForm1.N11Click(Sender: TObject); // готовые наборы
begin
Form2.se1.Value:=5;
Form2.edt1.Text:='2 1 1 1 3';
Form2.edt2.Text:='2 1 1 1 3';
btn1.Click;
end;
procedure TForm1.N21Click(Sender: TObject);
begin
Form2.se1.Value:=6;
Form2.edt1.Text:='2 1 1 1 2 3';
Form2.edt2.Text:='3 1 1 2 1 2';
btn1.Click;
end;
procedure TForm1.N31Click(Sender: TObject);
begin
Form2.se1.Value:=6;
Form2.edt1.Text:='3 1 1 2 1 2';
Form2.edt2.Text:='3 2 1 1 1 2';
btn1.Click;
end;
procedure TForm1.N41Click(Sender: TObject);
begin
Form2.se1.Value:=6;
Form2.edt1.Text:='3 2 1 1 1 2';
Form2.edt2.Text:='2 2 1 1 2 2';
btn1.Click;
end;
procedure TForm1.N51Click(Sender: TObject);
begin
Form2.se1.Value:=7;
Form2.edt1.Text:='2 1 1 1 1 3 3';
Form2.edt2.Text:='2 2 1 1 2 2 2';
btn1.Click;
end;
procedure TForm1.N61Click(Sender: TObject);
begin
Form2.se1.Value:=7;
Form2.edt1.Text:='4 1 1 2 1 1 2';
Form2.edt2.Text:='4 2 1 1 1 1 2';
btn1.Click;
end;
procedure TForm1.N71Click(Sender: TObject);
begin
Form2.se1.Value:=7;
Form2.edt1.Text:='3 1 1 1 1 1 4';
Form2.edt2.Text:='3 1 1 1 1 1 4';
btn1.Click;
end;
procedure TForm1.N81Click(Sender: TObject);
begin
Form2.se1.Value:=8;
Form2.edt1.Text:='2 2 2 1 1 2 2 4';
Form2.edt2.Text:='2 2 1 1 1 2 3 2';
btn1.Click;
end;
procedure TForm1.N91Click(Sender: TObject);
begin
Form2.se1.Value:=8;
Form2.edt1.Text:='3 2 1 1 2 2 2 3';
Form2.edt2.Text:='3 2 2 1 1 1 2 2';
btn1.Click;
end;
procedure TForm1.N101Click(Sender: TObject);
begin
Form2.se1.Value:=8;
Form2.edt1.Text:='2 2 2 1 1 2 2 2';
Form2.edt2.Text:='3 2 1 1 2 2 3 4';
btn1.Click;
end;
procedure TForm1.N111Click(Sender: TObject);
begin
Form2.se1.Value:=9;
Form2.edt1.Text:='2 3 2 1 1 2 2 1 2';
Form2.edt2.Text:='2 2 2 2 1 1 2 2 2';
btn1.Click;
end;
procedure TForm1.N121Click(Sender: TObject);
begin
Form2.se1.Value:=9;
Form2.edt1.Text:='7 1 1 1 1 1 1 1 2';
Form2.edt2.Text:='2 1 1 1 1 1 1 1 7';
btn1.Click;
end;
procedure TForm1.N131Click(Sender: TObject);
begin
Form2.se1.Value:=9;
Form2.edt1.Text:='2 2 3 1 1 2 2 1 2';
Form2.edt2.Text:='4 1 1 1 1 1 1 1 5';
btn1.Click;
end;
procedure TForm1.N141Click(Sender: TObject);
begin
Form2.se1.Value:=9;
Form2.edt1.Text:='2 1 1 2 2 1 1 4 2';
Form2.edt2.Text:='5 2 1 1 2 1 1 2 3';
btn1.Click;
end;
procedure TForm1.N151Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='5 1 1 1 1 1 1 1 1 5';
Form2.edt2.Text:='2 2 2 2 1 1 2 2 2 2';
btn1.Click;
end;
procedure TForm1.N161Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='2 1 2 3 1 2 1 3 1 2';
Form2.edt2.Text:='2 1 2 2 1 2 1 1 3 3';
btn1.Click;
end;
procedure TForm1.N171Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='2 1 1 1 1 1 1 1 4 5';
Form2.edt2.Text:='2 2 2 2 1 1 2 2 2 2';
btn1.Click;
end;
procedure TForm1.N181Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='2 1 2 1 1 1 1 1 3 5';
Form2.edt2.Text:='2 1 2 1 1 1 1 1 3 5';
btn1.Click;
end;
procedure TForm1.N191Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='2 1 2 1 2 1 1 2 3 5';
Form2.edt2.Text:='6 2 1 3 1 1 1 2 3 2';
btn1.Click;
end;
procedure TForm1.N201Click(Sender: TObject);
begin
Form2.se1.Value:=10;
Form2.edt1.Text:='2 1 2 2 2 2 2 1 2 2';
Form2.edt2.Text:='4 1 1 2 2 3 2 4 1 4';
btn1.Click;
end;
procedure TForm1.N8Click(Sender: TObject);
var
str: string;
begin
str:=Form2.edt2.Text;
if str='' then
ShowMessage('Введите свои данные или выберите номер головоломки из списка')
else
btn1.Click;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
ShowMessage(' Головоломка "Замкнутая змея"'+#10#13+
'Разработал учащийся гр. 93491 Баранкевич Иван Геннадьевич'+#10#13+
' 2011 год');
end;
end.
Unit2
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;
type
TForm2 = class(TForm)
lbl1: TLabel;
se1: TSpinEdit;
lbl2: TLabel;
edt1: TEdit;
Lbl3: TLabel;
edt2: TEdit;
btn1: TButton;
procedure btn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure edt1KeyPress(Sender: TObject; var Key: Char);
procedure edt2KeyPress(Sender: TObject; var Key: Char);
procedure se1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.btn1Click(Sender: TObject);
begin
Close;
Form1.btn1.Click;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
edt1.text:='';
edt2.text:='';
end;
procedure TForm2.edt1KeyPress(Sender: TObject; var Key: Char);
begin
case key of //ограничение на ввод
'1'..'9',#8,' ':;
#13: edt2.SetFocus;
else
key:=chr(0)
end;
end;
procedure TForm2.edt2KeyPress(Sender: TObject; var Key: Char);
begin
case key of //ограничение на ввод
'1'..'9',#8,' ':;
#13: btn1.Click;
else
key:=Chr(0);
end;
end;
procedure TForm2.se1KeyPress(Sender: TObject; var Key: Char);
begin
case key of //ограничение на ввод
'5','6','7','8','9','1','0',#8:;
#13: edt1.SetFocus
else
key:=Chr(0);
end;
end;
end.