cicoparser.cls

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

        Else
            icPtr = icPtr + icBytesNeed     ' move array pointer
            icBytesNeed = 16&               ' length of directory entry
            If icPtr + icBytesNeed * m_icDir.idCount > streamLength Then
                bIconFile = False           ' not enough bytes for expected entries
            Else
                ReDim m_icDirE(1 To m_icDir.idCount)        ' size our entries
                icBytesNeed = m_icDir.idCount * icBytesNeed ' & cache them
                CopyMemory m_icDirE(1).bWidth, m_Bits(icPtr), icBytesNeed
                icBytesNeed = icBytesNeed + 6       ' move array pointer
                For icEntry = 1 To m_icDir.idCount
                    ' each entry indicates how many bytes are used for it.
                    ' total the bytes and ensure enough bytes exist
                    icBytesNeed = icBytesNeed + m_icDirE(icEntry).dwBytesInRes
                Next
                If icBytesNeed > streamLength Then bIconFile = False ' not enough bytes
            End If
        End If
    End If
    
    If bIconFile Then
    
        ' Through experience, I have found the bitcount of the icons
        ' contained within the IconDirectoryEntry structures may be
        ' wrong or may not be filled in. Here, we will erase them & fill
        ' them in from the bitmap info headers that exist in the array.
        icBytesNeed = 0&
        For icEntry = 1 To m_icDir.idCount
            m_icDirE(icEntry).wPlanes = 1 ' not required, but used as a flag internally as indicating valid or invalid image
            ' get bitcount from the bitmap header
            CopyMemory icBytesNeed, m_Bits(m_icDirE(icEntry).dwImageOffset + 14), 2&
            
            If icBytesNeed = 0 Then ' if it is zero (shouldn't be); use the bitcount from the icon entry structure
                ' ensure the icon entry bitcount is not zero...
                If m_icDirE(icEntry).wBitCount = 0 Then
                    bIconFile = False
                Else
                    CopyMemory m_Bits(m_icDirE(icEntry).dwImageOffset + 14), m_icDirE(icEntry).wBitCount, 2&
                End If
                
            ElseIf icBytesNeed = 21060 Then
                ' flag for PNG, double check & abort if not -- then it is not an icon file
                bIconFile = ParsePNGheader(icEntry)
                
            Else    ' use the bitcount from the bitmap header
                m_icDirE(icEntry).wBitCount = icBytesNeed
            End If
        Next
    
        If bIconFile = True Then
            LoadStream = True

            ' appears we have a valid icon file. Find closest match for requested size
            If desiredWidth < 1 Then desiredWidth = 32 ' default if none provided
            If desiredHeight < 1 Then desiredHeight = 32
            icEntry = GetBestMatch(desiredWidth, desiredHeight)
            
            If Not icEntry = 0 Then ' else something is wrong with the icon structure(s) in this file
            
                If IsIconPNG(icEntry) Then ' png flag
                    
                    ' we need to pass this off to a PNG class for parsing/processing
                    Set cPNG = New cPNGParser
                    LoadStream = cPNG.LoadStream(inStream, cHost, m_icDirE(icEntry).dwImageOffset, m_icDirE(icEntry).dwBytesInRes)
                    Set cPNG = Nothing
                    If Not cHost.Handle = 0 Then cHost.ImageType = imgPNGicon
                    
                Else
                    ' create the main application's image, blank.
                    cHost.InitializeDIB Width(icEntry), Height(icEntry)
                    
                    ' copy the bitmap information header and fix it. Per MSDN, not all
                    ' members of the header are required to be filled in. We need them.
                    CopyMemory tBMPI.bmiHeader, m_Bits(m_icDirE(icEntry).dwImageOffset), 40&
                    With tBMPI.bmiHeader
                        .biClrUsed = ColorCount(icEntry)    ' fix when bitcount <= 8bpp
                        .biHeight = Height(icEntry)         ' height is doubled; fix it
                        .biSizeImage = 0                    ' erase; don't need this
                        .biXPelsPerMeter = 0                ' erase; don't need this
                        .biYPelsPerMeter = 0                ' erase; don't need this
                    End With
                    ' copy the fixed header back into the array
                    CopyMemory m_Bits(m_icDirE(icEntry).dwImageOffset), tBMPI.bmiHeader, 40&
                    
                    ' the next part of the routine is to create a compatible bitmap using
                    ' maximum screen colors on the system.  We will use the API to create it
                    ' for us from the bitmap header we just tweaked above. Otherwise we would
                    ' have to parse the bits ourselves, bloating code to handle 7 possible bit
                    ' depths in combination with several compression algorithms & various RGB masks.
                    tDC = GetDC(0&)
                    hDib = CreateDIBitmap(tDC, tBMPI.bmiHeader, 4, m_Bits(ColorByteOffset(icEntry)), m_Bits(m_icDirE(icEntry).dwImageOffset), 0&)
                    If hDib = 0 Then
                        ReleaseDC 0&, tDC
                        cHost.DestroyDIB
                        ' major problem here; the icon contained in the stream appears to be faulty
                        ' we can't use it. Abort.
                    Else
                        ' here we are defining our application's image.
                        With tBMPI.bmiHeader
                            .biSize = 40&
                            .biBitCount = 32            ' 32bpp
                            .biHeight = cHost.Height    ' same width & height
                            .biWidth = cHost.Width      ' of the source image
                            .biPlanes = 1
                            .biSizeImage = .biHeight * .biWidth * 4&
                        End With
                        ' transfer the image bits from the bitmap created from the array to
                        ' our application's image
                        GetDIBits tDC, hDib, 0, cHost.Height, ByVal cHost.BitsPointer, tBMPI, 0
                        ReleaseDC 0&, tDC               ' release dc; don't need it any longer
                        DeleteObject hDib               ' kill the source bitmap; not needed
                        ApplyAlphaMask icEntry, cHost   ' add the alpha channel to app's image
                    End If
                End If
            End If
        End If
    End If
    CopyMemory ByVal VarPtrArray(m_Bits), 0&, 4&    ' remove overlay
    
