如何用VB6创建透明图象

透过前面的图象看到背景图象，称前面的图象为透明图象，我们见过很多程序和电视节目中都有使用透明图象，而且大家一定会为图象的透明而称奇。究竟透明图象是如何做出来的呢？下面我们将来探讨这种透明图象的制作方法。

创建透明图象的五个必须的步骤：

准备两个位图文件，一个作背景，一个是将要成为透明图象的源位图。

1、 取得源位图的长、宽数据，依此数据保存一块和源位图一样大小的背景位图，源位图将要在这块背景位图上绘制。通过用白色像素显示位图的透明区域，黑色像素显示位图的不透明区域，创建决定位图透明的单色掩码。

2、单色掩码像素与所用的背景位图进行二进制“与”（and）位操作，不透明的区域，背景显示黑色。

3、用第一步所做的单色掩码建立一个反向拷贝，再用这个反向拷贝与所用的源位图进行二进制“与”（and）位操作，源位图透明的区域将显示黑色

4、用第二步修改过的背景和第三步修改的源位图进行二进制“异或”（Xor）位操作，这时可以透过透明位图看到背景。

5、把结果位图复制给背景

应用实例：

创建包含一个 CommandButton 控件和两个PictureBox控件的 窗体Form1。创建一个模块（在 "工程”菜单中单击“添加模块”）。

给窗体增加下列控件，设置相关的属性值：

控件 Name Property Settings
-----------------------------------------------------------------
PictureBox pictSource Picture ="C:\Flower_Vine.bmp"
PictureBox pictDest Picture ="C:\Stones_Blue.bmp"
Command button Command1 Caption ="透明图象"

---- 将下面的代码粘贴到窗体的声明部分中，

---- Option Explicit '' 这段代码调用过程Transparent()复制源位图到目标（背景）picturebox控件， '' 并将其变成透明，使人们可以看到后面的背景图象。

Sub command1_Click()
Call Transparent(PictSource.Picture.Handle, PictDest,
10, 10, QBColor(15))
End Sub

---- 将下面的代码粘贴到模块的声明部分中，

Option Explicit

---- '' 由于要读取位图的基本信息，所以首先要定义一个BITMAP结构的变量，然后

---- '' 利用这一变量来接受位图的基本信息。

''
Type Bitmap
Type As Long '' 位图类型
Width As Long ''宽度
Height As Long ''高度
WidthBytes As Long ''多少二进制位构成一个存储单位
Planes As Integer ''调色板数
BitsPixel As Integer ''每一个Pixel所占用的二进制位数
Bits As Long ''二进制位数据的起始位置
End Type

''API 函数说明
Declare Function GetObject Lib "gdi32"
Alias "GetObjectA" (ByVal hObject As _
Long, ByVal nCount As Long, lpObject As Any) As Long
''经由对象的Handle取得对象数据结构的API函数

Declare Function CreateCompatibleDC Lib "gdi32"
(ByVal hdc As Long) As Long ''
此函数将图象绘制到存储器中可避免直
''接将图象绘制到屏幕上而造成图象闪烁
Declare Function CreateBitmap Lib "gdi32"
(ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal nPlanes
As Long, _
ByVal nBitCount As Long, lpBits As Any)
As Long ''建立位图对象
Declare Function CreateCompatibleBitmap Lib
"gdi32" (ByVal hdc As Long, _
ByVal nWidth As Long, ByVal nHeight As Long)
As Long ''建立兼容性的位图
Declare Function BitBlt Lib "gdi32"
(ByVal hDestDC As Long, _
ByVal x As Long, ByVal y As Long, ByVal
nWidth As Long, _
ByVal nHeight As Long, ByVal hsourceDC As Long,
ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal dwRop As Long) As Long ''图象转移
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long,
ByVal crColor As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long)
As Long ''删除存储器DC
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long,
ByVal hObject As Long) As Long ''为DC选用对象
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long ''删除位图对象

---- 过程Transparent() 复制源位图到背景的任意 X,Y 位置，使这一区域变成透明。Transparent()接受五个参数：一个将要变成透明的源位图,一个目标 picturebox控件 (PictDest), 一个RGB颜色值，另两个是你想放置原位图的目的地坐标(destX 和 destY，以像素为单位)。

Sub Transparent(ByVal sourceBmp As Long, dest As Control, ByVal _
destX As Integer, ByVal destY As Integer, ByVal TransColor As Long)
Const PIXEL = 3
Dim sourceDC As Long ''源位图
Dim destScale As Long
Dim maskDC As Long ''mask位图 (monochrome)
Dim saveDC As Long ''源位图的备份
Dim resultDC As Long ''源位图与背景的合并
Dim invDC As Long ''Mask位图的反向图
Dim OrigColor As Long ''背景色
Dim Success As Long ''调用 Windows API的结果

