主题:[原创]让VB图片框显示32位真彩图像的代码
让VB图片框显示32位真彩图像的代码
最近笔者在编程时发现VB6的图片框和窗体不能显示32位真彩图标或32位真彩动画光标。这类图标或动画光标一般是非标准的,其特点是:
1.有的图标突破了windows图标最多内含8个图像的规定,竟包含了10多个图像;
2.这10多个图像并不全是32位真彩的,还有16色和256色甚至单色的;
3.这10多个图像的尺寸各有大小,有16×16的,有24×24的,最大的有128×128的,最小的居然为0×0(在BMP信息头中可以看到实际上为1×1);
4.这些非标图标文件特别大,动辄100多K,有的竟高达500多K。
500多K的图标文件不知用在哪些地方,反正我的程序中是不会用。再说了,内含10多个图像有什么用?它显示在屏幕上的只能是其中一个图像而已。而且10多个图像中,几乎有一半的图形看起来惨不忍睹。
但这些非标图标,它们在资源浏览器中能显示,而 VB6却不能显示,心里不免痒痒的,总想欣赏一下,总在想办法一窥全貌。终于灵机一动,转为24位真彩不就能显示了吗?于是上网查了一下32位真彩的有关知识。
原来32位真彩是用4个字节来表示一个像素的,而24位真彩用3个字节表示一个像素,但这两种真彩显示的颜色数都是2的24次方,所不同的是,32位真彩用第4个字节来描述256级灰度(也有的文章说是256级透明度)。不过文章又说,这256级灰度对人眼的视觉影响并不明显,换言之,人眼看24位真彩和看32位真彩并没有什么太大的区别。所以,这256级灰度数据完全可以去掉,转换为24位真彩,这样VB6就可以显示了。把32位真彩图标转为24位真彩图标需要做两项工作:
1.将XOR位图中,每4个字节去掉最后一个字节;
2.更改图像数据块的长度项的值。
其它的如文件头、AND位图等数据都不需要更改。根据这个设想,笔者编写了一个小程序,不但可以将32位真彩转换为24位的,还可以把图标中内含的图像全部列出来,你可以任意保存其中一个中意的图像为图标。不敢藏私,公布出来与大家共同探讨。下面是32位真彩转24位真彩的核心代码(代码中用到的API函数请自行声明),详见附件的小程序,该程序还可观赏ani文件和cur文件的图像。
Private Sub Command1_Click()
'On Error GoTo 100
Dim icoName As String, bytData() As Byte, ico() As Byte
Dim num As Long '基数
Dim aSize As Long 'AND位图长度
Dim iSize As Long '图像数据块长度
Dim i As Long, j As Long, k As Long, w As Integer, h As Integer, wh As Integer
CD.DialogTitle = "打开"
CD.Filter = "ani文件(*.ico)|*.ico|所有文件(*.*)|*.*"
CD.ShowOpen
icoName = CD.FileName
If Len(icoName) = 0 Or Len(Dir(icoName)) = 0 Then Exit Sub
Open icoName For Binary As #1
ReDim bytData(LOF(1) - 1)
Get #1, , bytData
Close #1
num = 0
If bytData(num + 4) <> 1 Then Exit Sub '如果有多个图像退出
If bytData(num + 36) <> 32 Then Exit Sub '如果不是32位真彩退出
iSize = bytData(num + 16) * 65536 + bytData(num + 15) * 256 + bytData(num + 14) '获取源图像数据块长度
w = bytData(num + 6): h = bytData(num + 7) '获取图像宽高
aSize = w * 4 * (w \ 32 + Abs((w Mod 32) > 0)) '计算AND位图长度
k = w * h '计算应去掉的XOR位图长度
j = iSize - k '计算新图像数据块长度
bytData(num + 16) = j \ 65536: bytData(num + 15) = (j Mod 65536) \ 256: bytData(num + 14) = j Mod 65536 Mod 256 '设置新图像信息块长度
j = j - 40
bytData(num + 44) = j \ 65536: bytData(num + 43) = (j Mod 65536) \ 256: bytData(num + 42) = j Mod 65536 Mod 256 '设置新图像BMP信息头中的长度
bytData(36) = 24 '设置为24位真彩
iSize = iSize - 40
ReDim ico(iSize - k + 62 - 1)
For i = 0 To 61: ico(i) = bytData(num + i): Next '复制ico文件头
k = i: j = i
For i = 1 To iSize - aSize '复制XOR位图数据
If (i Mod 4) <> 0 Then ico(j) = bytData(num + k): j = j + 1
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(num + i): Next '复制AND位图数据
'Picture2.Picture = getPictureFromByteStream(ico()) '原大小
Picture2.PaintPicture getPictureFromByteStream(ico()), 0, 0, Picture2.Width, Picture2.Height '放大
100
Close
End Sub
Private Function getPictureFromByteStream(bImageData() As Byte) As IPicture
On Error GoTo Err_Init
Dim lngByteCount As Long, hMem As Long, lpMem As Long
Dim IStream As stdole.IUnknown, IID_IPicture(15)
lngByteCount = UBound(bImageData) + 1 '获取数组大小
hMem = GlobalAlloc(&H42, lngByteCount) '按数组大小分配内存空间
If hMem Then '若分配内存成功
lpMem = GlobalLock(hMem) '锁定内存, 返回指针
If lpMem Then
CopyMemory ByVal lpMem, bImageData(0), lngByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, IStream) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(IStream), lngByteCount, 0, IID_IPicture(0), getPictureFromByteStream)
End If
End If
End If
End If
GlobalFree hMem
Err_Init:
End Function
你如果用附件中的程序来观赏附件中的动画光标,一定会发现,300.ani 和 400.ani 还是不能显示(但它们却能在资源管理器中显示)!为什么?哈哈,这两个文件也曾使笔者大伤脑筋,郁闷不已,因此特地放进来给大家看看,看各位能想到是什么原因吗?
我在研究这个问题大半天无果后,蓦然想到了图标的尺寸。其实用hex编辑器察看一下的话,就会发现这两个文件的尺寸不标准!图标图像的标准尺寸是16×16、24×24、32×32、48×48等能被4整除的,也是我们常见的。由于这两个是32位真彩,需要转换为24位真彩,于是,转换后就出现了图像尺寸与扫描线的规定的矛盾。这个问题的详情请参阅笔者的《ico文件数据结构》一文,下面只作简单分析。
以400.ani为例。该文件中的图像宽度是27像素,根据Windows的规定,27像素宽24位真彩的XOR位图的扫描线长度应为84字节,而笔者的代码把32位真彩的XOR位图每像素去掉了1个字节后,实际的扫描线长度就只有27×3=81字节,还必须补充3个空白字节,才符合扫描线的标准。根据这个分析,我修改了代码,再一试,果然成功!代码如下(新代码替换LoadANI.cls中的旧代码,怎么替换就不用我多说了吧):
If w Mod 4 = 0 Then '如果是标准扫描线
ReDim ico(iSize + 22 - k - 1)
For i = 0 To 61: ico(i) = bytData(iPos + i): Next '复制ico文件头、图像信息块、BMP信息头
k = i: j = i
For i = 1 To iSize - aSize - 40 '复制XOR位图数据
If i Mod 4 <> 0 Then ico(j) = bytData(iPos + k): j = j + 1
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(iPos + i): Next '复制AND位图数据
iSize = h * w * 3 + aSize + 40 '计算新图像数据块长度
Else
n1 = 4 * (w * 3 \ 4 + Abs((w * 3 Mod 4) > 0)) '计算标准24位真彩扫描线长度
n2 = w * 3 '当前扫描线长度
n3 = Abs(n1 - n2) '每条扫描线要增加的空白字节
ReDim ico(iSize + 22 - k - 1 + n3 * h)
For i = 0 To 61: ico(i) = bytData(iPos + i): Next '复制ico文件头
k = i: j = i: n = 0
For i = 1 To iSize - aSize - 40 '复制XOR位图数据
If i Mod 4 <> 0 Then ico(j) = bytData(iPos + k): n = n + 1: j = j + IIf(n Mod n2 = 0, n3 + 1, 1)
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(iPos + i): Next '复制AND位图数据
iSize = h * n1 + aSize + 40
End If
ico(16) = iSize \ 65536: ico(15) = (iSize Mod 65536) \ 256: ico(14) = iSize Mod 65536 Mod 256 '设置新图像信息块中的图像数据块长度
iSize = iSize - 40
ico(44) = iSize \ 65536: ico(43) = (iSize Mod 65536) \ 256: ico(42) = iSize Mod 65536 Mod 256 '设置新图像BMP信息头中的位图点阵长度
ico(36) = 24: BitCount = 24 '设置为24位真彩
最近笔者在编程时发现VB6的图片框和窗体不能显示32位真彩图标或32位真彩动画光标。这类图标或动画光标一般是非标准的,其特点是:
1.有的图标突破了windows图标最多内含8个图像的规定,竟包含了10多个图像;
2.这10多个图像并不全是32位真彩的,还有16色和256色甚至单色的;
3.这10多个图像的尺寸各有大小,有16×16的,有24×24的,最大的有128×128的,最小的居然为0×0(在BMP信息头中可以看到实际上为1×1);
4.这些非标图标文件特别大,动辄100多K,有的竟高达500多K。
500多K的图标文件不知用在哪些地方,反正我的程序中是不会用。再说了,内含10多个图像有什么用?它显示在屏幕上的只能是其中一个图像而已。而且10多个图像中,几乎有一半的图形看起来惨不忍睹。
但这些非标图标,它们在资源浏览器中能显示,而 VB6却不能显示,心里不免痒痒的,总想欣赏一下,总在想办法一窥全貌。终于灵机一动,转为24位真彩不就能显示了吗?于是上网查了一下32位真彩的有关知识。
原来32位真彩是用4个字节来表示一个像素的,而24位真彩用3个字节表示一个像素,但这两种真彩显示的颜色数都是2的24次方,所不同的是,32位真彩用第4个字节来描述256级灰度(也有的文章说是256级透明度)。不过文章又说,这256级灰度对人眼的视觉影响并不明显,换言之,人眼看24位真彩和看32位真彩并没有什么太大的区别。所以,这256级灰度数据完全可以去掉,转换为24位真彩,这样VB6就可以显示了。把32位真彩图标转为24位真彩图标需要做两项工作:
1.将XOR位图中,每4个字节去掉最后一个字节;
2.更改图像数据块的长度项的值。
其它的如文件头、AND位图等数据都不需要更改。根据这个设想,笔者编写了一个小程序,不但可以将32位真彩转换为24位的,还可以把图标中内含的图像全部列出来,你可以任意保存其中一个中意的图像为图标。不敢藏私,公布出来与大家共同探讨。下面是32位真彩转24位真彩的核心代码(代码中用到的API函数请自行声明),详见附件的小程序,该程序还可观赏ani文件和cur文件的图像。
Private Sub Command1_Click()
'On Error GoTo 100
Dim icoName As String, bytData() As Byte, ico() As Byte
Dim num As Long '基数
Dim aSize As Long 'AND位图长度
Dim iSize As Long '图像数据块长度
Dim i As Long, j As Long, k As Long, w As Integer, h As Integer, wh As Integer
CD.DialogTitle = "打开"
CD.Filter = "ani文件(*.ico)|*.ico|所有文件(*.*)|*.*"
CD.ShowOpen
icoName = CD.FileName
If Len(icoName) = 0 Or Len(Dir(icoName)) = 0 Then Exit Sub
Open icoName For Binary As #1
ReDim bytData(LOF(1) - 1)
Get #1, , bytData
Close #1
num = 0
If bytData(num + 4) <> 1 Then Exit Sub '如果有多个图像退出
If bytData(num + 36) <> 32 Then Exit Sub '如果不是32位真彩退出
iSize = bytData(num + 16) * 65536 + bytData(num + 15) * 256 + bytData(num + 14) '获取源图像数据块长度
w = bytData(num + 6): h = bytData(num + 7) '获取图像宽高
aSize = w * 4 * (w \ 32 + Abs((w Mod 32) > 0)) '计算AND位图长度
k = w * h '计算应去掉的XOR位图长度
j = iSize - k '计算新图像数据块长度
bytData(num + 16) = j \ 65536: bytData(num + 15) = (j Mod 65536) \ 256: bytData(num + 14) = j Mod 65536 Mod 256 '设置新图像信息块长度
j = j - 40
bytData(num + 44) = j \ 65536: bytData(num + 43) = (j Mod 65536) \ 256: bytData(num + 42) = j Mod 65536 Mod 256 '设置新图像BMP信息头中的长度
bytData(36) = 24 '设置为24位真彩
iSize = iSize - 40
ReDim ico(iSize - k + 62 - 1)
For i = 0 To 61: ico(i) = bytData(num + i): Next '复制ico文件头
k = i: j = i
For i = 1 To iSize - aSize '复制XOR位图数据
If (i Mod 4) <> 0 Then ico(j) = bytData(num + k): j = j + 1
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(num + i): Next '复制AND位图数据
'Picture2.Picture = getPictureFromByteStream(ico()) '原大小
Picture2.PaintPicture getPictureFromByteStream(ico()), 0, 0, Picture2.Width, Picture2.Height '放大
100
Close
End Sub
Private Function getPictureFromByteStream(bImageData() As Byte) As IPicture
On Error GoTo Err_Init
Dim lngByteCount As Long, hMem As Long, lpMem As Long
Dim IStream As stdole.IUnknown, IID_IPicture(15)
lngByteCount = UBound(bImageData) + 1 '获取数组大小
hMem = GlobalAlloc(&H42, lngByteCount) '按数组大小分配内存空间
If hMem Then '若分配内存成功
lpMem = GlobalLock(hMem) '锁定内存, 返回指针
If lpMem Then
CopyMemory ByVal lpMem, bImageData(0), lngByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, IStream) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(IStream), lngByteCount, 0, IID_IPicture(0), getPictureFromByteStream)
End If
End If
End If
End If
GlobalFree hMem
Err_Init:
End Function
你如果用附件中的程序来观赏附件中的动画光标,一定会发现,300.ani 和 400.ani 还是不能显示(但它们却能在资源管理器中显示)!为什么?哈哈,这两个文件也曾使笔者大伤脑筋,郁闷不已,因此特地放进来给大家看看,看各位能想到是什么原因吗?
我在研究这个问题大半天无果后,蓦然想到了图标的尺寸。其实用hex编辑器察看一下的话,就会发现这两个文件的尺寸不标准!图标图像的标准尺寸是16×16、24×24、32×32、48×48等能被4整除的,也是我们常见的。由于这两个是32位真彩,需要转换为24位真彩,于是,转换后就出现了图像尺寸与扫描线的规定的矛盾。这个问题的详情请参阅笔者的《ico文件数据结构》一文,下面只作简单分析。
以400.ani为例。该文件中的图像宽度是27像素,根据Windows的规定,27像素宽24位真彩的XOR位图的扫描线长度应为84字节,而笔者的代码把32位真彩的XOR位图每像素去掉了1个字节后,实际的扫描线长度就只有27×3=81字节,还必须补充3个空白字节,才符合扫描线的标准。根据这个分析,我修改了代码,再一试,果然成功!代码如下(新代码替换LoadANI.cls中的旧代码,怎么替换就不用我多说了吧):
If w Mod 4 = 0 Then '如果是标准扫描线
ReDim ico(iSize + 22 - k - 1)
For i = 0 To 61: ico(i) = bytData(iPos + i): Next '复制ico文件头、图像信息块、BMP信息头
k = i: j = i
For i = 1 To iSize - aSize - 40 '复制XOR位图数据
If i Mod 4 <> 0 Then ico(j) = bytData(iPos + k): j = j + 1
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(iPos + i): Next '复制AND位图数据
iSize = h * w * 3 + aSize + 40 '计算新图像数据块长度
Else
n1 = 4 * (w * 3 \ 4 + Abs((w * 3 Mod 4) > 0)) '计算标准24位真彩扫描线长度
n2 = w * 3 '当前扫描线长度
n3 = Abs(n1 - n2) '每条扫描线要增加的空白字节
ReDim ico(iSize + 22 - k - 1 + n3 * h)
For i = 0 To 61: ico(i) = bytData(iPos + i): Next '复制ico文件头
k = i: j = i: n = 0
For i = 1 To iSize - aSize - 40 '复制XOR位图数据
If i Mod 4 <> 0 Then ico(j) = bytData(iPos + k): n = n + 1: j = j + IIf(n Mod n2 = 0, n3 + 1, 1)
k = k + 1
Next
j = j - 1
For i = k To k + aSize - 1: j = j + 1: ico(j) = bytData(iPos + i): Next '复制AND位图数据
iSize = h * n1 + aSize + 40
End If
ico(16) = iSize \ 65536: ico(15) = (iSize Mod 65536) \ 256: ico(14) = iSize Mod 65536 Mod 256 '设置新图像信息块中的图像数据块长度
iSize = iSize - 40
ico(44) = iSize \ 65536: ico(43) = (iSize Mod 65536) \ 256: ico(42) = iSize Mod 65536 Mod 256 '设置新图像BMP信息头中的位图点阵长度
ico(36) = 24: BitCount = 24 '设置为24位真彩