Ресайз картинок средствами GDI+ в VB6

Обсуждения по программированию для ОС Windows безотносительно используемого языка программирования. Windows NT, Win32, Windows API, ядро и драйверы.
EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Ресайз картинок средствами GDI+ в VB6

Сообщение EducatedFool » 10.10.2013 (Чт) 5:50

Приветствую, коллеги.

Сделал функцию для изменения размеров картинок
(картинки на входе - разных форматов: jpg, bmp, gif, png и т.п., на выходе - jpg)

Всё работает, - если вызывать эту функцию для конкретной картинки, или из цикла СОТНИ раз.
Если же обрабатывать этой функцией в том же цикле ТЫСЯЧИ картинок, - возникают проблемы


Функция работает в виде макроса в Excel, и иногда Excel молча вылетает после обработки 2-3 тысяч картинок
(есть 5 тыс картинок. если обрабатывать их в 10 запусков по 500 картинок, - всё ОК, если запустить обработку всех 5000 сразу, - то возникает ошибка)

Код функции:
Код: Выделить всё
Function ResizeImage(ByVal FileName As String, ByVal newFilename As String, ByVal NewWidth&, ByVal NewHeight&) As Boolean
   Dim tJpgEncoder As GUID, tParams As EncoderParameters, uGdiInput As GdiplusStartupInput
    #If VBA7 Then
        Dim hGdiImage As LongPtr, hBitmap As LongPtr, quality As LongPtr, hGdiPlus As LongPtr, lRes As LongPtr
        Dim lGDIP As LongPtr, hDC As LongPtr, hBrush As LongPtr, Graphics As LongPtr, hResizedBitmap As LongPtr
    #Else
        Dim hGdiImage As Long, hBitmap As Long, quality As Long, hGdiPlus As Long, lRes As Long
        Dim lGDIP As Long, hDC As Long, hBrush As Long, Graphics As Long, hResizedBitmap As Long
    #End If

    uGdiInput.GdiplusVersion = 1: quality = 80
   
    If GdiplusStartup(hGdiPlus, uGdiInput) = Status_OK Then        'Запускаем GDI+

        If GdipCreateBitmapFromFile(StrPtr(FileName), hGdiImage) = Status_OK Then        'Создаём изображение в памяти
            'Делаем из изображения уменьшенное
            hDC = CreateCompatibleDC(ByVal 0&) ' Create a memory DC and select a bitmap into it, fill it in with the backcolor

            hBitmap = CreateBitmap(NewWidth&, NewHeight&, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)
            hBitmap = SelectObject(hDC, hBitmap)
            hBrush = CreateSolidBrush(vbWhite)
            hBrush = SelectObject(hDC, hBrush)
            PatBlt hDC, 0, 0, NewWidth&, NewHeight&, PATCOPY
            DeleteObject SelectObject(hDC, hBrush)

            ' Resize the picture
            GdipCreateFromHDC hDC, Graphics
            GdipSetInterpolationMode Graphics, InterpolationModeHighQualityBicubic

            lRes = GdipDrawImageRectI(Graphics, hGdiImage, 0, 0, NewWidth&, NewHeight&)
            GdipDeleteGraphics Graphics
            GdipDisposeImage hGdiImage

            ' Get the bitmap back
            hBitmap = SelectObject(hDC, hBitmap)
            DeleteDC hDC

            If GdipCreateBitmapFromHBITMAP(hBitmap, 0, hResizedBitmap) = 0 Then

               CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder        ' Initialize the encoder GUID
                tParams.Count = 1        ' Initialize the encoder parameters
                With tParams.Parameter        ' Quality
                    CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID        ' Set the Quality GUID
                    .NumberOfValues = 1: .Type = 4: .Value = VarPtr(quality)
                End With

                lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, tParams)        ' Save the image
                If lRes = 0 Then ResizeImage = True Else Debug.Print "Ошибка сохранения уменьшенного файла: " & lRes
                GdipDisposeImage hResizedBitmap        ' Destroy the bitmap
            Else
                Debug.Print "Ошибка преобразования размеров файла"
            End If
        End If
        GdiplusShutdown hGdiPlus
    Else
        Debug.Print "Ошибка при загрузке GDI+!"
    End If
End Function


