回 帖 发 新 帖 刷新版面

主题:[原创]让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位真彩

回复列表 (共8个回复)

沙发

加精、顶起!

板凳

好文章,顶起。

3 楼

Russian President Dmitry Medvedev on Sunday [url=http://www.soccercleatsonlines.com/adidas-soccer-cleats-adidas-adipower-predator-trx-fg-c-1_29.html]adidas Adipower predator[/url] ordered an investigation into the allegations of electoral fraud during last weeks parliamentary vote. The announcement came a day after tens of thousands of people rallied in Moscow and other cities to demand the December 4 polls [url=http://www.cheaptimberlandswholesale.com/]cheap timberlands[/url] won by Prime Minister Vladimir Putins ruling United Russia party be annulled and rerun. In a post on the social media site Facebook, Mr. Medvedev said that although he does not agree with any slogans or speeches made at the rallies, he has given [url=http://www.soccercleatcheap.com/]cheap soccer cleats[/url] instructions to check all information from polling station regarding compliance with the election laws. Within minutes of his statement, Mr. Medvedev had received over 1,000 comments on his Facebook site, most of them angry and some [url=http://www.timberlandoutletonline.com/]timberland outlet online[/url] disrespectful. The Occupy London protest site reached its 60th day Monday, running longer than its counterpart in New York did before it was dismantled. It now occupies three sites across the City of London - a cathedral courtyard, a square [url=http://www.soccercleatsonlines.com/adidas-soccer-cleats-adidas-f50-adizero-micoach-fg-c-1_9.html]adidas adizero f50[/url] and a building. One of the sites even has an art gallery. But with growth has come rivalry between the two, with criticism that some American protesters who have decamped to London from New York are too reliant on their creature [url=http://www.cheaptimberlandswholesale.com/mens-timberland-roll-top-boots-c-3.html]timberland boots on sale[/url] comforts. The U.S. economy has recently showed signs of improvement with the unemployment rate dropping from nine percent to 8.6 percent but it remains far above a normal traditional rate of four or five percent. The jobless rate [url=http://www.soccercleatcheap.com/nike-mercurial-glide-iii-ag-green-black-p-289.html]nike mercurial green[/url] is seen as a major factor in whether Mr. Obama can win re-election to another four-year term next November. The president once again called on Congress to approve his nominee, Richard Cordray, to head a new consumer [url=http://www.timberlandoutletonline.com/mens-timberland-roll-top-boots-wheat-p-50.html]timberland roll top boots[/url] protection agency. U.S. President Barack Obama is pressing Republicans in Congress to approve his nominee Richard Cordray to head the first ever consumer guardian agency. During his weekly address Saturday, Obama urged lawmakers to give [url=http://www.soccercleatsonlines.com/nike-soccer-cleats-nike-mercurial-vapor-viii-fg-c-41_64.html]nike mercurial vapor fg[/url] Americans the protection they need from being taken advantage of by mortgage lenders, payday lenders and debt collectors. The president says many people on Wall Street have made a lot money taking advantage of consumers. He is appealing [url=http://www.cheaptimberlandswholesale.com/]timberland for sale[/url] to legislators to give Americans an advocate he says will protect them from unscrupulous practices. Protesters came out across the worlds largest country to demand clean elections and to say what, only one week ago, [url=http://www.soccercleatcheap.com/nike-soccer-cleats-nike-mercurial-victory-iv-ag-c-41_73.html]nike mercurial victory iv[/url] was unsayable. Russia Without Putin was the favorite chant of thousands of demonstrators who marched within earshot of the Kremlin in the largest pro-democracy demonstration since Vladimir Putin came to power in 2000. From Vladivostok on the Pacific [url=http://www.timberlandoutletonline.com/mens-timberland-6-inch-premium-boots-olive-green-p-112.html]timberland boots for men[/url] Coast to Kaliningrad on the Baltic.CF

4 楼

好文章。总是支持一下的

5 楼

学习这类的内容,尤其是文件类型的内在数据结构,需要几方面的知识:
1、基础二进制知识
2、VB读取文件的二进制流的技术
3、对于二进制位进行计算的VB语法和注意细节

6 楼

3楼是啥东西呀?

7 楼

为什么总是看不到附件呢?

8 楼

看不到附件是因为论坛代码更新了,不支持原来的附件了。

我来回复

您尚未登录,请登录后再回复。点此登录或注册