cicoparser.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cICOparser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' No APIs are declared public. This is to prevent possibly, differently
' declared APIs, or different versions of the same API, from conflciting
' with any APIs you declared in your project. Same rule for UDTs.
' Note: I did take some liberties in several API declarations throughout

' Used for creating array overlays at other memory addresses
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

' used to create images as needed
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateDIBitmap Lib "gdi32.dll" (ByVal hDC As Long, ByRef lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, ByRef lpInitBits As Any, ByRef lpInitInfo As Any, ByVal wUsage As Long) As Long
Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetGDIObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function DrawIcon Lib "user32.dll" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long         ' +4 from .biSize
    biHeight As Long        ' +8
    biPlanes As Integer     ' +12
    biBitCount As Integer   ' +14
    biCompression As Long   ' +16
    biSizeImage As Long     ' +20
    biXPelsPerMeter As Long ' +24
    biYPelsPerMeter As Long ' +28
    biClrUsed As Long       ' +32
    biClrImportant As Long  ' 40th byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiPalette(0 To 255) As Long
End Type

Private Type SafeArrayBound
    cElements As Long
    lLbound As Long
End Type
Private Type SafeArray          ' used as DMA overlay on a DIB
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgSABound(0 To 1) As SafeArrayBound ' reusable UDT for 1 & 2 dim arrays
End Type

Private Type ICONDIRENTRY
    bWidth As Byte '// Width, in pixels, of the image
    bHeight As Byte '// Height, in pixels, of the image
    bColorCount As Byte '// Number of colors in image (0 if >=8bpp)
    bReserved As Byte '// Reserved ( must be 0)
    wPlanes As Integer '// Color Planes
    wBitCount As Integer '// Bits per pixel
    dwBytesInRes As Long '// How many bytes in this resource?
    dwImageOffset As Long '// Where in the file is this image?
End Type

Private Type ICONDIR
    idReserved As Integer '// Reserved (must be 0)
    idType As Integer '// Resource Type (1 for icons)
    idCount As Integer '// How many images?
    idEntries() As ICONDIRENTRY '// An entry for each image (idCount of 'em)
End Type

Private Const png_Signature1 As Long = 1196314761   ' 1st 8 bytes of a PNG file start with these 8 bytes
Private Const png_Signature2 As Long = 169478669

Private m_icDirE() As ICONDIRENTRY  ' collection of icon directory entries
Private m_icDir As ICONDIR          ' icon directory
Private m_Bits() As Byte            ' icon bits

Public Property Get Height(Index As Long) As Long
    Height = m_icDirE(Index).bHeight    ' height of icon
    If Height = 0& Then Height = 256&   ' 256x256 icons are identified as 0 in the icon structure
End Property
Public Property Get Width(Index As Long) As Long
    Width = m_icDirE(Index).bHeight     ' width of icon
    If Width = 0& Then Width = 256&     ' 256x256 icons are identified as 0 in the icon structure
End Property

Public Property Get IsIconPNG(Index As Long) As Boolean
    IsIconPNG = m_icDirE(Index).wPlanes = 255   ' custom flag to distinguish PNG from icon
End Property
Public Property Get bitDepth(Index As Long) As Long
    bitDepth = m_icDirE(Index).wBitCount    ' bit count/depth of icon
End Property

Public Property Get IconCount() As Long
    IconCount = m_icDir.idCount
End Property

Public Property Get ColorCount(Index As Long) As Long
    ' for paletted non-PNG images, number of colors that exist
    ' This should be straight forward and is generally supplied in the icon entry's .bColorCount
    ' member. But maybe .bColorCount may not be telling us the truth or it may be missing.
    
    ' To get the proper number supplied with the icon/bitmap, we will add the total bytes
    ' used for the image & mask bytes, then add that to the bytes used for the header.
    ' The difference/4 will always be correct.
    Dim imageBits As Long, headerBits As Long
    If m_icDirE(Index).wBitCount < 9 Then
        imageBits = ColorByteCount(Index) + MaskByteCount(Index)
        headerBits = m_Bits(m_icDirE(Index).dwImageOffset)
        ColorCount = (m_icDirE(Index).dwBytesInRes - (imageBits + headerBits)) \ 4&
    End If
End Property

