talte poster rykker progressbar

Du mangler at sætte Max til summen af tabllernes RecordCount, men dem skal du glemme og i stedet køre det procentvis. Men umiddelbart giver konstruktionen alligevel ingen mening. Når du tager RecordCount fra en tabel sker det øjeblikkeligt og du ser ikke trinene. Der hvor pauserne er, er ved åbning af tabellerne:

Jeg forstiller mig en form med en TMemo og en TProgressBar:

type
  TfrmSplash = class(TForm) // Husk: FormStyle := fsStayOnTop;
    mStatus: TMemo;
    pbStatus: TProgressBar;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    function GetMax: integer;
    function GetPosition: integer;
    procedure SetMax(const Value: integer);
    procedure SetPosition(const Value: integer);
  public
    function Add(const aString: string): integer; overload;
    function Add(const aString: string; const aArgs: array of const): integer; overload;
    property Max: integer read GetMax write SetMax;
    property Position: integer read GetPosition write SetPosition;
  end;

var
  frmSplash: TfrmSplash;

implementation

function TfrmSplash.Add(const aString: string; const aArgs: array of const): integer;
begin
  result := mStatus.Lines.Add(format(aString,aArgs));
  Application.ProcessMessages; // Opdaterer skærmen
end;

function TfrmSplash.Add(const aString: string): integer;
begin
  result := Add(aString,[]);
end;

procedure TfrmSplash.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmSplash.FormDestroy(Sender: TObject);
begin
  frmSplash := nil;
end;

function TfrmSplash.GetMax: integer;
begin
  result := pbStatus.Max;
end;

function TfrmSplash.GetPosition: integer;
begin
  result := pbStatus.Position;
end;

procedure TfrmSplash.SetMax(const Value: integer);
begin
  pbStatus.Max := Value;
  pbStatus.Position := 0;
  Application.ProcessMessages;
end;

procedure TfrmSplash.SetPosition(const Value: integer);
begin
  pbStatus.Position := Value;
  Application.ProcessMessages;
end;

// i programmet ser det således ud:

  frmSplash := TfrmSplash.Create(nil);
  frmSplash.Max := 100;
  frmSplash.Position := 0;
 
  frmSplash.Show;
  try
    Table1.Open;
    frmSplash.Add('Åbner tabel 1 (%d)',[Table1.RecordCount]);
    frmSplash.Postion := 33;
 
    Table2.Open;
    frmSplash.Add('Åbner tabel 2 (%d)',[Table2.RecordCount]);
    frmSplash.Postion := 66;
 
    Table3.Open;
    frmSplash.Add('Åbner tabel 3 (%d)',[Table3.RecordCount]);
    frmSplash.Postion := 100;
  finally
    frmSplash.Release; // alternativt denne: frmSplash.Close
  end;

Kan selvfølgelig også lave endnu et par overloads af Add funktionen:

function Add(const aString: string; const aPosition: integer): integer; overload;

function Add(const aString: string; const aArgs: array of const; const aPosition: integer): integer; overload;

// Implementeret

function Add(const aString: string; const aPosition: integer): integer;
begin
  result := Add(aString,[],aPosition);
end;

function Add(const aString: string; const aArgs: array of const; const aPosition: integer): integer;
begin
  result := Add(aString,aArgs);
  pbStatus.Position := aPosition;
  Application.ProcessMessages;
end;

... så sparer du en linje hver gang

For din egen skyld, giv dog dine objekter nogle fornuftige navne. Du løber alt for let sur i det og mister overblikket når du har ADOTable1, ADOTable2, ADOTable3, ... Et stykke tid væk fra programmet og du har ingen anelse om hvad de indeholder.