下载的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 TypePrivate Type ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
idEntries() As ICONDIRENTRY
End 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 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 LongPrivate m_Data() As Byte
Private m_iCount As Integer
Private m_iDir As ICONDIRPublic Property Get Count() As Long
Count = m_iCount
End PropertyPublic Property Get Height(Optional ByVal Index As Long) As Long
Height = m_iDir.idEntries(Index).bHeight
End PropertyPublic Property Get Width(Optional ByVal Index As Long) As Long
Width = m_iDir.idEntries(Index).bWidth
End PropertyPublic Property Get Length(Optional ByVal Index As Long) As Long
Length = m_iDir.idEntries(Index).dwBytesInRes
End 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 = d
End 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 If
End 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 hIcon
End FunctionPublic Sub SetFormIcon(ByVal hWnd As Long, Optional ByVal Index As Long = 0)
SendMessageLong hWnd, &H80, 0, hIcon(Index)
End SubPublic Function SaveToFile(ByVal FileName As String, Optional ByVal Index As Long = 0) As Boolean
'在这里,谢谢
End FunctionPrivate Sub Class_Terminate()
Erase m_Data
End Sub
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 TypePrivate Type ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
idEntries() As ICONDIRENTRY
End 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 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 LongPrivate m_Data() As Byte
Private m_iCount As Integer
Private m_iDir As ICONDIRPublic Property Get Count() As Long
Count = m_iCount
End PropertyPublic Property Get Height(Optional ByVal Index As Long) As Long
Height = m_iDir.idEntries(Index).bHeight
End PropertyPublic Property Get Width(Optional ByVal Index As Long) As Long
Width = m_iDir.idEntries(Index).bWidth
End PropertyPublic Property Get Length(Optional ByVal Index As Long) As Long
Length = m_iDir.idEntries(Index).dwBytesInRes
End 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 = d
End 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 If
End 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 hIcon
End FunctionPublic Sub SetFormIcon(ByVal hWnd As Long, Optional ByVal Index As Long = 0)
SendMessageLong hWnd, &H80, 0, hIcon(Index)
End SubPublic Function SaveToFile(ByVal FileName As String, Optional ByVal Index As Long = 0) As Boolean
'在这里,谢谢
End FunctionPrivate Sub Class_Terminate()
Erase m_Data
End Sub
*****************************************************************************
欢迎使用CSDN论坛专用阅读器 : CSDN Reader(附全部源代码) http://feiyun0112.cnblogs.com/
另外SavePicture保存的图标不行