我寫的一小段程式(是做圖形變換特效),我將圖形載入記憶體中後進行運算再將圖形繪至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