Сейчас эти данные отображаются на аналоговых датчикахнекорректна. Датчики только измеряют/контролируют что-то, отображают индикаторы.
grdChessBoard.Font.Size:= 20+trunc(grdChessBoard.DefaultRowHeight/QueensCount)-1;
grdChessBoard.Font.Style:=[fsBold];
grdChessBoard.Font.Name:='Times New Roman';
if ACol = 0 then
grdChessBoard.Canvas.TextRect(grdChessBoard.CellRect(ACol, ARow), grdChessBoard.CellRect(ACol, ARow).Left, grdChessBoard.CellRect(ACol, ARow).Top, IntToStr(QueensCount - ARow))
else if ARow = QueensCount then
grdChessBoard.Canvas.TextRect(grdChessBoard.CellRect(ACol, ARow), grdChessBoard.CellRect(ACol, ARow).Left, grdChessBoard.CellRect(ACol, ARow).Top, char(96+ACol))
else
// а тут уже отрисовка клеточек собственно доскиif RestoreLastSolution then
begin
For i := 1 to QueensCount do
x[i] := TmpArr[i];
a[Cout1] := True;
b[Cout2 + Cout1] := True;
c[Cout2 - Cout1] := True;
i:=Cout2;
Solve(i);
end;procedure StackSolution(RestoreLastSolution: boolean = false);
var
i, j, Y, X: integer;
a: array [1..MaxQueensCount] of boolean;
b: array [2..2*MaxQueensCount] of boolean;
c: array [1-MaxQueensCount..MaxQueensCount-1] of boolean;
Stack: TStack<integer>;
Function Uspeh: Boolean;
Var
usp: Boolean;
Begin
usp := false;
While (Y < QueensCount) And Not usp do
Begin
Y := Y + 1;
usp := a[Y] and b[X + Y] and c[Y - X];
End;
Result := usp;
End;
begin
Stack := TStack<integer>.Create;
try
// Сначала в любом случае заполняем массив True - все горизонтали и диагонали свободны
For i := 1 to QueensCount do
a[i] := True;
For i := 2 to 2*QueensCount do
b[i] := True;
For i := 1-QueensCount to QueensCount-1 do
c[i] := True;
if RestoreLastSolution then
begin
// Если восстанавливаем решение
// Отмечаем занятыми линии соответственно последнему решению (без последнего ферзя)
For i := 1 to QueensCount-1 do
begin
a[TmpArr[i]] := False;
b[i + TmpArr[i]] := False;
c[TmpArr[i] - i] := False;
end;
// В X и Y положение последнего ферзя в решении
X := QueensCount;
Y := TmpArr[QueensCount];
// Решение запихиваем в стек (без последнего ферзя)
For i := 1 to QueensCount-1 do
Stack.Push(TmpArr[i]);
end
else
begin
X := 1;
Y := 0;
end;
// Далее не меняется ничего
Repeat
if StopPressed then
Exit;
If Uspeh Then
Begin
Stack.Push(Y);
If X < QueensCount Then
Begin
a[Y] := False;
b[X + Y] := False;
c[Y - X] := False;
X := X + 1;
Y := 0;
End
Else
begin
frmMain.DrawSolution(Stack);
Stack.Pop;
end;
End
Else
Begin
X := X - 1;
If X > 0 Then
Begin
Y := Stack.Pop;
a[Y] := True;
b[X + Y] := True;
c[Y - X] := True;
End;
End;
Until X = 0;
finally
Stack.Free;
end;
end;