cpngparser.cls

很棒的网页音乐播放器,可以嵌入网页。界面很漂亮

        
    Next

    ' clean up & return result
    CopyMemory ByVal VarPtrArray(destBytes), 0&, 4
    ConvertPNGtoBMP_16Bit = True

    Exit Function

err_h:  ' should never get here
Err.Clear
If tSA.cDims Then CopyMemory ByVal VarPtrArray(destBytes), 0&, 4

End Function

Private Sub GetPaletteValue(ByVal PixelPos As Long, ByVal PixelValue As Byte, _
                Optional ByRef RtnIndex As Byte)

    ' // LaVolpe, Dec 1 thru 10 - added from scratch
    ' Returns a palette index and palette color from a compressed byte
    RtnIndex = (PixelValue \ pow2x8(PixelPos)) And (pow2x8(m_BitDepth) - 1)
    
End Sub

Private Function GetBytesPerPixel(totalWidth As Long, btsPerPixel As Byte) As Long
    ' // LaVolpe, Dec 1 thru 10
    ' returns number of bytes required to display n pixels at p color depth (byte aligned)
    GetBytesPerPixel = (totalWidth * btsPerPixel + 7) \ 8

End Function

Private Sub GetDepthInfo(destBitPP As Byte, destBytePP As Byte, _
                        rawBitsPP As Byte, rawBytesPP As Byte)
    
' returns the bits per pixel & bytes per pixel for the destination bitmap
' and also the respective values for the png image
    
' PNG > DIB bmp (per pixel) conversion chart I use throughout the routines:
'Color Type     bit depth   PNG bits/bytes per pixel  BMP bits/bytes pp (ignore alpha)
'----------     ---------   ------------------------- --------------------------------
'0 gray scale   1                   1   1                   1   1   (?  ?)
'               2                   2   1                   4   1   (?  ?)
'               4                   4   1                   4   1   (?  ?)
'               8                   8   1                   8   1   (8  1)
'               16                  16  2                   8   1   (8  1)

'2 true color   8                   24  3                   24  3   (24 3)
'               16                  48  6                   24  3   (24 3)

'3 palette      1                   1   1                   1   1   (?  ?)
'               2                   2   1                   4   1   (?  ?)
'               4                   4   1                   4   1   (?  ?)
'               8                   8   1                   8   1   (8  1)

'4 gray+alpha   8                   16  2                   32  4   (24 3)
'               16                  32  4                   32  4   (24 3)

'6 true+alpha   8                   32  4                   32  4   (24 3)
'               16                  64  8                   32  4   (24 3)

'any bit depth that uses simple transparency (trns chunk)   32  4   (n/a)
'--------------------------------------------------------------------------

    
    Select Case m_ColorType
    
    Case clrTrueAlpha ' true color w/alpha (only 8,16 bpp pngs)
        rawBytesPP = 4 * (m_BitDepth \ 8): rawBitsPP = m_BitDepth * 4
        
    Case clrGrayAlpha: ' grayscale w/alpha (only 8,16 bpp pngs)
        rawBytesPP = 2 * (m_BitDepth \ 8): rawBitsPP = m_BitDepth * 2
        
    Case clrTrueColor: ' true color (rgb triples) (8,16 bpp pngs)
        rawBytesPP = 3 * (m_BitDepth \ 8): rawBitsPP = m_BitDepth * 3
        
    Case clrGrayScale ' grayscale images (all bit depths)
        If m_BitDepth = 2 Then ' special case as MS bitmaps don't do 2bpp
            rawBytesPP = 1: rawBitsPP = 2
        ElseIf m_BitDepth > 4 Then ' (8,16 bpp pngs)
            rawBytesPP = m_BitDepth \ 8: rawBitsPP = m_BitDepth
        Else ' (1,4 bpp pngs)
            rawBytesPP = 1: rawBitsPP = m_BitDepth
        End If
        
    Case clrPalette: ' palette entries (1,2,4,8 bpp pngs)
        rawBytesPP = 1: rawBitsPP = m_BitDepth
        
    End Select
    
    ' our DIB will always be 32bpp
    destBitPP = 32: destBytePP = 4

End Sub

Private Function PaethPredictor(ByVal Left As Integer, ByVal Above As Integer, ByVal UpperLeft As Integer) As Integer

    ' // LaVolpe, Dec 1 thru 10 - rewrote for understanding & commented/linked
    
    ' http://www.w3.org/TR/PNG/#9-table91
    ' algorithm is used for both encoding & decoding the png image's filter
    ' based off of the formula created by Alan W. Paeth & provided fully in url above

    Dim pa As Integer, pb As Integer, pC As Integer, p As Integer
    p = (0 + Left + Above - UpperLeft)
    pa = Abs(p - Left)
    pb = Abs(p - Above)
    pC = Abs(p - UpperLeft)
    
    ' tie breaker
    ' The order in which the comparisons are performed is critical and shall not be altered
    If (pa <= pb) And (pa <= pC) Then
        PaethPredictor = Left
    ElseIf pb <= pC Then
        PaethPredictor = Above
    Else
        PaethPredictor = UpperLeft
    End If

