我寫的一小段程式(是做圖形變換特效),我將圖形載入記憶體中後進行運算再將圖形繪至PictureBox中,但似乎每次執行都會殘留些記憶體未釋放,導致程式連續執行後會產生憶體不足的訊息
請各位先進,般我看看我到底哪裡記憶體未釋放乾淨(由Cammand3_click開始整個程式的流程)
ps;我知道把整的程式碼Post出來大概就不會有人會回答,但還是懇請幫忙
Option Explicit
Dim hMemDC As Long
Private Sub Command1_Click()
Dim hOldPattern As Long, i As Integer
  Dim hBitmap As Long, hPattern As Long
  Dim sx As Long, sy As Long
  Dim pic As Picture

ScaleMode = vbPixels
  sx = Picture1.Width
  sy = Picture1.Height
 
  For i = 11 To 18
     
    Set pic = LoadResPicture("Pattern" & Format(i, "00"), vbResBitmap)
    hBitmap = pic.Handle
    hPattern = CreatePatternBrush(hBitmap)
    hOldPattern = SelectObject(Picture1.hDC, hPattern)
    BitBlt Picture1.hDC, 0, 0, sx, sy, hMemDC, 0, 0, &HAC0744
     
    SelectObject Picture1.hDC, hOldPattern
    DeleteObject hBitmap
    DeleteObject hPattern
   
    Set pic = Nothing
    delay 0.01

Next
  
  
  DeleteDC hMemDc2
  DeleteObject hBitmap
 
End Sub
'===================================
Private Sub Command2_Click()
Me.Text1 = Me.Text1 + 1
Picture1.Cls
  Command3_Click
End Sub
'==========================================
Sub delay(ByVal n As Single)
Dim tm1 As Long, tm2 As Long
  tm1 = timeGetTime
  Do
    tm2 = timeGetTime
    If (tm2 - tm1) / 1000 > n Then Exit Do
    DoEvents
  Loop
End Sub
'====================================開始
Private Sub Command3_Click()
Dim picBmp As Picture
Dim picMask As Picture
Set picBmp = LoadPicture(App.Path & "\" & "800Dtop1.bmp")
    Set picMask = LoadPicture(App.Path & "\" & "temp.bmp")
    
    NoBlinkDraw Me.Picture1.hDC, picBmp.Handle, picMask.Handle, 0, 0
   
    
   
    Set picMask = Nothing
    Set picBmp = Nothing
    Call Command1_Click
    Call Command2_Click
   
End Sub
'======================================================
Sub NoBlinkDraw(ByVal hDC As Long, ByVal hBmp As Long, ByVal hMask As Long, ByVal Left As Integer, ByVal Top As Integer)
Dim w As Integer, h As Integer   ' 圖片寬度及高度
  Dim hBitmap As Long
  Dim hMemDcTemp As Long
  Dim bm As BITMAP
 
  
  ' 取得圖片的寬度及高度
  GetObject hMask, LenB(bm), bm
  w = bm.bmWidth
  h = bm.bmHeight
  
  
  ' 建立記憶體 DC
  hMemDC = CreateCompatibleDC(hDC)
  hBitmap = CreateCompatibleBitmap(hDC, w, h)
  SelectObject hMemDC, hBitmap
  
    
 
  hMemDcTemp = CreateCompatibleDC(hDC)
  SelectObject hMemDcTemp, hBmp
  BitBlt hMemDC, 0, 0, w, h, hMemDcTemp, 0, 0, vbSrcCopy
  
  DeleteDC hMemDcTemp
  
 

End Sub

vbqa 發表在 痞客邦 留言(1) 人氣()