用户登录  |  用户注册
首 页源码下载网络学院最新源码源码排行屏蔽广告
当前位置:新兴网络 > 网络学院 > 编程开发 > Visual Basic

VB 将PictureBox控件中的图片写入到剪切板中

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2011-01-22 20:01:12

VB 复制Picture中的图片到剪切板中的函数:

VBScript code复制代码
'Download by http://www.NewXing.com
Private Declare Function SendMessage Lib "user32" Alias _
                          "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                          ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDC Lib "User32.dll" (ByVal hWnd As Long) As Long
Public Declare Function GetClientRect Lib "User32.dll" (ByVal hWnd As Long, ByRef lpRect As RectAPI) As Long
Public Declare Function SelectObject Lib "GDI32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "GDI32.dll" (ByVal hDC As Long) As Long
Public Declare Function GetWindowRect Lib "User32.dll" (ByVal hWnd As Long, ByRef lpRect As RectAPI) As Long
Public Declare Function CreateCompatibleBitmap Lib "GDI32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function ReleaseDC Lib "User32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long
Public Declare Function OpenClipboard Lib "User32.dll" (ByVal hWnd As Long) As Long
Public Declare Function EmptyClipboard Lib "User32.dll" () As Long
Public Declare Function SetClipboardData Lib "User32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CloseClipboard Lib "User32.dll" () As Long
Public Type RectAPI
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Const WM_PAINT = &HF
Public Const WM_PRINT = &H317
Public Const PRF_NONCLIENT = &H2
Public Const PRF_ERASEBKGND = &H8
Public Const PRF_CLIENT = &H4&     ' Draw the window's client area
Public Const PRF_CHILDREN = &H10&  ' Draw all visible child windows
Public Const PRF_OWNED = &H20&     ' Draw all owned windows
Public Const CF_BITMAP As Long = 2

Public Sub CopyPicture(ByVal A As PictureBox)
    Dim hDCMem As Long
    Dim Rect As RectAPI
    Dim hBmp As Long, hOld As Long
    Dim hDC As Long
    hDCMem = CreateCompatibleDC(0&)
    Call GetWindowRect(A.hWnd, Rect)
    hDC = GetDC(hWnd)
    hBmp = CreateCompatibleBitmap(hDC, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top)
    Call ReleaseDC(hWnd, hDC)
    hOld = SelectObject(hDCMem, hBmp)
    Call SendMessage(A.hWnd, WM_PAINT, hDCMem, 0)
    Call SendMessage(A.hWnd, WM_PRINT, hDCMem, ByVal (PRF_CHILDREN Or PRF_CLIENT Or PRF_ERASEBKGND Or PRF_NONCLIENT Or PRF_OWNED))
    Call SelectObject(hDCMem, hOld)
    Call DeleteObject(hDCMem)
    If (OpenClipboard(hWnd)) Then
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, hBmp)
        Call CloseClipboard
    End If
End Sub
 

Tags:Picture VB 控件 复制 剪切板

作者:佚名
  • 好的评价 如果您觉得此文章好,就请您
      0%(0)
  • 差的评价 如果您觉得此文章差,就请您
      0%(0)

网络学院评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论