End Function

Public Function ConvertstdPicTo32bpp(stdPic As StdPicture, cHost As c32bppDIB) As Boolean

    ' Purpose: Convert a single icon from a stdPicture to a 32bpp bitmap

    If stdPic Is Nothing Then Exit Function
    If Not stdPic.Type = vbPicTypeIcon Then Exit Function
    
    Dim icoInfo As ICONINFO, tBMPI As BITMAPINFO
    Dim tBMPc As BITMAPINFO, tBMPm As BITMAPINFO
    Dim tDC As Long, hostDC As Long
    
    ' see if we can get the icon information
    If GetIconInfo(stdPic.Handle, icoInfo) = 0 Then Exit Function
    
    m_icDir.idCount = 1
    m_icDir.idType = 2 - Abs(icoInfo.fIcon) ' 0=icon, 1=cursor
    ReDim m_icDirE(1 To 1)  ' we will have 1 entry
    
    tDC = GetDC(0&)
    If Not icoInfo.hbmColor = 0 Then    ' do we have a color image? no for B&W
        tBMPc.bmiHeader.biSize = 40&    ' let's fill in the BitmapInfo header
        If GetDIBits(tDC, icoInfo.hbmColor, 0, 0, ByVal 0&, tBMPc, 0) = 0 Then
            m_icDir.idCount = 0 ' oops; something critical happened
        Else
            With tBMPI.bmiHeader    ' now fill in our destination description
                .biBitCount = 32
                .biHeight = tBMPc.bmiHeader.biHeight
                .biWidth = tBMPc.bmiHeader.biWidth
                .biPlanes = 1
                .biSize = 40&
                cHost.InitializeDIB .biWidth, .biHeight ' setup destination DIB
            End With
            ' use API again, to pass the bits from the color icon image to our DIB
            GetDIBits tDC, icoInfo.hbmColor, 0, tBMPc.bmiHeader.biHeight, ByVal cHost.BitsPointer, tBMPI, 0
        End If
    End If
    
    ' pretty much same thing for the B&W, 1bpp mask
    ' Valid icons always have a mask, so no need to check .hbmMask=0 since
    ' this icon exists in a stdPicture and that validated the icon for us
    If m_icDir.idCount = 1 Then
        tBMPm.bmiHeader.biSize = 40&
        If GetDIBits(tDC, icoInfo.hbmMask, 0, 0, ByVal 0&, tBMPm, 0) = 0 Then
            m_icDir.idCount = 0 ' oops; something critical happened
        Else
            With tBMPI.bmiHeader
                If icoInfo.hbmColor = 0 Then
                    ' we have a b&w icon
                    .biBitCount = 32
                    .biHeight = tBMPm.bmiHeader.biHeight \ 2
                    .biWidth = tBMPm.bmiHeader.biWidth
                    .biPlanes = 1
                    .biSize = 40&
                    ' render the icon onto our dib
                    ' Note: in IDE, icon/cursor will be b&w, but when compiled
                    ' if the curosr had colors, the colors will be shown
                    cHost.InitializeDIB .biWidth, .biHeight  ' setup destination DIB
                    hostDC = cHost.LoadDIBinDC(True)
                    stdPic.Render hostDC + 0&, 0&, 0&, .biWidth + 0&, .biHeight + 0&, 0&, stdPic.Height, stdPic.Width, -stdPic.Height, ByVal 0&
                    cHost.LoadDIBinDC False
                    
                End If
                ' size our local array to hold the mask bits; these will be used
                ' to tweak the 32bpp DIB's alpha channel in ApplyAlphaMask
                ReDim m_Bits(0 To iparseByteAlignOnWord(1, .biWidth) * .biHeight - 1)
            End With
            
            ' prepare bitmap info for our 1bpp mask array
            ReDim tBMPI.bmiPalette(0 To 1)
            tBMPI.bmiPalette(1) = vbWhite
            With tBMPI.bmiHeader
                .biBitCount = 1
                .biClrUsed = 2
            End With
            ' use API again to pass the 1bpp image to our array
            GetDIBits tDC, icoInfo.hbmMask, 0&, tBMPI.bmiHeader.biHeight, m_Bits(0), tBMPI, 0
            
            ' fill in the icon entry structure
            With m_icDirE(1)
                .bHeight = tBMPI.bmiHeader.biHeight
                .bWidth = tBMPm.bmiHeader.biWidth
                .dwBytesInRes = UBound(m_Bits) + 1 ' we only have a mask in our array
                .wBitCount = 1  ' the bitmap retrieved from the icon/cursor can be 32bpp
                .wPlanes = 1    ' so we force the ApplyAlphaMask to use the 1bpp parsing routine
            End With
        
        End If
    End If
    ReleaseDC 0&, tDC
    
    ' clean up; GetIconInfo creates up to 2 bitmaps we must destroy
    If Not icoInfo.hbmColor = 0 Then DeleteObject icoInfo.hbmColor
    If Not icoInfo.hbmMask = 0 Then DeleteObject icoInfo.hbmMask
    
    If m_icDir.idCount = 1 Then ' now apply the mask
        ApplyAlphaMask 1, cHost
        Erase m_Bits()
        ConvertstdPicTo32bpp = True
    End If
    
End Function

Private Sub ApplyAlphaMask(Index As Long, cHost As c32bppDIB)

    ' Purpose: Either blend or simulate transparency for icons
    ' The primary DIB for this application is 32bpp. Icons may or
    '   may not be 32bpp. When 32bpp, the icon RGB values are not
    '   pre-multiplied; so we need to pre-multiply them.  When
    '   the icon is not 32bpp, then it may have transparency,
    '   and we will modify our 32bpp image to identify which
    '   pixels are transparent and which are not.