编程爱好者电子杂志 2001年第二期

读者应该注意到，对某一动态链接库进行基址重置，不仅可能造成加载时间的大幅度增加，还需要增加页文件（pagefile）的开销。加载动态链接库的第一步，需要创建区段对象（section object），区段对象是由动态链接库可执行文件支持的、内存中的一个相邻的区段。一旦动态链接库的某一页被从应用程序工作集中移去了，在下一次访问此页时，操作系统就会从动态链接库可执行文件中重新加载这一页。

当然，当动态链接库进行基址重置时，这一策略不再起作用，这主要是因为包含重定位地址的页与动态链接库可执行文件映射中的相应页不同。因此，一旦在加载可执行文件时，操作系统企图修正地址，就会拷贝相应的页（由于区段是通过COPY_ON_WRITE标志打开的）。在拷贝中进行的所有的修改，操作系统都会记住，从现在开始，页将在系统页文件中换入换出，而不再在可执行映象中进行页交换。

采用这种机制，潜在的性能命中有两种：首先，每个包含需要重定位地址的页都占用一页系统页文件（其结果是，减少了所有应用程序可用的虚拟内存数）；另外，由于操作系统执行动态链接库页中的第一次修正操作，新的页必须从页文件中分配，并将整个页拷贝下来。

尽管扫描动态链接库重定位区段以及进行内存修正的算法都有很高的效率，执行修正操作还是会增加动态链接库的加载时间。(跨段操作的复杂性是需要修复地址数量的线性函数。)

地址修正

关于动态链接库基址重置的一类经常问到的问题是，"地址修正究竟是什么含义？程序员是否有办法调整代码，以减少可执行程序中的地址修正？"对于这两个问题的回答是，这一切在很大程度上依赖于可执行程序建立在哪一种平台上。在本文中，我们将平台限制在Intel 386,、486、和奔腾（Pentium）处理器上，讨论相应的可执行程序。（注意：为其他平台建立的可执行程序，相应的地址修复概念与本文讨论的概念不同。）

在386、486、或奔腾处理器上，两种情况可能导致某地址被标识为"可重定位"的状态：一是静态对象（static objects），另一种情况是绝对跳转（absolute jumps）。

首先，如果动态链接库引用了静态对象，就会使用对象的绝对地址（假设动态链接库被加载到首选地址中）。例如，在如下的代码段中:

LPSTR lpName="Name";

动态链接库的载入程序就会将"Name"字串分配到动态链接库数据段中，并将此字串的起始地址填写到lpName变量对应的位置中去。如果由于DLL不能被加载到基地址而使得"Name"字串必须重定位，lpName必须相应地进行调整。注意，在这种情况下，代码段中每个引用lpName的变量也必须作相应的地址修正。

可以重定位的对象包括文字字串（例如，在上例中的"Name"字串）、任何一种类型的全局或静态数据、包含静态分配的C++对象。应该注意到，特别是在C++中，可能存在着许多从一个静态对象到另一个静态对象的交叉索引。未初始化的数据不需要在重定位过程中修正地址，但指向未初始化静态数据的索引需要进行地址修正。

在i386可执行代码中，另一类可以进行重定位的项是绝对跳转和函数调用，包括系统函数调用。注意到程序开发人员很难通过修改程序代码来避免地址重定位，唯一可以采用的办法就是缩减静态分配数据的数目。要缩减静态分配数据，一种办法就是尽量避免使用名字进行资源索引，而应该通过坐标进行资源索引（因为，程序员在代码中显式使用的每一个名字都会自动变成一个可重定位的项）。

尽管如此，作者并不建议程序开发人员带着减少加载时间这一特殊目的开发动态链接库代码，除非存在以下两种情况：（1）静态分配对象的数据可以大幅度减少；（2）程序员依据此种方式进行编程时，不会影响其他编程中需要考虑到的因素。

除此之外，程序开发人员还可以通过简单的优化方法，减少加载时间。例如，可以将所有可以重新定位的数据集中到几页中。很显然，如果动态链接库需要进行基址重置，每页含有一个重定位项的两页，都需要有页文件来支持。如果所有的重定位项都出现在同一页中，只有一页需要页文件来支持，因此只有一页会受到影响。在必要的情况下，读者可以使用pragma (data_seg，数据段)伪指令，确保尽可能多的可重定位项被分配到尽可能少的页中去。

