ProgressBar for TResourceStream (Delphi)

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?

I think i should use a MemoryStream but i don't know how is it possible. — Kermia, May 21 '11 at 13:39
You can't use ProgressBar with TResourceStream.SaveToFile method. But of course it is possible to save resources to files with ProgressBar visualization. — kludg, May 21 '11 at 14:39
A better way to ask your question: "I want to save to a file, and have progress bar update from 0% to 100% as it saves, how do I do that?". Any question that's less than 10 words long is almost always a terrible question. (How do I blah with blah? : Bad question) — Warren P, May 21 '11 at 16:40

NGLN · Accepted Answer · 2011-05-21T18:33:15.663

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;

What's the complicating part? Getting this sample code to run, or transforming this into a thread variant? — NGLN, May 21 '11 at 14:27
This code does not work. when i extract the file it will be corrupted. — Kermia, May 21 '11 at 17:47
I said: i extracted the file using this code but the extracted file will be corrupted. and doesn't work. — Kermia, May 21 '11 at 18:03
Ah, compris. Well, that's how TResourceStream works I'm afraid. To check the code actually is correct: compare this file with the one generated by the standard SaveToFile routine. — NGLN, May 21 '11 at 18:06
I did. files will be extracted correctly using `SaveToFile` method. — Kermia, May 21 '11 at 18:13
Unicode Delphi version? Can you try to change `P: PChar;` into `P: PAnsiChar;`? — NGLN, May 21 '11 at 18:26
It is overcomplex. However, gonna work because reimplemented version is slower than original (see TCustomMemoryStream.SaveToStream) — Premature Optimization, May 21 '11 at 22:28
The number of lines of code is not a well criterion for a fair comparison. Try to profile: you will see that there is no difference. — NGLN, May 22 '11 at 00:03

score 4 · Answer 2 · answered May 21 '11 at 13:52

4

Since it inherits from TStream you could use the Size property to get the total size and Position to get the current position. You can use those to 'drive' your progressbar. Then instead of using SaveToFile to write to the file you would use a seperate TFileStream and write to it block by block from TResourceStream. You could use the TStream.CopyFrom method for that last part.

answered May 21 '11 at 13:52

Lars Truijens

42,837
6
126
143

1

But he did not use `CopyFrom` method. – Kermia May 21 '11 at 18:00

ProgressBar for TResourceStream (Delphi)

2 Answers2

Linked