Dim bmp As Bitmap ''原位图的数据结构说明
Dim hResultBmp As Long ''源与背景的位图合并
Dim hSaveBmp As Long ''原位图的拷贝
Dim hSrcPrevBmp As Long
Dim hDestPrevBmp As Long
Dim hInvBmp As Long ''反转掩码位图 (monochrome)
Dim hPrevBmp As Long
Dim hInvPrevBmp As Long
Dim hSavePrevBmp As Long
Dim hMaskBmp As Long
Dim hMaskPrevBmp As Long

destScale = dest.ScaleMode ''保存 ScaleMode以便后面恢复
dest.ScaleMode = PIXEL ''设置 ScaleMode

sourceDC = CreateCompatibleDC(dest.hdc) ''建立存储器DC
saveDC = CreateCompatibleDC(dest.hdc) ''建立存储器DC

invDC = CreateCompatibleDC(dest.hdc) ''建立存储器DC
maskDC = CreateCompatibleDC(dest.hdc) ''建立存储器DC
resultDC = CreateCompatibleDC(dest.hdc) ''建立存储器DC
''接受源位图得到它的的宽度和长度 (bmp.Width ， bmp.Height)
Success = GetObject(sourceBmp, Len(bmp), bmp)
''创建单色掩码位图
hMaskBmp = CreateBitmap(bmp.Width, bmp.Height, 1, 1, ByVal 0&)
hInvBmp = CreateBitmap(bmp.Width, bmp.Height, 1, 1, ByVal 0&)

hResultBmp = CreateCompatibleBitmap(dest.hdc, bmp.Width, _
bmp.Height)
hSaveBmp = CreateCompatibleBitmap(dest.hdc, bmp.Width, _
bmp.Height)
hSrcPrevBmp = SelectObject(sourceDC, sourceBmp)
hSavePrevBmp = SelectObject(saveDC, hSaveBmp)
hMaskPrevBmp = SelectObject(maskDC, hMaskBmp)
hInvPrevBmp = SelectObject(invDC, hInvBmp)
hDestPrevBmp = SelectObject(resultDC, hResultBmp) ''选择位图
Success = BitBlt(saveDC, 0, 0, bmp.Width, bmp.Height, sourceDC, _
0, 0, vbSrcCopy) ''制作源位图的拷贝以便后面恢复

OrigColor = SetBkColor(sourceDC, TransColor)
Success = BitBlt(maskDC, 0, 0, bmp.Width, bmp.Height, sourceDC, _
0, 0, vbSrcCopy)
TransColor = SetBkColor(sourceDC, OrigColor)

Success = BitBlt(invDC, 0, 0, bmp.Width, bmp.Height, maskDC, _
0, 0, vbNotSrcCopy)
''拷贝背景图并创建最终的透明位图
Success = BitBlt(resultDC, 0, 0, bmp.Width, bmp.Height, _
dest.hdc, destX, destY, vbSrcCopy)

Success = BitBlt(resultDC, 0, 0, bmp.Width, bmp.Height, _
maskDC, 0, 0, vbSrcAnd)
Success = BitBlt(sourceDC, 0, 0, bmp.Width, bmp.Height, invDC, _
0, 0, vbSrcAnd)

Success = BitBlt(resultDC, 0, 0, bmp.Width, bmp.Height, _
sourceDC, 0, 0, vbSrcInvert)

Success = BitBlt(dest.hdc, destX, destY, bmp.Width, bmp.Height, _
resultDC, 0, 0, vbSrcCopy) ''在背景上显示透明位图

Success = BitBlt(sourceDC, 0, 0, bmp.Width, bmp.Height, saveDC, _
0, 0, vbSrcCopy) ''恢复位图
''选择对象以便释放
hPrevBmp = SelectObject(resultDC, hDestPrevBmp)
hPrevBmp = SelectObject(sourceDC, hSrcPrevBmp)
hPrevBmp = SelectObject(saveDC, hSavePrevBmp)
hPrevBmp = SelectObject(invDC, hInvPrevBmp)
hPrevBmp = SelectObject(maskDC, hMaskPrevBmp)
''释放资源
Success = DeleteDC(saveDC)
Success = DeleteDC(invDC)
Success = DeleteDC(resultDC)
Success = DeleteObject(hSaveBmp)
Success = DeleteObject(hMaskBmp)
Success = DeleteObject(hInvBmp)
Success = DeleteDC(sourceDC)
Success = DeleteDC(maskDC)

Success = DeleteObject(hResultBmp)
dest.ScaleMode = destScale ''恢复 ScaleMode
End Sub