如何在截屏后清空内存中刚才截的图片？？？

[wingdes]

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long

Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long

Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long

Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private 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

Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long

Private Declare Function GetForegroundWindow Lib "USER32" () As Long

Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As
Long, ByVal bForceBackground As Long) As Long

Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long

Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) 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 Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long


看了高手做了截屏的的程序，用到以上这些库。我想实现一个屏幕录像成图片的功能，但是我做完之后，大约运行5分钟，就会报虚拟内存溢出，我想一定是没有释放掉前面截的屏的内存位图，不知哪位可以指点一下，在我把内存位图保存为本地图片之后，清空这个内存位图，多谢了！！！

[wingdes]

自己先顶一下……！！！

[michael_zy]

贴这么多函数声明有什么用？？谁知道你的代码是怎么写的？？

[wingdes]

Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
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 Function

Public 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函数截屏后，不知如何清空内存位图。

[Mister]

这个2个函数好熟啊，是从网上粘的吧？这2个函数我以前就用过 N 次，抓过 N 次的图片，没有出现你说的那种问题啊......是不是你自己的代码有点问题。


如果要销毁对像，这样：Set Object=Nothing

Public Sub SaveFile()
Dim mPic As StdPicture

Set mPic=CaptureWindow(参数) '抓屏。
SavePicture mpic, "文件名" '将图片保存为磁盘文件（位图）。
Set mPic=Nothing '销毁对像。

End Sub

[wzxiaodu]

高手们，借贵宝地问个问题？
就是通过上面两个程序等或其他，
如何用过鼠标，截取一部分屏幕在存图？？？

[michael_zy]

这个很简单....
先把整个屏幕抓下来....
在从你鼠标所画的区域把图片抓出来....主要是坐标的问题.......
长度宽度和开始的坐标