Print Screen的三個方法：

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

Private Sub Picture1_Click()
Dim DesktopDC As Long
　DesktopDC = GetWindowDC(GetDesktopWindow)
　BitBlt Picture1.hdc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, DesktopDC, 0, 0, vbSrcCopy
　ReleaseDC GetDesktopWindow, DesktopDC
End Sub

　在 http://www.mvps.org/vbnet/ 還找到另一個方法，以供參考：

BAS Module Code：

Option Explicit
Option Base 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Public Declare Function GetDesktopWindow Lib _
"user32" () As Long

Public Declare Function CreateCompatibleDC Lib _
"gdi32" _
(ByVal hdc As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib _
"gdi32" _
(ByVal hdc As Long, ByVal nWidth As Long, _
ByVal nHeight As Long) As Long

Public Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function BitBlt Lib "gdi32" _ 
(ByVal hDCDest As Long, ByVal XDest As Long, _
ByVal YDest As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hDCSrc As Long, _
ByVal XSrc As Long, ByVal YSrc As Long, _
ByVal dwRop As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long

Public Declare Function GetWindowDC Lib "user32" _
(ByVal hWnd As Long) As Long

Public Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long

Public Declare Function OleCreatePictureIndirect Lib _
"olepro32.dll" _
(PicDesc As PicBmp, RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long


Public Function GetOLEScreenSnapshot() As Picture

Dim hWndSrc As Long
Dim hDCSrc As Long
Dim hDCMemory As Long
Dim hBmp As Long
Dim hBmpPrev As Long
Dim WidthSrc As Long
Dim HeightSrc As Long

Dim r As Long

Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID

'CaptureWindow 
WidthSrc = Screen.Width \ Screen.TwipsPerPixelX
HeightSrc = Screen.Height \ Screen.TwipsPerPixelY

'Get a handle to the desktop window and get the proper device context 
hWndSrc = GetDesktopWindow()
hDCSrc = GetWindowDC(hWndSrc) 

'Create a memory device context for the copy process 
hDCMemory = CreateCompatibleDC(hDCSrc)

'Create a bitmap and place it in the memory DC 
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)

'Copy the on-screen image into the memory DC 
Call BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, _
hDCSrc, 0, 0, vbSrcCopy)

'Remove the new copy of the the on-screen image 
hBmp = SelectObject(hDCMemory, hBmpPrev)

'Release the device context resources back to the system 
Call DeleteDC(hDCMemory)
Call ReleaseDC(hWndSrc, hDCSrc)

'Fill in OLE IDispatch Interface ID 
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'Fill Pic with necessary parts 
With Pic
.Size = Len(Pic) 'Length of structure
.Type = vbPicTypeBitmap 'Type of Picture (bitmap)
.hBmp = hBmp 'Handle to bitmap
.hPal = 0& 'Handle to palette (may be null)
End With

'Create OLE Picture object 
Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

'Return the new Picture object 
Set GetOLEScreenSnapshot = IPic

End Function
'--end block--'

Form Code：

Private Sub Command1_Click()

Set Picture1.Picture = GetOLEScreenSnapshot()

'Remove the comment on the next line to
'save the picture to disk. Assure that the
'path provided is valid for your system.
'SavePicture Picture1, "d:\test.bmp"

End Sub
'--end block--'

上一頁