2012-02-24 961 views

回答

2

有一個similar question關於如何使用C#實現這個。請注意0​​,它解釋了爲什麼有些情況下根本不可能。

有關如何截取屏幕截圖的一些VB示例代碼,請參閱Microsoft的this article。這裏是最相關的部分:

Option Explicit 
Option Base 0 

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 

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 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' 
' CreateBitmapPicture 
' - Creates a bitmap type Picture object from a bitmap and 
'  palette. 
' 
' hBmp 
' - Handle to a bitmap. 
' 
' hPal 
' - Handle to a Palette. 
' - Can be null if the bitmap doesn't use a palette. 
' 
' Returns 
' - Returns a Picture object containing the bitmap. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture 
    Dim r As Long 
    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 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' 
' CaptureWindow 
' - Captures any portion of a window. 
' 
' hWndSrc 
' - Handle to the window to be captured. 
' 
' LeftSrc, TopSrc, WidthSrc, HeightSrc 
' - Specify the portion of the window to capture. 
' - Dimensions need to be specified in pixels. 
' 
' Returns 
' - Returns a Picture object containing a bitmap of the specified 
'  portion of the window that was captured. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Public Function CaptureWindow(_ 
    ByVal hWndSrc As Long, _ 
    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 

    ' Get device context for entire window. 
    hDCSrc = GetWindowDC(hWndSrc) 

    ' 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 
+0

嗨特雷布,感謝的人。編輯:哇這實際上似乎很好。我會嘗試的! – Mike 2012-02-24 11:48:35

+0

您是否知道我是否可以找出「未滾動區域」(實際下方)是否被渲染?或者你知道這是否也適用於OL? – Mike 2012-02-24 12:16:39

+0

對不起,我沒有辦法找到編程,它取決於應用程序如何處理窗口的繪圖。至於展望,我認爲你將不得不嘗試以找出... – Treb 2012-02-24 12:26:22

相關問題