cpngparser.cls

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

        ptrLoc = 9                  ' next position in the file
        Seek FileNumber, ptrLoc     ' move to that position
   End If
    
    ReDim IDATdata(0 To streamLength \ 2)   ' array to hold compressed data; start with arbritrary length
    bCRCchecks = zValidateZLIBversion()     ' verify we can use zLIB
    
    Do ' read & pre-process the png file
    
        ' Chunks consist of 4 bytes for the length of the chunk
        '                 + n bytes for the chunk
        '                 + 4 bytes for a CRC value
        If FileName = vbNullString Then
            CopyMemory gpLong, pngStream(ptrArray), &H4 ' length of the current chunk
        Else
            Get FileNumber, , gpLong ' number of bytes for the chunk
        End If
        ChunkLen = iparseReverseLong(gpLong) ' longs are big endian, need little endian for Windows
        
        ' track position of pointer in the file
        ptrLoc = ptrLoc + ChunkLen + 12 ' 12 = 4byte name + 4byte CRC + 4byte chunk count
        If ptrLoc > streamLength Then
            ' corrupted file; abort
            lError = 1
            Exit Do
        End If
        
        ' read chunk name & chunk data, read CRC separately
        If FileName = vbNullString Then
            If bCRCchecks = True Then CopyMemory crc32value, pngStream(ptrArray + ChunkLen + 8), &H4
        Else
            ReDim pngStream(0 To ChunkLen + 3)
            Get FileNumber, , pngStream
            Get FileNumber, , gpLong             ' read the CRC value (big endian)
            If bCRCchecks = True Then crc32value = gpLong
        End If
        CopyMemory ChunkName, pngStream(ptrArray + 4), &H4 ' extract the chunk name
        
        If ChunkLen < 1 Then
            ' should never be <0; however can be zero at anytime
            If ChunkName = chnk_IEND Then Exit Do
        Else
            
            ' each of the chunk parsing routines will be in a separate function.
            ' This is so that they can easily be modified without affecting any
            ' of the other code. Additionally, it is possible that chunk types will
            ' increase as PNG continues to evolve. Except IDAT, all chunks
            ' are in their own routines; even sRGB which is only a 1 byte chunk.
            Select Case ChunkName
            
            Case chnk_IDAT ' UCase chunk names are critical - CRC check
                ' compressed, filtered image data
                On Error Resume Next
                ' error? what error? all precautions taken in zChunk_IHDR function
                ' However; no predicting "Out of Memory" errors
                If Not crc32value = 0 Then
                    lError = Not (zCheckCRCvalue(VarPtr(pngStream(ptrArray + 4)), ChunkLen + 4, crc32value))
                End If
                If Not lError = 0 Then Exit Do
                
                gpLong = lenIDAT + ChunkLen ' size of array needed
                If gpLong > UBound(IDATdata) Then ' test length & increment if needed
                    ReDim Preserve IDATdata(0 To gpLong + streamLength \ 4)
                End If
                CopyMemory IDATdata(lenIDAT), pngStream(ptrArray + 8), ChunkLen ' & append the new data
                lenIDAT = gpLong  ' cache number of compressed bytes so far
                If Err Then
                    lError = 1
                    Exit Do
                End If
                On Error GoTo 0
            
            Case chnk_PLTE ' UCase chunk names are critical - CRC check
                lError = zChunk_PLTE(ChunkLen, ptrArray + 4, crc32value)
                If Not lError = 0 Then Exit Do
            
            Case chnk_tRNS ' simple transparency option
                ' CRC checked 'cause if invalid, we could generate an out of bounds
                ' error in one of the other routines that reference this array
                lError = zChunk_tRNS(ChunkLen, ptrArray + 4, crc32value)
                If Not lError = 0 Then Exit Do
                
            Case chnk_IHDR ' UCase chunk names are critical - CRC check
                ' Note: the zChunk_IHDR routine also calculates uncompressed size
                lError = zChunk_IHDR(ChunkLen, ptrArray + 4, uncmprssSize, crc32value)
                If Not lError = 0 Then Exit Do
                
            Case chnk_IEND ' UCase chunk names are critical - CRC check
                ' should CRC check for corrupted file; but why? we're at end of image
                Exit Do
                
            End Select
    
        End If
        If FileName = vbNullString Then ptrArray = ptrArray + ChunkLen + 12 ' move to next position in the array
    Loop

