高分求助：求一BMP图像的压缩算法 等待中...

Question

求一Bmp图像的压缩算法，最好能给出源代码，谢谢啦。

Answer 1

我有BMP壓縮成JPG的源碼。
MSN：[email protected]

Answer 2

好的，能给我一份吗，谢谢啦。
[email protected]

Answer 3

曾經在之前討論遠程屏幕傳送時小吉貼出過一段快速度的壓縮算法,下面我就貼出來.
另外還有JPEG的壓縮代碼相對比較長看能否貼得上來,而我群里還有一個使用Zlib進行文件壓縮的動態庫,可能樓主不適用^_^-------------------
'模块中
Option ExplicitPublic Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Public Function Compress(abytInArray() As Byte, Optional lngCompressLevel As Long = 16) As Byte()
    'lngCompressLevel是压缩级别，建议在0-255之间，数字越大，压缩包越小，耗时越大。默认值为16，比较平衡。
    Dim intMaxLen As Integer, intCount As Integer, intBufferLocation As Integer
    Dim intNext As Integer, intPrev As Integer, intBitCount As Integer
    Dim intMatchPos As Integer, intMatchLen As Integer
    Dim aintWindowNext(&H2001) As Integer, aintWindowPrev(&H1001) As Integer
    Dim abytOutArray() As Byte, abytWindow(&H1012) As Byte
    Dim lngByteCodeWritten As Long, lngBytesRead As Long
    Dim lngTemp As Long, lngOutPos As Long, lngArrayUBound As Long
    On Error GoTo PROC_ERR
    For intCount = 0 To &H1000
        aintWindowPrev(intCount) = &H1000
        abytWindow(intCount) = &H20
    Next
    CopyMemory aintWindowNext(0), aintWindowPrev(0), &H2002
    CopyMemory aintWindowNext(&H1001), aintWindowPrev(0), &H2000
    CopyMemory abytWindow(&H1001), abytWindow(0), 17
    lngArrayUBound = UBound(abytInArray)
    ReDim abytOutArray(lngArrayUBound)
    CopyMemory abytOutArray(0), lngArrayUBound, 4
    intMaxLen = 18
    lngBytesRead = 18
    intBitCount = 1
    lngOutPos = 4
    lngByteCodeWritten = lngOutPos + 1
    CopyMemory abytWindow(0), abytInArray(0), 18
    CopyMemory abytWindow(&H1000), abytInArray(0), 18
    Do While intMaxLen
        intMatchPos = 0
        intMatchLen = 0
        intPrev = aintWindowNext(((&H100& * abytWindow(intBufferLocation + 1) + abytWindow(intBufferLocation)) And &HFFF) + &H1001)
        intCount = 0
        Do Until intCount > lngCompressLevel Or intPrev = &H1000
            intNext = 0
            Do While (abytWindow(intPrev + intNext) = abytWindow(intBufferLocation + intNext)) And intNext < 18
                intNext = intNext + 1
            Loop
            If intNext > intMatchLen Then
                intMatchLen = intNext
                intMatchPos = intPrev
                If intNext = 18 Then
                    aintWindowNext(aintWindowPrev(intPrev)) = aintWindowNext(intPrev)
                    aintWindowPrev(aintWindowNext(intPrev)) = aintWindowPrev(intPrev)
                    aintWindowNext(intPrev) = &H1000
                    aintWindowPrev(intPrev) = &H1000
                    Exit Do
                End If
            End If
            intPrev = aintWindowNext(intPrev)
            intCount = intCount + 1
        Loop
        If intBitCount And &H100 Then
            lngOutPos = lngByteCodeWritten
            lngByteCodeWritten = lngOutPos + 1
            intBitCount = 1
            abytOutArray(lngOutPos) = 0
        End If
        If intMatchLen < 3 Then
            intMatchLen = 1
            abytOutArray(lngByteCodeWritten) = abytWindow(intBufferLocation)
            abytOutArray(lngOutPos) = abytOutArray(lngOutPos) Or intBitCount
        End If
        If intMatchLen > 1 Then
            If intMatchLen > intMaxLen Then intMatchLen = intMaxLen
            abytOutArray(lngByteCodeWritten) = intMatchPos And &HFF
            lngByteCodeWritten = lngByteCodeWritten + 1
            abytOutArray(lngByteCodeWritten) = (((intMatchPos \ 16) And &HF0) Or intMatchLen - 3) And &HFF
        End If
        lngByteCodeWritten = lngByteCodeWritten + 1
        intBitCount = intBitCount * 2
        Do While intMatchLen
            intPrev = intBufferLocation + 18
            intNext = intPrev And &HFFF
            If aintWindowPrev(intNext) <> &H1000 Then
                aintWindowNext(aintWindowPrev(intNext)) = aintWindowNext(intNext)
                aintWindowPrev(aintWindowNext(intNext)) = aintWindowPrev(intNext)
                aintWindowNext(intNext) = &H1000
                aintWindowPrev(intNext) = &H1000
            End If
            If lngBytesRead < lngArrayUBound Then
                abytWindow(intNext) = abytInArray(lngBytesRead)
                If intPrev >= &H1000 Then abytWindow(intPrev) = abytInArray(lngBytesRead)
                lngBytesRead = lngBytesRead + 1
            End If
            intPrev = ((&H100& * abytWindow(intBufferLocation + 1) + abytWindow(intBufferLocation)) And &HFFF) + &H1001
            intNext = aintWindowNext(intPrev)
            aintWindowPrev(intBufferLocation) = intPrev
            aintWindowNext(intBufferLocation) = intNext
            aintWindowNext(intPrev) = intBufferLocation
            If intNext <> &H1000 Then aintWindowPrev(intNext) = intBufferLocation
            intBufferLocation = (intBufferLocation + 1) And &HFFF
            intMatchLen = intMatchLen - 1
        Loop
        If lngBytesRead >= lngArrayUBound Then
        intMaxLen = intMaxLen - 1
        End If
    Loop
    ReDim Preserve abytOutArray(lngByteCodeWritten - 1)
    Compress = abytOutArray
    Exit Function
