api - out of memory

[TiG]

Подскажите почему через несколько минут работы программы Windows пишет что не хватает памяти. Текст программы без модулей прилагаю:

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

Dim ii As Integer
Private Sub Command1_Click()
Call Destroy
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Destroy
End Sub
Private Sub refr()
BitBlt CDC, 0, 0, 400, 400, MDC2, 0, 0, SRCCOPY
End Sub
Private Sub Create()
Dim pict As String
Select Case ii
Case 1: pict = "red.bmp"
Case 2: pict = "red1.bmp"
Case 3: pict = "red2.bmp"
Case 4: pict = "red3.bmp"
Case 5: pict = "red4.bmp"
End Select
CDC = GetDC(Form1.hwnd)
MDC2 = CreateCompatibleDC(CDC)
MBM2 = CreateCompatibleBitmap(CDC, 400, 400)
ReleaseDC Form1.hwnd, CDC
SelectObject MDC2, LoadPicture(pict)
End Sub

Private Sub Destroy()
DeleteObject MBM2
DeleteDC MDC2
End Sub

Private Sub Timer1_Timer()
ii = ii + 1
If ii > 5 Then ii = 1
Call Create
Call refr
Call Destroy
End Sub

[Inferno]

Странно у тебя как-то написано. Ты уж наверное обяви CDC , MDC2,MBM2 как глобальные или передавай их значения. И end в клике тоже никчему.

[Alexanbar]

А что, разве нельзя заранее заготовить пять картинок, и выбирать их из ImagelIst-а? Похоже, что память не освобождается. Что-то подобное у меня было при использовании ф-й работы с памятью типа CopyMemory.

[TiG]

Все переменные у меня объявлены как глобальные в том же модуле, где я декларирую api функции.

Программа работает. Помещать картинки куда либо мне не надо. - это просто пример для отладки более крутой программы.

Что то я прописал неверно. поэтому память и не высвобождается.
Вопрос ЧТО!!!!!
Поэтому и прошу совета у спецов по блитингу.

[TiG]

УРА !!!

Разобрался сам.
Для интересующихся прилагаю идеально работающий вариант программы (без модуля декларации api функций и переменных).

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

Dim pict As String
Dim ii As Integer

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
ii = 1
CDC = GetDC(Form1.hwnd)
CompDC = CreateCompatibleDC(CDC) 'Создаём совместимый DC
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteDC CompDC 'Удаляем DC
DeleteDC CDC 'Удаляем DC
End Sub

Private Sub Timer1_Timer()
ii = ii + 1
If ii > 5 Then ii = 1
Select Case ii
Case 1: pict = "red.bmp"
Case 2: pict = "red1.bmp"
Case 3: pict = "red2.bmp"
Case 4: pict = "red3.bmp"
Case 5: pict = "red4.bmp"
End Select
Text1.Text = CStr(ii)
Call ref(pict)
End Sub

Private Sub ref(pict)
OldBM = SelectObject(CompDC, LoadPicture(pict))
BitBlt CDC, 0, 0, 400, 400, CompDC, 0, 0, vbSrcCopy
newBM = SelectObject(CompDC, OldBM)
DeleteObject newBM
End Sub