如何保存图标

[warcraftmgq]

下载的Modest的模块，但是模块中没有把指定图标保存为文件的过程，谁能帮我加上

Option Explicit

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'  VB6中使用32位图标(第二版)
'  Programmed by 魏滔序
'  WebSite: http://www.chenoe.com
'  Blog: http://blog.csdn.net/Modest
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Private 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 Long
End Type

Private Type ICONDIR
    idReserved As Integer
    idType As Integer
    idCount As Integer
    idEntries() As ICONDIRENTRY
End Type

Private 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 Long
Private 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 Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private 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 Long

Private m_Data() As Byte
Private m_iCount As Integer
Private m_iDir As ICONDIR

Public Property Get Count() As Long
    Count = m_iCount
End Property

Public Property Get Height(Optional ByVal Index As Long) As Long
    Height = m_iDir.idEntries(Index).bHeight
End Property

Public Property Get Width(Optional ByVal Index As Long) As Long
    Width = m_iDir.idEntries(Index).bWidth
End Property

Public Property Get Length(Optional ByVal Index As Long) As Long
    Length = m_iDir.idEntries(Index).dwBytesInRes
End Property

Public 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 = d
End Property

Public 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 If
End Function

Public 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 Function

Public 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 Property

Public 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 hIcon
End Function

Public Sub SetFormIcon(ByVal hWnd As Long, Optional ByVal Index As Long = 0)
    SendMessageLong hWnd, &H80, 0, hIcon(Index)
End Sub

Public Function SaveToFile(ByVal FileName As String, Optional ByVal Index As Long = 0) As Boolean
'在这里，谢谢
End Function

Private Sub Class_Terminate()
    Erase m_Data
End Sub

[warcraftmgq]

自己解决了谢谢
另外SavePicture保存的图标不行

[feiyun0112]

Draw画到picturebox,SavePicture 保存

*****************************************************************************
欢迎使用CSDN论坛专用阅读器 : CSDN Reader(附全部源代码)

http://feiyun0112.cnblogs.com/