Results 1 to 2 of 2

Thread: Memory

  1. #1

    Thread Starter
    New Member
    Join Date
    Oct 2000
    Posts
    4

    Unhappy

    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
    //MVH takko

  2. #2
    Hyperactive Member
    Join Date
    Jun 2000
    Location
    Auckland, NZ
    Posts
    411

    Where do you ReleaseDC?

    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:

    Code:
    if ScreenDC <> 0 then Call ReleaseDC (0, ScreenDC)
    and the declare should be:
    Code:
    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
    Paul Lewis

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width