回到目录

利用DLL增强软件功能

---- Microsoft Windows 提供了称之为动态连接库的特殊库（DLL），让应用程序共享代码和资源。DLL 是一个包括了若干函数的可执行模块，为其他应用程序提供服务。Windows 利用DLL 来提供所有Windows 应用程序均可以使用的代码和资源。此外，应用程序也可以创建自己的DLL，在自己的各个应用程序之间共享代码和资源。

---- DLL 主要有如下目标：

应用程序之间共享代码和资源

基于系统范围的消息过滤

创建设备驱动程序

提供开发复杂应用程序的设施

---- 我们现在要研究的问题是，如何通过开发DLL 来拓展、增强常用软件的功能，如：VB4.0、ToolBook3.0 等。

---- 常用来开发DLL 的平台有BlandC++、MS VisualC++，二者之间在开发DLL 是有一定的差别，但最方便的是MS VisualC++。这里我们利用MS VisualC++ 开发一个Demo.DLL，它定义一个函数：F1=（x,y）=x*y。通过这个实例说明DLL 的程序结构，再通过对Demo.DLL 的调用说明增强软件功能。

---- 实例：

---- 在Demo.DLL 中定义一个 F1（x,y）=x*y ；

---- 总共需要三个文件：Demo.h ；Demo.c；Demo.DEF

* 在头文件（Demo.h）中：

#include

extern int_export_far_pascal F1（int,int）;

* 在源程序（Demo.c）中：

#include

#include"Demo.h"

int FAR PASCAL LibMain（HINSTANCE hInstance,

WORD wDataSegment,

WORD wHeapSize,

LPSTR lpszCmdLine）

{

return 1;

}

int _export_far_pascal F1（int X,int Y）

{

int data;

data=X*Y;

return data;

}

int FAR PASCAL WEP（int bSystemExit）

{ return 1;

}

* 在模块文件（Demo.def）中：

LIBRARY Demo

DESCRIPTION 'c++xyy DLL for Windows'

EXETYPE WINDOWS

CODE MOVEABLE DISCARDABLE

DATA MOVEABLE SINGLE

HEAPSIZE 0

EXPORTS

F1@1

---- * 在VB 使用DLL ：

---- 在调用之削首先要在MODULE 模块中声明函数，声明的格式是：

Declare Function 函数名

Lib"DLL 名"（Byval 参数 As Datatype,,）

Declare Function F1 Lib"Demo"（ByVal X As Integer,

ByVal X As Integer）As Integer

---- 然后就可以在任何地方使用函数F1（）。

---- * 在ToolBook3.0 中使用DLLs：

---- 在调用之前首先要连接DLL，并声明函数原型，声明的格式是：

link DLL "Demo.dll"

函数类型函数名（参数类型，，）

INT F1（INT,INT）

end linkDLL

---- 利用以上方法可以方便地开发DLL，用来拓展vb4.0、ToolBook3.0、Delphi1.0 等大部分软件的功能，使其功能更加强大，比如：实现对非标准硬件的控制、满足要求。这样我们即利用了新型软件的可视化对象编程，又结合了C++ 语言的任意按需编程的优势，给我们的软件开发带来许多便利。

回到目录

用程序取得CPU信息

---- 很多软件可以判断所运行的电脑类型而自动做不同的处理。如PhotoShop 5 可以探测CPU 是否有MMX 支持而调用不同的处理函数，《金山词霸》发现有MMX 支持会产生半透明的翻译提示，很多软件可以区分Intel,Cyrix,AMD 的CPU...

---- 现在，且让我细细道来如何让你在自己的程序中取得CPU 信息。

---- 主要可利用 CPUID 汇编指令( 机器码:0FH A2H, 如果你的编译器不支持CPUID 指令，只有 emit 机器码了) 该指令可以被如下CPU 识别

Intel 486 以上的CPU,

Cyrix M1 以上的CPU,

AMD Am486 以上的CPU

(1) 取CPU OEM 字符串, 判断CPU 厂商

先让EAX=0，再调用CPUID

Inel 的CPU 将返回:

EBX:756E6547H 'Genu'

EDX:49656E69H 'ineI'

