1:
2:
3:
4:
5:

    CStream := TZCompressionStream.Create(m);
    CStream.OnProgress := ZipOnProgress;
    CStream.CopyFrom(InpStream, InpStream.Size);
    CStream.Free;
    m.SaveToStream(OutStream);                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

Procedure TForm1.MyProgress(Sender: TObject);
Begin
  ProgressBar1.Position := (Sender as TCompressionStream).Position;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var sStream: TFileStream;
    cStream: TCompressionStream;
    dStream: TFileStream;
begin
  sStream := TFileStream.Create('i:\i.bin', fmOpenRead);
  dStream := TFileStream.Create('i:\j.bin', fmCreate);
  cStream := TCompressionStream.Create(clFastest, dStream);
  Try
    cStream.OnProgress := MyProgress;
    ProgressBar1.Max := sStream.Size; // wichtig!!
    cStream.CopyFrom(sStream, sStream.Size);
  Finally
    sStream.Free;
    dStream.Free;
  End;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

function TZCompressionStream.Write(const buffer; count: Longint): Longint;
begin
  FZStream.next_in := @buffer;
  FZStream.avail_in := count;

  if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;

  while FZStream.avail_in > 0 do
  begin
    ZCompressCheck(deflate(FZStream, Z_NO_FLUSH));

    if FZStream.avail_out = 0 then
    begin
      FStream.WriteBuffer(FBuffer, SizeOf(FBuffer));

      FZStream.next_out := FBuffer;
      FZStream.avail_out := SizeOf(FBuffer);

      FStreamPos := FStream.Position;
      //hier stand mal DoProgress;
    end;
    DoProgress; //hier stehts jetzt
  end;

  result := Count;
end;