Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function CreateCompatibleBitmap 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 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 hObject 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 Function 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 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" (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 Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
看了高手做了截屏的的程序,用到以上这些库。我想实现一个屏幕录像成图片的功能,但是我做完之后,大约运行5分钟,就会报虚拟内存溢出,我想一定是没有释放掉前面截的屏的内存位图,不知哪位可以指点一下,在我把内存位图保存为本地图片之后,清空这个内存位图,多谢了!!!
Long, ByVal bForceBackground As Long) As LongPrivate Declare 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" (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 Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
看了高手做了截屏的的程序,用到以上这些库。我想实现一个屏幕录像成图片的功能,但是我做完之后,大约运行5分钟,就会报虚拟内存溢出,我想一定是没有释放掉前面截的屏的内存位图,不知哪位可以指点一下,在我把内存位图保存为本地图片之后,清空这个内存位图,多谢了!!!
解决方案 »
- 除了文件操作有没其他方法
- 取整函数是什么了?
- 如何通过VB的OLE功能调用微软Word的拼音指南功能?
- 请问只会一门VB能找到工作吗??
- VB+ADO+SQL(OR ACCESS)怎样调用数据库中的关系,或在程序中使用关系。
- vb 打包问题 急 谢谢了
- 100分100分---------------------请教数字签名的问题?????---------------------
- ACTIVE REPORT的参数传递问题!十万火急!!!
- ShellExecute调用WORD打开文档时出现“应用程序错误”
- 在VB中如何动态的在一个表中增加或减少一个字段?
- 有没有办法让计数器计数周期更小!
- 如何用VB把SQL中的数据导入到ORACLE里
Dim r As Long Dim Pic As PicBmp Dim IPic As IPicture
Dim IID_IDispatch As GUID With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
End With r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) Set CreateBitmapPicture = IPic
End FunctionPublic Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long
Dim hBmp As Long
Dim hBmpPrev As Long
Dim r As Long
Dim hDCSrc As Long
Dim hPal As Long
Dim hPalPrev As Long
Dim RasterCapsScrn As Long
Dim HasPaletteScrn As Long
Dim PaletteSizeScrn As Long
Dim LogPal As LOGPALETTE If Client Then
hDCSrc = GetDC(hWndSrc)
Else
hDCSrc = GetWindowDC(hWndSrc)
End If hDCMemory = CreateCompatibleDC(hDCSrc)
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp) RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
HasPaletteScrn = RasterCapsScrn And RC_PALETTE
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) If HasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
r = RealizePalette(hDCMemory)
End If ' Copy the on-screen image into the memory DC.
r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)' Remove the new copy of the on-screen image.
hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If r = DeleteDC(hDCMemory)
r = ReleaseDC(hWndSrc, hDCSrc) Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function主要是这两个函数,我用CaptureWindow函数截屏后,不知如何清空内存位图。
如果要销毁对像,这样:Set Object=NothingPublic Sub SaveFile()
Dim mPic As StdPicture
Set mPic=CaptureWindow(参数) '抓屏。
SavePicture mpic, "文件名" '将图片保存为磁盘文件(位图)。
Set mPic=Nothing '销毁对像。End Sub