ECX:6C65746EH 'ntel'

EBX,EDX,ECX 将连成"GenuineIntel", 真正的Intel。

Cyrix 的CPU 将返回:

EBX:43797269H

EDX:78496E73H

ECX:74656164H

"CyrixInstead"，"Cyrix 来代替"。

AMD 的CPU 将返回:

EBX:41757468H

EDX:656E7469H

ECX:63414D44H

"AuthenticAMD"，可信的AMD。

---- 在Windows98 中，用右键单击" 我的电脑"，选择" 属性- 常规" 在计算机描述处就可看见CPU OEM 字符串。

(2)CPU 到底是几86, 是否支持MMX

先让EAX=1，再调用CPUID

EAX 的 8 到11 位就表明是几86

3 - 386

4 - i486

5 - Pentium

6 - Pentium Pro Pentium II

2 - Dual Processors

EDX 的第0 位：有无FPU

EDX 的第23 位:CPU 是否支持IA MMX, 很重要啊！如果你想用那57 条新增的指令, 先检查这一位吧，否则就等着看Windows 的" 该程序执行了非法指令，将被关闭" 吧。

(3) 专门检测是否P6 架构

先让EAX=1，再调用CPUID

如果AL=1, 就是Pentium Pro 或Pentium II

(4) 专门检测AMD 的CPU 信息

先让EAX=80000001H，再调用CPUID

如果EAX=51H, 是AMD K5

如果EAX=66H, 是K6

EDX 第0 位: 是否有FPU

EDX 第23 位，CPU 是否支持MMX,

程序如下: 是C++Builder 的控制台程序, 可以给出你的" 心" 的信息。如果把这个技术用于 DLL 中，便可以使VB 程序也知道" 心" 的信息。

//------CPUID Instruction Demo Program------------

#include

#pragma hdrstop

//------------------------------------------------

#pragma inline

#pragma argsused

int main(int argc, char **argv)

{

char OEMString[13];

int iEAXValue,iEBXValue,iECXValue,iEDXValue;

_asm {

mov eax,0

cpuid

mov DWORD PTR OEMString,ebx

mov DWORD PTR OEMString+4,edx

mov DWORD PTR OEMString+8,ecx

mov BYTE PTR OEMString+12,0

}

cout<< "This CPU 's OEM String is:"< < OEMString< < endl;

_asm {

mov eax,1

cpuid

mov iEAXValue,eax

mov iEBXValue,ebx

mov iECXValue,ecx

mov iEDXValue,edx

}

if(iEDXValue&0x800000)

cout << "This is MMX CPU"< < endl;

else

cout << "None MMX Support."< < endl;

int iCPUFamily=(0xf00 & iEAXValue) > >8;

cout << "CPU Family is:"< < iCPUFamily< < endl;

_asm{

mov eax,2

CPUID

}

if(_AL==1)

cout << "Pentium Pro or Pentium II Found";

getch();

return 0;

}

回到目录

用VB编程实现Oicq头像DIY

作者：辛国茂

本人在用Oicq聊天时，经常收到一些好友发给我的用文本符号描绘的图像，觉得好羡慕啊，于是一想何不自己编一个程序来解决一下这个问题呢。本人近期正好在学Vb，所以我就打算用Vb来搞定:).

首先，新建一个工程。在窗体Form1上放200个Shape控件（大量的复制粘贴，要有耐心),并让其成为一个从Shape(0)到Shape(199)的数组 .大家也可以先在窗体Form1上放一个Shape控件，然后用Load语句来完成加载。把Shape控件的FillColor属性设置为白色，FillStyle属性设置为Solid(实填充), BorderColor属性设置为黑色，BorderWidth属性设置为1，Shape属性设置为0(Rectangle),Height和Width属性设置为195。

然后，用"工具"下的"菜单编辑器"加入四个菜单项，标题分New,Save,Char,Exit,名称分别为NewMenu,SaveMenu,CharMenu和ExitMenu.

以上的准备工作完成以后，下面就来写程序代码了。首先介绍一下本程序设计的大体思想。本程序通过用鼠标来描绘图形，当按着鼠标左键在Shape控件上移动时，处在鼠标位置的Shape控件的颜色变为蓝色,当按右键时变为白色（Shape控件按20*10的方式排列）。用一个20*10的字符串数组来纪录各个Shape控件的状态，如着色则对应的数组元素为当前设置的字符串，否则为空格.当存盘时，把字符串数组写入文件。

