It shows 1 combination less (arrangement of queens), what should I do?

Question

Delphi

And again my queens, tweaked the design, well, the file at the same time, as a result, my problems came out:
1) how can I paint over the board more adequately?
2) one of the main questions: I only show from 1 combination to 9, the counter, when the combination is shown, shows the value, one more, for example, I have 1 combination, and the counter has already jumped to 2, please tell me how to fix it this moment?
I give the entire listing of the program, where this aspect needs to be fixed, at the moment:

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, Buttons, StdCtrls, Spin, Menus, jpeg;

Const Maxlen = 15;
{При размере доски 15 x 15 будет 2279184 различных комбинаций расстановки ферзей, для 14 - 365596}

Type
ta=array[1..Maxlen] of 0..Maxlen;

  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    procedure Draw(var a:ta; co: cardinal);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BackTracking(k:integer;a:ta);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DeleteThisFileContent(const FileToClear: string);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

Var
  Form1: TForm1;
  Input: TextFile;

implementation

uses Unit2;

var
  a:ta;
  t:cardinal;
  exitclick:boolean;
  NumOfPlacements:cardinal;
  curlen:integer;
  showtime:cardinal;

{$R *.dfm}

procedure TForm1.DeleteThisFileContent(const FileToClear: string);
Begin
  Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Placements.txt');
  Rewrite(Input);
  Closefile(Input);
End;

procedure TForm1.Draw(var a:ta; co: cardinal);
var I, J:integer;
  HelpString: string;
  img1, img2: TPicture;
Begin
  Assignfile(Input, 'D:\Работы по ОАиП\Курсовая работа\Placements.txt');
  Append(Input);
  writeln(Input,'Placement № ',co);
  if Curlen-1 div 10 = 1 then
  Begin
    while Length(HelpString) < ((curlen-1)*3+curlen-2+curlen mod 10) do
      HelpString := '-' + HelpString;
    writeln(Input,HelpString)
  End
  else
  Begin
    while Length(HelpString) < ((curlen-1)*3+curlen-2) do
      HelpString := '-' + HelpString;
    writeln(Input,HelpString)
  End;
  for i:=1 to Curlen-1 do
  begin
    Write(Input,char(ord(96+a[i])),'-',curlen-i);
    if I <> curlen-1 then write(Input,',');
  end;
  writeln(Input);
  writeln(Input,HelpString);
  CloseFile(Input);
  img1:= TPicture.Create;
  img1.LoadFromFile('D:\Работы по ОАиП\Курсовая работа\Ферзь 1.bmp');
  img2:= TPicture.Create;
  img2.LoadFromFile('D:\Работы по ОАиП\Курсовая работа\Ферзь 2.bmp');
  for I:=1 to Curlen-1 do with StringGrid1 do
  Begin
    for j:=1 to Curlen-1 do with StringGrid1 do
    Begin
      if (j+i) mod 2 = 1 then
      Begin
        StringGrid1.Canvas.Brush.Color:=$478bd1;
        StringGrid1.Canvas.Rectangle(CellRect(i,j));
      End
      else
      Begin
        StringGrid1.Canvas.Brush.Color:=$9ecfff;
        StringGrid1.Canvas.Rectangle(CellRect(i,j));
      End;
    End;
  End;
  StringGrid1.Canvas.Brush.Color:=clYellow;
  for I:=1 to Curlen-1 do with StringGrid1 do
    if (I+A[I]) mod 2 = 0 then
      StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(i,a[i]), img1.Graphic)
    else
      StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(i,a[i]), img2.Graphic);
End;

procedure TForm1.BackTracking(k:integer;a:ta);
var I, J:integer;
  Po:boolean;
  B:ta;
Begin
  if not exitclick then
  Begin
    if k<curlen-1 then
    Begin
      for i:=1 to curlen-1 do b[i]:=a[i];
      for i:=1 to curlen-1 do
      Begin
        po:=true;
        for j:=1 to k do
        Begin
          if a[j]=i then po:=false;
          if abs(a[j]-i)=abs(j-k-1) then po:=false
        End;
        if po then
        Begin
          b[k+1]:=i;
          BackTracking(k+1,b)
        End
      End
    End
    else
    Begin
      Inc(NumOfPlacements);
      Form1.Caption:=IntToStr(NumOfPlacements);
      Form1.Draw(a,NumOfPlacements);
      t:=GetTickCount;
      repeat
        Application.ProcessMessages;
      until (GetTickCount-t)>showtime;
      StringGrid1.Repaint
    End
  End
End;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var i,j: integer;
Rect: TRect;
Begin
  assignfile(Input, 'Placements.txt');
  rewrite(Input);
  closefile(Input);
  NumOfPlacements:=0;
  exitclick:=false;
  showtime:=SpinEdit2.Value;
  curlen:=SpinEdit1.Value+1;
  StringGrid1.ColCount:=curlen;
  StringGrid1.RowCount:=curlen;
  StringGrid1.DefaultColWidth:=trunc((StringGrid1.Width-2*curlen)/curlen);
  StringGrid1.DefaultRowHeight:=trunc((StringGrid1.Height-2*curlen)/curlen);
  i:=1;
  J:=Curlen-1;
  while (I <= Curlen) do with StringGrid1 do
  begin
    Font.Size:=20+trunc(StringGrid1.DefaultRowHeight/curlen)-1;
    Font.Style:=[fsBold];
    Font.Name:='Times New Roman';
    StringGrid1.Canvas.Brush.Color:=clRed;
    StringGrid1.Canvas.FillRect(Rect);
    StringGrid1.Cells[i, 0] := char(ord(96+i));
    StringGrid1.Cells[0, I] := IntToStr(J);
    Inc(I);
    Dec(J);
  end;
  BackTracking(0,a)
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  Curlen:=8;
  Showtime:=300
End;

procedure TForm1.SpeedButton2Click(Sender: TObject);
Begin
  exitclick:=true;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Hide;
  Form2.Show;
end;

End.

Answer 1

1. It was necessary to draw not on StringGrid, but on DrawGrid, which has an OnDrawCell event. It is called for each cell (store grid data in an array, for example, a two-dimensional array from record). And there will be no need to do a terrible loop using the Application.ProccessMessages crutch
2. The current combination variable is 1