功能 Picture对象相关操作
类别 模块

Option Explicit

*****************************************************************
* 将 icon 对象转换为 VB 的 picture 对象
* 参数∶ hIcon 一个有效的图标句柄
*****************************************************************
Function IconToPicture(ByVal hIcon As Long) As IPicture
　　Dim ipic As IPicture
　　Dim picdes As PICTDESC, iidIPicture As IID

　　If hIcon = hNull Then Exit Function
　　picdes.cbSizeofstruct = Len(picdes)
　　picdes.picType = vbPicTypeIcon
　　picdes.hgdiobj = hIcon
　　 Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
　　iidIPicture.Data1 = &H7BF80980
　　iidIPicture.Data2 = &HBF32
　　iidIPicture.Data3 = &H101A
　　iidIPicture.Data4(0) = &H8B
　　iidIPicture.Data4(1) = &HBB
　　iidIPicture.Data4(2) = &H0
　　iidIPicture.Data4(3) = &HAA
　　iidIPicture.Data4(4) = &H0
　　iidIPicture.Data4(5) = &H30
　　iidIPicture.Data4(6) = &HC
　　iidIPicture.Data4(7) = &HAB
　
　　OleCreatePictureIndirect picdes, iidIPicture, True, ipic
　
　　Set IconToPicture = ipic
End Function

****************************************************************
* 将 Cursor 对象转换为 VB 的 Picture 对象
* 参数∶ hIcon 一个有效的光标句柄
****************************************************************
Function CursorToPicture(ByVal hIcon As Long) As IPicture
　　 Its just an alias
　　Set CursorToPicture = IconToPicture(hIcon)
　　End Function

****************************************************************
* 将 bitmap 对象转换为 VB 的 picture 对象
* 参数∶ hBmp 一个有效的位图句柄
* hpal 一个有效的调色板句柄
****************************************************************
Function BitmapToPicture(ByVal hBmp As Long, _
　　　　　　　　　　　　 Optional ByVal hPal As Long = hNull) As IPicture
　
　　Dim ipic As IPicture
　　Dim picdes As PICTDESC, iidIPicture As IID
　　picdes.cbSizeofstruct = Len(picdes)
　　picdes.picType = vbPicTypeBitmap
　　picdes.hgdiobj = hBmp
　　picdes.hPalOrXYExt = hPal
　　 Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
　　iidIPicture.Data1 = &H7BF80980
　　iidIPicture.Data2 = &HBF32
　　iidIPicture.Data3 = &H101A
　　iidIPicture.Data4(0) = &H8B
　　iidIPicture.Data4(1) = &HBB
　　iidIPicture.Data4(2) = &H0
　　iidIPicture.Data4(3) = &HAA
　　iidIPicture.Data4(4) = &H0
　　iidIPicture.Data4(5) = &H30
　　iidIPicture.Data4(6) = &HC
　　iidIPicture.Data4(7) = &HAB

　　OleCreatePictureIndirect picdes, iidIPicture, True, ipic
　
　　Set BitmapToPicture = ipic
End Function