新建From1(窗体),新建Command1(按钮CommandButton),代码:
Private Sub Command1_Click()
Dim arrPic() As Byte
Open App.Path & "\123.bmp" For Binary As #1
ReDim arrPic(LOF(1) - 1) '二进制方式载入文件
Get #1, , arrPic
Close #1
Set Me.Picture = PictureFromBits(arrPic())
End Sub
新建模块 modBinaryPicture.bas,代码:
Option Explicit
Public Enum CBoolean
CFalse = 0
CTrue = 1
End Enum
Private Const S_OK = 0
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As CBoolean, riid As GUID, ppvObj As Any) As Long
Public Type GUID
dwData1 As Long
wData2 As Integer
wData3 As Integer
abData4(7) As Byte
End Type
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Public Function PictureFromBits(abPic() As Byte) As IPicture
Dim nLow As Long
Dim cbMem As Long
Dim hMem As Long
Dim lpMem As Long
Dim IID_IPicture As GUID
Dim istm As stdole.IUnknown
Dim ipic As IPicture
On Error GoTo Out
nLow = LBound(abPic)
On Error GoTo 0
cbMem = (UBound(abPic) - nLow) + 1
hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
If hMem Then
lpMem = GlobalLock(hMem)
If lpMem Then
MoveMemory ByVal lpMem, abPic(nLow), cbMem
Call GlobalUnlock(hMem)
If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
End If
End If
End If
End If
Out:
End Function
记得准备123.bmp在当前目录,jpg不行。