Как найти утечку памяти?

[Matew]

Есть вот такая процедура:

Код: Выделить всё

Sub RisovatKonstr(Konstr As Konstrukcia, Frm As Object, tpVydel As Vydel)
Dim hBmpPrev As Long, pbDocHeight As Long, pbDocWidth As Long
Dim ret As Long, pbDochDC As Long, hBmp As Long
pbDochDC = CreateCompatibleDC(GetDC(0))
pbDocHeight = 2000
pbDocWidth = 2000
hBmp = CreateCompatibleBitmap(GetDC(0), pbDocWidth, pbDocHeight)
If hBmp = 0 Then
    MsgBox "Пора перезагрузиться. "
    End
End If
hBmpPrev = SelectObject(pbDochDC, hBmp)
SetBkMode pbDochDC, TRANSPARENT
Ster pbDochDC, pbDocWidth, pbDocHeight' pbDochDC закрашивается цветом фона
Narisovat Konstr, pbDochDC, tpVydel' на pbDochDC рисуется рисунок
StretchBlt Frm.hdc, 0, 0, Frm.ScaleWidth, Frm.ScaleHeight, pbDochDC, 0, 0, pbDocWidth, pbDocHeight, vbSrcCopy
hBmp = SelectObject(pbDochDC, hBmpPrev)
ret = DeleteDC(pbDochDC)
DeleteObject hBmp
End Sub


Так вот перезагружаться приходится очень часто . Как найти, где утекает память? Может можно хоть временно отсрочить перезагрузку, наример создав другой битмап, когда этот обнуляется?

[HiSER]

для какой цели сделано так:

Код: Выделить всё

hBmpPrev = SelectObject(pbDochDC, hBmp)
....
hBmp = SelectObject(pbDochDC, hBmpPrev)


[Matew]

HiSER, копировал из очень старого проекта. Видать, хотел создать и вернуть на место. А как должно быть?

[HiSER]

Например:

Код: Выделить всё

DeleteObject SelectObject(pbDochDC, hBmp)

Без:

Код: Выделить всё

hBmp = SelectObject(pbDochDC, hBmpPrev)

[Matew]

HiSER
Не помогает ни так:

Код: Выделить всё

DeleteObject SelectObject(pbDochDC, hBmp)


ни так:

Код: Выделить всё

DeleteObject hBmpPrev


[HiSER]

Полный код в студию.

[Matew]

Неет, не буду - стесняюсь

[HiSER]

Неет, не буду - стесняюсь

Сначало выложил потом удалил, я все равно успел скачать...
Немного переделал:

Код: Выделить всё

Sub RisovatKonstr(Konstr As Konstrukcia, Frm As Object, tpVydel As Vydel)
Dim hBmpPrev As Long, pbDocHeight As Long, pbDocWidth As Long
Dim ret As Long, pbDochDC As Long, hBmp As Long, hdc As Long
hdc = GetDC(0)
pbDochDC = CreateCompatibleDC(hdc)
pbDocHeight = 2000
pbDocWidth = 2000
hBmp = CreateCompatibleBitmap(hdc, pbDocWidth, pbDocHeight)
DeleteObject SelectObject(pbDochDC, hBmp)
SetBkMode pbDochDC, TRANSPARENT
Ster pbDochDC, pbDocWidth, pbDocHeight ' pbDochDC закрашивается цветом фона
Narisovat Konstr, pbDochDC, tpVydel ' на pbDochDC рисуется рисунок
StretchBlt Frm.hdc, 0, 0, Frm.ScaleWidth, Frm.ScaleHeight, pbDochDC, 0, 0, pbDocWidth, pbDocHeight, vbSrcCopy
ret = DeleteDC(pbDochDC)
DeleteObject hBmp
ReleaseDC 0, hdc
End Sub


[Matew]

HiSER, надеюсь, не очень позорно написано?
За доработку спасибо. Пока не смог уронить.

[HiSER]

HiSER, надеюсь, не очень позорно написано?

Нету понятия позорно, не позорно...

[Matew]

Та же процедура чуть-чуть модифицирована:

Код: Выделить всё

Sub RisovatKonstr(Konstr As Konstrukcia, Frm As Object, tpVydel As Vydel)
Dim hBmpPrev As Long
Static pbDocHeight As Long, pbDocWidth As Long
If pbDocHeight = 0 Then
    pbDocHeight = 2500
    pbDocWidth = 2500
End If
pbDocHeight = pbDocHeight + 1
pbDocWidth = pbDocHeight
Dim ret As Long, pbDochDC As Long, hBmp As Long, hdc As Long
hdc = GetDC(0)
pbDochDC = CreateCompatibleDC(hdc)
hBmp = CreateCompatibleBitmap(hdc, pbDocWidth, pbDocHeight)
If hBmp = 0 Then
    MsgBox "Слишком большие габариты!"
    End
End If
hBmpPrev = SelectObject(pbDochDC, hBmp)
SetBkMode pbDochDC, TRANSPARENT
Ster pbDochDC, pbDocWidth, pbDocHeight
Narisovat Konstr, pbDochDC, tpVydel 'рисует на pbDochDC
StretchBlt Frm.hdc, 0, 0, Frm.ScaleWidth, Frm.ScaleHeight, pbDochDC, 0, 0, pbDocWidth, pbDocHeight, vbSrcCopy
ret = DeleteDC(pbDochDC)
DeleteObject hBmp
ReleaseDC 0, hdc


Так вот Bitmap перестает создаваться при pbDocWidth* pbDocHeight=~7450000 кв. пикселей.
Чем обусловлено это ограничение и как его можно обойти?

[Matew]

Вот нашел похожий случай:
http://www.dore.ru/perl/nntp.pl?f=1&gid=24&mid=34962
Ответа нет. Подскажите, что делать. Если нельзя обойти ограничения, то как проще всего поменять логику? Может вместо битмапа использовать какой-нибудь контрол с огромными размерами?