最近做一个将文字转换为图片做视频叠加字幕的软件，大家都知道VB的图像控件Picture Box只能输出BMP格式位图，自然我的软件是用Picture Box做图像输出的也不例外，但是客户要求要输出带alpha通道的TGA格式，以方便视频制作软件去除背景色实现透明，找了一些资料，都没见到与VB相关的说明更不用说代码了，也想过借助第3方软件用命令行方式来转换，但是找到转换软件一看，都不支持透明色处理，没办法，最后只好参照支离破碎图像格式资料，又结合Photoshop输出的透明与不透明类型TGA图片进行对比，基本参悟出了最常见的“图像类型”为 02 的TGA格式图像文件结构。TGA格式的图像类型在用的有10几种，难得一一破解了，我偷懒，挑了最常见的未压缩真彩格式来解读。TGA文件格式说明大家可以随处搜索到，我也不做详解，大家一看代码便知，主要是针对位图添加alpha通道实现背景透明色这个问题做点简单的探讨。
以下是最常见的TGA格式文件结构VB定义，后面的程序员目录之类的信息多余，略定义。
Public
Type TgaFileHeaderInfo taID_Length
As
Byte
'
载入文件头的TGA图像信息偏移量
taPalType
As
Byte
'
调色板类型
taImageType
As
Byte
'
图像类型 02 未压缩的，rgb 图像
'
-----------------------------------------------
taPalFirstNdx
As
Integer
'
调色板索引
taPalLength
As
Integer
'
调色板长度
taPalBits
As
Byte
'
调色板颜色数
'
--------------------------------------------------------
taLeft
As
Integer
taBottom
As
Integer
taWidth
As
Integer
'
宽度
taHeight
As
Integer
'
高度
taBits
As
Byte
'
图象颜色数
TgaDescriptor
As
Byte
End
Type
Public
Type TGAfiles tgaH
As
TgaFileHeaderInfo TgaStream()
As
Byte
End
Type
和其他位图文件一样。TGA有标准的文件头，后跟图像数据区，最后面可以留文件脚注信息，Photoshop就会在文件尾部留“TRUEVISION-XFILE”这样一串字符，脚注也是有格式要求的，我嫌多余，不要脚注也不影响图像显示，就省略了。当然，大家有兴趣的可以参照Photoshop留的信息整一个个性化的文件脚注出来。至于图像数据区，TGA在未采用压缩时图像数据区和BMP格式的图像数据区是一样的格式。所以，24位BMP格式文件不加透明通道转换为TGA格式是最简单的：只要将BMP文件的文件头中图像宽高信息和颜色数3个值拿来TGA文件头既可，数据区都不用进行任何操作，直接保存既可。大多数BMP格式转TGA格式的“图像格式转换专家”之类的软件就是这么做的，这种软件要之何用？如果不能添加alpha通道的话，我何苦要转换为TGA格式？无奈之余决心自己写一个能将指定色做alpha通道透明处理的BMP to TGA图像转换模块出来。
首先看下所谓的alpha通道是怎么回事，在24位的BMP图像中。一个象素的VB定义如下：
Public
Type RGBdate rgbBlue
As
Byte
'
指定蓝色强度
rgbGreen
As
Byte
'
指定绿色强度
rgbRed
As
Byte
'
指定红色强度
End
Type
如果TGA格式图像不添加alpha通道的时候也是上述形式的象素定义，而增加了alpha通道后的TGA图像中，一个象素的VB定义就变为：
Public
Type RGBA rgbBlue
As
Byte
'
指定蓝色强度
rgbGreen
As
Byte
'
指定绿色强度
rgbRed
As
Byte
'
指定红色强度
alpha
As
Byte
'
透明通道
End
Type
这样的话，一个象素就变为了32位的，文件尺寸也就相应增大了。这样的对比不难看出格式转换程序的思路了。即以象素为单位，先将对应RGB数据传递过来，之后再判断该象素的颜色是否是指定的透明色，或者先判断是否透明色也可以，根据判断结果，来置alpha的值，透明色的话，alpha值置为0,其他颜色的话置为255（&HFF&）（为了便于理解，暂不考虑置半透明值&H80之类的值），这样转换完成后得到新的图像数据区就是具备了alpha通道支持透明处理的TGA图像了。
下面是整个转换函数的代码（其中含多余的变量定义），BMP文件相关内容参见我的其他文章：
Private
Sub
TrenBMtoTGA(BMfilePath
As
String
, TGAfilePath
As
String
, BColor
As
Long
)
Dim
freefn
As
Integer
Dim
colorN
As
Long
Dim
i
As
Long
, j
As
Long
, k
As
Long
, l
As
Long
, m
As
Long
, tmp(
0
To
2
)
As
Byte
Dim
BmPix()
As
Byte
, PixStr
As
String
, BmPix555()
As
Long
Dim
bitC1
As
Integer
'
每个字节包含的象素数量0 to －1
Dim
bitC2
As
Integer
'
每个象素所占位数
Dim
x
As
Long
, hPal
As
Long
Dim
BMLineBytes
As
Long
, TGALineBytes
As
Long
Dim
Bmfd
As
bmpfile
Dim
TGAfd
As
TGAfiles
'
-----------------------------
freefn
=
FreeFile Open BMfilePath
For
Binary
As
#freefn
'
以二进制方式度文件
Get
#freefn, , Bmfd.bmHead
Get
#freefn, , Bmfd.bmInfo.bmiHeader colorN
=
pColor(Bmfd.bmHead.bfOffBits, Bmfd.bmInfo.bmiHeader.biSize)
If
colorN
<
0
Then
'
---------文件损坏，拒绝读入
Close #freefn
MsgBox
"
文件损坏，拒绝读入
"
, vbCritical,
"
Error!
"
Exit
Sub
ElseIf
colorN
>
0
Then
'
--------有色彩表，并进行定义
ReDim
Bmfd.bmInfo.bmiColors(colorN)
Get
#freefn, , Bmfd.bmInfo.bmiColors
Else
'
--------无色彩表
End
If
'
--------------------------计算每行字节数
BMLineBytes
=
((Bmfd.bmInfo.bmiHeader.biWidth
*
Bmfd.bmInfo.bmiHeader.biBitCount
+
31
)
And
&
HFFFFFFE0)
8
ReDim
Bmfd.bmDate(BMLineBytes
-
1
, Bmfd.bmInfo.bmiHeader.biHeight
-
1
)
'
(x,y)(列，行)
Get
#freefn, , Bmfd.bmDate Close #freefn
'
----------------------------转换TGA格式
With
TGAfd.tgaH .taID_Length
=
0
.taPalType
=
0
.taImageType
=
2
.taPalFirstNdx
=
0
.taPalLength
=
0
.taPalBits
=
0
.taLeft
=
0
.taBottom
=
0
.taWidth
=
Bmfd.bmInfo.bmiHeader.biWidth .taHeight
=
Bmfd.bmInfo.bmiHeader.biHeight .taBits
=
32
'
32位色
.TgaDescriptor
=
8
'
图像象素存储顺序（上下左右），00001000,同BMP图像数据区默认存储方式。
End
With
'
-------------添加图像Alpha通道
TGALineBytes
=
((Bmfd.bmInfo.bmiHeader.biWidth
*
TGAfd.tgaH.taBits
+
31
)
And
&
HFFFFFFE0)
8
ReDim
TGAfd.TgaStream(TGALineBytes
-
1
, TGAfd.tgaH.taHeight
-
1
)
As
Byte
For
i
=
0
To
TGAfd.tgaH.taHeight
-
1
For
j
=
0
To
BMLineBytes
/
3
-
1
For
k
=
0
To
2
m
=
j
*
3
+
k l
=
m
+
j TGAfd.TgaStream(l, i)
=
Bmfd.bmDate(m, i) tmp(k)
=
Bmfd.bmDate(m, i)
Next
k
If
RGB
(tmp(
2
), tmp(
1
), tmp(
0
))
<>
BColor
Then
'
处理透明色置Alpha值
TGAfd.TgaStream(l
+
1
, i)
=
&
HFF
&
End
If
Next
j DoEvents
Next
i
'
------------------------------------
freefn
=
FreeFile Open TGAfilePath
For
Binary
As
#freefn Put #freefn, , TGAfd.tgaH Put #freefn, , TGAfd.TgaStream Close #freefn
'
------------------------------------
End Sub
代码中最后保存数据时为什么不直接“ Put #freefn, , TGAfd ”而要分开单独保存头和数据区呢？大家可以用“ Put #freefn, , TGAfd ”看看保存的结果再问。
上面的代码中只是针对最常见的24位位图数据的转换处理，并且不涉及半透明效果，只要是让大家明白转换的原理，而TGA格式的图像类型还有很多种，这只是其中微不足道的一种，所以请高手不要见笑。上面转换时的代码看起来比较费时间，经测试在我2.4GHz CPU配置的机器上720*576尺寸的BMP图像文件转换时间约为0.125秒，还算可以接受。
转载请注明出处！多谢！
'-------------------------------------------------------------------------------------------------------------
补充BMP文件格式定义：
Option
Explicit
'
-BMP 文件格式读写模块
'
-BMP文件格式定义
'
--------------一些常量，固定定义图像信息等。
'
-----说明文件的类型.（该值必需是0x4D42，也就是字符'BM'。我们不需要判断OS/2的位图标识，这么做现在来看似乎已经没有什么意义了，而且如果要支持OS/2的位图，程序将变得很繁琐。所以，在此只建议你检察'BM'标识）
'
文件标识
'
bfType As String * 2 ' Integer 'UINT,文件标识
Public
Const
bfTypeBM
As
String
*
2
=
"
BM
"
'
： Windows 3.1x, 95, NT, ..."
Public
Const
bfTypeBA
As
String
*
2
=
"
BA
"
'
：OS/2 Bitmap Array
Public
Const
bfTypeCI
As
String
*
2
=
"
CI
"
'
：OS/2 Color Icon
Public
Const
bfTypeCP
As
String
*
2
=
"
CP
"
'
：OS/2 Color Pointer
Public
Const
bfTypeIC
As
String
*
2
=
"
IC
"
'
： OS/2 Icon
Public
Const
bfTypePT
As
String
*
2
=
"
PT
"
'
：OS/2 Pointer
'
位图信息头(Bitmap Info Header)的长度，用来描述位图的颜色、压缩方法等。下面的长度表示：
'
biSize As Long 'DWORD ;Bitmap Header Size
Public
Const
biSizeWin
As
Long
=
&
H28
'
- Windows 3.1x, 95, NT, ...
Public
Const
biSizeOS21x
As
Long
=
&
HC
'
- OS/2 1.x
Public
Const
biSizeOS22x
As
Long
=
&
HF0
'
- OS/2 2.x
'
Bits Per Pixel 1 word 每个象素的位数
'
biBitCount As Integer ';WORD;Bits Per Pixel,每个象素的位数
Public
Const
biBitCount1c
As
Integer
=
1
'
1 - 单色位图（实际上可有两种颜色，缺省情况下是黑色和白色。你可以自己定义这两种颜色）
Public
Const
biBitCount16c
As
Integer
=
4
'
4 - 16 色位图
Public
Const
biBitCount256c
As
Integer
=
8
'
8 - 256 色位图
Public
Const
biBitCount16bit
As
Integer
=
16
'
16 - 16bit 高彩色位图
Public
Const
biBitCount24bit
As
Integer
=
24
'
24 - 24bit 真彩色位图
Public
Const
biBitCount32bit
As
Integer
=
32
'
32 - 32bit 增强型真彩色位图
'
001Eh Compression 1 dword 压缩说明：
'
biCompression As Long ';DWORD,Compression,压缩说明：
Public
Const
biCBI_RGB
As
Long
=
0
'
0 - 不压缩 (使用BI_RGB表示)
Public
Const
biCBI_RLE8
As
Long
=
1
'
1 - RLE 8-使用8位RLE压缩方式(用BI_RLE8表示)
Public
Const
biCBI_RLE4
As
Long
=
2
'
2 - RLE 4-使用4位RLE压缩方式(用BI_RLE4表示)
Public
Const
biCBI_BITFIELDS
As
Long
=
3
'
3 - Bitfields-位域存放方式(用BI_BITFIELDS表示)
'
-------位图文件头,BITMAPFILEHEADER
'
位图文件头包含有关于文件类型、文件大小、存放位置等信息
Public
Type bmfh bfType
As
String
*
2
'
Integer 'UINT,文件标识
bfSize
As
Long
'
DWORD File Size
bfReserved1
As
Integer
'
UINT Reserved
bfReserved2
As
Integer
'
UINT Reserved
bfOffBits
As
Long
'
DWORD Bitmap Data Offset
End
Type
'
--------------------位图信息头,BITMAPINFOHEADER
'
说明BITMAPINFOHEADER结构，其中包含了有关位图的尺寸及位格式等信息
Public
Type bmih
'
BITMAPINFOHEADER ,bmiHeader;
biSize
As
Long
'
DWORD ;Bitmap Header Size
biWidth
As
Long
'
LONG ;Width 1 dword 位图的宽度，以象素为单位
biHeight
As
Long
'
LONG ;Height 1 dword 位图的高度，以象素为单位
biPlanes
As
Integer
'
WORD ;Planes 1 word 位图的位面数（注：该值将总是1）
biBitCount
As
Integer
'
;WORD;Bits Per Pixel,每个象素的位数
biCompression
As
Long
'
;DWORD,Compression,压缩说明：
biSizeImage
As
Long
'
;DWORD;Bitmap Data Size 1 dword 用字节数表示的位图数据的大小。该数必须是4的倍数
biXPelsPerMeter
As
Long
'
;LONG;HResolution 1 dword 用象素/米表示的水平分辨率
biYPelsPerMeter
As
Long
'
;LONG;VResolution 1 dword 用象素/米表示的垂直分辨率
biClrUsed
As
Long
'
;DWORD;Colors 1 dword 位图使用的颜色数。如8-比特/象素表示为100h或者 256.
biClrImportant
As
Long
'
;DWORD;Important Colors 1 dword 指定重要的颜色数。当该域的值等于颜色数时（或者等于0时），表示所有颜色都一样重要
End
Type
'
-----------------色彩表
'
说明彩色表RGBQUAD结构的阵列，其中包含索引图像的真实RGB值。
Public
Type rgbq
'
RGBQUAD, bmiColors[1];
rgbBlue
As
Byte
'
指定蓝色强度
rgbGreen
As
Byte
'
指定绿色强度
rgbRed
As
Byte
'
指定红色强度
rgbReserved
As
Byte
'
保留，设置为0
End
Type
'
-----------------位图信息,BITMAPINFO
Public
Type bmi bmiHeader
As
bmih
'
;BITMAPINFOHEADER
bmiColors()
As
rgbq
'
RGBQUAD ;
End
Type
'
-------------------------文件构成
Public
Type bmpfile bmHead
As
bmfh
'
位图文件头
bmInfo
As
bmi
'
位图信息
bmDate()
As
Byte
'
图象数据,位图颜色数据
End
Type
'
------------------------转换16Bit颜色数据
Public
Type RGBdate rgbBlue
As
Byte
'
指定蓝色强度
rgbGreen
As
Byte
'
指定绿色强度
rgbRed
As
Byte
'
指定红色强度
End
Type
'
Public LineBytes As Long
Declare
Function
SetDIBitsToDevice Lib
"
gdi32
"
(ByVal HDC
As
Long
, ByVal X
As
Long
, ByVal Y
As
Long
, ByVal dx
As
Long
, ByVal dy
As
Long
, ByVal SrcX
As
Long
, ByVal SrcY
As
Long
, ByVal Scan
As
Long
, ByVal NumScans
As
Long
, Bits
As
Any, BitsInfo
As
bmi, ByVal wUsage
As
Long
)
As
Long
Declare
Function
GlobalLock Lib
"
kernel32
"
(ByVal hMem
As
Long
)
As
Long
Declare
Function
GlobalUnlock Lib
"
kernel32
"
(ByVal hMem
As
Long
)
As
Long
Declare
Function
GlobalFree Lib
"
kernel32
"
(ByVal hMem
As
Long
)
As
Long
'
-----------计算色彩表位置和数量
Public
Function
pColor(bfOffBits
As
Long
, biSize
As
Long
)
As
Long
Dim
PclC
As
Long
PclC
=
bfOffBits
-
biSize
-
&
HE
If
PclC
>
0
Then
'
--------有色板
If
Int
(PclC
/
4
)
*
4
<>
PclC
Then
pColor
=
-
1
Else
If
PclC
<
8
Then
pColor
=
-
1
Else
pColor
=
(PclC
/
4
)
-
1
End
If
End
If
ElseIf
PclC
<
0
Then
'
-------坏文件
pColor
=
-
1
Else
'
--------无色板
pColor
=
PclC
End
If
End Function
'====================================================================================
先前发的转换函数有严重BUG，即：将TGA行字节数量也按照BMP格式的做了DWORD对齐为4的整数倍，可是在TGA格式中，行字节数量是不用做对齐调整的。这个BUG在BMP行实际象素字节数不是4的整数倍时就会出现。今天转换一张291象素宽度的BMP图片时发现的这个BUG，现已修复，并将修复代码贴在后面跟上（之所以保留以前有错误的代码是为了让大家能理解到BUG出现在哪里）：
Private
Sub
TrenBMtoTGA(BMfilePath
As
String
, TGAfilePath
As
String
, TBackColor
As
Long
)
Dim
freefn
As
Integer
Dim
colorN
As
Long
Dim
i
As
Long
, j
As
Long
, k
As
Long
, l
As
Long
, m
As
Long
, tmp(
0
To
2
)
As
Byte
Dim
BmPix()
As
Byte
, PixStr
As
String
, BmPix555()
As
Long
Dim
bitC1
As
Integer
'
每个字节包含的象素数量0 to －1
Dim
bitC2
As
Integer
'
每个象素所占位数
Dim
x
As
Long
, hPal
As
Long
Dim
BMLineBytes
As
Long
, TGALineBytes
As
Long
, BMTrueLineBytes
As
Long
, BMpicByte
As
Integer
Dim
Bmfd
As
bmpfile
Dim
TGAfd
As
TGAfiles
'
-----------------------------
freefn
=
FreeFile Open BMfilePath
For
Binary
As
#freefn
'
以二进制方式读文件
Get
#freefn, , Bmfd.bmHead
Get
#freefn, , Bmfd.bmInfo.bmiHeader colorN
=
pColor(Bmfd.bmHead.bfOffBits, Bmfd.bmInfo.bmiHeader.biSize)
If
colorN
<
0
Then
'
---------文件损坏，拒绝读入
Close #freefn
MsgBox
"
文件损坏，拒绝读入
"
, vbCritical,
"
Error!
"
Exit
Sub
ElseIf
colorN
>
0
Then
'
--------有色彩表，并进行定义
ReDim
Bmfd.bmInfo.bmiColors(colorN)
Get
#freefn, , Bmfd.bmInfo.bmiColors
Else
'
--------无色彩表
End
If
'
--------------------------计算每行字节数
BMLineBytes
=
((Bmfd.bmInfo.bmiHeader.biWidth
*
Bmfd.bmInfo.bmiHeader.biBitCount
+
31
)
And
&
HFFFFFFE0)
8
'
每一扫描行的字节数必需是4的整倍数，也就是DWORD对齐的
BMpicByte
=
Bmfd.bmInfo.bmiHeader.biBitCount
/
8
BMTrueLineBytes
=
Bmfd.bmInfo.bmiHeader.biWidth
*
BMpicByte
ReDim
Bmfd.bmDate(BMLineBytes
-
1
, Bmfd.bmInfo.bmiHeader.biHeight
-
1
)
'
(x,y)(列，行)
'
--------------直接加载
Get
#freefn, , Bmfd.bmDate Close #freefn
'
----------------------------转换TGA格式
With
TGAfd.tgaH .taID_Length
=
0
.taPalType
=
0
.taImageType
=
2
.taPalFirstNdx
=
0
.taPalLength
=
0
.taPalBits
=
0
.taLeft
=
0
.taBottom
=
0
.taWidth
=
Bmfd.bmInfo.bmiHeader.biWidth .taHeight
=
Bmfd.bmInfo.bmiHeader.biHeight .taBits
=
32
.TgaDescriptor
=
8
End
With
'
-------------添加图像Alphi通道
TGALineBytes
=
Bmfd.bmInfo.bmiHeader.biWidth
*
(TGAfd.tgaH.taBits
/
8
)
'
TGA格式不用行DWORD对齐
ReDim
TGAfd.TgaStream(TGALineBytes
-
1
, TGAfd.tgaH.taHeight
-
1
)
As
Byte
'
Dim t1 As Single, t2 As Single
'
t1 = Timer
For
i
=
0
To
TGAfd.tgaH.taHeight
-
1
For
j
=
0
To
BMTrueLineBytes
/
BMpicByte
-
1
'
根据实际象素来传递数据
For
k
=
0
To
2
m
=
j
*
3
+
k l
=
m
+
j TGAfd.TgaStream(l, i)
=
Bmfd.bmDate(m, i) tmp(k)
=
Bmfd.bmDate(m, i)
Next
k
If
RGB
(tmp(
2
), tmp(
1
), tmp(
0
))
<>
TBackColor
Then
TGAfd.TgaStream(l
+
1
, i)
=
&
HFF
&
End
If
Next
j DoEvents
Next
i
'
t2 = Timer
'
MsgBox Trim(Str(t2 - t1)) + "秒"
'
------------------------------------
freefn
=
FreeFile Open TGAfilePath
For
Output
As
#freefn
'
清空文件
Close #freefn freefn
=
FreeFile Open TGAfilePath
For
Binary
As
#freefn Put #freefn, , TGAfd.tgaH Put #freefn, , TGAfd.TgaStream Close #freefn
'
------------------------------------
End Sub
3383
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
