Question

How to use ProgressBar for SaveToFile method ? Actually I want to save a resource to a file, and have progress bar update from 0% to 100% as it saves, how do I do that?

Answer 1

You can make your own TResourceStream descendant like in the code below. But for large resources (and that’s probably the case, otherwise you wouldn’t have to see progress) it’s better to “wrap” this in a separate thread. Yell if you need help with that.

type
  TForm1 = class(TForm)
    Button: TButton;
    ProgressBar: TProgressBar;
    procedure ButtonClick(Sender: TObject);
  private
    procedure StreamProgress(Sender: TObject; Percentage: Single);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TStreamProgressEvent = procedure(Sender: TObject;
    Percentage: Single) of object;

  TProgressResourceStream = class(TResourceStream)
  private
    FOnProgress: TStreamProgressEvent;
  public
    procedure SaveToFile(const FileName: TFileName);
    property OnProgress: TStreamProgressEvent read FOnProgress
      write FOnProgress;
  end;

{ TProgressResourceStream }

procedure TProgressResourceStream.SaveToFile(const FileName: TFileName);
var
  Count: Int64;
  Stream: TStream;
  BlockSize: Int64;
  P: PAnsiChar;
  WriteCount: Int64;
begin
  if Assigned(FOnProgress) then
  begin
    Count := Size;
    if Count <> 0 then
    begin
      Stream := TFileStream.Create(FileName, fmCreate);
      try
        if Count < 500 then
          BlockSize := 5
        else
          BlockSize := Count div 50;
        P := Memory;
        WriteCount := 0;
        while WriteCount < Count do
        begin
          if WriteCount < Count - BlockSize then
            Inc(WriteCount, Stream.Write(P^, BlockSize))
          else
            Inc(WriteCount, Stream.Write(P^, Count - WriteCount));
          Inc(P, BlockSize);
          FOnProgress(Self, WriteCount / Count);
        end;
      finally
        Stream.Free;
      end;
    end;
  end
  else
    inherited SaveToFile(FileName);
end;

{ TForm1 }

procedure TForm1.ButtonClick(Sender: TObject);
var
  Stream: TProgressResourceStream;
begin
  ProgressBar.Min := 0;
  Stream := TProgressResourceStream.Create(HInstance, 'TFORM1', RT_RCDATA);
  try
    Stream.OnProgress := StreamProgress;
    Stream.SaveToFile('TForm1.dat');
  finally
    Stream.Free;
  end;
end;

procedure TForm1.StreamProgress(Sender: TObject; Percentage: Single);
begin
  with ProgressBar do
    Position := Round(Percentage * Max);
end;