程序的变量说明为:

Dim imagearray(1 To 10, 1 To 20) As String

Dim curstr As String '当前的描绘字符串

1.在Form_Load()过程中加入初始化代码,如下:

Private Sub Form_Load()

Dim i As Integer

Dim j As Integer

For i = 1 To 10

For j = 1 To 20

imagearray(i, j) = " " '把数组都清为空格

tops = (Form1.Height - 2000) 2 - 500

lefts = (Form1.Width - 4000) 2

For i = 0 To 199

Shape1(i).Top = tops + (i 20) * 200

Shape1(i).Left = lefts + (i Mod 20) * 200

Next '排列控件,使之按20*10排列

curstr = "*"

End Sub

2.在MouseDown过程中添加如下代码:

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim i As Integer

Dim j As Integer

If Button = 1 Then '如果是左键

For i = 1 To 10

For j = 1 To 20

If (X 》= lefts + (j - 1) * 200) And (X 《= lefts + j * 200) And (Y 》= tops + (i - 1) * 200) And (Y 《= tops + i * 200) Then

'以上判断鼠标点在哪个控件上

imagearray(i, j) = curstr '置相应的数组元素为Curstr

Shape1((i - 1) * 20 + j - 1).FillColor = vbBlue

'控件颜色变为蓝色

End If

ElseIf Button = 2 Then '如果是右键

For i = 1 To 10

For j = 1 To 20

If (X 》= lefts + (j - 1) * 200) And (X 《= lefts + j * 200) And (Y 》= tops + (i - 1) * 200) And (Y 《= tops + i * 200) Then

imagearray(i, j) = " " '置相应的数组元素为空格

Shape1((i - 1) * 20 + j - 1).FillColor = vbWhite

'控件颜色变为白色

End If

End Sub

3.在MouseDown过程添加如下代码:

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim i As Integer

Dim j As Integer

If Button = 1 Then '按着鼠标左键

For i = 1 To 10

For j = 1 To 20

If (X 》= lefts + (j - 1) * 200) And (X 《= lefts + j * 200) And (Y 》= tops + (i - 1) * 200) And (Y 《= tops + i * 200) Then

imagearray(i, j) = curstr '置相应的数组元素为Curstr

Shape1((i - 1) * 20 + j - 1).FillColor = vbBlue

'控件颜色变为蓝色

End If

ElseIf Button = 2 Then '按着鼠标右键

For i = 1 To 10

For j = 1 To 20

If (X 》= lefts + (j - 1) * 200) And (X 《= lefts + j * 200) And (Y 》= tops + (i - 1) * 200) And (Y 《= tops + i * 200) Then

imagearray(i, j) = " " '置相应的数组元素为空格

Shape1((i - 1) * 20 + j - 1).FillColor = vbWhite

'控件颜色变为白色

End If

End Sub

4.New菜单的Click事件:

Private Sub NewMenu_Click(Index As Integer)

Dim i As Integer

Dim j As Integer

For i = 1 To 10

For j = 1 To 20

imagearray(i, j) = " " '数组全清为空格

For i = 0 To 199

Shape1(i).FillColor = vbWhite '控件的颜色全置为白色

End Sub

5.Char菜单的Click事件:

Private Sub CharMenu_Click(Index As Integer)

Dim str As String

str = InputBox("请输入描绘字符串:", "输入描绘字符串:", curstr)

If str 《》 "" Then '如输入的字符串不为空

curstr = str

End If

End Sub

6.Save菜单的Click事件:

Private Sub SaveMenu_Click(Index As Integer)

Dim i As Integer

Dim j As Integer

Dim fso As Object

Dim ts As TextStream

Dim filename As String

Set fso = CreateObject("Scripting.FileSystemObject")

filename = InputBox("请输入文件名:", "输入文件名:", "*.txt") '输入文件名

Set ts = fso.CreateTextFile(filename, True)

For i = 1 To 10

For j = 1 To 20

ts.Write imagearray(i, j)

ts.WriteLine '写一新行

End Sub

7.Exit菜单的Click事件:

