CSDN博客

img shawls

图象转换上

发表于2002/2/24 8:51:00  1019人阅读

图象转换上

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

 


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

0 0

相关博文

我的热门文章

img
取 消
img