Function LoadResPicture(id, restype As Integer) As IPictureDisp VB.Global 的成员 从资源文件(.RES)中加载位图、图标或光标并返回到相应的控件。
我要求用loadimage函数?能不能实现?
Option ExplicitPrivate Type PictDesc cbSizeofStruct As Long picType As Long hImage As Long xExt As Long yExt As Long End TypePrivate Type Guid Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _ lpPictDesc As PictDesc, _ riid As Guid, _ ByVal fPictureOwnsHandle As Long, _ ipic As IPicture _ ) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _ (ByVal lpLibFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule _ As Long) As Long Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _ (ByVal hInst As Long, ByVal lpsz As String, _ ByVal iType As Long, _ ByVal cx As Long, ByVal cy As Long, _ ByVal fOptions As Long) As LongPrivate Const IMAGE_BITMAP = 0 Private Const IMAGE_ICON = 1 Private Const IMAGE_CURSOR = 2Private Const LR_LOADMAP3DCOLORS = &H1000 Private Const LR_LOADFROMFILE = &H10 Private Const LR_LOADTRANSPARENT = &H20 Private Sub Command1_Click() Dim hModule As Long, hBitmap As Long hModule = LoadLibrary("CARDS.DLL") hBitmap = LoadImage(hModule, "#1", 0, 0, 0, LR_LOADMAP3DCOLORS) Set Picture1.Picture = BitmapToPicture(hBitmap) FreeLibrary hModule End Sub Public Function BitmapToPicture(ByVal hBmp As Long) As IPicture If (hBmp = 0) Then Exit Function Dim NewPic As Picture, tPicConv As PictDesc, IGuid As Guid With tPicConv .cbSizeofStruct = Len(tPicConv) .picType = vbPicTypeBitmap .hImage = hBmp End With With IGuid .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With OleCreatePictureIndirect tPicConv, IGuid, True, NewPic Set BitmapToPicture = NewPic End Function
VB.Global 的成员
从资源文件(.RES)中加载位图、图标或光标并返回到相应的控件。
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End TypePrivate Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
lpPictDesc As PictDesc, _
riid As Guid, _
ByVal fPictureOwnsHandle As Long, _
ipic As IPicture _
) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule _
As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
(ByVal hInst As Long, ByVal lpsz As String, _
ByVal iType As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal fOptions As Long) As LongPrivate Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Sub Command1_Click()
Dim hModule As Long, hBitmap As Long
hModule = LoadLibrary("CARDS.DLL")
hBitmap = LoadImage(hModule, "#1", 0, 0, 0, LR_LOADMAP3DCOLORS)
Set Picture1.Picture = BitmapToPicture(hBitmap)
FreeLibrary hModule
End Sub
Public Function BitmapToPicture(ByVal hBmp As Long) As IPicture
If (hBmp = 0) Then Exit Function
Dim NewPic As Picture, tPicConv As PictDesc, IGuid As Guid
With tPicConv
.cbSizeofStruct = Len(tPicConv)
.picType = vbPicTypeBitmap
.hImage = hBmp
End With
With IGuid
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
OleCreatePictureIndirect tPicConv, IGuid, True, NewPic
Set BitmapToPicture = NewPic
End Function
"#1"是什么意思?