利用VB捕捉并保存屏幕图像

利用VB捕捉并保存屏幕图像大家知道在VB下利用API函数Bitblt可以将屏幕或者窗口上的图像拷贝到VB中的PictureBox对象中，但是如果简单地利用PictureBox的SavePicture函数来保存图像，会发现什么也保存不了。这篇文章就是介绍如何捕获并利用Windows下的OLEAPI函数保存图像。首先来看源程序，先建立一个新的工程文件，然后在Form1中加入5个CommandButton对象和一个PictureBox对象，然后在Form1中加入以下代码：OptionExplicitOptionBase0PrivateTypePALETTEENTRYpeRedAsBytepeGreenAsBytepeBlueAsBytepeFlagsAsByteEndTypePrivateTypeLOGPALETTEpalVersionAsIntegerpalNumEntriesAsIntegerpalPalEntry(255)AsPALETTEENTRYEndTypePrivateTypeGUIDData1AsLongData2AsIntegerData3AsIntegerData4(7)AsByteEndTypePrivateConstRASTERCAPSAsLong=38PrivateConstRC_PALETTEAsLong=＆H100PrivateConstSIZEPALETTEAsLong=104PrivateTypeRECTLeftAsLongTopAsLongRightAsLongBottomAsLongEndTypePrivateDeclareFunctionCreateCompatibleDCLib“GDI32(ByValhDCAsLong)AsLongPrivateDeclareFunctionCreateCompatibleBitmapLib“GDI32(ByValhDCAsLong,_ByValnWidthAsLong,ByValnHeightAsLong)AsLongPrivateDeclareFunctionGetDeviceCapsLib“GDI32(ByValhDCAsLong,ByVal_iCapabilitiyAsLong)AsLongPrivateDeclareFunctionGetSystemPaletteEntriesLib“GDI32(ByValhDCAsLong,_ByValwStartIndexAsLong,ByValwNumEntriesAsLong,lpPaletteEntries_AsPALETTEENTRY)AsLongPrivateDeclareFunctionCreatePaletteLib“GDI32(lpLogPaletteAsLOGPALETTE)_AsLongPrivateDeclareFunctionSelectObjectLib“GDI32(ByValhDCAsLong,ByValhObject_AsLong)AsLongPrivateDeclareFunctionBitBltLib“GDI32(ByValhDCDestAsLong,ByValXDestAsLong,ByValYDestAsLong,ByValnWidthAsLong,ByValnHeightAsLong,_ByValhDCSrcAsLong,ByValXSrcAsLong,ByValYSrcAsLong,ByValdwRop_（AsLong)AsLongPrivateDeclareFunctionDeleteDCLib“GDI32(ByValhDCAsLong)AsLongPrivateDeclareFunctionGetForegroundWindowLib“USER32()AsLongPrivateDeclareFunctionSelectPaletteLibGDI32(ByValhDCAsLong,ByValhPalette_AsLong,ByValbForceBackgroundAsLong)AsLongPrivateDeclareFunctionRealizePaletteLib“GDI32(ByValhDCAsLong)AsLongPrivateDeclareFunctionGetWindowDCLib“USER32(ByValhWndAsLong)AsLongPrivateDeclareFunctionGetDCLib“USER32(ByValhWndAsLong)AsLongPrivateDeclareFunctionGetWindowRectLib“USER32(ByValhWndAsLong,lpRectAs_RECT)AsLongPrivateDeclareFunctionReleaseDCLib“USER32(ByValhWndAsLong,ByValhDCAs_Long)AsLongPrivateDeclareFunctionGetDesktopWindowLib“USER32()AsLongPrivateTypePicBmpSizeAsLongTypeAsLonghBmpAsLonghPalAsLongReservedAsLongEndTypePrivateDeclareFunctionOleCreatePictureIndirectLib“olepro32.dll(PicDescAs_PicBmp,RefIIDAsGUID,ByValfPictureOwnsHandleAsLong,IPicAsIPicture)AsLong'捕捉整个屏幕PrivateSubCommand1_Click()SetPicture1.Picture=CaptureScreen()EndSub'在两秒钟后捕捉当前的活动窗口PrivateSubCommand2_Click()MsgBox“当你关闭这个对话框两秒钟之后程序会捕捉处于活动状态的窗口。'等待两秒钟DimEndTimeAsDateEndTime=DateAdd(“s,2,Now)DoUntilNowEndTimeDoEventsLoopSetPicture1.Picture=CaptureActiveWindow()Me.SetFocusEndSubPrivateSubCommand3_Click()SetPicture1.Picture=NothingEndSubPublicFunctionCreateBitmapPicture(ByValhBmpAsLong,ByValhPalAsLong)AsPictureDimrAsLongDimPicAsPicBmpDimIPicAsIPictureDimIID_IDispatchAsGUID'填充IDispatch界面WithIID_IDispatch.Data1=＆H20400.Data4(0)=＆HC0.Data4(7)=＆H46EndWith'填充PicWithPic.Size=Len(Pic)'Pic结构长度.Type=vbPicTypeBitmap'图像类型.hBmp=hBmp'位图句柄.hPal=hPal'调色板句柄EndWith’建立Picture图像r=OleCreatePictureIndirect(Pic,IID_IDispatch,1,IPic)'返回Picture对象SetCreateBitmapPicture=IPicEndFunctionPublicFunctionCaptureWindow(ByValhWndSrcAsLong,ByValClientAsBoolean,ByVal_LeftSrcAsLong,ByValTopSrcAsLong,ByValWidthSrcAsLong,ByValHeightSrc_AsLong)AsPictureDimhDCMemoryAsLongDimhBmpAsLongDimhBmpPrevAsLongDimrAsLongDimhDCSrcAsLongDimhPalAsLongDimhPalPrevAsLongDimRasterCapsScrnAsLongDimHasPaletteScrnAsLongDimPaletteSizeScrnAsLongDimLogPalAsLOGPALETTEIfClientThenhDCSrc=GetDC(hWndSrc)ElsehDCSrc=GetWindowDC(hWndSrc)EndIfhDCMemory=CreateCompatibleDC(hDCSrc)hBmp=CreateCompatibleBitmap(hDCSrc,WidthSrc,HeightSrc)hBmpPrev=SelectObject(hDCMemory,hBmp)'获得屏幕属性RasterCapsScrn=GetDeviceCaps(hDCSrc,RASTERCAPS)HasPaletteScrn=RasterCapsScrnAndRC_PALETTEPaletteSizeScrn=GetDeviceCaps(hDCSrc,SIZEPALETTE)'如果屏幕对象有调色板则获得屏幕调色板IfHasPaletteScrnAnd(PaletteSizeScrn=256)Then'建立屏幕调色板的拷贝LogPal.palVersion=＆H300LogPal.palNumEntries=256r=GetSystemPaletteEntries(hDCSrc,0,256,LogPal.palPalEntry(0))hPal=CreatePalette(LogPal)'将新建立的调色板选如建立的内存绘图句柄中hPalPrev=SelectPalette(hDCMemory,hPal,0)r=RealizePalette(hDCMemory)EndIf'拷贝图像r=BitBlt(hDCMemory,0,0,WidthSrc,HeightSrc,hDCSrc,LeftSrc,TopSrc,vbSrcCopy)hBmp=SelectObject(hDCMemory,hBmpPrev)IfHasPaletteScrnAnd(PaletteSizeScrn=256)ThenhPal=SelectPalette(hDCMemory,hPalPrev,0)EndIf'释放资源r=DeleteDC(hDCMemory)r=ReleaseDC(hWndSrc,hDCSrc)SetCaptureWindow=CreateBitmapPicture(hBmp,hPal)EndFunction'capturescreen函数捕捉整个屏幕图像PublicFunctionCaptureScreen()AsPictureDimhWndScreenAsLong'获得桌面的窗口句柄hWndScreen=GetDesktopWindow()SetCaptureScreen=CaptureWindow(hWndScreen,False,0,0,Screen.Width_\Screen.TwipsPerPixelX,Screen.Height\Screen.TwipsPerPixelY)EndFunctionPublicFunctionCaptureActiveWindow()AsPictureDimhWndActiveAsLongDimrAsLongDimRectActiveAsRECThWndActive=GetForegroundWindow()r=GetWindowRect(hWndActive,RectActive)SetCaptureActiveWindow=CaptureWindow(hWndActive,False,0,0,_RectActive.Right－RectActive.Left,RectActive.Bottom－RectActive.Top)EndFunctionPublicSubPrintPictureToF