PctGL SERIES  
http://pctgl.cnblogs.com

一个小函数解决了 VB6 使用程序资源加载真彩图标的问题,有点欣慰 

 

VB6 的资源文件无法使用真彩图标,当你想在资源文件中加入一个真彩图标时会显示错误,同时也无法用内置函数 LoadResPicture 加载真彩图标使用

Win10 都快过期了,这个从 WinXP 年代真正流行起来的真彩图标在 VB6 中使用只能是外挂,把真彩图标当作一个文件独立于 Exe 之外用 LoadIcon 或者 LoadImage 使用...

 

这两天有感于某行业软件过于垃圾,一个 USB 锁的 web 登录程序,安装包将近 250MB , 安装后系统中同时安装了将近 10 个各种各样的程序

哪个有用哪个没用没法判断,因为每个程序都拖了一堆 DLL ,你也不知道是不是存在依赖..............

这就是现在这帮程序垃圾写的垃圾程序 ...........

经过测试,有 2 个程序必须启动的情况下就可以保证 USB锁 正常使用, 我有系统资源苛求洁癖......

那些没用的玩意都删了怕出错,试错过程太痛苦索性不删了

于是我想做个小程序,把那堆垃圾程序编成组,启动其中之一就按顺序启动所有程序,关闭某个就全关闭

 

写这个程序的时候,做界面想写个列表显示所有关联程序,想花哨一点,用个中间透明的图标盖住程序图标

形成圆形头像的效果,这必然得是真彩图标,因为那个中空的圆形图标如果不是真彩图标的话,那个圆很糙.....

解决这个问题就两种办法,要么用 GDI+ 自己用反锯齿画圆, 要么就是简单的 GDI 和真彩图标绘图,我选择后者,因为太简单了

 

So...

我上网站下了一个 圆形 的PNG图,用 PS 把圆的四边改成背景色,在找个网站 PNG > ICO ,这样可以盖住圆以外的图像

于是我得到了一个 32位  ICO ,也就是真彩的,带 alphi 通道的图标

曲折的过程不再说了...

 

应用:

在 VB6 的资源编辑器中,添加 “自定义资源” 选择 真彩图标

下面的演示代码中 我的自定义资源名字就叫 ICON,不要混淆,不是ICO资源, 也可以叫PNG/JPG/WORD/CAD.. 也可以是各种乱七八糟,总之不要混淆

再用下面的函数加载,你就得到了一个图标句柄 hIcon ,图标绘图要用 DrawIcon ,怎么用,自己去琢磨吧

 

这里的一个重要问题: 

  CreateIconFromResourceEx 这个api的第一个参数,文心一言和msdn都说是图标资源的首字节地址,反复测试都是错误的

根据成功的实例代码,这个参数应该是指定的某一个图标帧的地址,然后去找文心一言核实了,这家伙太没谱了,一会说是一会不是...

 

最终效果:

 

代码,其中注释细读体会:

 

 1 Option Explicit
 2 
 3 Private Type ICONDIRENTRY
 4     bWidth   As Byte
 5     bHeight   As Byte
 6     bColorCount   As Byte
 7     bReserved   As Byte
 8     wPlanes   As Integer
 9     wBitCount   As Integer
10     dwBytesInRes   As Long
11     dwImageOffset   As Long
12 End Type
13 
14 Private Type ICONDIR
15     idReserved  As Integer
16     idType  As Integer
17     idCount  As Integer
18     'idEntries()  As ICONDIRENTRY
19 End Type
20 
21 '// 将 ICON 数据流转换为 HICON 句柄, 第一个参数 pbIcon 为ico的某个图像的数据流偏移量,每个ico都可以包含多个不同尺寸的ico
22 Private Declare Function CreateIconEx Lib "user32" Alias "CreateIconFromResourceEx" (ByVal offsetImageFrame As Long, ByVal SizeOfImageFrame As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cyDesired As Long, ByVal cxDesired As Long, ByVal uiFlags As Long) As Long
23 
24 Function LoadIcon(ByVal ResourceID As Long, Optional ByVal ResourceName As String = "ICON", Optional ByVal IndexOfIconGroup As Long = 0) As Long
25     
26     '// LoadIcon( 资源ID, 资源名, 图标索引 )
27     '//          loadicon 可以加载图标组图标文件(数据流), 也可以加载单个图标(数据流)
28     '//                   图标组可以视为有多个帧的单个图标文件, 因此使用loadicon需要指定 图标索引值 index , index 从 0 计数
29     '//                   由于 loadicon 一次只读取一个图标, 所以必须指定 index , 默认值 0 就是第一个图标
30     
31     Dim hResFound As Long
32     Dim hResBlock As Long
33     Dim hResStream As Long
34     Dim SizeOfRes As Long
35 
36     Dim IcoHeader       As ICONDIR
37     Dim IcoBody         As ICONDIRENTRY
38       
39     ' 查找
40     hResFound = FindResourceIdStr(App.hInstance, 101, ResourceName)
41       
42     ' 加载
43     hResBlock = LoadResource(App.hInstance, hResFound)
44       
45     ' 锁定
46     hResStream = LockResource(hResBlock)
47     
48     ' 获取大小
49     SizeOfRes = SizeofResource(App.hInstance, hResFound)
50     
51             
52     '// 获取图标头数据
53     CopyMemory IcoHeader, ByVal hResStream, 6
54     
55     '// 验证是否是图标
56     If IcoHeader.idReserved = 0 And IcoHeader.idType = 1 Then
57         
58         '// 验证要获取的图标帧是否有效
59         If IndexOfIconGroup < IcoHeader.idCount Then
60             
61             '// 获取指定的图像帧信息, 基址(hResStream) +  [Sizeof(Icobody) * N] + SizeOf(IcoHeader), N = 图标帧 索引值
62             CopyMemory IcoBody, ByVal hResStream + Len(IcoBody) * IndexOfIconGroup + 6, Len(IcoBody)
63             
64             '// 加载图标创建图标句柄
65             LoadIcon = CreateIconEx(hResStream + IcoBody.dwImageOffset, IcoBody.dwBytesInRes, 1&, &H30000, 0&, 0&, LR_DEFAULTCOLOR)
66             
67         Else
68             '// 图标帧不存在
69             LoadIcon = -1
70         
71         End If
72         
73     Else
74         
75         '// 不是图标数据
76         LoadIcon = 0
77         
78     End If
79     
80 
81 End Function

 

 

posted on 2024-08-02 23:46  PctGL  阅读(27)  评论(0编辑  收藏  举报