End Function

Private Sub DecodeFilter_Avg(Filtered() As Byte, ByVal RowNr As Long, ByVal ScanLine As Long, ByVal stepVal As Integer)

    ' // LaVolpe, Dec 1 thru 10 - rewrote for understanding; nothing wrong with original
    'http://www.w3.org/TR/PNG/#9-table91
    'Filters may use the original values of the following bytes to generate the new byte value:
    '
    'x  the byte being filtered;
    'a  the byte corresponding to x in the pixel immediately before the pixel containing x (or the byte immediately before x, when the bit depth is less than 8);
    'b  the byte corresponding to x in the previous scanline;
    'c  the byte corresponding to b in the pixel immediately before the pixel containing b (or the byte immediately before b, when the bit depth is less than 8).
    
    ' algorithm: Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)
    ' Unsigned arithmetic modulo 256 is used, so that both the inputs and outputs fit into bytes

    Dim X As Long, startByte As Long
    
    startByte = RowNr * ScanLine + 1
    
    On Error GoTo eh
    ' break out for faster loops, removing IF statements/combinations
    If RowNr = 0 Then   ' 1st row; there will be no Top row to get data from
        ' if png is encoded properly, shouldn't get here
        ' now process the 2nd pixel on, to finish the scanline
        For X = startByte + stepVal To startByte + ScanLine - 2
            Filtered(X) = (0 + Filtered(X) + (Filtered(X - stepVal) \ 2)) Mod 256
        Next
        
    Else    ' 2nd or subsequent rows
        ' process the 1st n bytes (1st pixel only)
        For X = startByte To startByte + stepVal - 1
            Filtered(X) = (0 + Filtered(X) + (Filtered(X - ScanLine) \ 2)) Mod 256
        Next
        ' now process the 2nd pixel on, to finish the scanline
        For X = X To startByte + ScanLine - 2
            Filtered(X) = (0 + Filtered(X) + (0 + Filtered(X - stepVal) + Filtered(X - ScanLine)) \ 2) Mod 256
        Next
    End If
eh:
End Sub

Private Sub DecodeFilter_Paeth(Filtered() As Byte, ByVal RowNr As Long, ByVal ScanLine As Long, ByVal stepVal As Integer)

    ' // LaVolpe, Dec 1 thru 10 - rewrote for understanding; nothing wrong with original
    'http://www.w3.org/TR/PNG/#9-table91
    
    'Filters may use the original values of the following bytes to generate the new byte value:
    '
    'x  the byte being filtered;
    'a  the byte corresponding to x in the pixel immediately before the pixel containing x (or the byte immediately before x, when the bit depth is less than 8);
    'b  the byte corresponding to x in the previous scanline;
    'c  the byte corresponding to b in the pixel immediately before the pixel containing b (or the byte immediately before b, when the bit depth is less than 8).
    
    ' algorithm: Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))
    ' Unsigned arithmetic modulo 256 is used, so that both the inputs and outputs fit into bytes

    Dim X As Long, startByte As Long

    startByte = RowNr * ScanLine + 1
    
    ' break out for faster loops, removing IF statements/combinations
    On Error GoTo eh
    
    If RowNr = 0 Then    ' 1st row; there will be no Top row to get data from
        ' if png is encoded properly, shouldn't get here
        ' now process the 2nd pixel on, to finish the scanline
        For X = startByte + stepVal To startByte + ScanLine - 2
            Filtered(X) = (0 + Filtered(X) + Filtered(X - stepVal)) Mod 256
        Next
    
    Else    ' 2nd or subsequent rows
        ' process the 1st n bytes (1st pixel only)
        For X = startByte To startByte + stepVal - 1
            Filtered(X) = (0 + Filtered(X) + Filtered(X - ScanLine)) Mod 256
        Next
        ' now process the 2nd pixel on, to finish the scanline
        For X = X To startByte + ScanLine - 2
            Filtered(X) = (0 + Filtered(X) + PaethPredictor(Filtered(X - stepVal), Filtered(X - ScanLine), Filtered(X - ScanLine - stepVal))) Mod 256
        Next

    End If
eh:
End Sub

