function TfmCargoOutgoing.DoChangeOwnerContractCargoSub(AOldContractCargoSubId,
  ANewContractCargoSubId: integer): integer;
var
  CardCount: integer;
  ChangedCount: integer; // кол-во измененных карточек
begin
  ChangedCount := 0;

...
    // 1. Определить количество карточек для переноса
    ...
    if Assigned(fP) then
      fP.Max3 := CardCount; // инициализация общего количества для прогресс-бара
    ....
    // 2. Перенести все карточки в новый подтип груза по договору    
    while not q.Q.Eof do
      begin
        if DoChangeOwnerCargoCard(q.Q.FieldByName('id').AsInteger, ANewContractCargoSubId) <> 0 then
          begin
            inc(ChangedCount);

            if Assigned(fP) then
              fP.Position3 := ChangedCount; // обновление позиции прогресс-бара

          end;
        q.Q.Next;
      end;

    Result := ChangedCount;
end;

procedure TfmChangeOwnerProgress.SetPosition3(const Value: integer);
begin
  ProgressBarCargoCard.Position := Value;
  Application.ProcessMessages;
end;

type
  TfmChangeOwnerProgress = class(TForm)
  ....
  public
    { Public declarations }
    property Position1: integer read GetPosition1 write SetPosition1;
    property Position2: integer read GetPosition2 write SetPosition2;
    property Position3: integer read GetPosition3 write SetPosition3;
    property Max1: integer read GetMax1 write SetMax1;
    property Max2: integer read GetMax2 write SetMax2;
    property Max3: integer read GetMax3 write SetMax3;
  end;
...

ProgressBarCargoCard.Position := Value;
  Application.ProcessMessages;

ProgressBarCargoCard.Position := Value;
  ProgressBarCargoCard.Update;

constructor TChangeOwnerThread.Create(const ACargoCardId: Integer);
begin
  Fcargo_card_id := ACargoCardId;

  FfmProgress := TfmChangeOwnerProgress.Create(nil);
  FfmProgress.ShowModal;

  OnTerminate := TerminateHandler;
  inherited Create(true);
  FreeOnTerminate := false;
end;

procedure TChangeOwnerThread.TerminateHandler(Sender: TObject);
begin
  FreeAndNil(FfmProgress);
end;

type
  TForm2 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  while ProgressBar1.Position < ProgressBar1.Max do
  begin
    ProgressBar1.StepIt;
    sleep(100);
  end;
end;

ChThread := TChangeOwnerThread.Create(coChange, placement_cargo_card_id);
  try
    ChThread.Start;
  finally
    if ChThread.ret_cargo_card_id <> 0 then
      begin
        ChangeQueryCargo; // обновляет основную сетку
        placement_cargo_card_id := ChThread.ret_cargo_card_id; // позиционирует курсор на запись в сетке
      end;
    ChThread.Free;
  end;

constructor TChangeOwnerThread.Create(AMode: TcoMode; const ACargoCardId: Integer);
begin
  FMode := AMode;
  Fcargo_card_id := ACargoCardId;

  FfmProgress := TfmChangeOwnerProgress.Create(nil);
  FfmProgress.ShowModal;

  OnTerminate := TerminateHandler;
  inherited Create(true);
  FreeOnTerminate := false;
end;

type
  TForm2 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  while ProgressBar1.Position < ProgressBar1.Max do
  begin
    ProgressBar1.StepIt;
    sleep(100);
  end;
end;

// 2. Перенести все карточки в новый подтип груза по договору
    q.From('cargo_card', 'cc');
    q.Select('cc.id');
    q.Where('object_type= ?', 'placement');
    q.AndWhere('get_weight_brutto_remains(cc.id) > 0', '');
    q.AndWhere('cc.contract_cargo_sub_id=?', AOldContractCargoSubId);
    q.Open;
    while not q.Q.Eof do
      begin
        if DoChangeOwnerCargoCard(q.Q.FieldByName('id').AsInteger, ANewContractCargoSubId) <> 0 then
          begin
            inc(ChangedCount);
            if Assigned(fP) then
              fP.Position3 := ChangedCount;
            ShowMessage(IntToStr(ChangedCount));
          end;
        q.Q.Next;
      end;

function TfmCargoOutgoing.DoChangeOwnerContractCargoSub(AOldContractCargoSubId,
  ANewContractCargoSubId: integer): integer;
var
  CardCount: integer;
  q: TBISMySQLQuery;
  ChangedCount: integer; // кол-во измененных карточек
//  f: TForm;
//  i: integer;
//  pb: TProgressBar;
begin
  ChangedCount := 0;

  q := TBISMySQLQuery.Create;
  try
    // 1. Определить количество карточек для переноса
    q.From('cargo_card', 'cc');
    q.Select('COUNT(*) AS cnt');
    q.Where('object_type= ?', 'placement');
    q.AndWhere('get_weight_brutto_remains(cc.id) > 0', '');
    q.AndWhere('cc.contract_cargo_sub_id=?', AOldContractCargoSubId);
    q.Open;
    CardCount := q.Q.FieldByName('cnt').AsInteger;
    if Assigned(fP) then
      fP.Max3 := CardCount;

    // 2. Перенести все карточки в новый подтип груза по договору
    q.From('cargo_card', 'cc');
    q.Select('cc.id');
    q.Where('object_type= ?', 'placement');
    q.AndWhere('get_weight_brutto_remains(cc.id) > 0', '');
    q.AndWhere('cc.contract_cargo_sub_id=?', AOldContractCargoSubId);
    q.Open;

//      f := TForm.Create(nil);
//  f.SetBounds(0, 0, 300, 70);
//  f.Position := poScreenCenter;
//  pb := TProgressBar.Create(f);
//  pb.Align := alClient;
//  pb.Parent := f;
//  pb.Min := 0;
//  pb.Max := CardCount;
//  pb.Step := 1;
//  f.Show();
//  for i := pb.Min to pb.Max do begin
////    pb.StepIt;
//    pb.Position := i;
//    sleep (100);
//  end;


    while not q.Q.Eof do
      begin
        if DoChangeOwnerCargoCard(q.Q.FieldByName('id').AsInteger, ANewContractCargoSubId) <> 0 then
          begin
            inc(ChangedCount);
//            pb.StepIt;

            if Assigned(fP) then
              fP.Position3 := ChangedCount;
//            ShowMessage(IntToStr(ChangedCount));
          end;
        q.Q.Next;
      end;

//    f.Free;
  finally
    q.Free;
    Result := ChangedCount;
  end;
end;