VB屏幕截圖代碼

'聲明部分

Option Explicit

Private Const SRCCOPY = &HCC0020

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 GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowDC 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 Sub Form_Load()

Me.AutoRedraw = True

End Sub

Private Sub Command1_Click()

CopyScreen "d:\1.bmp"

End Sub

Sub CopyScreen(FileName As String)

Dim w As Long, h As Long

Dim hwndSrc As Long

Dim hSrcDC As Long

hwndSrc = GetDesktopWindow()

hSrcDC = GetWindowDC(hwndSrc)

w = Screen.Width \ Screen.TwipsPerPixelX

h = Screen.Height \ Screen.TwipsPerPixelY

Call BitBlt(hdc, 0, 0, w, h, hSrcDC, 0, 0, SRCCOPY)

Call ReleaseDC(hwndSrc, hSrcDC)

SavePicture Me.Image, FileName

End Sub

將整個屏幕截圖保存到指定文件名的位圖文件

CopyScreen(FileName As String)

參數 FileName 為完整路徑文件名即可