(Resolvido) compactando com Zlib

[Marcos Augusto]

Olá pessoal, estou tentando compactar com o zlib do delphi, a compactacao em consigo mas noa consigo mostrar o andamento da compactação em um ProgressBar, o progressbar so funciona apos ter acabado de compactar, alguém tem alguma resposta simples para isso pois sou novato em programacao. Grato Marcos Augusto

esse é o codigo que compacata mas não funciona o progressbar

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Zlib, ComCtrls, StdCtrls;

type
  TForm4 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.Button1Click(Sender: TObject);
begin
  CompactaArquivo('c:\z.z', 'c:\', 'z.y');
end;

procedure TForm4.CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
  var
    FileIni, FileOut    : TFileStream;         //TMemoryStream
    Zip                 : TCompressionStream;
    cont                : Integer;
begin
  if FileExists(CaminhoIn) then
    begin
      Screen.Cursor := crHourGlass;
      if NomeFile <>  '' then NomeFile := CaminhoOut + NomeFile;
      if NomeFile =   '' then NomeFile := CaminhoOut + '\DefArq.cmf';

      FileIni :=  TFileStream.Create(CaminhoIn, fmOpenRead and fmShareExclusive);
      FileOut :=  TFileStream.Create(NomeFile, fmCreate or fmShareExclusive);
      Zip     :=  TCompressionStream.Create(clMax, FileOut);

      ProgressBar1.Max        := FileIni.Size;
      Zip.CopyFrom(FileIni, FileIni.Size);
      ProgressBar1.Position   := FileIni.Position;

      Zip.Free;
      FileOut.Free;
      FileIni.Free;
      Screen.Cursor := crDefault;
    end
  else
    begin
      Application.MessageBox('Arquivo não encontrado.','Erro',MB_ICONERROR);
    end;
end;

end.

Editado Abril 28, 2008 por Micheus
Incluída tag's CODE para melhorar a visualização. Utilize a identação também ;)

[Micheus]

a compactacao em consigo mas noa consigo mostrar o andamento da compactação em um ProgressBar, o progressbar so funciona apos ter acabado de compactar

Marcos Augusto, você precisará criar uma procedure para ser atribuída ao evento OnProgress da classe TCompressionStream. Com isso, a cada parte do processo de compactação que for avançada, este seu procedimento será chamado.

Deve ficar mais ou menos assim (não tenho isso implementado):

type
  TForm4 = class(TForm)
    ...
  private
    procedure CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
        procedure OnCompressProgress(Sender :TObject);    << ============= AQUI
    { Private declarations }

...

procedure TForm4.OnCompressProgress(Sender :TObject);
begin
  ProgressBar1.Position := (Sender as TStream).Position;
  Application.ProcessMessages;
end;

procedure TForm4.CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
...

      Zip := TCompressionStream.Create(clMax, FileOut);
      Zip.OnProgress := OnCompressProgress;  << ======= AQUI
      ProgressBar1.Max := FileIni.Size;
      Zip.CopyFrom(FileIni, FileIni.Size);
//      ProgressBar1.Position := FileIni.Position;  << ======= AQUI - retira/comenta
      Zip.Free;
...
end;

Tente e veja se faltou algo.

Abraços

[Marcos Augusto]

a compactacao em consigo mas noa consigo mostrar o andamento da compactação em um ProgressBar, o progressbar so funciona apos ter acabado de compactar

Marcos Augusto, você precisará criar uma procedure para ser atribuída ao evento OnProgress da classe TCompressionStream. Com isso, a cada parte do processo de compactação que for avançada, este seu procedimento será chamado.

Deve ficar mais ou menos assim (não tenho isso implementado):

type
  TForm4 = class(TForm)
    ...
  private
    procedure CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
        procedure OnCompressProgress(Sender :TObject);    << ============= AQUI
    { Private declarations }

...

procedure TForm4.OnCompressProgress(Sender :TObject);
begin
  ProgressBar1.Position := (Sender as TStream).Position;
  Application.ProcessMessages;
end;

procedure TForm4.CompactaArquivo(CaminhoIn, CaminhoOut, NomeFile : String);
...

      Zip := TCompressionStream.Create(clMax, FileOut);
      Zip.OnProgress := OnCompressProgress;  << ======= AQUI
      ProgressBar1.Max := FileIni.Size;
      Zip.CopyFrom(FileIni, FileIni.Size);
//      ProgressBar1.Position := FileIni.Position;  << ======= AQUI - retira/comenta
      Zip.Free;
...
end;

Tente e veja se faltou algo.

Abraços

Grato Micheus, sua dica serviu como uma luva. Muito obrigado.