Windows spinning wheel freezes progress bar

Question

In a Lazarus application I use a progress bar that shows data export from a database.

procedure TFOpere.bEsportaVocabolarioClick(Sender: TObject);
var
   separa: String;
   titolo: String;
begin
 id_opera:=fontedati.qOpere.FieldByName('id_opera').AsInteger;
 titolo := Utf8ToAnsi(fontedati.qOpere.FieldByName('cognome').AsString) + ' - ' +
 Utf8ToAnsi(fontedati.qOpere.FieldByName('titolo').AsString) + '.txt';
 dRegistrazione.FileName:=titolo;
 dRegistrazione.Execute;
 AssignFile(docTesto, dRegistrazione.FileName);
 Rewrite(docTesto);
 Write(docTesto,chr(239)+chr(187)+chr(191)); // codifica UTF-8 : $FE $FF [$EF $BB $BF]
 fontedati.sVocabolario.DataSet.DisableControls;
 fontedati.qVocabolario.Last;
 volume := fontedati.qVocabolario.RecordCount;
 fontedati.qVocabolario.First;
 parziale :=0;
 Thermo.Position := 0;
 Thermo.Min := 0;
 Thermo.Max := volume;
 passo:= trunc(volume/100);
 while not fontedati.qVocabolario.Eof do
   begin
     parziale := parziale + 1;
     separa := fontedati.qVocabolario.FieldByName('separatore').AsString;
     separa := AnsiReplaceText(separa, 'P', chr(13)+chr(10));
     separa := AnsiReplaceText(separa, 'S', chr(32));
     Write(docTesto, fontedati.qVocabolario.FieldByName('vocabolo').AsString);
     Write(docTesto, separa);
     fontedati.qVocabolario.Next;
     if parziale = passo then
       begin
         Thermo.StepBy(passo);
         parziale := 0;
       end;
   end;
 fontedati.qVocabolario.First;
 fontedati.sVocabolario.DataSet.EnableControls;
 Thermo.Position := 0;
 CloseFile(docTesto);
 Beep;
end; 

Sometimes - but only sometimes, in a random way - the Windows spinning wheel freezes the bar, but not the application, so I can't see the progress of export. Is there a way to avoid this problem? Thank you.