Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End TypePrivate Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As LongPrivate Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapID As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPrivate Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As LongPublic Function LoadPicture(sResourceFileName As String, lResourceId As Long) As PictureDim hInst As Long Dim hBmp As Long Dim Pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID Dim lRC As LonghInst = LoadLibrary(sResourceFileName) If hInst <> 0 Then hBmp = LoadBitmap(hInst, lResourceId) If hBmp <> 0 Then IID_IDispatch.Data1 = &H20400 IID_IDispatch.Data4(0) = &HC0 IID_IDispatch.Data4(7) = &H46 Pic.Size = Len(Pic) Pic.Type = vbPicTypeBitmap Pic.hBmp = hBmp Pic.hPal = 0 lRC = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) If lRC = 0 Then Set LoadPicture = IPic Set IPic = Nothing Else Call DeleteObject(hBmp) End If End If Call FreeLibrary(hInst) hInst = 0 End If End FunctionPrivate Sub Form_Load() ' Try ID 130 in Win98, or 131 in NT ' to see the Windows logo... Set Me.Picture = LoadPicture("shell32.dll", 130) End Sub
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End TypePrivate Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As LongPrivate Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapID As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPrivate Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As LongPublic Function LoadPicture(sResourceFileName As String, lResourceId As Long) As PictureDim hInst As Long
Dim hBmp As Long
Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
Dim lRC As LonghInst = LoadLibrary(sResourceFileName)
If hInst <> 0 Then
hBmp = LoadBitmap(hInst, lResourceId)
If hBmp <> 0 Then
IID_IDispatch.Data1 = &H20400
IID_IDispatch.Data4(0) = &HC0
IID_IDispatch.Data4(7) = &H46
Pic.Size = Len(Pic)
Pic.Type = vbPicTypeBitmap
Pic.hBmp = hBmp
Pic.hPal = 0
lRC = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
If lRC = 0 Then
Set LoadPicture = IPic
Set IPic = Nothing
Else
Call DeleteObject(hBmp)
End If
End If
Call FreeLibrary(hInst)
hInst = 0
End If
End FunctionPrivate Sub Form_Load()
' Try ID 130 in Win98, or 131 in NT
' to see the Windows logo...
Set Me.Picture = LoadPicture("shell32.dll", 130)
End Sub