关于 Delphi 中流的使用(10): 压缩与解压缩进度 - 回复 "ilst" 的问题

问题来源: http://www.cnblogs.com/del/archive/2008/08/02/1022539.html#1275599

---

本例是在这个例子的基础上修改的: http://www.cnblogs.com/del/archive/2008/01/01/1022539.html

---

本例效果图:

---

代码文件:

---

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CsProgress(Sender: TObject); {压缩的 OnProgress 事件}
    procedure DsProgress(Sender: TObject); {解压缩的 OnProgress 事件}
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Zlib;

{压缩的 OnProgress 事件}
procedure TForm1.CsProgress(Sender: TObject);
begin
  ProgressBar1.Position := Integer(TCompressionStream(Sender).Position div 1024);
  Application.ProcessMessages;
end;

{解压缩的 OnProgress 事件}
procedure TForm1.DsProgress(Sender: TObject);
begin
  ProgressBar1.Position := Integer(TDecompressionStream(Sender).Position div 1024);
  Application.ProcessMessages;
end;

{压缩}
procedure TForm1.Button1Click(Sender: TObject);
var
  cs: TCompressionStream;
  fs,ms: TMemoryStream;
  num: Integer;
begin
  fs := TMemoryStream.Create;
  fs.LoadFromFile('c:\temp\test.txt'); {我是用一个 15M 的文本文件测试的}
  num := fs.Size;

  ms := TMemoryStream.Create;
  ms.Write(num, SizeOf(num));

  cs := TCompressionStream.Create(clMax, ms);

  {在原来代码基础是添加这两行}
  ProgressBar1.Max := Integer(fs.Size div 1024);
  cs.OnProgress := CsProgress;

  fs.SaveToStream(cs);
  cs.Free;

  ms.SaveToFile('c:\temp\test.zipx');

  ms.Free;
  fs.Free;
end;


{解压缩}
procedure TForm1.Button2Click(Sender: TObject);
var
  ds: TDecompressionStream;
  fs,ms: TMemoryStream;    
  num: Integer;
begin
  fs := TMemoryStream.Create;
  fs.LoadFromFile('c:\temp\test.zipx');
  fs.Position := 0;
  fs.ReadBuffer(num,SizeOf(num));

  ms := TMemoryStream.Create;
  ms.SetSize(num);

  ds := TDecompressionStream.Create(fs);

  {在原来代码基础是添加这两行}
  ProgressBar1.Max := Integer(ms.Size div 1024);
  ds.OnProgress := DsProgress;

  ds.Read(ms.Memory^, num);

  ms.SaveToFile('c:\temp\test2.txt');

  ds.Free;
  ms.Free;
  fs.Free;
end;

end.

窗体文件:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 136
  ClientWidth = 205
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 64
    Top = 24
    Width = 75
    Height = 25
    Caption = #21387#32553
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 64
    Top = 55
    Width = 75
    Height = 25
    Caption = #35299#21387#32553
    TabOrder = 1
    OnClick = Button2Click
  end
  object ProgressBar1: TProgressBar
    Left = 24
    Top = 97
    Width = 150
    Height = 17
    TabOrder = 2
  end
end