Memory

[takko]

The following code suck all my memory up, and I don't know why. Anyone who knows?

Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Dim ScreenDC As Long, CursorPos As POINTAPI, b As Integer, Minus As Boolean
Dim MainRgn As Long, MoveRgn As Long, UrRgn As Long, PicDCRgn As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Sub Form_Load()
Dim i As Long
ScaleMode = 3
MainRgn = CreateEllipticRgn(0, 20, Me.ScaleWidth, Me.ScaleHeight)
MoveRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, 20, 20, 20)
UrRgn = CreateRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight)
PicDCRgn = CreateEllipticRgn(0, 0, picScreenDC.Width, picScreenDC.Height)
SetWindowRgn picScreenDC.hwnd, PicDCRgn, False
Call CombineRgn(UrRgn, MoveRgn, MainRgn, 2)
SetWindowRgn Me.hwnd, UrRgn, True
SetWindowPos Me.hwnd, -1, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0
picScreenDC.Left = picScreenDC.Left + 0.4
For i = 20 To 2000 Step 100
picLine.Line (0, i)-(5000, i), &HC0C000
Next
Timer1.Enabled = True
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If (x >= 0 And x <= Me.ScaleWidth) And (y >= 0 And y <= 20) Then
Call ReleaseCapture
Call SendMessage(Me.hwnd, &HA1, 2, 0)
End If
End Sub

Private Sub lblAvsluta_Click(Index As Integer)
Unload Me
End Sub

Private Sub lblAvsluta_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
lblAvsluta(Index).ForeColor = vbRed

End Sub

Private Sub lblAvsluta_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
lblAvsluta(Index).ForeColor = &HC0C000
End Sub

Private Sub lblCaption_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Call ReleaseCapture
Call SendMessage(Me.hwnd, &HA1, 2, 0)
End Sub

Sub Timer1_Timer()
ScreenDC = GetDC(0)
Call GetCursorPos(CursorPos)
Call StretchBlt(picScreenDC.hdc, 0, 0, Form1.ScaleWidth, Form1.ScaleWidth, ScreenDC, CursorPos.x - ((Me.ScaleHeight / 2) / 2), CursorPos.y - ((Me.ScaleHeight / 2) / 2) + 10, Me.ScaleWidth / 2, (Me.ScaleHeight - 20) / 2, vbSrcCopy)
DoEvents
End Sub

Private Sub Timer2_Timer()
If Minus = True Then
b = b - 1
Else
b = b + 1
End If
Call BitBlt(Form1.hdc, 0, 20, Me.Width, Me.Height, picLine.hdc, 0, b, &H660046)
If b > 20 Then
Minus = True
ElseIf b <= 0 Then
Minus = False
End If
DoEvents
End Sub

[PaulLewis]

I am not positive because I am not likely to try your code out (I hate rebooting), but if you have a DC and don't release it, you will eventually run out of DC's. I know you're only getting the DC for the whole screen and you probably think that it's released each time timer1 is called but it is not. All you are doing in timer1 is making it impossible to ever call ReleaseDC because you are overwriting the contents of the ScreenDC variable with the new DC.

You HAVE to call ReleaseDC (not DeleteDC of course) in order to remain safe. Add this to timer1 before the first line:


if ScreenDC <> 0 then Call ReleaseDC (0, ScreenDC)


and the declare should be:

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) as Long


Even if this is not the answer, my win32API book tells me to always Release the DC.

Cheers