Problems with processbar

When I run this code the progressbar just show me the end result. I want it to show me everytime it has handle a request.

I hope this is a simple and eay question.

procedure TFrmMain.Button3Click(Sender: TObject);
var List, ItemList, SubList: TStrings; I, n: Integer;
  aMan: string;
begin
  IdSMTP1.Host := 'mail.firm.org';
  ItemList := TStringList.Create;
  try
    List := TStringList.Create;
    try
      for I := 0 to Memo2.Lines.Count-1 do
      begin
        ItemList.CommaText := Memo2.Lines[I];
        aMan := ItemList[4];
        n := List.IndexOf(aMan);
        if n = -1 then
        begin
          SubList := TStringList.Create;
          n := List.AddObject(aMan, SubList);
        end;
        TStringList(List.Objects[n]).Add(ItemList[0] + ' ' + ItemList[1]);
      end;
      IdMessage1.From.Address := 'Automail@firm.com';
      IdMessage1.Subject := Edit1.Text;
      ProgressBar1.Max := list.Count;
      ProgressBar1.Step := round(100 / progressbar1.Max);
      for I := 0 to List.Count-1 do
      begin
        IdMessage1.Body.Clear;
        IdMessage1.Recipients.Add.Address := '';
        IdMessage1.Subject := 'Manager ' + List[I];
        IdMessage1.Body.AddStrings(memo1.Lines);
        IdMessage1.Body.Add('');
        IdMessage1.Body.Add('Manager ' + List[I]);
        IdMessage1.Body.Add('----------------------');
        IdMessage1.Body.AddStrings(TStringList(List.Objects[I]));
        IdMessage1.Body.Add('');
        IdMessage1.Body.Add('');
        IdSMTP1.Connect;
        IdSMTP1.Send(IdMessage1);
        IdSMTP1.Disconnect();
        ProgressBar1.Stepit;
        Application.Processmessages;
      end;
    finally
      FreeAndNil(List);
    end;
  finally
    FreeAndNil(ItemList);
  end;
  Edit1.Clear;
  memo1.Clear;
end;

Select allOpen in new window