Public Property Get ColorByteOffset(Index As Long) As Long
    ' Return the position in the source stream where the 1st byte of the color image
    ' can be found; not called for PNGs
    Dim Offset As Long
    CopyMemory Offset, m_Bits(m_icDirE(Index).dwImageOffset), 4& ' header bytes
    Offset = m_icDirE(Index).dwImageOffset + Offset ' shift offset to where icon structure begins
    ' when image is paletted, the palette is included too
    If m_icDirE(Index).wBitCount < 16 Then          ' get number of colors used in image
        Offset = Offset + (2& ^ m_icDirE(Index).wBitCount) * 4& ' add that to the offset
    End If
    ColorByteOffset = Offset
End Property

Private Property Get MaskByteOffset(Index As Long) As Long
    ' Return the position in the source stream where the 1st byte of the mask image
    ' can be found; not called for PNGs. Here we work from the end of the icon structure
    Dim Offset As Long
    
    ' Note: 32bpp icons have masks too
    Offset = m_icDirE(Index).dwImageOffset + m_icDirE(Index).dwBytesInRes
    Offset = Offset - MaskByteCount(Index)
    MaskByteOffset = Offset
End Property

Private Property Get ColorByteCount(Index As Long) As Long
    ' Return the number of image bytes used for the color image; not PNGs
    ColorByteCount = iparseByteAlignOnWord(m_icDirE(Index).bWidth, m_icDirE(Index).wBitCount) * m_icDirE(Index).bHeight
End Property
Private Property Get MaskByteCount(Index As Long) As Long
    ' Return the number of image bytes used for the mask image; not PNGs
    MaskByteCount = iparseByteAlignOnWord(m_icDirE(Index).bWidth, 1&) * m_icDirE(Index).bHeight
End Property

Public Function LoadStream(inStream() As Byte, _
                ByVal desiredWidth As Long, ByVal desiredHeight As Long, _
                cHost As c32bppDIB, streamOffset As Long, streamLength As Long, _
                icoBitDepth As Long, Optional GlobalToken As Long) As Boolean

    ' Purpose: Parse byte stream to determine if it is an icon file.
    '   If it is an icon file, then select the best match for the passed
    '   size and create our application's main image from the icon
    ' Note: GIF, JPG, BMP, PNG & other formats have a magic number that
    '   indicates what type of file it is. Icons/cursors do not; so we parse & error check
    
    ' Parameters:
    ' inStream() :: an array of the icon file; can consist of more than one icon
    ' desiredWidth :: width of icon to use, if available, else used for closest match
    ' desiredHeight :: height of icon to use, if available, else used for closest match
    ' cHost :: the application's image class
    
    ' IMPORTANT: the array offset & length are not checked in this class.
    '   They were checked before this class was called. If this class is to
    '   be pulled out and put in another project, ensure you include the
    '   validation shown in c32bppDIB.LoadPicture_Stream
    
    Dim icEntry As Long, icValue As Long
    Dim icPtr As Long, icBytesNeed As Long
    Dim bIconFile As Boolean
    
    Dim tDC As Long, hDib As Long, dDC As Long, hObj As Long
    Dim tSA As SafeArray
    Dim tBMPI As BITMAPINFO
    Dim cPNG As cPNGparser
    
    With tSA                    ' overlay the passed stream with our module-level array
        .cbElements = 1         ' as byte
        .cDims = 1              ' as 1 dimensional
        .pvData = VarPtr(inStream(LBound(inStream)))
        If streamLength = 0 Then streamLength = UBound(inStream) + 1
        .rgSABound(0).cElements = streamLength
    End With
    CopyMemory ByVal VarPtrArray(m_Bits), VarPtr(tSA), 4& ' establish overlay
    
    icBytesNeed = 6&                        ' length of the ICONDIRECTORY
    If icPtr + icBytesNeed <= streamLength Then    ' ensure enough bytes exist
        bIconFile = True                    ' good, let's continue
        ' cache the ICONDIRECTORY
        CopyMemory m_icDir.idReserved, m_Bits(icPtr), icBytesNeed
        If m_icDir.idCount < 1 Then         ' no icons or not an icon file
            bIconFile = False
        ElseIf Not m_icDir.idReserved = 0 Then  ' per MSDN, must be zero
            bIconFile = False
        ElseIf m_icDir.idType < 1 Or m_icDir.idType > 2 Then
            bIconFile = False               ' per MSDN, must be 1 or 2 (1=icon,2=cursor)
        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