图象转换上

图象转换上

'功能 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 = ipicEnd Function

'******************************************************************'* 将 Cursor 对象转换为 VB 的 Picture 对象'* 参数∶ hIcon 一个有效的光标句柄'******************************************************************Function CursorToPicture(ByVal hIcon As Long) As IPicture　　' It's 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 = ipicEnd Function

 

       以上代码来自： 源代码数据库(SourceDataBase)           当前版本： 1.0.436               作者： Shawls           个人主页： Http://Shawls.Yeah.Net             E-Mail： ShawFile@163.Net                 QQ： 9181729