Пример вызова функции:
Код: Выделить всё
Sub test()
    Dim file1$, file2$
    file1$ = "C:\Documents and Settings\Admin\Рабочий стол\file.jpg"
    file2$ = "C:\Documents and Settings\Admin\Рабочий стол\file_new.jpg"
    Debug.Print ResizeImage(file1$, file2$, 100, 200) ' 100, 200 - новые размеры картинки
End Sub


Возможно, где-то из 5000 картинок одна - какая-то «проблемная», - но не в этом суть,
косяк однозначно в коде (раз он не учитывает все возможные ошибки)

После того, как проявляется ошибка, - перестаёт работать ресайз даже для отдельно взятой картинки (процедура test).
Проблема в этой строке кода:
Код: Выделить всё
hBitmap = CreateBitmap(NewWidth&, NewHeight&, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)

когда функция перестаёт работать, в переменную hBitmap функция CreateBitmap возвращает ноль.
(соответственно, дальнейшая обработка в функции уже значения не имеет)
Если перезапустить Excel, и снова выполнить процедуру test, - всё снова начинает работать.

Функции WinAPI объявлены так: http://excelvba.ru/code/ResizeImages
(код функций в статье под спойлером)

PS: В WinAPI я плохо разбираюсь, в GDI/GDI+ - тем более.
Код собирал из нескольких источников по форумам, - возможно, где-то некорректно вызываются функции,
или вообще надо применять другой подход.

Вопрос: чем вызвано прекращение корректной работы функции после нескольких тысяч вызовов?

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение alibek » 10.10.2013 (Чт) 8:39

EducatedFool писал(а):Проблема в этой строке кода:
Код: Выделить всё
hBitmap = CreateBitmap(NewWidth&, NewHeight&, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)

когда функция перестаёт работать, в переменную hBitmap функция CreateBitmap возвращает ноль.
(соответственно, дальнейшая обработка в функции уже значения не имеет)

Значит нужно почитать документацию к функции.
Посмотреть GetLastError.
В зависимости от ошибки проверить код. Скорее всего ошибка будет указывать на нехватку памяти/ресурсов.
Lasciate ogni speranza, voi ch'entrate.

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение iGrok » 10.10.2013 (Чт) 11:17

Я даже догадываюсь, каких именно ресурсов будет не хватать...

Это откуда вообще такие загадочные конструкции?
Код: Выделить всё
hBitmap = SelectObject(hDC, hBitmap)
...
hBrush = SelectObject(hDC, hBrush)
...
DeleteObject SelectObject(hDC, hBrush)
...
hBitmap = SelectObject(hDC, hBitmap)
label:
cli
jmp label

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение EducatedFool » 11.10.2013 (Пт) 11:54

alibek писал(а):Посмотреть GetLastError.
В зависимости от ошибки проверить код. Скорее всего ошибка будет указывать на нехватку памяти/ресурсов.


Вы абсолютно правы:
ERROR_NOT_ENOUGH_MEMORY 8 (0x8)
Not enough storage is available to process this command


Подскажите, где в коде утечка памяти, и как её избежать?


iGrok писал(а):Это откуда вообще такие загадочные конструкции?
hBitmap = SelectObject(hDC, hBitmap)
hBrush = SelectObject(hDC, hBrush)
DeleteObject SelectObject(hDC, hBrush)
hBitmap = SelectObject(hDC, hBitmap)



Взял за основу код отсюда: Load and Resize Pictures with GDI+
Я вообще плохо понимаю, для чего все эти строки кода, и можно ли без них обойтись

Как можно упростить код, и что из него можно убрать лишнее?

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение alibek » 11.10.2013 (Пт) 13:21

EducatedFool писал(а):Подскажите, где в коде утечка памяти, и как её избежать?

В коде не утечка, в коде просто не освобождаются ресурсы после использования.
Примеры и документацию лучше смотреть не на каких-то левых сайтах, а на MSDN.
Там даже пример был.
Lasciate ogni speranza, voi ch'entrate.

EducatedFool
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 10
Зарегистрирован: 21.02.2009 (Сб) 10:30
Откуда: Россия, Урал

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение EducatedFool » 22.10.2013 (Вт) 4:11

Сколько не лазил по MSDN, - все примеры только для .Net, типа такого:

Код: Выделить всё
Bitmap b = new Bitmap(destWidth, destHeight);

