图象转换下
'**********************************************************************'* 刷新 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 FunctionerrHandle: UpdatePicture = False If oldScMode <> -1 Then PicBox.ScaleMode = oldScModeEnd 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 ByteEnd Type
Public Type PICTDESC cbSizeofstruct As Long picType As Long hgdiobj As Long hPalOrXYExt As LongEnd 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
