Public Type TgaFileHeaderInfo taID_Length AsByte'载入文件头的TGA图像信息偏移量 taPalType AsByte'调色板类型 taImageType AsByte'图像类型 02 未压缩的,rgb 图像 '----------------------------------------------- taPalFirstNdx AsInteger'调色板索引 taPalLength AsInteger'调色板长度 taPalBits AsByte'调色板颜色数 '-------------------------------------------------------- taLeft AsInteger taBottom AsInteger taWidth AsInteger'宽度 taHeight AsInteger'高度 taBits AsByte'图象颜色数 TgaDescriptor AsByte End Type Public Type TGAfiles tgaH As TgaFileHeaderInfo TgaStream() AsByte 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 AsByte' 指定蓝色强度 rgbGreen AsByte' 指定绿色强度 rgbRed AsByte' 指定红色强度 End Type
PrivateSub TrenBMtoTGA(BMfilePath AsString, TGAfilePath AsString, BColor AsLong) Dim freefn AsInteger Dim colorN AsLong Dim i AsLong, j AsLong, k AsLong, l AsLong, m AsLong, tmp(0To2) AsByte Dim BmPix() AsByte, PixStr AsString, BmPix555() AsLong Dim bitC1 AsInteger'每个字节包含的象素数量0 to -1 Dim bitC2 AsInteger'每个象素所占位数 Dim x AsLong, hPal AsLong Dim BMLineBytes AsLong, TGALineBytes AsLong 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 <0Then '---------文件损坏,拒绝读入 Close #freefn MsgBox"文件损坏,拒绝读入", vbCritical, "Error!" ExitSub ElseIf colorN >0Then '--------有色彩表,并进行定义 ReDim Bmfd.bmInfo.bmiColors(colorN) Get #freefn, , Bmfd.bmInfo.bmiColors Else '--------无色彩表 EndIf '--------------------------计算每行字节数 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图像数据区默认存储方式。 EndWith '-------------添加图像Alpha通道 TGALineBytes = ((Bmfd.bmInfo.bmiHeader.biWidth * TGAfd.tgaH.taBits +31) And&HFFFFFFE0) 8 ReDim TGAfd.TgaStream(TGALineBytes -1, TGAfd.tgaH.taHeight -1) AsByte For i =0To TGAfd.tgaH.taHeight -1 For j =0To BMLineBytes /3-1 For k =0To2 m = j *3+ k l = m + j TGAfd.TgaStream(l, i) = Bmfd.bmDate(m, i) tmp(k) = Bmfd.bmDate(m, i) Next k IfRGB(tmp(2), tmp(1), tmp(0)) <> BColor Then'处理透明色置Alpha值 TGAfd.TgaStream(l +1, i) =&HFF& EndIf 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秒,还算可以接受。
PrivateSub TrenBMtoTGA(BMfilePath AsString, TGAfilePath AsString, TBackColor AsLong) Dim freefn AsInteger Dim colorN AsLong Dim i AsLong, j AsLong, k AsLong, l AsLong, m AsLong, tmp(0To2) AsByte Dim BmPix() AsByte, PixStr AsString, BmPix555() AsLong Dim bitC1 AsInteger'每个字节包含的象素数量0 to -1 Dim bitC2 AsInteger'每个象素所占位数 Dim x AsLong, hPal AsLong Dim BMLineBytes AsLong, TGALineBytes AsLong, BMTrueLineBytes AsLong, BMpicByte AsInteger 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 <0Then '---------文件损坏,拒绝读入 Close #freefn MsgBox"文件损坏,拒绝读入", vbCritical, "Error!" ExitSub ElseIf colorN >0Then '--------有色彩表,并进行定义 ReDim Bmfd.bmInfo.bmiColors(colorN) Get #freefn, , Bmfd.bmInfo.bmiColors Else '--------无色彩表 EndIf '--------------------------计算每行字节数 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 EndWith '-------------添加图像Alphi通道 TGALineBytes = Bmfd.bmInfo.bmiHeader.biWidth * (TGAfd.tgaH.taBits /8) 'TGA格式不用行DWORD对齐 ReDim TGAfd.TgaStream(TGALineBytes -1, TGAfd.tgaH.taHeight -1) AsByte ' Dim t1 As Single, t2 As Single ' t1 = Timer For i =0To TGAfd.tgaH.taHeight -1 For j =0To BMTrueLineBytes / BMpicByte -1'根据实际象素来传递数据 For k =0To2 m = j *3+ k l = m + j TGAfd.TgaStream(l, i) = Bmfd.bmDate(m, i) tmp(k) = Bmfd.bmDate(m, i) Next k IfRGB(tmp(2), tmp(1), tmp(0)) <> TBackColor Then TGAfd.TgaStream(l +1, i) =&HFF& EndIf 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