VB6 - Screenshot-Funktion

Question

Ich habe eine Screenshot-Funktion gefunden, die ich anrufe, wenn auf eine Schaltfläche geklickt wird. Das Problem, das ich sehe, ist, dass nur ein bestimmter Teil des Bildschirms (beginnend von der oberen rechten Ecke, in Richtung der Mitte des Bildschirms) in dem Bild, das ich auf meinem Formular habe, enthalten ist. Gibt es eine Möglichkeit für mich, die Dimensionen anzugeben, die ich sehen möchte, oder grundsätzlich die Möglichkeit zu haben, den gesamten Bildschirm in picScreen anzupassen?

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 Sub 

* Here's where I call my function specifying that I want the entire screen. 

Private Sub cmdScreenShot_Click() 
Call GetScreenshot(GetDesktopWindow) 
End Sub 

Answer 1

Statt

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 

Versuchen Sie, ganzen Bildschirm mit Twips calc

'Use size of screen 
Width = Screen.Width \ Screen.TwipsPerPixelX 
Height = Screen.Height \ Screen.TwipsPerPixelY 

'Copy the data from the screen hDC to this VB form 
BitBlt picScreen.hDC, 0, 0, Width, Height, hDC, 0, 0, vbSrcCopy