串流壓縮方法

壓縮程度有4個，分別是clNone, clDefault, clFastest, clMax;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ZLib, ExtCtrls; //ZLib記得要加進去喔

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//TmemoryStream壓縮
procedure CompressBitmap(var CompressedStream: TMemoryStream;const CompressionLevel: TCompressionLevel);
var
  SourceStream: TCompressionStream;
  DestStream: TMemoryStream;
  Count: Integer;
Begin
  Count := CompressedStream.Size;
  DestStream := TMemoryStream.Create;
  SourceStream:=TCompressionStream.Create(CompressionLevel, DestStream);
  Try
    CompressedStream.SaveToStream(SourceStream);
    SourceStream.Free;
    CompressedStream.Clear;
    CompressedStream.WriteBuffer(Count, SizeOf(Count));
    CompressedStream.CopyFrom(DestStream, 0);
  finally
    DestStream.Free;
  end;
end;
//TmemoryStream解壓縮
procedure UnCompressBitmap(const CompressedStream: TFileStream; var Bmp: TBitmap);
var
  SourceStream: TDecompressionStream;
  DestStream: TMemoryStream;
  Buffer: PChar;
  Count: Integer;
Begin
  CompressedStream.ReadBuffer(Count, SizeOf(Count));
  GetMem(Buffer, Count);
  DestStream := TMemoryStream.Create;
  SourceStream := TDecompressionStream.Create(CompressedStream);
  Try
    SourceStream.ReadBuffer(Buffer^, Count);
    DestStream.WriteBuffer(Buffer^, Count);
    DestStream.Position := 0;
    Bmp.LoadFromStream(DestStream);
  finally
    FreeMem(Buffer);
    DestStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  dc:hdc;
  mycanvas:TCanVas;
  Bmp:TBitmap;
  MStream: TMemoryStream; //宣告記憶體的串流
begin
  application.Minimize;
  application.ProcessMessages;

  mycanvas:=TCanvas.Create;
  Bmp:=tbitmap.Create;
  MStream := TMemoryStream.Create; //建立記憶體的串流
  dc:=getdc(0);
  try
    myCanvas.Handle   :=   DC;
    Bmp.Width   :=   Screen.Width;
    Bmp.Height   :=   Screen.Height;
    Bmp.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),myCanvas,Rect(0,0,Screen.Width,Screen.Height));

    Bmp.SaveToStream(MStream);    //將Bmp儲存到串流中
    CompressBitmap(MStream, clMax); //壓縮Bitmap探用ClMax為最大壓縮，並儲存至MStream
    MStream.SaveToFile('test.dat'); //將MStream儲存至檔案
  finally
    releasedc(0,dc);
    mycanvas.Free;
    Bmp.Free;
    MStream.Free; //釋放記憶體的串流
  end;
  application.Restore;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  CompressedStream: TFileStream; //宣告記憶體的串流
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  CompressedStream := TFileStream.Create('test.dat' , fmOpenRead);  //建立檔案串流，並讀取至CompressedStream
  Try
    UnCompressBitmap(CompressedStream, Bmp); //呼叫解壓縮Bitmap函式
    image1.Picture.Bitmap.Assign(Bmp);
  finally
    Bmp.Free;
    CompressedStream.Free; //釋放記憶體的串流
  end;
end;

end.