ExitRoutine:
    ' clean up
    If Not FileName = vbNullString Then
        Close #FileNumber
        Erase pngStream()
    End If
    
    If lenIDAT = 0 Or lError <> 0 Then  ' invalid png image
        If Err Then Err.Clear
    Else

        ' process the compressed data
        Call PostLoadPNG(IDATdata(), lenIDAT, uncmprssSize)
    End If

End Function

Private Function PostLoadPNG(IDATdata() As Byte, lenIDAT As Long, uncmprssSize As Long) As Boolean

    ' Purpose: Uncompress compressed bytes and send to the un-filtering routines
    Dim RawPNGdata() As Byte
    Dim bUncompressed As Boolean
    Dim lRtn As Long

    On Error Resume Next
    ' we need to uncompress our PNG file
    ReDim RawPNGdata(0 To uncmprssSize - 1)
    
    ' if zLIB is available, let it uncompress; faster than pure VB
    If Not m_ZLIBver = 0& Then   ' tested/set in LoadPNG routine
        bUncompressed = zInflate(VarPtr(RawPNGdata(0)), VarPtr(uncmprssSize), VarPtr(IDATdata(0)), lenIDAT)
    End If

    If Not bUncompressed Then
        ' either zLib returned an error or it wasn't available, uncompress by hand
        bUncompressed = vbDecompress(RawPNGdata(), IDATdata(), uncmprssSize)
        If Err Then Err.Clear
    End If
    Erase IDATdata()
    
    If Not bUncompressed Then
        ' failed to uncompress & shouldn't happen 'cause if I calculated uncmprssSize
        ' wrong, then other calculations in this routine are wrong too
        ' See: CalcUncompressedWidth
        Exit Function
    End If

    Call InitializePalette  ' if PNG is palettized, create palette
    cHost.InitializeDIB m_Width, m_Height    ' create 32bpp DIB to hold PNG
    
    ' call function to begin converting PNG to Bitmap
    If m_Interlacing = 0 Then
        lRtn = UnfilterNI(RawPNGdata()) ' non-interlaced image
    Else
        lRtn = UnfilterInterlaced(RawPNGdata()) ' interlaced image
    End If

    ' return results
    If lRtn = 0 Then
        cHost.DestroyDIB ' failure decoding the PNG
    Else
        If m_ColorType > clrPalette Then
            cHost.Alpha = True
        ElseIf m_TransColor <> -1 Then
            cHost.Alpha = True
        Else
            cHost.Alpha = False
        End If
        cHost.ImageType = imgPNG
        PostLoadPNG = True
    End If

End Function

Private Function CalcUncompressedWidth() As Long

    Dim uncompressedWidth As Long, iBitPP As Byte
    Dim Pass As Long, passWidth As Long, passHeight As Long

    On Error GoTo NoLoad

    InitializeMatrix    ' build the interlacing matrix; also used for non-interlaced too

    ' get the actual bits per pixel the png is using
    ' (i.e., 16bitdepth png @ ColorType 6 = 64bits per pixel)
    GetDepthInfo 0, 0, iBitPP, 0
    
    If m_Interlacing = 0 Then ' no interlacing
        ' uncompressed width will be byte aligned width + 1 for filter byte
        ' multiplied by the height
        passWidth = GetBytesPerPixel(m_Width, iBitPP)
        uncompressedWidth = passWidth * m_Height + m_Height
    Else
        ' interlaced will also be byte aligned but per scanline width
        ' Each of the 7 passes can have different widths + 1 filter byte per line
        For Pass = 1 To 7
            ' calculate number of pixels per scan line
            passWidth = m_Width \ MatrixColAdd(Pass) - (m_Width Mod MatrixColAdd(Pass) > MatrixCol(Pass))
            ' determine number of bytes needed for each scanline
            passWidth = GetBytesPerPixel(passWidth, iBitPP)
            ' calculate number of rows for this scan's pass
            passHeight = m_Height \ MatrixRowAdd(Pass) - (m_Height Mod MatrixRowAdd(Pass) > MatrixRow(Pass))
            ' now get the total bytes needed for the entire pass,
            ' adding 1 filter byte for each line in the pass:  i.e., + passHeight
            uncompressedWidth = uncompressedWidth + passWidth * passHeight + passHeight
        Next
        
    End If
    
    CalcUncompressedWidth = uncompressedWidth

