cpngparser.cls

AeroSuite--一组非常漂亮的VISTA控件集

        dRow = m_MatrixDat(scanPass, MatrixRow)
    Else
        dRow = startOffset
    End If

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

    For rRow = startOffset To scanCY - 1& ' < in relation to rawBytes() array
        
        dIndex = (m_Height - dRow - 1&) '* dRowWidth ' < destBytes array pointer for 1st pixel in scanline
        rColumn = rRow * rBPRow + 1&  ' < rawBytes array pointer for 1st pixel in scanline
        
        dColumn = m_MatrixDat(scanPass, MatrixCol) ' column in relation to the destBytes() array
        
        Do While dColumn < m_Width
        
            destPos = dColumn * 4& + 3&
            
            Select Case m_ColorType
            
            Case clrTrueAlpha ' true color with alpha (32 bit)
                destBytes(destPos, dIndex) = rawBytes(rColumn + 3&)  ' alpha channel
                
            Case clrGrayAlpha  ' grayscale with alpha (1,2,4,8 bit)
                destBytes(destPos, dIndex) = rawBytes(rColumn + 1&)  ' alpha channel
            
            Case clrTrueColor ' true color + simple transparency (24 bit)
                destBytes(destPos, dIndex) = &HFF                    ' alpha channel
                If Not m_TransColor = -1& Then   ' transparency is used
                    If (m_TransColor And &HFF) = rawBytes(rColumn + 2&) Then
                        If ((m_TransColor \ &H100&) And &HFF) = rawBytes(rColumn + 1&) Then
                            If ((m_TransColor \ &H10000) And &HFF) = rawBytes(rColumn) Then destBytes(destPos, dIndex) = 0&
                        End If
                    End If
                End If

            End Select
            
            Select Case destBytes(destPos, dIndex)
            Case 0: ' do nothing, RGB is zero
            Case 255
                destBytes(destPos - 3&, dIndex) = rawBytes(rColumn + rgbIncrR)
                destBytes(destPos - 2&, dIndex) = rawBytes(rColumn + rgbIncrG)
                destBytes(destPos - 1&, dIndex) = rawBytes(rColumn)
            Case Else
                destBytes(destPos - 3&, dIndex) = (0& + rawBytes(rColumn + rgbIncrR)) * destBytes(destPos, dIndex) \ 255
                destBytes(destPos - 2&, dIndex) = (0& + rawBytes(rColumn + rgbIncrG)) * destBytes(destPos, dIndex) \ 255
                destBytes(destPos - 1&, dIndex) = (0& + rawBytes(rColumn)) * destBytes(destPos, dIndex) \ 255
            End Select
            
            rColumn = rColumn + rBytePP      ' else increment per source byte pp
            dColumn = dColumn + m_MatrixDat(scanPass, MatrixColAdd)
        
        Loop
        dRow = dRow + m_MatrixDat(scanPass, MatrixRowAdd)
        
    Next

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

    Exit Function

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

End Function

