Picture中绘制的图像(手工绘的,Bitblt绘的,GDI+绘的都行),不经保存,如何直接从内存转化为一个Picture对象(StdPicture)?

Option Explicit



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

Private Declare Function GetClientRect Lib "User32.dll" (ByVal hWnd As Long, ByRef lpRect As RectAPI) As Long

Private Declare Function SelectObject Lib "GDI32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleDC Lib "GDI32.dll" (ByVal hDC As Long) As Long

Private Declare Function GetWindowRect Lib "User32.dll" (ByVal hWnd As Long, ByRef lpRect As RectAPI) As Long

Private Declare Function CreateCompatibleBitmap Lib "GDI32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function ReleaseDC Lib "User32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long

Private Declare Function OpenClipboard Lib "User32.dll" (ByVal hWnd As Long) As Long

Private Declare Function EmptyClipboard Lib "User32.dll" () As Long

Private Declare Function SetClipboardData Lib "User32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Private Declare Function CloseClipboard Lib "User32.dll" () As Long

Private Type RectAPI

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Const WM_PAINT = &HF

Private Const WM_PRINT = &H317

Private Const PRF_NONCLIENT = &H2

Private Const PRF_ERASEBKGND = &H8

Private Const PRF_CLIENT = &H4&    

Private Const PRF_CHILDREN = &H10& 

Private Const PRF_OWNED = &H20&    

Private Const CF_BITMAP As Long = 2

  

Private Sub Command1_Click()

    Dim hDCMem As Long

    Dim Rect As RectAPI

    Dim hBmp As Long, hOld As Long

    Dim hDC As Long

    hDCMem = CreateCompatibleDC(0&)

    Call GetWindowRect(Picture1.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(Picture1.hWnd, WM_PAINT, hDCMem, 0)

    Call SendMessage(Picture1.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

        Dim X As New StdPicture

        Set X = Clipboard.GetData

        Set Picture2.Picture = X     '从StdPicture对象获取

        Picture3 = Clipboard.GetData '直接从裁剪板获取

    End If

End Sub



Private Sub Form_Load()

    Picture1.BorderStyle = 0

    Picture1.Line (0, 0)-(1000, 1000)

End Sub