VB编程高手进

答案：直接 API 实现，整个代码太长，无法上传，下面是核心代码
  
你可以以关键字百度搜索，很多的
  
Private 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
  
Dim LogPal As LOGPALETTE
  
If Client Then
  
    hDCSrc = GetDC(hWndSrc) ' Get device context for client area
  
Else
  
    hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire window
  
End If
  
hDCMemory = CreateCompatibleDC(hDCSrc)
  
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 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 Functio

上一个：VB怎么声明数组
下一个：VB编写BHO插件