Конвертация bmp в jpg на VB6

Тема в разделе "Visual Basic 6 / Сценарии VBScript, JScript", создана пользователем Сергей, 14 дек 2015.

  1. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    254
    Симпатии:
    120
    VB6 сохраняет изображения в формате bmp. А как можно сохранять или конвертировать в ipg ?
     
    Kиpилл нравится это.
  2. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.498
    Симпатии:
    4.312
    С помощью GDI+.
    Держи JPEG Encoder Class от John Korejwa.
     

    Вложения:

    • SaveToJPEG.rar
      Размер файла:
      69,4 КБ
      Просмотров:
      7
    Kиpилл и Сергей нравится это.
  3. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    254
    Симпатии:
    120
    Спасибо.
     
  4. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.498
    Симпатии:
    4.312
    Без сторонних DLL через GDI+ (на основе примера от The Trick "Сохранение скриншота в байтовый массив"):

    Код (vb.net):
    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 LoadImage Lib "user32" Alias "LoadImageW" (ByVal hinst As Long, ByVal lpszName As Long, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

    Private Const IMAGE_BITMAP = 0&
    Private Const LR_LOADFROMFILE = &H10&

    Private Sub Form_Load()
        ConvertBmpToJpeg "c:\temp\akel_calc.bmp", "c:\temp\akel_calc.jpg"
    End Sub

    Function ConvertBmpToJpeg(SourceFile As String, DestinationFile As String, Optional Quality As Byte) As Boolean
        Dim hBmp    As Long
        Dim IStream As IUnknown
        Dim hMem    As Long
        Dim lSize   As Long
        Dim lPt     As Long
        Dim Dat()   As Byte
        Dim fNum    As Integer
        Dim FileSrc As String
        Dim FileDst As String

        hBmp = LoadImage(0&, StrPtr(SourceFile), IMAGE_BITMAP, 0&, 0&, LR_LOADFROMFILE)
        If hBmp = 0 Then MsgBox "Ошибка загрузки файла: " & SourceFile: Exit Function

        If CreateStreamOnHGlobal(0&, 1&, IStream) Then MsgBox "Ошибка создание потока": Exit Function
        If Not SaveJPG(hBmp, IStream, Quality) Then MsgBox "Ошибка сохранение файла в поток": DeleteObject (hBmp): Exit Function
        DeleteObject hBmp

        If GetHGlobalFromStream(ObjPtr(IStream), hMem) Then MsgBox "Ошибка получения хендла памяти": Exit Function
        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 DestinationFile For Binary As fNum
        Put fNum, , Dat
        Close fNum
        ConvertBmpToJpeg = True
    End Function

    Private Function SaveJPG(hBitmap As Long, Stream As IUnknown, Optional Quality As Byte = 50) As Boolean
        Dim SI As GdiplusStartupInput
        Dim token As Long, lBmp As Long
        Dim JpgEnc As GUID, Res As Long
        Dim Par As EncoderParameters

        SI.GdiplusVersion = 1
        If GdiplusStartup(token, SI) Then Exit Function
        If GdipCreateBitmapFromHBITMAP(hBitmap, 0, lBmp) Then GdiplusShutdown (token): Exit Function
        CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), JpgEnc
        Par.Count = 1
        Par.Parameter.NumberOfValues = 1
        Par.Parameter.type = 4
        Par.Parameter.Value = VarPtr(Quality)
        CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), Par.Parameter.GUID
        Res = GdipSaveImageToStream(lBmp, Stream, JpgEnc, Par)
        GdipDisposeImage lBmp
        GdiplusShutdown token
        If Res Then Exit Function
        SaveJPG = True
    End Function
     
    Качество можно регулировать 3-м параметром функции ConvertBmpToJpeg.
     
    Последнее редактирование: 12 авг 2016
  5. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    254
    Симпатии:
    120
    Круто!!!
    (3-й параметр: 1 = наилучшее, 255 = наихудшее качество)
    Код (Text):
    ConvertBmpToJpeg "c:\temp\akel_calc.bmp", "c:\temp\akel_calc.jpg", 128
    - я правильно понял?
    --- Объединённое сообщение, 12 авг 2016 ---
    наоборот 255-0
     
  6. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.498
    Симпатии:
    4.312
    0 - 100.

    0 - самое высокое сжатие.
    100 - самое высокое качество.

    Encoder.Quality - поле (System.Drawing.Imaging)
     
  7. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    254
    Симпатии:
    120
    Я подумал, что если третий параметр - as byte, то - до 255
     

Поделиться этой страницей