用ZipTV控件http://delphi.yesite.com/vcl_zip.htm
图象压缩例子
======Delphi数据压缩处理
Borland公司推出的 RAD开发工具 Delphi 5.0作为 Windows平台上的主流开发工具，
其可视化的开发环境和面向对象编程的强大功能已经吸引了无数的开发人员。但是，
一些程序员在实际的开发过程中却时常为对大量的数据进行压缩而伤透脑筋，不得不
去查找一些高效的压缩算法或在网上查找第三方的控件来实现压缩。难道 Delphi本
身没有提供这个功能吗？其实 Delphi的程序设计师早就考虑到了这一点，他们提供了
Zlib.pas和 Zlibconst.pas两个单元文件来解决数据压缩问题，实现了很高的数据
压缩比率。这两个文件保存在 Delphi 5.0安装光盘上 /Info/Extras/Zlib目录下，
此外，在 Info/Extras/Zlib/Obj目录中还保存了 Zlib.pas单元引用的 Obj文件。
下面本文以压缩一个屏幕拷贝为例介绍如何使用这项功能。
解决思路
首先利用屏幕拷贝捕捉到当前整个屏幕的图像，然后在内存中保存为 BMP文件格式。
压缩时，使用 TCompressionStream对象对原始图像进行压缩并且保存为自定义的
文件格式；解压缩时，使用 TDecompressionStream对象对被压缩的图像进行解压缩，
还原为 BMP格式的图像文件。
具体实现
新建一个项目文件，在主单元的接口部分引用 Zlib.pas，在主表单上放置两个按钮
Button1、 Button2，在它们的 OnClick事件中写上相应的过程调用代码。
部分程序源代码如下：
unit Unit1
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Zlib
type
TForm1 = class(TForm)
Button1: TButton
Button2: TButton
procedure Button1Click(Sender: TObject)
procedure Button2Click(Sender: TObject)
private
{ Private declarations }
public
{ Public declarations }
end
var
Form1: TForm1
implementation
{＄ R＊ .DFM}
1．捕捉全屏幕图像
procedure GetScreen(var Bmp: TBitmap)
var
Dc: HDC
MyCanvas: TCanvas
MyRect: TRect
begin
Dc := GetWindowDC(0)
MyCanvas := TCanvas.Create
try
MyCanvas.Handle := Dc
MyRect:=Rect(0， 0,Screen.Width, Screen.Height)
//图像为 24位真彩色，也可根据实际需要调整
Bmp.PixelFormat := pf24bit
Bmp.Width := MyRect.Right
Bmp.Height := MyRect.Bottom
//捕捉整个屏幕图像
Bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect)
finally
MyCanvas.Handle := 0
MyCanvas.Free
ReleaseDC(0, Dc)
end
end
2．压缩图像
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
//SourceStream中保存着原始的图像流
CompressedStream.SaveToStream(SourceStream)
//将原始图像流进行压缩， DestStream中保存着压缩后的图像流
SourceStream.Free
CompressedStream.Clear
//写入原始图像的尺寸
CompressedStream.WriteBuffer(Count, SizeOf
(Count))
//写入经过压缩的图像流
CompressedStream.CopyFrom(DestStream, 0)
finally
DestStream.Free
end
end
3．还原被压缩图像
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
//将被压缩的图像流解压缩，然后存入 Buffer内存块中
SourceStream.ReadBuffer(Buffer^, Count)
//将原始图像流保存至 DestStream流中
DestStream.WriteBuffer(Buffer^, Count)
DestStream.Position := 0;//复位流指针
//从 DestStream流中载入原始图像流
Bmp.LoadFromStream(DestStream)
finally
FreeMem(Buffer)
DestStream.Free
end
end
4．压缩按钮 OnClick事件
procedure TForm1.Button1Click(Sender: TObject)
var
Bmp: TBitmap
CompressedStream: TMemoryStream
begin
Bmp := TBitmap.Create
CompressedStream := TMemoryStream.Create
Try
//捕获当前整个屏幕 ,将图像保存至 Bmp对象中 GetScreen(Bmp)
//将 Bmp对象中的图像保存至内存流中
Bmp.SaveToStream(CompressedStream)
//按缺省的压缩比例对原始图像流进行压缩
CompressBitmap(CompressedStream, clDefault)
//将压缩之后的图像流保存为自定义格式的文件
CompressedStream.SaveToFile(‘ C:/cj.dat’ )
finally
Bmp.Free
CompressedStream.Free
end
end
5．解压缩按钮 OnClick事件
procedure TForm1.Button2Click(Sender: TObject)
var
CompressedStream: TFileStream
Bmp: TBitmap
begin
Bmp := TBitmap.Create
//以文件流的只读方式打开自定义的压缩格式文件
CompressedStream := TFileStream.Create(‘ C:/cj.dat’ , fmOpenRead)
Try
//将被压缩的图像流进行解压缩
UnCompressBitmap(CompressedStream, Bmp)
//将原始图像流还原为指定的 BMP文件
Bmp.SaveToFile(‘ C:/cj.bmp’ )
finally
Bmp.Free
CompressedStream.Free
end
end
此外 TCompressionStream对象还提供了 CompressionRate属性，该属性用于描述对
原始数据进行压缩后的压缩比率，而 OnProgress事件在压缩与解压缩过程中都会被
触发，开发人员可以在该事件中编写用于显示进度的代码。
以上代码在 Delphi 5.0中调试运行通过。
别忘了给我加分！