Private Sub DecodeFilter_Sub(Filtered() As Byte, ByVal RowNr As Long, ByVal ScanLine As Long, ByVal stepVal As Integer)

    ' // LaVolpe, Dec 1 thru 10 - rewrote for understanding; nothing wrong with original
    'http://www.w3.org/TR/PNG/#9-table91
    
    'Filters may use the original values of the following bytes to generate the new byte value:
    '
    'x  the byte being filtered;
    'a  the byte corresponding to x in the pixel immediately before the pixel containing x (or the byte immediately before x, when the bit depth is less than 8);
    'b  the byte corresponding to x in the previous scanline;
    'c  the byte corresponding to b in the pixel immediately before the pixel containing b (or the byte immediately before b, when the bit depth is less than 8).
    
    ' algorithm: Recon(x) = Filt(x) + Recon(a)
    ' Unsigned arithmetic modulo 256 is used, so that both the inputs and outputs fit into bytes

    Dim startByte As Long
    Dim n As Long, X As Long
    
    startByte = RowNr * ScanLine + 1
    
    On Error GoTo eh
    ' 1st n bytes for 1st pixel are unfiltered
    For n = startByte + stepVal To startByte + ScanLine - 2 Step stepVal
        For X = n To n + stepVal - 1
            Filtered(X) = (0 + Filtered(X) + Filtered(X - stepVal)) Mod 256
        Next
    Next
eh:
End Sub

Private Sub DecodeFilter_Up(Filtered() As Byte, ByVal RowNr As Long, ByVal ScanLine As Long, ByVal stepVal As Integer)

    ' // LaVolpe, Dec 1 thru 10 - rewrote for understanding; nothing wrong with original
    'http://www.w3.org/TR/PNG/#9-table91
    
    'Filters may use the original values of the following bytes to generate the new byte value:
    '
    'x  the byte being filtered;
    'a  the byte corresponding to x in the pixel immediately before the pixel containing x (or the byte immediately before x, when the bit depth is less than 8);
    'b  the byte corresponding to x in the previous scanline;
    'c  the byte corresponding to b in the pixel immediately before the pixel containing b (or the byte immediately before b, when the bit depth is less than 8).
    
    ' algorithm:  Recon(x) = Filt(x) + Recon(b)
    ' Unsigned arithmetic modulo 256 is used, so that both the inputs and outputs fit into bytes
    
    Dim startByte As Long, X As Long
    
    On Error GoTo eh
    If Not RowNr = 0 Then    ' 1st row; there will be no Top row to get data from
        startByte = RowNr * ScanLine + 1
        For X = startByte To startByte + ScanLine - 2
            Filtered(X) = (0 + Filtered(X) + Filtered(X - ScanLine)) Mod 256
        Next
    End If
eh:
End Sub

Private Function UnfilterInterlaced(Filtered() As Byte) As Boolean

    ' // LaVolpe, Dec 1 thru 10 - built from scratch
    ' http://www.libpng.org/pub/png/spec/1.2/PNG-DataRep.html#DR.Interlaced-data-order
    
    ' Progressive display/scan order per 8 pixel blocks (64 total pixels)
    '   1 6 4 6 2 6 4 6     ' 1st scan: 1 pixel (@col 0), row 0 [1/64 of total image]
    '   7 7 7 7 7 7 7 7     ' 2nd scan: 1 pixel (@col 4), row 0 [1/32 of image shown]
    '   5 6 5 6 5 6 5 6     ' 3rd scan: 2 pixels (@cols 0:4), row 4 [1/16 of image]
    '   7 7 7 7 7 7 7 7     ' 4th scan: 4 pixels (@cols 2:6), rows 0:4 [1/8]
    '   3 6 4 6 3 6 4 6     ' 5th scan: 8 pixels (@cols 0:2:4:6), rows 2:6 [1/4]
    '   7 7 7 7 7 7 7 7     ' 6th scan: 16 pixels (@cols 1:3:5:7), rows 0:2:4:6 [1/2]
    '   5 6 5 6 5 6 5 6     ' 7th scan: 32 pixels (@cols all), rows 1:3:5:7 [100%]
    '   7 7 7 7 7 7 7 7                 64 pixels, 15 scanlines over 7 passes
    
    ' Note : all logic in this routine is based off of the above grid.
    ' Scanline widths are only guaranteed to be same for each scanline in the same pass.
    ' Scanlines can be padded both horizontally & vertically if the image doesn't fit into
    '   a nice 8x8 grid evenly.
    ' Each scanline in interlaced image is also filtered, but they are filtered in relation
    ' to only the other scanlines in the same pass, different than non-interlaced images.
    ' Think of non-interlaced images as single-pass interlaced images.

    ' counter variables
    Dim Pass As Byte, srcRow As Long
    ' sizing/bit alignment variables
    Dim nr8wide As Long, nr8high As Long
    Dim nrBytes As Long, passPtr As Long
    Dim InterlacePass() As Byte  ' unfiltered progressive display (used 7x for 7 passes)
    ' bytes and bits per pixel values
    Dim bytesPP As Byte, BPRow As Long, bitPP As Byte
    
    ' need bit & byte information
    GetDepthInfo 0, 0, bitPP, bytesPP
    
    ' oversize array for "pass" bytes to prevent reszing array on each pass
    BPRow = GetBytesPerPixel((m_Width \ MatrixColAdd(7)), bitPP)
    ' how many bytes are needed for the final pass; largest pass size in bytes