我做了 一个抓屏的软件，但按下DEL+CTRL+SHIF时弹出的winddos 全安提示 时的屏幕抓下来是黑的

Question

我做了 一个抓屏的软件，但按下DEL+CTRL+SHIF时弹出的winddos 全安提示 时的屏幕抓下来是黑的 
计算机锁定时抓下来是也黑的   我想是bitblt函数出错了 谁知道怎么解决

Answer 1

Option Explicit
Option Base 0Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End TypePrivate Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End TypePrivate 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 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 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
Dim si As Long
Dim da2
Dim da1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'捕  捉  屏  幕
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Public Function bmp16x() As Picture
Select Case si
Case 0da2 = Now
si = si + 1Case 100da1 = Now
si = 0
Case Else
si = si + 1
Form1.Caption = si
End Select
  Dim hWndScreen As Long   hWndScreen = GetDesktopWindow()
   Set bmp16x = CaptureWindow(hWndScreen, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  捕 捉 活 动 窗口'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Public Function CaptureActiveWindow() As Picture    Dim hWndActive As Long
    Dim r As Long
    
    Dim RectActive As RECT
    
    hWndActive = GetForegroundWindow()
    
    r = GetWindowRect(hWndActive, RectActive)
    
    Set CaptureActiveWindow = CaptureWindow(hWndActive, 0, 0, RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top)
End Function
'----------------------------------------------------------- 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  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   'ByVal hWndSrc As Long '要捕捉窗口的句柄
  
   'ByVal LeftSrc As Long '窗口的左边起点
   'ByVal TopSrc As Long  '窗口的顶
   'ByVal WidthSrc As Long '窗口的宽
   'ByVal HeightSrc As Long '窗口的高
   
   
   
  Dim hDCMemory As Long
  Dim hBmp As Long
  Dim hBmpPrev As Long
  Dim r As Long
  Dim hdcsrc As Long  
  hdcsrc = GetWindowDC(hWndSrc) '得到桌面设备场景
 
  hDCMemory = CreateCompatibleDC(hdcsrc)    '创建一个与特定设备场景一致的内存设备场景
   
  hBmp = CreateCompatibleBitmap(hdcsrc, WidthSrc, HeightSrc) '创建一幅与设备有关位图，它与指定的设备场景兼容
  
  hBmpPrev = SelectObject(hDCMemory, hBmp)
   
   '每个设备场景都可能有选入其中的图形对象。其中包括位图、刷子、字体、画笔以及区域等等。
   '一次选入设备场景的只能有一个对象。选定的对象会在设备场景的绘图操作中使用。
   '例如，当前选定的画笔决定了在设备场景中描绘的线段颜色及样式
   
  r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hdcsrc, LeftSrc, TopSrc, vbSrcCopy) 'vbSrcCopy
  
  hBmp = SelectObject(hDCMemory, hBmpPrev)
  
   r = DeleteDC(hDCMemory)
   r = ReleaseDC(hWndSrc, hdcsrc)
  
   Dim Pic As PicBmp
   Dim IPic As Picture
   Dim IID_IDispatch As GUID   With IID_IDispatch
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With   With Pic
      .Size = Len(Pic)          ' Length of structure.
      .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
      .hBmp = hBmp              ' Handle to bitmap.
      .hPal = 0              ' Handle to palette (may be null).
   End With   r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
   
Set CaptureWindow = IPic
   
  
End Function

Answer 2

以上是我的代码，但但按下DEL+CTRL+SHIF时弹出的winddos 全安提示 时的屏幕抓下来是黑的 ，正常情况上我正常抓图  谁帮我一下啊，