Graphics g = Graphics.FromImage((Image)b);
g.InterpolationMode = InterpolationMode.HighQualityBicubic;

g.DrawImage(imgToResize, 0, 0, destWidth, destHeight);
g.Dispose();

return (Image)b;

Тут все просто и понятно, - вот только сделать по аналогии в VB6 у меня не получается
(как в VB6 создать объект Graphics из Bitmap, иначе как в моей функции (через HDC)? Я не нашел такой функции в MSDN...)

Вы говорите, что проблема в SelectObject, - а как обойтись без вызова этой функции?
Какие ресурсы я забываю освободить?

Ещё вопрос: то, что я тысячи раз запускаю GDI+, не замедляет процесс, и не тратит ресурсы?
Как вообще оптимизировать этот код?

Часть лишнего из кода выкинул, - но, всё равно, на тысячах картинок заканчиваются ресурсы:

Код: Выделить всё
Function ResizeImage(ByVal FileName As String, ByVal newFilename As String, ByVal NewWidth&, ByVal NewHeight&) As Boolean
   
    Dim tJpgEncoder As GUID, tParams As EncoderParameters, uGdiInput As GdiplusStartupInput
    Dim hGdiImage As Long, hBitmap1 As Long, hBitmap2 As Long, hBitmap3 As Long, quality As Long, hGdiPlus As Long, lRes As Long
    Dim lGDIP As Long, hDC As Long, hBrush As Long, Graphics As Long, hResizedBitmap As Long

    uGdiInput.GdiplusVersion = 1: quality = 80

    If GdiplusStartup(hGdiPlus, uGdiInput) = Status_OK Then        'Запускаем GDI+

        If GdipCreateBitmapFromFile(StrPtr(FileName), hGdiImage) = Status_OK Then        'Создаём изображение в памяти
           
            ' Create a memory DC and select a bitmap into it
            hDC = CreateCompatibleDC(ByVal 0&)

            hBitmap1 = CreateBitmap(NewWidth&, NewHeight&, GetDeviceCaps(hDC, PLANES), GetDeviceCaps(hDC, BITSPIXEL), ByVal 0&)
            If hBitmap1 = 0 Then
                Debug.Print "LastDllError=" & Err.LastDllError ' ошибка 8 (нехватка ресурсов)
                Stop
            End If
           
            hBitmap2 = SelectObject(hDC, hBitmap1)

            ' Resize the picture
            GdipCreateFromHDC hDC, Graphics
            GdipSetInterpolationMode Graphics, InterpolationModeHighQualityBicubic

            lRes = GdipDrawImageRectI(Graphics, hGdiImage, 0, 0, NewWidth&, NewHeight&)
            GdipDeleteGraphics Graphics
            GdipDisposeImage hGdiImage

            ' Get the bitmap back
            hBitmap3 = SelectObject(hDC, hBitmap2)
            DeleteDC hDC

            If GdipCreateBitmapFromHBITMAP(hBitmap3, 0, hResizedBitmap) = 0 Then

                CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder        ' Initialize the encoder GUID
                tParams.Count = 1        ' Initialize the encoder parameters
                With tParams.Parameter        ' Quality
                    CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID        ' Set the Quality GUID
                    .NumberOfValues = 1: .Type = 4: .Value = VarPtr(quality)
                End With

                lRes = GdipSaveImageToFile(hResizedBitmap, StrPtr(newFilename), tJpgEncoder, tParams)        ' Save the image
                If lRes = 0 Then ResizeImage = True Else Debug.Print "Ошибка сохранения уменьшенного файла: " & lRes
                GdipDisposeImage hResizedBitmap        ' Destroy the bitmap
            Else
                Debug.Print "Ошибка преобразования размеров файла"
            End If
            GdipDisposeImage hBitmap2        ' не знаю, нужна ли эта строка...
        End If
        GdiplusShutdown hGdiPlus
    Else
        Debug.Print "Ошибка при загрузке GDI+!"
    End If
End Function

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 22.10.2013 (Вт) 11:52

EducatedFool писал(а):Сколько не лазил по MSDN, - все примеры только для .Net