Private Sub ExitMenu_Click(Index As Integer)

end '程序结束

End Sub

做完以上工作后就可以运行程序了,该程序只是一个简化版本,由许多可以改进的地方.以上代码大家也可到http://cattyxin.yeah.net/下载。

回到目录

用顶点着色器在 DirectX 8 中渲染动画

摘要：本文讨论了 Microsoft DirectX 8 中对象体和轮廓的动画渲染，并提供一个示例应用程序。

请在 MSDN Online Code Center（英文）中查看 Toon.exe 示例代码。

下载 Toon.exe 示例文件。(242 KB)

简介

"动画渲染"并没有特定的定义。它大体上是指以非照片真实感的风格渲染对象，效果类似于动画片和漫画书。通常，它使用大面积单一色块和对象轮廓线进行简单的着色。在这里讨论的架构中，渲染可分为两个问题：

按照一定风格使用分明的颜色条渲染对象"体"。（有意思的是，大多数情况下人们不希望出现颜色条，而在这里我们却要突出它。）

将轮廓的边渲染为粗黑线。

渲染对象体

我们进行法向漫射光照计算（在此例中使用一个单向光源）。但是我们不将结果输入漫射迭代颜色，而是将光照值作为简单光照纹理条的纹理坐标。使用加载到漫射迭代器中的所需材质颜色调制此纹理可进行染色。下面是顶点着色器程序：

; 输入: v0 = 位置

; v1 = 法向

; c0 = (0,0.5,xxx,xxx) 有用的常量

; c1-4 = WorldView 矩阵

; c5-9 = WorldViewProjection 矩阵

; c9 = 光照/材料颜色

; c10 = 光照方向（在观察空间中）

vs.1.0 ; 着色器版本 1.0

m4x4 oPos , v0 , c5 ; 计算投影位置

m3x3 r1 , v1 , c1 ; r1 = 观察空间法向

dp3 r2 ,-r1 , c10 ; r2 = 漫射光照计算

max r2 , r2 , c0.x ; 将 r2 固定为 0

mov oT0.x, r2 ; 纹理坐标 0 为 (r2,0.5)

mov oT0.y, c0.y

mov oD0 , c9 ; 漫射颜色 = c9

为简化起见，光照计算是在视图空间中进行的。在对象空间中，显然要进行优化，使着色器不用执行第二次矩阵乘法运算（在视图空间我们要进行后向变换以提供光源方向）。

关键的步骤是我们将光照计算的结果加载到纹理坐标的"u"分量。这将有效地将坐标变为一维的查找表格，根据它我们可以准确获得需要的纹理条。

最后，我们将材质的颜色（也可以把它看作一种光照）加载到漫射迭代器，我们将用它来调制从纹理中读取的强度值。如果我们愿意，可以从顶点元素读取这个值。但是为了简化，我们假设此对象只有单一颜色，因此只需使用一个常数。

请注意如何将多个有用的常数压缩成一个 c0 常数注册项。既然我们想使它成为纹理坐标中的"v"分量（将其放置于纹理中部，避免某些边界抽样问题），那么我们将零加载到 c0.x，来限制它的光照点积，同时将 0.5 加载到 c0.y。

渲染轮廓

要渲染对象轮廓，我们需要检测轮廓的边。如果一条边毗邻的两个面具有不同的方向性，例如一个是后向面而另一个不是，那么这条边是轮廓的一部分。对于平滑对象，如果顶点处的法线垂直于指向顶点的视图矢量，就可以近似处理为该顶点位于轮廓上。换句话说，如果屏幕空间位置与法向的点积为零，则假设顶点位于轮廓上。

这样，我们就可以用顶点着色器来计算正交化视图矢量和顶点法向的点积。等于或近似于零的值表明我们位于或者接近轮廓。粗略地说，点积值表明我们与轮廓边界的距离。为了加粗轮廓边界，以产生良好的"卡通"效果，我们设置一个阈值，只要是低于这个值的点就认为它是轮廓的一部分，阈值越高则轮廓的边越粗。

既然我们想获得轮廓分明的效果，那么就对每一个像素测试这个阈值。好在已经有执行这种测试的 Alpha 测试机制。如果我们将点积（从 [-1,-1] 重新调节至 [0,1]）加载到漫射迭代器的 Alpha 通道，那么我们可以通过 Alpha 测试排除不在轮廓上的点，然后把剩下的像素渲染为纯黑色。

