图象转换上

图象转换上

'功能 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
    评论
  • 1
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值