Question

在VB中怎样将PictureBox内显示的内容（包括里边的控件）保存为图片文件？

用Picture1.Image只能得到PictureBox的图像，我在把PictureBox里边控件的样子也要出现在图片中，请问这应该怎样弄？
ldc4399，很感谢你，同时指出一下你Picture1.Left和Picture1.Top后忘加/15了。
我明白你的原理，你是利用截屏吧，现在问题是，我现在是Picture1中含有Picture2，Picture2加载了很大的图片，含有各种控件，程序中是需要拖动Picture2来一部分一部分地显示的。我现在要将整个Picture2的内容保存为图片，按你这个方法，恐怕就不行了。

Answer 1

在VB中将PictureBox内显示内容（包含里面加载的控件）保存为图片文件需要使用多个API函数来实现。被保存的图片是bmp格式的。

实现代码：

Option Explicit
    Private Const BI_RGB = 0&
    Private Const DIB_RGB_COLORS = 0
    Private Const BITMAPTYPE = &H4D42
    Private Const INVALID_HANDLE_VALUE = (-1)
    Private Const GENERIC_WRITE = &H40000000
    Private Const CREATE_ALWAYS = 2
    Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
    End Type
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
    End Type
    Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
    End Type
    Private Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
    End Type
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Sub CmdSave_Click()
    '保存转换后的图像
    Dim hmemDC As Long
    Dim hmemBMP As Long
    Dim lpmemBits As Long
    Dim bmp_info As BITMAPINFO
    Dim hFile As Long
    Dim bmpfile_info As BITMAPFILEHEADER
    Dim lpBytesWritten As Long
    Picture1.ScaleMode = vbPixels
    With bmp_info.bmiHeader
        .biSize = LenB(bmp_info.bmiHeader)
        .biWidth = Picture1.ScaleWidth
        .biHeight = Picture1.ScaleHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
        .biSizeImage = .biHeight * (((.biWidth * .biBitCount + 31) And &HFFFFFFE0) \ 8)
    End With
    hmemDC = CreateCompatibleDC(Picture1.hdc)
    hmemBMP = CreateDIBSection(Picture1.hdc, bmp_info, DIB_RGB_COLORS, lpmemBits, 0, 0)
    SelectObject hmemDC, hmemBMP
    BitBlt hmemDC, 0, 0, bmp_info.bmiHeader.biWidth, bmp_info.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy
    '保存图片
    hFile = CreateFile(App.Path & "\test.bmp", GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile <> INVALID_HANDLE_VALUE Then
        With bmpfile_info
            .bfType = BITMAPTYPE
            .bfOffBits = 14 + bmp_info.bmiHeader.biSize
            .bfSize = .bfOffBits + bmp_info.bmiHeader.biSizeImage
        End With
        WriteFile hFile, bmpfile_info.bfType, 2, lpBytesWritten, 0
        WriteFile hFile, bmpfile_info.bfSize, 12, lpBytesWritten, 0
        WriteFile hFile, bmp_info.bmiHeader, bmp_info.bmiHeader.biSize, lpBytesWritten, 0
        WriteFile hFile, ByVal lpmemBits, bmp_info.bmiHeader.biSizeImage, lpBytesWritten, 0
        CloseHandle hFile
    End If
    DeleteObject hmemBMP
    DeleteDC hmemDC
End Sub

Answer 2

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Sub Command1_Click()
Dim hdc As Long
hdc = GetDC(0)
BitBlt Picture2.hdc, 0, 0, Me.Picture1.Width, Picture1.Height, hdc, Me.Left / 15 + 8 + Picture1.Left, Me.Top / 15 + 30 + Me.Picture1.Top, vbSrcCopy
ReleaseDC 0, hdc
End Sub一个按钮 两个picturebox

不知你有没有边框。。我这个是加了边框的（边框就是标题栏什么的。。）不加边框的话把8,30去掉即可。。
还有假如是.net的改的就多了。。不知需要否。。