VB 如何用资源文件(.RES)里自定义的JPG图片做窗体背景
1个回答
展开全部
标准模块代码:
Option Explicit
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength 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 Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pCLSID As Guid) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Const sIID_IPicture As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE As Long = &H2
Private Const S_OK As Integer = 0 ' indicates successful HRESULT
Public Enum CBoolean ' enum members are Long data types
CFalse = 0
CTrue = 1
End Enum
Private Type Guid ' 16 bytes (128 bits)
dwData1 As Long ' 4 bytes
wData2 As Integer ' 2 bytes
wData3 As Integer ' 2 bytes
abData4(7) As Byte ' 8 bytes, zero based
End Type
Function ImageFromRes(sResID As Long, sRedType As String) As IPicture ' not a StdPicture!!
''''此过程从数据库的数据中分离图片,此图片格式为 IPicture
''''图片为内存数据图片,可直接加载
Dim nLow As Long, cbMem As Long, hMem As Long, lpMem As Long
Dim IID_IPicture As Guid
Dim istm As stdole.IUnknown
Dim ipic As IPicture
Dim ImageData() As Byte
On Error GoTo Out
ImageData = LoadResData(sResID, sRedType)
nLow = LBound(ImageData)
On Error GoTo 0
cbMem = (UBound(ImageData) - nLow) + 1
hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
If hMem Then
lpMem = GlobalLock(hMem)
If lpMem Then
MoveMemory ByVal lpMem, ImageData(nLow), cbMem
Call GlobalUnlock(hMem)
If (CreateStreamOnHGlobal(hMem, True, istm) = S_OK) Then _
If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then _
Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, ImageFromRes)
End If
End If
Out:
End Function
'======================================================================
窗体里调用:
form1.Picture = ImageFromRes(200, "MYIMAGE") '其中200为自定义资源ID,MYIMAGE 为任意自定义资源名称
Option Explicit
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength 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 Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pCLSID As Guid) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Const sIID_IPicture As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE As Long = &H2
Private Const S_OK As Integer = 0 ' indicates successful HRESULT
Public Enum CBoolean ' enum members are Long data types
CFalse = 0
CTrue = 1
End Enum
Private Type Guid ' 16 bytes (128 bits)
dwData1 As Long ' 4 bytes
wData2 As Integer ' 2 bytes
wData3 As Integer ' 2 bytes
abData4(7) As Byte ' 8 bytes, zero based
End Type
Function ImageFromRes(sResID As Long, sRedType As String) As IPicture ' not a StdPicture!!
''''此过程从数据库的数据中分离图片,此图片格式为 IPicture
''''图片为内存数据图片,可直接加载
Dim nLow As Long, cbMem As Long, hMem As Long, lpMem As Long
Dim IID_IPicture As Guid
Dim istm As stdole.IUnknown
Dim ipic As IPicture
Dim ImageData() As Byte
On Error GoTo Out
ImageData = LoadResData(sResID, sRedType)
nLow = LBound(ImageData)
On Error GoTo 0
cbMem = (UBound(ImageData) - nLow) + 1
hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
If hMem Then
lpMem = GlobalLock(hMem)
If lpMem Then
MoveMemory ByVal lpMem, ImageData(nLow), cbMem
Call GlobalUnlock(hMem)
If (CreateStreamOnHGlobal(hMem, True, istm) = S_OK) Then _
If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then _
Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, ImageFromRes)
End If
End If
Out:
End Function
'======================================================================
窗体里调用:
form1.Picture = ImageFromRes(200, "MYIMAGE") '其中200为自定义资源ID,MYIMAGE 为任意自定义资源名称
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询