Visual Basic RBG Захват с экрана - PullRequest
Новая
       0

Visual Basic RBG Захват с экрана

3 голосов
/ 13 марта 2012

Мне нужен код, который будет работать в Visual Basic для захвата экрана и преобразования его в массив значений пикселей RBG - должен быть достаточно быстрым.

Любая помощь?

1 Ответ

8 голосов
/ 12 апреля 2012

Этот код сделает снимок экрана из окна или всего рабочего стола (виртуальный экран) и перетянет его в пользовательскую коробку с картинками. 

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowDC 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 Const SM_XVIRTUALSCREEN = 76
Private Const SM_YVIRTUALSCREEN = 77
Private Const SM_CYVIRTUALSCREEN = 79
Private Const SM_CXVIRTUALSCREEN = 78

Private Sub GetScreenshot(Optional ByVal hWnd As Long = 0)
Dim hDC As Long

Dim WindowRect As RECT
Dim Left As Long
Dim Top As Long
Dim Width As Long
Dim Height As Long

  If hWnd = 0 Then
    'Get the DC of the desktop
    hDC = GetWindowDC(GetDesktopWindow)

    'Get the virtual screen coordinates (this handles multiple monitors too :)
    Left = GetSystemMetrics(SM_XVIRTUALSCREEN)
    Top = GetSystemMetrics(SM_YVIRTUALSCREEN)
    Width = GetSystemMetrics(SM_CXVIRTUALSCREEN)
    Height = GetSystemMetrics(SM_CYVIRTUALSCREEN)

  Else
    'Get the DC of the window we want to capture
    hDC = GetWindowDC(hWnd)

    'Get the window coordinates
    GetWindowRect hWnd, WindowRect
    Left = 0
    Top = 0
    Width = WindowRect.Right - WindowRect.Left
    Height = WindowRect.Bottom - WindowRect.Top

  End If

  'BitBlt into our own DC
  BitBlt picScreen.hDC, 0, 0, Width, Height, hDC, Left, Top, vbSrcCopy

  'Delete our reference to the windows's DC
  ReleaseDC hWnd, hDC
End Function

Обратите внимание на использование GetSystemMetrics() при захвате рабочего стола. Это позволяет получить полные размеры экрана виртуального экрана при использовании нескольких мониторов вместо только основного монитора .

...