利用VB捕捉并保存屏幕圖象

1、    大家知道在VB下利用API函數(shù)Bitblt可以將屏幕或者窗口上的圖象拷貝到VB中的PictureBox對(duì)象中,但是如果簡(jiǎn)單的利用PictureBox的SavePicture函數(shù)來保存圖象，會(huì)發(fā)現(xiàn)什么也保存不了。這篇文章就是介紹如何捕獲并利用Windows下的OLE API函數(shù)保存圖象。首先來看源程序，首先建立一個(gè)新的工程文件，然后在Form1中加入5個(gè)CommandButton對(duì)象和一個(gè)PictureBox對(duì)象，然后在Form1中加入以下代碼：Option ExplicitOption Base 0Private Type PALETTEENTR

2、Y peRed As Byte peGreen As Byte peBlue As Byte peFlags As ByteEnd TypePrivate Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRYEnd TypePrivate Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As ByteEnd TypePrivate Const RASTERCAPS As L

3、ong = 38Private Const RC_PALETTE As Long = &H100Private Const SIZEPALETTE As Long = 104Private Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function CreateCompat

4、ibleBitmap Lib "GDI32" (ByVal hDC As Long, _ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal _iCapabilitiy As Long) As LongPrivate Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal

5、 hDC As Long, _ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries _As PALETTEENTRY) As LongPrivate Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) _As LongPrivate Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObje

6、ct _As Long) As LongPrivate 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 LongPrivate Declare Functi

7、on DeleteDC Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function GetForegroundWindow Lib "USER32" () As LongPrivate Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette _As Long, ByVal bForceBackground As Long) As LongPrivate Declare

8、Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As LongPrivate Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As LongPrivate Declare Function GetWindowRect Lib "USER32&q

9、uot; (ByVal hWnd As Long, lpRect As _RECT) As LongPrivate Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As _Long) As LongPrivate Declare Function GetDesktopWindow Lib "USER32" () As LongPrivate Type PicBmp Size As Long Type As Long hBmp As Long hPal As Lo

10、ng Reserved As LongEnd TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As _PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long注釋：捕捉整個(gè)屏幕Private Sub Command1_Click() Set Picture1.Picture = CaptureScreen()End Sub注釋：在兩秒鐘后捕捉當(dāng)前的活動(dòng)

11、窗口Private Sub Command2_Click()MsgBox "當(dāng)你關(guān)閉這個(gè)對(duì)話框兩秒鐘之后程序會(huì)捕捉處于活動(dòng)狀態(tài)的窗口."注釋：等待兩秒鐘Dim EndTime As DateEndTime = DateAdd("s", 2, Now)Do Until Now > EndTime DoEvents LoopSet Picture1.Picture = CaptureActiveWindow()Me.SetFocusEnd SubPrivate Sub Command3_Click()Set Picture1.Picture = Not

12、hingEnd SubPublic Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As PictureDim r As Long Dim Pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID 注釋：填充IDispatch界面 With IID_IDispatch.Data1 = &H20400.Data4(0) = &HC0.Data4(7) = &H46 End With 注釋：填充Pic With Pic.Size = Len(Pic)注釋： Pic結(jié)構(gòu)長度.Type = vbPicTypeBitma