一時對圖片處理特別感興趣.....下面就來轉一篇有關于截屏的文章.
本文轉自:http://im0518.blog.163.com/blog/static/2655641720071022101445585/
兩種方法：感覺第一種方法來得直接一些
方法一：
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc 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 Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
'filePath為截屏要保存的路徑
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Picture1.Visible = False
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
SavePicture Picture1, filePath '保存圖片
End Sub
方法二：
'form中放一個按鈕和一個圖片框
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 0
Const theForm = 1
Private Sub Command1_Click()
Call keybd_event(vbKeySnapshot, theScreen, 0, 0)
DoEvents
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
End Sub
方法一修改后：
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc 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 Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
'filePath為截屏要保存的路徑
Me.Visible = False
Me.WindowState = 2
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
' Picture1.Visible = False
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
Me.Visible = True
' SavePicture Picture1, filePath '保存圖片
End Sub
Private Sub Command1_Click()
saveMyScreen "filePath"
End Sub復制代碼