PROC_ERR:
Compress = abytInArray
End Function
Public Function Decompress(abytInArray() As Byte) As Byte()
    Dim intTemp As Integer, intBufferLocation As Integer, intLength As Integer
    Dim bytHiByte As Byte, bytLoByte As Byte, intWindowPosition As Integer
    Dim lngFlags As Long, lngOriginalUBound As Long
    Dim lngInPos As Long, lngOutPos As Long
    Dim abytWindow(&H1012) As Byte, abytOutArray() As Byte
    'On Error GoTo PROC_ERR
    CopyMemory lngOriginalUBound, abytInArray(0), 4
    lngInPos = 4
    ReDim abytOutArray(lngOriginalUBound)
    Do While lngOutPos < lngOriginalUBound
        lngFlags = lngFlags \ 2
        If (lngFlags And &H100) = 0 Then
            lngFlags = &HFF00& Or abytInArray(lngInPos)
            lngInPos = lngInPos + 1
        End If
        If (lngFlags And 1) Then
            abytWindow(intWindowPosition) = abytInArray(lngInPos)
            abytOutArray(lngOutPos) = abytInArray(lngInPos)
            lngInPos = lngInPos + 1
            lngOutPos = lngOutPos + 1
            intWindowPosition = (intWindowPosition + 1) And &HFFF
        Else
            bytHiByte = abytInArray(lngInPos)
            lngInPos = lngInPos + 1
            bytLoByte = abytInArray(lngInPos)
            intBufferLocation = ((bytLoByte And &HF0) * 16 + bytHiByte) And &HFFF
            intLength = (bytLoByte And &HF) + 3
            lngInPos = lngInPos + 1
            intTemp = intBufferLocation + intLength
            Do While intBufferLocation < intTemp
                abytOutArray(lngOutPos) = abytWindow((intBufferLocation) And &HFFF)
                abytWindow(intWindowPosition) = abytOutArray(lngOutPos)
                intBufferLocation = intBufferLocation + 1
                intWindowPosition = (intWindowPosition + 1) And &HFFF
                lngOutPos = lngOutPos + 1
                If lngOutPos > lngOriginalUBound Then Exit Do
            Loop
        End If
    Loop
    Decompress = abytOutArray
    Exit Function
PROC_ERR:
    Decompress = abytInArray
End Function

Answer 4

JPEG的實在太長了,貼也要好多貼^_^

Answer 5

回复人：unsigned(僵哥（VB群:11141442,Cpp群:9478900,D群:21590636）) ( 五级(中级)) 信誉：100
------------------------------
以小弟的才学对上面的算法，了解很困难，老大能不能简单的介绍一下呢，谢谢啦。

Answer 6

给你一个变通方法：将 .bmp 文件加载到 PictureBox 或 Image 控件，然后用下面的 SaveJPG 函数保存为 .jpg 文件。Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End TypePrivate Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End TypePrivate Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End TypePrivate Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End TypePrivate Declare Function GdiplusStartup Lib "GDIPlus" ( _
   token As Long, _
   inputbuf As GdiplusStartupInput, _
   Optional ByVal outputbuf As Long = 0) As LongPrivate Declare Function GdiplusShutdown Lib "GDIPlus" ( _
   ByVal token As Long) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
   ByVal hbm As Long, _
   ByVal hpal As Long, _
   Bitmap As Long) As LongPrivate Declare Function GdipDisposeImage Lib "GDIPlus" ( _
   ByVal Image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
   ByVal Image As Long, _
   ByVal Filename As Long, _
   clsidEncoder As GUID, _
   encoderParams As Any) As LongPrivate Declare Function CLSIDFromString Lib "ole32" ( _
   ByVal str As Long, _
   id As GUID) As Long' ----==== SaveJPG ====----   Public Sub SaveJPG( _
   ByVal pict As StdPicture, _
   ByVal filename As String, _
   Optional ByVal quality As Byte = 80)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long   ' Initialize GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
   
   If lRes = 0 Then
   
      ' Create the GDI+ bitmap
      ' from the image handle
      lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
   
      If lRes = 0 Then
         Dim tJpgEncoder As GUID
         Dim tParams As EncoderParameters
         
         ' Initialize the encoder GUID
         CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                         tJpgEncoder
      
         ' Initialize the encoder parameters
         tParams.Count = 1
         With tParams.Parameter ' Quality
            ' Set the Quality GUID
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 4
            .Value = VarPtr(Quality)
         End With
         
         ' Save the image
         lRes = GdipSaveImageToFile( _
                  lBitmap, _
                  StrPtr(Filename), _
                  tJpgEncoder, _
                  tParams)
                             
         ' Destroy the bitmap
         GdipDisposeImage lBitmap
         
      End If
      
      ' Shutdown GDI+
      GdiplusShutdown lGDIP   End If
   
   If lRes Then
      Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
   End If
   
End Sub