Сохранение картинки в байтовый массив в формате jpeg

Обсуждение проектов наших жителей.
Вы можете выставить проект на тест или найти помощников для его реализации.

Модератор: BV

The trick
Постоялец
Постоялец
 
Сообщения: 494
Зарегистрирован: 26.06.2010 (Сб) 23:08

Сохранение картинки в байтовый массив в формате jpeg

Сообщение The trick » 11.03.2014 (Вт) 11:34

Может пригодится например для передачи или упаковки.
Также можно сделать и сохранение в другие форматы аналогично и открытие рисунка также из памяти.
Код: Выделить всё
Option Explicit
   
Private Type GUID
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
     GdiplusVersion As Long
     DebugEventCallback As Long
     SuppressBackgroundThread As Long
     SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
     GUID As GUID
     NumberOfValues As Long
     type As Long
     value As Long
End Type
Private Type EncoderParameters
     Count As Long
     Parameter As EncoderParameter
End Type
   
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
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 CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
   
Private Const JpgCLSID As String = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"         ' Строковое представление CLSID jpeg энкодера
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"   ' Строковое представление GUID качества сохранения
Private Const EncoderParameterValueTypeLong As Long = 4                             ' Тип значений для энкодера 32 битный без знака
   
Private Sub Form_Load()
     Dim dDc As Long                                         ' Контекст устройства рабочего стола
     Dim dhWnd As Long                                       ' Хендл окна рабочего стола
     Dim tBmp As Long                                        ' Bitmap, в который копируем данные
     Dim IStream As IUnknown                                 ' Объект потока
     Dim hMem As Long                                        ' Хендл объекта памяти
     Dim lSize As Long                                       ' Размер памяти, предоставляемый объектом памяти
     Dim lPt As Long                                         ' Адрес памяти
     Dim Dat() As Byte                                       ' Данные рисунка, после кодирования (фактически бинарный JPG)
     Dim fNum As Integer                                     ' Файловый номер
     Dim tDc As Long                                         ' Временный контекст устройства
     Dim oBmp As Long                                        ' Старая картинка, выбраная во временный контекст
         
     dhWnd = GetDesktopWindow()                              ' Получаем хендл окна рабочего стола
     dDc = GetDC(dhWnd)                                      ' Получаем контекст устройства рабочего стола
     tDc = CreateCompatibleDC(dDc)                           ' Создаем совместимый с ним контекст
     tBmp = CreateCompatibleBitmap(dDc, Screen.Width / _
            Screen.TwipsPerPixelX, Screen.Height / _
            Screen.TwipsPerPixelY)                           ' Создаем картинку по размеру экрана
     oBmp = SelectObject(tDc, tBmp)                          ' Выбираем картинку во временный контекст
     BitBlt tDc, 0, 0, Screen.Width / _
            Screen.TwipsPerPixelX, Screen.Height / _
            Screen.TwipsPerPixelY, dDc, 0, 0, vbSrcCopy      ' Отрисовываем все с рабочего стола во временную картинку
     SelectObject tDc, oBmp                                  ' Очистка ресурсов ...
     DeleteDC tDc
     ReleaseDC dhWnd, dDc
       
     If CreateStreamOnHGlobal(0&, 1&, IStream) Then _
            MsgBox "Ошибка создание потока": _
            DeleteObject (tBmp): Exit Sub                    ' Создаем объект потока
     If Not SaveJPG(tBmp, IStream) Then _
            MsgBox "Ошибка сохранение файла в поток": _
            DeleteObject (tBmp): Exit Sub                    ' Сохраняем картинку
     
     DeleteObject tBmp                                       ' Очистка ресурсов
     
     If GetHGlobalFromStream(ObjPtr(IStream), hMem) Then _
            MsgBox "Ошибка получения хендла памяти": _
            Exit Sub                                         ' Получаем хендл объекта памяти потока
     lSize = GlobalSize(hMem)                                ' Получаем размер объекта памяти
     If lSize Then                                           ' Если размер действительный...
         lPt = GlobalLock(hMem)                              ' Блокируем и получаем указатель на него
         ReDim Dat(0 To lSize - 1)                           ' Выделяем буфер, куда сохраняться данные
         CopyMemory Dat(0), ByVal lPt, lSize                 ' Копируем данные из объекта памяти потока в буфер
         GlobalUnlock hMem                                   ' Разблокируем объект памяти
     End If
     
     ' Для проверки, сохраним данные в файл
     fNum = FreeFile
     Open "D:\Temp.jpg" For Binary As fNum
     Put fNum, , Dat
     Close fNum
     
End Sub
' Процедура сохранения картинки в jpeg формате в поток
Private Function SaveJPG(hBitmap As Long, Stream As IUnknown, Optional Quality As Byte = 50) As Boolean
     Dim SI As GdiplusStartupInput                           ' Для инициализации GDI+
     Dim token As Long                                       ' Маркер GDI +
     Dim lBmp As Long                                        ' Картинка GDI+
     Dim JpgEnc As GUID                                      ' CLSID jpeg энкодера
     Dim Res As Long                                         ' Результат операции сохранения в поток
     Dim Par As EncoderParameters                            ' Параметры jpeg энкодера
     
     SI.GdiplusVersion = 1                                   ' Параметры запуска
     If GdiplusStartup(token, SI) Then Exit Function         ' Запускаем GDI+
     If GdipCreateBitmapFromHBITMAP(hBitmap, 0, lBmp) Then _
             GdiplusShutdown (token): Exit Function          ' Создаем GDI+ картинку из хендла картинки GDI
     CLSIDFromString StrPtr(JpgCLSID), JpgEnc                ' Получаем структуру CLSID для jpeg энкодера
     ' Задаем количество параметров для энкодера
     Par.Count = 1                                           ' Количество - 1 (качество картинки)
     Par.Parameter.NumberOfValues = 1                        ' Количество значений в параметре 1
     Par.Parameter.type = EncoderParameterValueTypeLong      ' Значение параметра 32 битное без знака
     Par.Parameter.value = VarPtr(CLng(Quality))             ' Указатель на значение качества сохранения
     CLSIDFromString StrPtr("EncoderQuality"), _
             Par.Parameter.GUID                              ' Получаем GUID качества сохранения
     Res = GdipSaveImageToStream(lBmp, Stream, JpgEnc, Par)  ' Сохраняем в поток
     GdipDisposeImage lBmp                                   ' Очистка ресурсов ...
     GdiplusShutdown token                                   ' Выключаем GDI+
     If Res Then Exit Function                               ' Если неудачно сохранили, то выходим
     SaveJPG = True                                          ' Успешное выполнение
End Function
UA6527P

Вернуться в Наши проекты

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

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

    TopList