下面是顶点着色器程序：

; 输入: v0 = 位置

; v1 = 法向

; c0 = 有用的常量 (0,xxx,xxx,xxx)

; c1-4 = WorldView 矩阵

; c5-9 = WorldViewProjection 矩阵

vs.1.0 ; 着色器版本 1.0

m4x4 r0 , v0 , c1 ; r0 = 观察空间位置

m3x3 r1 , v1 , c1 ; r1 = 观察空间法向

m4x4 oPos , v0 , c5 ; 计算投影位置

dp3 r2.x , r0 , r0 ; 正交化 r0（位置）

rsq r2.x , r2.x

mul r0 , r0 , r2.x

dp3 r3.x , r0 , -r1 ; 计算点积

mad oD0.w, r3.x , c0.y , c0.y ; 缩放到 [0,1]，并进行 Alpha 处理

mov oD0.xyz , c0.x ; 漫射 RGB 为 0

请注意输出位置是用 World+View+Projection 合并矩阵的直接变换计算的，而不是由投影矩阵的视图空间乘积以递增方式计算。原因是我们要确保执行位置计算的方法与我们为对象体渲染采用的方法"完全"一样，否则可能会产生重影效果。

进行此处理的的像素管道设置为复制漫射颜色和进行 Alpha 测试，因此代码应为：

m_pd3dDevice->SetRenderState( D3DRS_ALPHATESTENABLE , TRUE );

m_pd3dDevice->SetRenderState( D3DRS_ALPHAFUNC , D3DCMP_LESS );

m_pd3dDevice->SetRenderState( D3DRS_ALPHAREF , m_dwSilhouetteAmount );

我们可以通过更改 Alpha 测试参考值来控制轮廓边的粗细，即 m_dwSilhouetteAmount。

限制

这种技术有一些限制。特别是对于具有大面积平坦表面或由镶嵌面构成的对象，渲染效果通常不理想，因为这些面上法线方向变化不大或根本没有变化，结果整个对象体都被染成单一颜色，也可能把大面积的区域标记为"轮廓"。有时候这种效果可能符合我们期望的风格，但在一般情况下，只能说是差强人意。运用更复杂的点光源光照方案，可以在一定程度上消除对象体单一着色的问题。但是，对于大面积平坦表面，应用此处介绍的轮廓渲染技术仍有困难。然而，如果是基本圆滑的对象，那么效果很好。

示例应用程序

"Toon"示例应用程序以 Microsoft? DirectX? 8 SDK 中的示例应用程序框架为基础，演示了这种技术对简单网格的应用。要编译该示例程序，请在"MSSDK\Samples\Multimedia\Direct3D\"路径下创建一个目录，然后把源文件复制到该目录中（此示例程序引用了一些 DirectX 8 SDK 的公用示例应用程序框架文件）。

请在 MSDN Online Code Center（英文）中查看 Toon.exe 示例代码。

下载 Toon.exe 示例文件。(242 KB)

控制方式如下：

操作控制

增大/减小阈值 Q / A

切换内置网格（圆环面或圆环体） T

旋转对象单击左键并拖动

加载 .X 文件 L

渲染加载的 .X 文件 O

回到目录

Delphi数据压缩处理

蔡健

mailto:chaijian@21cn.com

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;

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;

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;

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;

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;

此外 TCompressionStream对象还提供了 CompressionRate属性，该属性用于描述对原始数据进行压缩后的压缩比率，而 OnProgress事件在压缩与解压缩过程中都会被触发，开发人员可以在该事件中编写用于显示进度的代码。

以上代码在 Delphi 5.0中调试运行通过。

回到目录

《编程爱好者》订退方法

请在下面的文本框内输入您订阅本刊的邮件地址，并按右面的订阅按钮即可。如果您觉得这份刊物还不错的话，欢迎把它推荐给您的朋友。

欢迎订阅

不知道您看了这期刊物有什么想法或者是意见，欢迎向我提出来。

本人感激不尽，我的联系方法如下:

Homepage： http://www.pfan.net

E-mail： pfan2000@163.net

OICQ： 15987743