Языки программирования скачать

Const N = 8; // 8 Клеток
M = 8; // [block]0[/block]

Type Queen = record
X,Y : Integer;
End;

Procedure ShowQueen;
Var I : Integer;
Begin
For I := 1 To M Do
WriteLn('Q',I, ' [', K[I].X, ',', K[I].Y, ']');
End;

Procedure SetQueen;
Begin
For I := 1 To M Do
If (K[I].X <> 0) And (K[I].Y <> 0) Then
A[K[I].X, K[I].Y] := I;
End;

Procedure ClearArray;
Var I,J : Integer;
Begin
For I := 1 To N Do
For J := 1 To N Do
A[I, J] := 0;
End;

Procedure ShowArray;
Var I,J : Integer;
Begin
For I := 1 To N Do
Begin
For J := 1 To N Do
Write(A[I, J]:3);
WriteLn;
End;
End;

Procedure SetArray(X,Y : Integer);
Var I,J : Integer;
Begin
For I := 1 To N Do Inc(A[I,Y]);
For I := 1 To N Do Inc(A[X,I]);
For I := -N To N Do
If (X+I>=1) And (X+I<=N) And (Y+I>=1) And (Y+I<=N) Then
Inc(A[X+I,Y+I]);
For I := -N To N Do
If (X+I>=1) And (X+I<=N) And (Y-I>=1) And (Y-I<=N) Then
Inc(A[X+I,Y-I]);
End;

Function CountArray:Integer;
Var I,J,S : Integer;
Begin
S := 0;
For I := 1 To N Do
For J := 1 To N Do
If A[I, J] = 0 Then Inc(S);
CountArray := S;
End;

Begin
ClrScr;
ClearArray;
ClearQueen;

// =ЦЕЛОЕ((B2-1)/8)+1
// =B2-8*(C2-1)

Q := 1;
I := 1;

While (Q <= M) Do
Begin
X := Trunc((I-1)/N)+1;
Y := I-N*(X-1);
If A[X,Y] = 0
Then
Begin
SetArray(X,Y);
K[Q].X := X;
K[Q].Y := Y;
Inc(Q);
End
Else Inc(I);

If I > N*N
Then
Begin
Dec(Q);
I := 1+((K[Q].X - 1) * N + K[Q].Y);
K[Q].X := 0;
K[Q].Y := 0;

ClearArray;
For J := 1 To Q-1 Do SetArray(K[J].X,K[J].Y);
End;

End;

ClrScr;
ShowQueen;
ClearArray;
SetQueen;
ShowArray;