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分钟,就会报虚拟内存溢出,我想一定是没有释放掉前面截的屏的内存位图,不知哪位可以指点一下,在我把内存位图保存为本地图片之后,清空这个内存位图,多谢了!!!

解决方案 »

  1.   

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

  2.   

    这个2个函数好熟啊,是从网上粘的吧?这2个函数我以前就用过 N 次,抓过 N 次的图片,没有出现你说的那种问题啊......是不是你自己的代码有点问题。
    如果要销毁对像,这样:Set Object=NothingPublic Sub SaveFile()
       Dim mPic As StdPicture
       
       Set mPic=CaptureWindow(参数)  '抓屏。
       SavePicture mpic, "文件名"    '将图片保存为磁盘文件(位图)。
       Set mPic=Nothing              '销毁对像。End Sub