源码少了一个模块
自行添加模块及下列代码可用
Option Explicit
Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As CBoolean, riid As GUID, ppvObj As Any) As Long
Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const ERROR_SUCCESS = 0
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_FILEMUSTEXIST = &H1000
Type GUID
dwDataA As Long
wDataB As Integer
wDataC As Integer
abDataD(7) As Byte
End Type
Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Enum CBoolean
CFalse = 0
CTrue = 1
End Enum
Public Function PictureFromBits(ByRef VarDataByte() As Byte) As IPicture
Dim VarMin As Long
Dim VarLength As Long
Dim VarMemoryHandle As Long
Dim VarMemoryPointer As Long
Dim IID_IPicture As GUID
Dim ISTM As stdole.IUnknown
On Error GoTo PictureFromBitsError
VarMin = LBound(VarDataByte)
VarLength = (UBound(VarDataByte) - VarMin) + 1
VarMemoryHandle = GlobalAlloc(GMEM_MOVEABLE, VarLength)
If VarMemoryHandle Then
VarMemoryPointer = GlobalLock(VarMemoryHandle)
If VarMemoryPointer Then
MoveMemory ByVal VarMemoryPointer, VarDataByte(VarMin), VarLength
Call GlobalUnlock(VarMemoryHandle)
If (CreateStreamOnHGlobal(VarMemoryHandle, CTrue, ISTM) = ERROR_SUCCESS) Then
If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = ERROR_SUCCESS) Then
Call OleLoadPicture(ByVal ObjPtr(ISTM), VarLength, CFalse, IID_IPicture, PictureFromBits)
End If
End If
End If
End If
Exit Function
PictureFromBitsError:
'错误处理
End Function