下 面 的 方 法 實 際 上 是 抓 取 屏 幕 圖 象 的 方 法 。 
    如 果 要 得 到 一 個 PictureBox中 的 圖 形 （ 不 包 括 覆 蓋 在 其 上 的 控 件 ） ， 可 以 使 用 SavePicture Picture1.Picture "c:\test.bmp"語 句 將 圖 形 存 盤 。 這 種 方 法 不 管 整 個 圖 形 部 分 是 否 可 見 ， 都 可 以 保 存 下 來 。 
    如 果 要 包 括 覆 蓋 在 其 上 的 控 件 ， 可 以 用 下 面 的 辦 法 ： 
    首 先 建 立 一 個 模 塊 ， 輸 入 以 下 內 容 ： 
    Private Type PALETTEENTRY 
     peRed As Byte 
     peGreen As Byte 
     peBlue As Byte 
     peFlags As Byte 
    End Type 
     
    Private Type LOGPALETTE 
     palVersion As Integer 
     palNumEntries As Integer 
     palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors. 
    End Type 
     
    Private Type GUID 
     Data1 As Long 
     Data2 As Integer 
     Data3 As Integer 
     Data4(7) As Byte 
    End Type 
     
    #If Win32 Then 
     
     Private Const RASTERCAPS As Long = 38 
     Private Const RC_PALETTE As Long = &H100 
     Private Const SIZEPALETTE As Long = 104 
     
     Private Type RECT 
     Left As Long 
     Top As Long 
     Right As Long 
     Bottom As Long 
     End Type 
     
     Private Declare Function CreateCompatibleDC Lib "GDI32" ( _ 
     ByVal hDC As Long) As Long 
     Private Declare Function CreateCompatibleBitmap Lib "GDI32" ( _ 
     ByVal hDC As Long, ByVal nWidth As Long, _ 
     ByVal nHeight As Long) As Long 
     Private Declare Function GetDeviceCaps Lib "GDI32" ( _ 
     ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long 
     Private Declare Function GetSystemPaletteEntries Lib "GDI32" ( _ 
     ByVal hDC As Long, ByVal wStartIndex As Long, _ 
     ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) _ 
     As Long 
     Private Declare Function CreatePalette Lib "GDI32" ( _ 
     lpLogPalette As LOGPALETTE) 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 hDCDest As Long, ByVal XDest As Long, _ 
     ByVal YDest As Long, ByVal nWidth As Long, _ 
     ByVal nHeight As Long, ByVal hDCSrc As Long, _ 
     ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _ 
     As Long 
     Private Declare Function DeleteDC Lib "GDI32" ( _ 
     ByVal hDC As Long) As Long 
     Private Declare Function GetForegroundWindow Lib "USER32" () _ 
     As Long 
     Private Declare Function SelectPalette Lib "GDI32" ( _ 
     ByVal hDC As Long, ByVal hPalette As Long, _ 
     ByVal bForceBackground As Long) As Long 
     Private Declare Function RealizePalette Lib "GDI32" ( _ 
     ByVal hDC As Long) As Long 
     Private Declare Function GetWindowDC Lib "USER32" ( _ 
     ByVal hWnd As Long) As Long 
     Private Declare Function GetDC Lib "USER32" ( _ 
     ByVal hWnd As Long) As Long 
     Private Declare Function GetWindowRect Lib "USER32" ( _ 
     ByVal hWnd As Long, lpRect As RECT) As Long 
     Private Declare Function ReleaseDC Lib "USER32" ( _ 
     ByVal hWnd As Long, ByVal hDC As Long) As Long 
     Private Declare Function GetDesktopWindow Lib "USER32" () As Long 
     
     Private Type PicBmp 
     Size As Long 
     Type As Long 
     hBmp As Long 
     hPal As Long 
     Reserved As Long 
     End Type 
     
     Private Declare Function OleCreatePictureIndirect _ 
     Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _ 
     ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 
     
    #ElseIf Win16 Then 
     
     Private Const RASTERCAPS As Integer = 38 
     Private Const RC_PALETTE As Integer = &H100 
     Private Const SIZEPALETTE As Integer = 104 
     
     Private Type RECT 
     Left As Integer 
     Top As Integer 
     Right As Integer 
     Bottom As Integer 
     End Type 
     
     Private Declare Function CreateCompatibleDC Lib "GDI" ( _ 
     ByVal hDC As Integer) As Integer 
     Private Declare Function CreateCompatibleBitmap Lib "GDI" ( _ 
     ByVal hDC As Integer, ByVal nWidth As Integer, _ 
     ByVal nHeight As Integer) As Integer 
     Private Declare Function GetDeviceCaps Lib "GDI" ( _ 
     ByVal hDC As Integer, ByVal iCapabilitiy As Integer) As Integer 
     Private Declare Function GetSystemPaletteEntries Lib "GDI" ( _ 
     ByVal hDC As Integer, ByVal wStartIndex As Integer, _ 
     ByVal wNumEntries As Integer, _ 
     lpPaletteEntries As PALETTEENTRY) As Integer 
     Private Declare Function CreatePalette Lib "GDI" ( _ 
     lpLogPalette As LOGPALETTE) As Integer 
     Private Declare Function SelectObject Lib "GDI" ( _ 
     ByVal hDC As Integer, ByVal hObject As Integer) As Integer 
     Private Declare Function BitBlt Lib "GDI" ( _ 
     ByVal hDCDest As Integer, ByVal XDest As Integer, _ 
     ByVal YDest As Integer, ByVal nWidth As Integer, _ 
     ByVal nHeight As Integer, ByVal hDCSrc As Integer, _ 
     ByVal XSrc As Integer, ByVal YSrc As Integer, _ 
     ByVal dwRop As Long) As Integer 
     Private Declare Function DeleteDC Lib "GDI" ( _ 
     ByVal hDC As Integer) As Integer 
     Private Declare Function GetForegroundWindow Lib "USER" _ 
     Alias "GetActiveWindow" () As Integer 
     Private Declare Function SelectPalette Lib "USER" ( _ 
     ByVal hDC As Integer, ByVal hPalette As Integer, ByVal _ 
     bForceBackground As Integer) As Integer 
     Private Declare Function RealizePalette Lib "USER" ( _ 
     ByVal hDC As Integer) As Integer 
     Private Declare Function GetWindowDC Lib "USER" ( _ 
     ByVal hWnd As Integer) As Integer 
     Private Declare Function GetDC Lib "USER" ( _ 
     ByVal hWnd As Integer) As Integer 
     Private Declare Function GetWindowRect Lib "USER" ( _ 
     ByVal hWnd As Integer, lpRect As RECT) As Integer 
     Private Declare Function ReleaseDC Lib "USER" ( _ 
     ByVal hWnd As Integer, ByVal hDC As Integer) As Integer 
     Private Declare Function GetDesktopWindow Lib "USER" () As Integer 
     
     Private Type PicBmp 
     Size As Integer 
     Type As Integer 
     hBmp As Integer 
     hPal As Integer 
     Reserved As Integer 
     End Type 
     
     Private Declare Function OleCreatePictureIndirect _ 
     Lib "oc25.dll" (PictDesc As PicBmp, RefIID As GUID, _ 
     ByVal fPictureOwnsHandle As Integer, IPic As IPicture) _ 
     As Integer 
    #End If 
    #If Win32 Then 
     Public Function CaptureWindow(ByVal hWndSrc As Long, _ 
     ByVal Client As Boolean, ByVal LeftSrc As Long, _ 
     ByVal TopSrc As Long, ByVal WidthSrc As Long, _ 
     ByVal HeightSrc As Long) As Picture 
     
     Dim hDCMemory As Long 
     Dim hBmp As Long 
     Dim hBmpPrev As Long 
     Dim r As Long 
     Dim hDCSrc As Long 
     Dim hPal As Long 
     Dim hPalPrev As Long 
     Dim RasterCapsScrn As Long 
     Dim HasPaletteScrn As Long 
     Dim PaletteSizeScrn As Long 
    #ElseIf Win16 Then 
     Public Function CaptureWindow(ByVal hWndSrc As Integer, _ 
     ByVal Client As Boolean, ByVal LeftSrc As Integer, _ 
     ByVal TopSrc As Integer, ByVal WidthSrc As Long, _ 
     ByVal HeightSrc As Long) As Picture 
     
     Dim hDCMemory As Integer 
     Dim hBmp As Integer 
     Dim hBmpPrev As Integer 
     Dim r As Integer 
     Dim hDCSrc As Integer 
     Dim hPal As Integer 
     Dim hPalPrev As Integer 
     Dim RasterCapsScrn As Integer 
     Dim HasPaletteScrn As Integer 
     Dim PaletteSizeScrn As Integer 
    #End If 
     Dim LogPal As LOGPALETTE 
     
     ' Depending on the value of Client get the proper device context. 
     If Client Then 
     hDCSrc = GetDC(hWndSrc) ' Get device context for client area. 
     Else 
     hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire 
     ' window. 
     End If 
     
     ' Create a memory device context for the copy process. 
     hDCMemory = CreateCompatibleDC(hDCSrc) 
     ' Create a bitmap and place it in the memory DC. 
     hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 
     hBmpPrev = SelectObject(hDCMemory, hBmp) 
     
     ' Get screen properties. 
     RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster 
     ' capabilities. 
     HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette 
     ' support. 
     PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of 
     ' palette. 
     
     ' If the screen has a palette make a copy and realize it. 
     If HasPaletteScrn And (PaletteSizeScrn = 256) Then 
     ' Create a copy of the system palette. 
     LogPal.palVersion = &H300 
     LogPal.palNumEntries = 256 
     r = GetSystemPaletteEntries(hDCSrc, 0, 256, _ 
     LogPal.palPalEntry(0)) 
     hPal = CreatePalette(LogPal) 
     ' Select the new palette into the memory DC and realize it. 
     hPalPrev = SelectPalette(hDCMemory, hPal, 0) 
     r = RealizePalette(hDCMemory) 
     End If 
     
     ' Copy the on-screen image into the memory DC. 
     r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _ 
     LeftSrc, TopSrc, vbSrcCopy) 
     
    ' Remove the new copy of the on-screen image. 
     hBmp = SelectObject(hDCMemory, hBmpPrev) 
     
     ' If the screen has a palette get back the palette that was 
     ' selected in previously. 
     If HasPaletteScrn And (PaletteSizeScrn = 256) Then 
     hPal = SelectPalette(hDCMemory, hPalPrev, 0) 
     End If 
     
     ' Release the device context resources back to the system. 
     r = DeleteDC(hDCMemory) 
     r = ReleaseDC(hWndSrc, hDCSrc) 
     
     ' Call CreateBitmapPicture to create a picture object from the 
     ' bitmap and palette handles. Then return the resulting picture 
     ' object. 
     Set CaptureWindow = CreateBitmapPicture(hBmp, hPal) 
    End Function 
     
    #If Win32 Then 
     Public Function CreateBitmapPicture(ByVal hBmp As Long, _ 
     ByVal hPal As Long) As Picture 
     
     Dim r As Long 
    #ElseIf Win16 Then 
     Public Function CreateBitmapPicture(ByVal hBmp As Integer, _ 
     ByVal hPal As Integer) As Picture 
     
     Dim r As Integer 
    #End If 
     Dim Pic As PicBmp 
     ' IPicture requires a reference to "Standard OLE Types." 
     Dim IPic As IPicture 
     Dim IID_IDispatch As GUID 
     
     ' Fill in with IDispatch Interface ID. 
     With IID_IDispatch 
     .Data1 = &H20400 
     .Data4(0) = &HC0 
     .Data4(7) = &H46 
     End With 
     
     ' Fill Pic with necessary parts. 
     With Pic 
     .Size = Len(Pic) ' Length of structure. 
     .Type = vbPicTypeBitmap ' Type of Picture (bitmap). 
     .hBmp = hBmp ' Handle to bitmap. 
     .hPal = hPal ' Handle to palette (may be null). 
     End With 
     
     ' Create Picture object. 
     r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 
     
     ' Return the new Picture object. 
     Set CreateBitmapPicture = IPic 
    End Function 
     
    只 要 使 用 以 下 語 句 就 可 以 完 成 你 所 要 求 的 任 務 。 
    SavePicture CaptureWindow(Picture1.hWnd, False, 0, 0, _ 
     Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), _ 
     Picture1.ScaleY(Picture1.Height, vbTwips, vbPixels)) _ 
     , "C:\test.bmp" 
    這 時 保 存 的 是 可 見 部 分 ， 如 果 要 保 存 不 可 見 的 PictureBox中 的 背 景 ， 可 以 這 樣 ： 
    Picture2.Picture = Picture1.Picture 
    Picture2.PaintPicture CaptureWindow(Picture1.hWnd, False, 0, 0, _ 
     Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), _ 
     Picture1.ScaleY(Picture1.Height, vbTwips, vbPixels)), 0, 0 
    SavePicture Picture2.Picture "c:\test.bmp" 
    事 實 上 ， CaptureWindow可 以 截 取 任 何 窗 口 的 圖 象 。 
<END>