VB6-屏幕截图功能

问题描述:

我找到了单击按钮时调用的屏幕截图功能.我看到的问题是,窗体上的picScreen仅包含屏幕的特定部分(从右上角开始,朝屏幕的中心).是否可以指定我要查看的尺寸,或者基本上可以将整个屏幕放入picScreen中.

I have found a screen shot function that I call when a button is clicked. The problem I'm seeing is that only a certain part of the screen (starting from top right corner, going towards the center of screen) is included in the picScreen that I have on my form. Would there be a way for me to specify the dimensions I want to see, or basically have the ability to fit the entire screen inside picScreen.

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

而不是

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

尝试使用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