NoLoad:
End Function

Private Sub InitializeMatrix()
        
    ' a quick look up table for bit shifting operations
    If m_ColorType = clrGrayScale Or m_ColorType = clrPalette Then
        Dim i As Integer
        ReDim pow2x8(0 To 8)
        pow2x8(0) = 1
        For i = 1 To 8
            pow2x8(i) = pow2x8(i - 1) * 2
        Next
    End If
    
    ' initialize interlacing matrix, used in the ConvertPNGtoBMP routine and
    ' also used to calculate the uncompressed size of the compressed PNG data
    
    ' Non-interlaced images are considered Pass#8, where interlaced images always
    ' contain 7 passes (1 thru 7).
    
    ' determines what row in the interlaced image, the current pass begins at
    CopyMemory MatrixRow(1), 262144, &H4
    CopyMemory MatrixRow(5), 65538, &H4 'Array(0, 0, 4, 0, 2, 0, 1, 0)
    ' determines what column in the interlaced image, the current pass begins at
    CopyMemory MatrixCol(1), 33555456, &H4
    CopyMemory MatrixCol(5), 256&, &H4 'Array(0, 4, 0, 2, 0, 1, 0, 0)
    ' determines the row interval of the current pass
    CopyMemory MatrixRowAdd(1), 67635208, &H4
    CopyMemory MatrixRowAdd(5), 16908804, &H4 'Array(8, 8, 8, 4, 4, 2, 2, 1)
    ' determines the column interval of the current pass
    CopyMemory MatrixColAdd(1), 67373064, &H4
    CopyMemory MatrixColAdd(5), 16843266, &H4 'Array(8, 8, 4, 4, 2, 2, 1, 1)
    
    ' 1st 7 elements of next 2 arrays used for pixellated interlaced images
    ' determines the width of each pixellated pixel for the current pass
    CopyMemory MatrixCX(1), 33817608, &H4
    CopyMemory MatrixCX(5), 16843010, &H4 'Array(8, 4, 4, 2, 2, 1, 1, 1)
    ' determines the height of each pixellated pixel for the current pass
    CopyMemory MatrixCY(1), MatrixColAdd(1), &H8 'Array(8, 8, 4, 4, 2, 2, 1, 1)

End Sub


Private Function ConvertPNGtoBMP_NonPalette(rawBytes() As Byte, ByVal scanPass As Byte, _
                    ByVal scanCY As Long, ByVal rBPRow As Long, _
                    Optional ByVal startOffset As Long = 0) As Boolean

' Routine processes only non-paletted, non-16bit PNG data

' rawBytes() are the png scanline bytes
' scanPass() is a valid number btwn 1-8 (8 indicates non-interlaced)
' scanCY is number of scanlines (btwn 1 and image height)
' rBPRow is the number of bytes per scanline of the rayBytes array (byte aligned)

    Dim rRow As Long, rColumn As Long ' current row/column of the png image
    Dim dRow As Long, dColumn As Long ' current row/column of destination bitmap
    Dim dIndex As Long ' position of dRow in the destBytes() array
    
    Dim rBytePP As Byte ' nr of bytes per pixel in png image
    Dim destPos As Long, rgbIncrR As Long, rgbIncrG As Long
    
    Dim destBytes() As Byte ' placeholders for DIB bits (DMA)
    Dim tSA As SafeArray  ' array overlays for DIB bits (DMA)
    
    On Error GoTo err_h
    
    ' use direct memory access (DMA) to reference the DIB pixel data
    With tSA
        .cDims = 2                          ' Number of dimensions
        .cbElements = 1                     ' Size of data elements
        .pvData = cHost.BitsPointer         ' Data address
        .rgSABound(0).cElements = m_Height
        .rgSABound(1).cElements = m_Width * 4 ' Nr of Elements
    End With
    CopyMemory ByVal VarPtrArray(destBytes), VarPtr(tSA), 4

    ' determine the bits/bytes of the png and bitmap images
    GetDepthInfo 0, 0, 0, rBytePP

    ' get location of BMP scanline we are processing from PNG scanline
    If startOffset = 0 Then
        dRow = MatrixRow(scanPass)
    Else
        dRow = startOffset
    End If

    If Not m_ColorType = clrGrayAlpha Then
        rgbIncrR = 2
        rgbIncrG = 1