Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
0
Добавлен:
25.12.2019
Размер:
7.36 Кб
Скачать
unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls;

const
MaxN=20;

type
TArray = array [0..MaxN] of integer;

TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Button1: TButton;
Label2: TLabel;
ListBox1: TListBox;
Label3: TLabel;
StringGrid1: TStringGrid;
Label4: TLabel;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);

private
{ Private declarations }
N:integer; // количество ферзей, размер доски
public
{ Public declarations }
function IsStrike(x1, y1, x2, y2:integer):boolean;
function Strike(M:TArray; p:integer):boolean;

// обработка TStringGrid
procedure InitStringGrid(N:integer);
procedure ShowStringGrid(s:string; N:integer);

// добавить строку s в ListBox1 в заданном формате
procedure AddToListBox(M:TArray; N:integer);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
// проверка, бьются ли два ферзя
function TForm1.IsStrike(x1, y1, x2, y2:integer):boolean;
var
tx, ty:integer;
begin

// 1. Горизонталь, вертикаль
// Ферзи бьют друг друга, если любый 2 значення-параметра совпадают
if (x1=x2) or (y1=y2) then
begin
IsStrike := true;
exit;
end;

// 2. Главная диагональ
// 2.1. Влево-вверх
tx := x1-1;
ty := y1-1;
while (tx>=1)and(ty>=1) do
begin
if (tx=x2)and(ty=y2) then
begin
IsStrike:=true;
exit;
end;
tx:=tx-1; ty:=ty-1;
end;

// 2.2. Вправо-вниз
tx:=x1+1; ty:=y1+1;
while (tx<=N)and(ty<=N) do
begin
if (tx=x2) and (ty=y2) then
begin
IsStrike:=true;
exit;
end;
tx:=tx+1;
ty:=ty+1;
end;

// 3. Дополнительная диагональ
// 3.1. Вправо-вверх
tx:=x1+1; ty:=y1-1;
while (tx<=N)and(ty>=1) do
begin
if (tx=x2)and(ty=y2) then
begin
IsStrike:=true;
exit;
end;
tx:=tx+1;
ty:=ty-1;
end;

// 3.2. Влево-вниз
tx:=x1-1; ty:=y1+1;
while (tx>=1)and(ty<=N) do
begin
if (tx=x2)and(ty=y2) then
begin
IsStrike:=true;
exit;
end;
tx:=tx-1;
ty:=ty+1;
end;
IsStrike:=false;
end;

function TForm1.Strike(M: TArray; p: Integer):boolean;
var
px, py, x, y, i: integer;
begin
px := M[p];
py := p;

for i:=1 to p-1 do
begin
x := M[i];
y := i;

if IsStrike(x,y,px,py) then
begin
Strike:=true;
exit;
end;
end;
Strike:=false;
end;

// инициализация StringGrid
procedure TForm1.InitStringGrid(N: Integer);
var
i,j:integer;
begin
// края доски
StringGrid1.FixedCols:=1;
StringGrid1.FixedRows:=1;

// размеры доски
StringGrid1.RowCount:=N+1;
StringGrid1.ColCount:=N+1;

// заголовок
for i:=1 to N do
begin
StringGrid1.Cols[i].Text:=IntToStr(i);
StringGrid1.Rows[i].Text:=IntToStr(i);

// ширина колонки
StringGrid1.ColWidths[i]:=30;
end;

// ширина нулевой колонки
StringGrid1.ColWidths[0]:=35;

// очистка ячеек
for i:=1 to N do
for j:=1 to N do
StringGrid1.Cells[i,j]:='';
end;

// Процедура, отображающая в StringGrid1 строку s,
// N - количество ферзей
// принимаем, что StringGrid1 уже инициализировано в размер N*N
procedure TForm1.ShowStringGrid(s: string; N: Integer);
var
i, j:integer;
xs, ys:string;
x, y:integer;
begin
// очистить StringGrid1
for i:=1 to N do
for j:=1 to N do
Form1.StringGrid1.Cells[i,j]:='';

j:=0; // смещение
for i:=1 to N do
begin
// сформировать xs
xs:='';
while s[j+1] <> ',' do
begin
xs:=xs+s[j+1];
j:=j+1;
end; // xs - число x в виде строки

// прокрутить смещения
j:=j+1;

// сформировать ys
ys:='';
while s[j+1]<>'-' do
begin
ys:=ys+s[j+1];
j:=j+1;
end;

// прокрутить
j:=j+1;

x:=StrToInt(xs);
y:=StrToInt(ys);

// обозначить позицию x,y ферзя
StringGrid1.Cells[x,y]:='X';
end;
end;
// Активизация формы
procedure TForm1.FormActivate(Sender: TObject);
begin
InitStringGrid(1);
end;
// записать строку в listBox1
// входные параметры: M - массив чисел, N - количество элементов в массиве M
procedure TForm1.AddToListBox(M:TArray; N:integer);
var
s:string;
i:integer;
begin
for i:=1 to N do
s:=s+IntToStr(M[i])+','+IntToStr(i)+'-';
ListBox1.Items.Add(s);
end;
// клик на строке в ListBox1
procedure TForm1.ListBox1Click(Sender: TObject);
var
num:integer;
begin
if ListBox1.Items.Count<=0 then
exit;
num:=ListBox1.ItemIndex;
ShowStringGrid(ListBox1.Items[num],N);
end;
// Обработчик события Click элемента управления Button - реализует размещение
procedure TForm1.Button1Click(Sender: TObject);
var
M:TArray; // массив, формирующий размещения ферзей
p:integer; // номер размещаемого ферзя
k:integer; // количество вариантов размещения
begin
// взять количество ферзей
N:=StrToInt(Edit1.Text);

// Инициализировать StringGrid1
InitStringGrid(N);

// очистить listBox1
ListBox1.Items.Clear;

// АЛГОРИТМ ФОРМИРОВАНИЯ РАЗМЕЩЕНИЯ
// начальные настройки
p:=1;
M[p]:=0;
k:=0;

// цикл поиска вариантов размещений
while p>0 do
begin
M[p]:=M[p]+1;
if p=N then // последний элемент
begin
if M[p]>N then
while M[p]>N do p:=p-1 // перемотать обратно
else
begin
if not Strike(M,p) then
begin
// зафиксировать размещение
AddToListBox(M,N);
k:=k+1;
p:=p-1;
end;
end;
end
else // не последний элемент
begin
if M[p]>N then
while M[p]>N do p:=p-1 // перемотать обратно
else
begin
if not Strike(M,p) then
begin
p:=p+1;
M[p]:=0;
end;
end;
end;
end;

// вывести количество варіантов размещения
if k>0 then
begin
ListBox1.ItemIndex:=0;
ListBox1Click(Sender);
Label4.Caption:='Число положений = ' + IntToStr(k);
end;
end;
end.
Соседние файлы в папке Курсовая (Задача о 8 ферзях)
  • #
    25.12.201948.8 Кб1Project1.dproj
  • #
    25.12.2019402 б0Project1.dproj.local
  • #
    25.12.201977 б0Project1.identcache
  • #
    25.12.201959.52 Кб1Project1.res
  • #
    25.12.201911.82 Кб0Unit1.dcu
  • #
    25.12.20197.36 Кб0Листинг.txt