VB6中使用32位图标(第二版)

原帖：http://blog.csdn.net/Modest/archive/2008/05/22/2468937.aspx

 

本版添加了hIcon属性和SetFormIcon方法，顾名思义SetFormIcon就是实现vb6窗体的32位Icon应用。实现起来非常简单，发一个消息足矣。hIcon属性会根据图标索引返回图标句柄，用这个句柄还可以实现32位Icon在托盘中的美化应用。

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::' VB6中使用32位图标(第二版)' Programmed by 魏滔序' WebSite: http://www.chenoe.com' Blog: http://blog.csdn.net/Modest'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Option ExplicitPrivate Type ICONDIRENTRY bWidth As Byte bHeight As Byte bColorCount As Byte bReserved As Byte wPlanes As Integer wBitCount As Integer dwBytesInRes As Long dwImageOffset As LongEnd TypePrivate Type ICONDIR idReserved As Integer idType As Integer idCount As Integer idEntries() As ICONDIRENTRYEnd TypePrivate Declare Function CreateIconFromResourceEx Lib "user32" (presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal uFlags As Long) As LongPrivate Declare Function DrawIconEx Lib "user32.dll" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate m_Data() As BytePrivate m_iCount As IntegerPrivate m_iDir As ICONDIRPublic Property Get Count() As Long Count = m_iCountEnd PropertyPublic Property Get Height(Optional ByVal Index As Long) As Long Height = m_iDir.idEntries(Index).bHeightEnd PropertyPublic Property Get Width(Optional ByVal Index As Long) As Long Width = m_iDir.idEntries(Index).bWidthEnd PropertyPublic Property Get Length(Optional ByVal Index As Long) As Long Length = m_iDir.idEntries(Index).dwBytesInResEnd PropertyPublic Property Get Data(Optional ByVal Index As Long) As Byte() Dim o As Long, l As Long, d() As Byte o = m_iDir.idEntries(Index).dwImageOffset l = m_iDir.idEntries(Index).dwBytesInRes ReDim d(l - 1) CopyMemory d(0), m_Data(o), l Data = dEnd PropertyPublic Function LoadFromData(Data() As Byte) As Boolean Dim i As Long m_Data = Data CopyMemory m_iCount, m_Data(4), 2 '取得图标个数 If m_iCount > 0 Then ReDim m_iDir.idEntries(0 To m_iCount - 1) '图标目录结构数据 For i = 0 To m_iCount - 1 CopyMemory m_iDir.idEntries(i), m_Data(6 + Len(m_iDir.idEntries(i)) * i), Len(m_iDir.idEntries(i)) Next LoadFromData = True End IfEnd FunctionPublic Function LoadFromFile(ByVal FileName As String) As Boolean Dim hFile As Integer Dim Data() As Byte If Dir(FileName) = "" Then Exit Function hFile = FreeFile Open FileName For Binary As #hFile ReDim Data(LOF(hFile) - 1) Get #hFile, , Data Close #hFile LoadFromFile = LoadFromData(Data)End FunctionPublic Property Get hIcon(Optional ByVal Index As Long) As Long Dim d() As Byte, l As Long, w As Long, h As Long d = Data(Index): l = Length(Index) w = Width(Index): h = Height(Index) hIcon = CreateIconFromResourceEx(d(0), l, 1, &H30000, w, h, 0)End PropertyPublic Function Draw(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, Optional ByVal Index As Long = 0) As Boolean Dim w As Long, h As Long w = Width(Index): h = Height(Index) Draw = DrawIconEx(hdc, x, y, hIcon(Index), w, h, 0, 0, 3) <> 0 DestroyIcon hIconEnd FunctionPublic Sub SetFormIcon(ByVal Form As Form, Optional ByVal Index As Long = 0) SendMessageLong Form.hWnd, &H80, 0, hIcon(Index)End SubPrivate Sub Class_Terminate() Erase m_DataEnd Sub