图象转换下

图象转换下

'**********************************************************************
'* 刷新 PictureBox 控件的 Picture 对象。对PictureBox中的任何绘图操作,
'*                  通过它即可转换为Picture对象
'* 使用该函数可将PictureBox内的图象编辑结果永久更新为 Picture 对象
'* 参数∶ PicBox PictureBox控件名
'*        lWidth 需要更新的图象宽度(按你的需要,不局限于目前Picture对
'*               象的实际大小),也是最后要形成的Picture对象的图象宽度(单位∶像素)
'*        lHeight 需要更新的图象高度,其他类同与 lWidth(单位∶像素)
'**********************************************************************
Function UpdatePicture(ByRef PicBox As Object, Optional ByVal lWidth As Long = -1, _
            Optional ByVal lHeight As Long = -1) As Boolean
 
 On Error GoTo errHandle

  Dim oldScMode As Integer
  Dim hNewDC As Long
  Dim hOldBit As Long
  Dim hNewBit As Long

  oldScMode = -1
  oldScMode = PicBox.ScaleMode
  If lWidth = -1 Then
    lWidth = PicBox.ScaleX(PicBox.Picture.Width, 8, vbPixels)
  End If
  If lHeight = -1 Then
    lHeight = PicBox.ScaleY(PicBox.Picture.Height, 8, vbPixels)
  End If

  hNewDC = CreateCompatibleDC(PicBox.hdc)
  hNewBit = CreateCompatibleBitmap(PicBox.hdc, lWidth, lHeight)
  hOldBit = SelectObject(hNewDC, hNewBit)

  BitBlt hNewDC, 0, 0, lWidth, lHeight, PicBox.hdc, 0, 0, vbSrcCopy
  SelectObject hNewDC, hOldBit

  PicBox.Picture = BitmapToPicture(hNewBit)

  DeleteObject hNewDC
  DeleteDC hNewDC
  If oldScMode <> -1 Then PicBox.ScaleMode = oldScMode
  UpdatePicture = True

  Exit Function
errHandle:
  UpdatePicture = False
  If oldScMode <> -1 Then PicBox.ScaleMode = oldScMode
End Function
有关的API函数声明

Option Explicit

Public Const hNull = 0

Public Type IID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Public Type PICTDESC
  cbSizeofstruct As Long
  picType As Long
  hgdiobj As Long
  hPalOrXYExt As Long
End Type

Public Declare Sub OleCreatePictureIndirect Lib "olepro32.dll" ( _
  lpPictDesc As PICTDESC, _
  riid As IID, _
  ByVal fPictureOwnsHandle As Long, _
  ipic As IPicture)
Public Declare Function CreateCompatibleDC& Lib "gdi32" (ByVal hdc As Long)
Public Declare Function CreateCompatibleBitmap& Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long)
Public Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Public Declare Function SelectObject& Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hObject As Long)
Public Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)


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

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

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

抵扣说明:

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

余额充值