'N' Queen problem

program FPProgT15;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, math, SysUtils;

type
  QueenArray = Array of Integer;


var
  MainQueens: QueenArray;
  i, n, SuccessCounter, AttemptCounter: int64;
  OverFlow: Boolean;
  MyFile: TextFile;
  today: TDateTime;
  {$R *.res}

function isLegit(Queens: QueenArray): Boolean;
var
   i, j: integer;
   final: boolean;
begin
     final := true;
     for i := 1 to n do
     begin
       if final = true then
       begin
         for j := i - 1 downto 1 do
         begin
            if Queens[i] = Queens[j] then final := false
            else if Queens[j] = Queens[i] - (i-j) then final := false
            else if Queens[j] = Queens[i] + (i-j) then final := false;
         end;
       end;
     if final = true then isLegit := true
     else isLegit := false;
     end;
end;

procedure AddLineToFile(var FileToAppend: TextFile; LineToAdd: String);
begin
  Append(FileToAppend);
  Writeln(FileToAppend, LineToAdd);
  CloseFile(FileToAppend);
end;

procedure quit;
begin
  //SolutionList.SaveToFile(IntToStr(n) + '_Solutions.txt');
  writeln;
  writeln;
  writeln('Press <Enter> To Quit');
  today := now;
  writeln('Completed at: ' + TimeToStr(today));
  readln;
end;

procedure DrawBoard(Queens: QueenArray);
var
   i, j: integer;
   isWhite: Boolean;
   OutStr: String;
begin
  for i := n downto 1 do
  begin
  OutStr := '';
    for j := 1 to n do
    begin
      if ((i + j) mod 2) = 0 then isWhite := false
      else isWhite := true;
      if Queens[j] = i then
      begin
        if isWhite = true then OutStr := OutStr + ' W Q'
        else OutStr := OutStr + ' B Q';
      end
      else
      begin
        if isWhite = true then OutStr := OutStr + ' WNQ'
        else OutStr := OutStr + ' BNQ'
      end;
    end;
    Writeln(OutStr);
    //SolutionList.Append(OutStr);
    AddLineToFile(MyFile, OutStr);
  end;
  Writeln;
  //SolutionList.Append('');
  AddLineToFile(MyFile, '');
end;

procedure AdvanceQueen(Index: Integer);
var
  i: integer;
begin
  if MainQueens[Index] < n then MainQueens[Index] := MainQueens[Index] + 1 //if there is room to progress then progress
  else
  begin
    index := index + 1;
    for i := Index - 1 downto 1 do
    begin
      MainQueens[i] := 1
    end;
    if Index <= n then AdvanceQueen(Index)
    else OverFlow := True;
  end;
end;

procedure SolveForN;
begin
  SuccessCounter := 0;
  SetLength(MainQueens, 0); //Clear the array
  SetLength(MainQueens, n); //Reset its size
  AssignFile(MyFile, (IntToStr(n) + '_Solutions.txt'));
  ReWrite(MyFile);
  for i := 1 to n do MainQueens[i] := 1; //initialise all the queens
  OverFlow := False;
  AttemptCounter := 0;
  repeat
  begin
    AdvanceQueen(0);
    AttemptCounter := AttemptCounter + 1;
    if isLegit(MainQueens) = true then
    begin
      SuccessCounter := SuccessCounter + 1;
      Today := now;
      Writeln('Success on attempt: ' + inttostr(AttemptCounter) + ' at: ' + TimeToStr(today));
      Writeln('Board No. ' + IntToStr(SuccessCounter));
      AddLineToFile(MyFile, 'Board No. ' + IntToStr(SuccessCounter));
      DrawBoard(MainQueens);
    end
    else if AttemptCounter mod 100000000 = 0 then writeln('Failed on attempt: ' + IntToStr(AttemptCounter) + ' out of 285311670611');
  end;
  until OverFlow = true;
end;

begin
  n := 11;
  SolveForN;
  quit;
end.