图标应用程序--添加、删除、保存图标

  在网上找了一个类cFileIcon.cls来验证资源管理器中,用鼠标获取到的图标属性是图标文件中按顺序排列的最后一个图标。我改进了一下，并作了简化，原来那个类不能打开24、32位真彩色图标，现在可以了。

  演示工程源码下载地址：http://download.csdn.net/source/3119185

  类模块：IconClass.cls
Option Explicit ' ===================================================================================== ' 文件名: IconClass.cls ' 作 者: chenjl1031(东方之珠) ' 日 期: 2011-03-18 '====================================================================================== '====================================================================================== '结构名: ICONDIRENTRY '结构大小: 16字节 '结构说明: 图标入口信息 '====================================================================================== Private Type ICONDIRENTRY bWidth As Byte '&H0 图标宽度(以像素为单位) bHeight As Byte '&H1 图标高度(以像素为单位)，XOR位图+AND位图高度 bColorCount As Byte '&H2 图标的颜色数(02为单色，00表示>=8bpp) bReserved As Byte '&H3 保留字(该值总为0) wPlanes As Integer '&H4 图标的平面数(即帧数,该值总为1) wBitCount As Integer '&H6 图标的位数 dwBytesInRes As Long '&H8 图标所占字节数 dwImageOffset As Long '&HC 图标在文件中的位置(即偏移量) End Type '====================================================================================== '结构名: ICONDIR '结构大小: 22字节 '结构说明: 图标文件头 '====================================================================================== Private Type ICONDIR '22字节 idReserved As Integer '&H0 保留字(该值总为0) idType As Integer '&H2 资源类型(1表示图标,2表示光标) idCount As Integer '&H4 文件中含有图标的个数 'idEntries() As ICONDIRENTRY '&H6 图标入口信息 End Type '====================================================================================== '结构名: BITMAPINFOHEADER '结构大小: 40字节 '结构说明: BMP位图信息头部 '====================================================================================== Private Type BITMAPINFOHEADER '40个字节 biSize As Long '&H0 BITMAPINFOHEADER结构的大小 biWidth As Long '&H4 图像宽度(以像素为单位) biHeight As Long '&H8 图像高度(XOR图高度＋AND图高度,以像素为单位) biPlanes As Integer '&HC 目标设备的位平面数(该值总为1) biBitCount As Integer '&HE 每个像素所占位数 biCompression As Long '&H10 图像数据的压缩类型(0表示未压缩) biSizeImage As Long '&H14 图像所占字节数(不包括BITMAPINFOHEADER结构) biXPelsPerMeter As Long '&H18 水平方向上的每米的像素个数 biYPelsPerMeter As Long '&H1C 垂直方向上的每米的像素个数 biClrUsed As Long '&H20 调色板中实际使用的颜色数 biClrImportant As Long '&H24 现实位图时必须的颜色数 End Type '====================================================================================== '结构名: RGBQUAD '结构大小: 4字节 '结构说明: XOR(异或)位图调色板 '====================================================================================== Private Type RGBQUAD '4字节 rgbBlue As Byte '&H0 蓝色分量(值范围为0-255) rgbGreen As Byte '&H1 绿色分量(值范围为0-255) rgbRed As Byte '&H2 红色分量(值范围为0-255) rgbReserved As Byte '&H3 保留字(该值总为0) End Type '存放图标的DIB位 Private Type tBits bBits() As Byte End Type ' 资源类型: Private Const IMAGE_BITMAP = 0 Private Const IMAGE_ICON = 1 Private Const IMAGE_CURSOR = 2 ' 通过Win32 API读写文件 Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const CREATE_ALWAYS = 2 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const INVALID_HANDLE_VALUE = -1 Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long Private Const FILE_BEGIN = 0 '获取DPI设置 Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Const LOGPIXELSX As Long = 88 '像素/逻辑英寸（水平） Private Const LOGPIXELSY As Long = 90 '像素/逻辑英寸（垂直） 'Resource functions: Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long ' Missing from VB API declarations: Private Const LOAD_LIBRARY_AS_DATAFILE = &H2& Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long Private Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long ' The FindResource and FindResou