const N=15;
   type Index=1..N;
   Rasstanovka=array [Index] of 0..N;
var
  Form1: TForm1;
  X:Rasstanovka;
  Count:word;
  time1,time2,time:integer;
implementation

{$R *.dfm}
function P(var X:Rasstanovka;k,y:Index):boolean;
var i:Index;
begin
     i:=1;
     while (i<k)and(y<>X[i])and(abs(k-i)<>abs(y-X[i])) do inc(i);
     P:=i=k
end;

procedure Backtracking(k:Index);
var i,y:Index;
begin
   for y:=1 to N do
   if P(X,k,y) then
   begin
    X[k]:=y;
    if k=N then
     begin
       {for i:=1 to N do write(X[i]);writeln;}
       inc(Count);
       if (count mod 10000=0) then
       form1.label4.Caption:='Loop: '+inttostr(Count div 10000);
       application.ProcessMessages;
     end;
    Backtracking(k+1);
   end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Count:=0;
   label2.Caption:='Total: 0 variants';
   label1.Caption:='Replacing '+inttostr(N)+' Queens'
   +'     Table '+inttostr(n)+'x'+inttostr(n);
   time1:=gettickcount;
   Backtracking(1);
   time2:=gettickcount;
   time:=time2-time1;
   label2.Caption:='Total: '+inttostr(Count)+' variants';
   form1.Panel1.Caption:='Elapsed time: '+floattostr(time /1000)+' sec';
end;

 if (count mod 10000=0) then
       form1.label4.Caption:='Loop: '+inttostr(Count div 10000);
       application.ProcessMessages;