Private Function ConvertPNGtoBMP_Palettes(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 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, rBitPP As Byte ' nr of bytes per pixel in png image
    
    Dim tColor(0 To 3) As Byte ' color value when copying 3 or 4 bytes to a 3 or 4 byte array
    Dim palOffset As Long
    Dim destPos As Long
    Dim pIndex As Byte ' alpha related variables
    
    Dim destBytes() As Byte ' placeholders for DIB bits (DMA)
    Dim tSA As SafeArray  ' array overlays for DIB bits (DMA)
    
    Dim maskShift As Long

    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 = m_MatrixDat(scanPass, MatrixRow)
    Else
        dRow = startOffset
    End If

    For rRow = startOffset To scanCY - 1& ' < in relation to rawBytes() array
        
        dIndex = (m_Height - dRow - 1&) '* dRowWidth ' < destBytes array pointer for 1st pixel in scanline
        rColumn = rRow * rBPRow + 1&  ' < rawBytes array pointer for 1st pixel in scanline
        
        dColumn = m_MatrixDat(scanPass, MatrixCol) ' column in relation to the destBytes() array
        maskShift = 8& - m_BitDepth
        
        Do While dColumn < m_Width
        
            destPos = dColumn * 4&
            
            Select Case m_ColorType
            
            Case clrPalette ' paletted with/without simple transparency in its own palette-alpha table
                ' 1,2,4,8 bit
                Call GetPaletteValue(maskShift, rawBytes(rColumn), pIndex)
                palOffset = pIndex * 3&
                If m_TransColor = -1& Then    ' no transparency used
                    destBytes(destPos + 3&, dIndex) = &HFF
                    destBytes(destPos, dIndex) = m_Palette(palOffset + 2&)
                    destBytes(destPos + 1&, dIndex) = m_Palette(palOffset + 1&)
                    destBytes(destPos + 2&, dIndex) = m_Palette(palOffset)
                Else
                    destBytes(destPos + 3&, dIndex) = m_TransSimple(pIndex)
                    Select Case m_TransSimple(pIndex)
                    Case 0
                    Case 255
                        destBytes(destPos, dIndex) = m_Palette(palOffset + 2&)
                        destBytes(destPos + 1&, dIndex) = m_Palette(palOffset + 1&)
                        destBytes(destPos + 2&, dIndex) = m_Palette(palOffset)
                    Case Else
                        destBytes(destPos, dIndex) = (0& + m_Palette(palOffset + 2&)) * m_TransSimple(pIndex) \ &HFF
                        destBytes(destPos + 1&, dIndex) = (0& + m_Palette(palOffset + 1&)) * m_TransSimple(pIndex) \ &HFF
                        destBytes(destPos + 2&, dIndex) = (0& + m_Palette(palOffset)) * m_TransSimple(pIndex) \ &HFF
                    End Select
                End If

            Case clrGrayScale ' grayscale with/without simple transparency
                ' 1,2,4,8 bit
                Call GetPaletteValue(maskShift, rawBytes(rColumn), pIndex)
                If Not m_TransColor = pIndex Then   ' else fully transparent
                    destBytes(destPos + 3&, dIndex) = &HFF
                    destBytes(destPos, dIndex) = m_Palette(3& * pIndex)
                    destBytes(destPos + 1&, dIndex) = destBytes(destPos, dIndex)
                    destBytes(destPos + 2&, dIndex) = destBytes(destPos, dIndex)
                End If

            End Select
            
            ' ensure our source byte pointer is moved along appropriately
            If m_BitDepth < 8& Then
                If maskShift = 0& Then
                    rColumn = rColumn + 1&
                    maskShift = 8& - m_BitDepth
                Else
                    maskShift = maskShift - m_BitDepth
                End If
            Else
                rColumn = rColumn + rBytePP      ' else increment per source byte pp
            End If
            dColumn = dColumn + m_MatrixDat(scanPass, MatrixColAdd)
        
        Loop
        dRow = dRow + m_MatrixDat(scanPass, MatrixRowAdd)
        
    Next

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

    Exit Function

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

End Function

Private Function ConvertPNGtoBMP_16Bit(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 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 destPos As Long, rBytePP As Byte
    Dim 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
    
    ' determine the bits/bytes of the png and bitmap images
    GetDepthInfo 0, 0, 0, rBytePP
    
    ' 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&

    ' get location of BMP scanline we are processing from PNG scanline
    If startOffset = 0& Then
        dRow = m_MatrixDat(scanPass, MatrixRow)
    Else
        dRow = startOffset
    End If
    
    If m_ColorType = clrTrueAlpha Or m_ColorType = clrTrueColor Then
        rgbIncrR = 4&: rgbIncrG = 2&
    End If

    For rRow = startOffset To scanCY - 1& ' < in relation to rawBytes() array
        
        dIndex = (m_Height - dRow - 1&) '* dRowWidth ' < destBytes array pointer for 1st pixel in scanline
        rColumn = rRow * rBPRow + 1&  ' < rawBytes array pointer for 1st pixel in scanline
        
        dColumn = m_MatrixDat(scanPass, MatrixCol) ' column in relation to the destBytes() array
        
        Do While dColumn < m_Width
        
            destPos = dColumn * 4& + 3&
            
            Select Case m_ColorType
            
            Case clrTrueAlpha ' true color with alpha (64 bit)
                destBytes(destPos, dIndex) = rawBytes(rColumn + 6&)  ' alpha channel
            
            Case clrGrayAlpha  ' grayscale with alpha (32 bit)
                destBytes(destPos, dIndex) = rawBytes(rColumn + 2&)
            
            Case clrTrueColor ' true color with/without simple transparency (48 bit)
                
                destBytes(destPos, dIndex) = &HFF
                If Not m_TransColor = -1& Then   ' transparency is used
                    If rawBytes(rColumn + rgbIncrR) = m_TransSimple(rgbIncrR) Then
                        If rawBytes(rColumn + rgbIncrG) = m_TransSimple(rgbIncrG) Then
                            If rawBytes(rColumn) = m_TransSimple(0) Then destBytes(destPos, dIndex) = 0&
                        End If
                    End If
                End If

            Case clrGrayScale ' grayscale with or without simple transparency (16 bit)
                If m_TransColor = -1& Then
                    destBytes(destPos, dIndex) = &HFF
                ElseIf Not rawBytes(rColumn) = m_TransSimple(0) Then
                    destBytes(destPos, dIndex) = &HFF
                End If

            End Select
            
            Select Case destBytes(destPos, dIndex)
            Case 0: ' do nothing, fully transparent
            Case 255
                destBytes(destPos - 3&, dIndex) = rawBytes(rColumn + rgbIncrR)