Потому что из MSDN вычистили информацию по VB6 и даже VBA не особо видно.
Тоже вот недавно искал информацию по тому как сделать кое-что с формой - только описания раньше вы могли сделать то-то, а теперь на VB.NET это делается вот так... Да я и сам знаю, что мог, и сам знаю как это на VB.NET, а вот как именно оно делалось на VB6 - не помню и в MSDN это тоже не написано :(


EducatedFool писал(а):Часть лишнего из кода выкинул, - но, всё равно, на тысячах картинок заканчиваются ресурсы:

Чтобы ресурсы не заканчивались, их надо освобождать...

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re:

Сообщение alibek » 22.10.2013 (Вт) 12:05

Qwertiy писал(а):Потому что из MSDN вычистили информацию по VB6 и даже VBA не особо видно.

Фантазировать не нужно.
MSDN CreateBitmap
Lasciate ogni speranza, voi ch'entrate.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 22.10.2013 (Вт) 17:32

alibek писал(а):Фантазировать не нужно.

Эм.. С каких пор CPP == VB6?

Viper
Артефакт VBStreets
Артефакт VBStreets
Аватара пользователя
 
Сообщения: 4394
Зарегистрирован: 12.04.2005 (Вт) 17:50
Откуда: Н.Новгород

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение Viper » 22.10.2013 (Вт) 19:52

Qwertiy писал(а):
alibek писал(а):Фантазировать не нужно.
Эм.. С каких пор CPP == VB6?
А разве есть какая-то принципиальная разница по использованию API-функции в VB и в С++?
Весь мир матрица, а мы в нем потоки байтов!

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение iGrok » 22.10.2013 (Вт) 21:28

Я, признаться, вообще не помню, чтобы там когда-то были примеры использования API на vb6. Вроде бы всегда был только cpp.
label:
cli
jmp label

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение iGrok » 22.10.2013 (Вт) 21:42

EducatedFool писал(а):Вы говорите, что проблема в SelectObject, - а как обойтись без вызова этой функции?
Какие ресурсы я забываю освободить?

Не в SelectObject, а в её использовании. В последнем варианте уже лучше.

На вскидку, не вижу освобождения hBitmap1 (он же hBitmap3, но эта переменная вообще не нужна, можно сделать обратно hBitmap1 = SelectObject(hDC, hBitmap2), и дальше использовать hBitmap1, впрочем, вреда от такого использования, как у тебя, быть не должно).

hBitmap2 не нужно удалять.

Возможно ещё что-то есть, подробно не смотрел. Вообще, общее правило, если что-то создаёшь, это что-то потом нужно удалить.
SelectObject "переключает" используемые контекстом (DC) объекты. Возвращает хэндл заменённого объекта. Аналогично, нужно вернуть его обратно в DC по завершению операции.

Посмотреть, что творится с объектами во время работы, можно по "Диспетчеру задач". На вкладке "процессы" можно включить столбцы "Объекты USER" и "Объекты GDI". Если количество растёт - ищи, что ты создаёшь и не удаляешь.
label:
cli
jmp label

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 22.10.2013 (Вт) 21:53

Viper писал(а):А разве есть какая-то принципиальная разница по использованию API-функции в VB и в С++?

Я сказал, что из MSDN вычистили информацию по VB6. Я ничего не говорил про WinApi. Так почему же ответ "Фантазировать не нужно"?

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение iGrok » 23.10.2013 (Ср) 1:25

Qwertiy писал(а):вычистили информацию по VB6

А она там точно была? Я ни разу не видел.
label:
cli
jmp label

Viper
Артефакт VBStreets
Артефакт VBStreets
Аватара пользователя
 
Сообщения: 4394
Зарегистрирован: 12.04.2005 (Вт) 17:50
Откуда: Н.Новгород

Re: Ресайз картинок средствами GDI+ в VB6

Сообщение Viper » 23.10.2013 (Ср) 4:47

iGrok писал(а):А она там точно была? Я ни разу не видел.
Не было никогда, все примеры использования на С++.
З.Ы. Синтаксис VB6 был в MSDN не позднее 98 года.
Весь мир матрица, а мы в нем потоки байтов!

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re:

Сообщение alibek » 23.10.2013 (Ср) 7:19

Qwertiy писал(а):Так почему же ответ "Фантазировать не нужно"?

Потому.
Lasciate ogni speranza, voi ch'entrate.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 23.10.2013 (Ср) 8:56

alibek писал(а):Потому.

Хм.. Похоже описание языка действительно имеется...


Вернуться в Windows-программирование

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0

    TopList