GDI/图象编程

开发平台：
Visual Basic

cPNGwriter.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cPNGwriter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' This class is a partial version of a full-blown PNG creation class.
' It creates a PNG with many options, but not nearly all PNG options avaialble
' and is specifically modified to creating PNGs from pre-multiplied 32bpp DIBs.
' There still may be references to Interlacing. Interlacing options do not
' exist in this class and any such references are results of extracting the
' routines from the full-version PNG creation class.
' Note that GDI+ does not offer any PNG options when creating PNGs, this class
' exposes several options and can be modified to support all PNG options.
' CUSTOM TAILORED FOR PRE-MULTIPLIED 32bpp DIBS. Routines not portable for normal DIBs.
' Required is a version of the zLIB DLL which can be found at www.zlib.net.
' zLIB comes in at least two varieties: C calling convention (_cdecl) and
' VB/PASCAL calling convention (_stdcall). This routine can use either of those
' conventions, but the zLIB file must be named one of the two following,
' not case sensitive, both are original filenames:  zLib.dll or zLib1.dll
' Key highlights:
' 1. PNGs can be created without GDI+ as long as zlib or zlib1 is present
' 2. Using bit reduction algorithms, a 32bpp DIB can be converted to one of the
'       the following:  8 bpp paletted, 24 bpp or 32 bpp PNGs; supporting full alpha
' 3. The PNG compression filtering mechanism in this routine is user-selected.
'       Filters assist in reorganizing byte information to make it compress better
'       Speed vs Size tradeoffs: filter type None is fastest while type Paeth is smallest (generally)
'       See notes in FilterImage routine, set filter in c32bppDIB.PngPropertySet routine
' 4. Over a dozen options available when creating PNGs, see Me.AddProperty
' 5. This class almost always creates smaller PNG files than GDI+ when default filtering is used
' 6. PNGs can be saved to file or saved to an array
' array mapping structures
Private Type SafeArrayBound
    cElements As Long               ' number of array items
    lLbound As Long                 ' the LBound of the array
End Type
Private Type SafeArray
    cDims As Integer                ' numer of dimensions (1) for this UDT
    fFeatures As Integer            ' not used
    cbElements As Long              ' byte size of each element (byte=1,Int=2,Long=4)
    cLocks As Long                  ' not used
    pvData As Long                  ' pointer to memory space containing array
    rgSABound(0 To 1) As SafeArrayBound
End Type
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
' change to msvbvm50.dll for VB5 projects:
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
' zLIB calls, needed to compress/decompress png data
' ///////////// ZLIB.DLL REQUIREMENT \\\\\\
' validated via ValidateDLLExists function
Private Declare Function Zcrc32 Lib "zlib.dll" Alias "crc32" (ByVal crc As Long, ByRef buf As Long, ByVal Length As Long) As Long
Private Declare Function Zcompress Lib "zlib.dll" Alias "compress" (ByRef Dest As Long, ByRef destLen As Long, ByRef Source As Long, ByVal sourceLen As Long) As Long
Private Declare Function Zcompress2 Lib "zlib.dll" Alias "compress2" (ByRef Dest As Long, ByRef destLen As Long, ByRef Source As Long, ByVal sourceLen As Long, ByVal Level As Long) As Long
Private Declare Function Zcrc321 Lib "zlib1.dll" Alias "crc32" (ByVal crc As Long, ByRef buf As Any, ByVal Length As Long) As Long
Private Declare Function Zcompress1 Lib "zlib1.dll" Alias "compress" (ByRef Dest As Long, ByRef destLen As Long, ByRef Source As Long, ByVal sourceLen As Long) As Long
Private Declare Function Zcompress21 Lib "zlib1.dll" Alias "compress2" (ByRef Dest As Long, ByRef destLen As Long, ByRef Source As Long, ByVal sourceLen As Long, ByVal Level As Long) As Long
Private Const zlibMaxCompression = 9
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Enum eColorTypes    ' internal use only
    clrGrayScale = 0
    clrTrueColor = 2
    clrPalette = 3
    clrGrayAlpha = 4
    clrTrueAlpha = 6
End Enum
'----------------------------------------------------------------------------
' following are optional PNG properties only
Private m_Filter As eFilterMethods
Private m_bKGD As Long          ' default PNG background color if a view opts to render against solid bkg
Private m_Captions() As String  ' see c32bppDIB.ePngProperties
Private m_PNGprops As Long      ' indicates which, if any, m_Captions are used
'----------------------------------------------------------------------------
Private cCfunction As cCDECL        ' class to allow using C calling convention
Private m_ZLIBver As Long           ' which version of zLIB?
Private m_Palette() As Byte         ' PNG palette if image can be palettized
Private m_transPal() As Byte        ' alpha values for PNG palettes as needed
Private m_Uncompressed() As Byte    ' initialized, contains uncompressed DIB bytes in 8,24,32 bit formats
Private m_Stream() As Byte          ' never initialized, overlay to host 32bpp DIB
Private m_Trans As Long             ' flag indicating whether or not transparency is used in DIB
Private m_ColorType As eColorTypes  ' the color type the PNG will be created in
Friend Function SavePNGex(cHost As c32bppDIB, FileName As String, outStream() As Byte) As Boolean
    If cHost.Handle = 0& Then Exit Function
    
    Dim tSA As SafeArray    ' overlay onto our DIB as needed
    Dim bSuccess As Boolean
    Dim fileNum As Integer
    Dim hFile As Long
    Dim bSkipBKGD As Boolean
    
    ' if we don't have Zlib, we can't continue with this class
    If zValidateZLIBversion = False Then Exit Function
    
    If Not FileName = vbNullString Then
        hFile = iparseGetFileHandle(FileName, False)
        If (hFile = INVALID_HANDLE_VALUE) Then Exit Function
    End If
    
    With tSA                ' overlay DIB
        .cbElements = 1
        .cDims = 2
        .pvData = cHost.BitsPointer
        .rgSABound(0).cElements = cHost.Height
        .rgSABound(1).cElements = cHost.scanWidth
    End With
    CopyMemory ByVal VarPtrArray(m_Stream), VarPtr(tSA), 4&
    
    ' optimizations to reduce bit depth and reduce palette data
    
     On Error GoTo ExitRoutine
    ' Can image be palettized (smallest PNG size)?
    m_Trans = -1&
    If PalettizeImage(cHost.Alpha) = False Then
        ' if not, can we reduce to 24bpp from 32bpp?
        OptimizeTrueColor cHost.Alpha
    End If
    '  The above functions converted 32bpp DIB to necessary format for PNG creation
    ' The conversion is in the m_uncompress array. Remove overlay now
    CopyMemory ByVal VarPtrArray(m_Stream), 0&, 4&
    tSA.cDims = 0
    
''   CREATE THE PNG using following rules
''   ------------------------------------
''    Critical chunks (must appear in this order):
''
''               Name  Multiple Ok?  Ordering constraints
''               IHDR    No          Must be first
''               PLTE    No          Before first IDAT (chunk is optional)
''               IDAT    Yes         Multiple IDATs must be consecutive
''               IEND    No          Must be last
''
''    Ancillary chunks (among other ancilliary chunks, order is not dictated):
''
''               Name  Multiple OK?  Ordering constraints relative to Critical chunks
''               cHRM    No          Before PLTE and IDAT
''               gAMA    No          Before PLTE and IDAT
''               iCCP    No          Before PLTE and IDAT
''               sBIT    No          Before PLTE and IDAT
''               sRGB    No          Before PLTE and IDAT
''               bKGD    No          After PLTE; before IDAT
''               hIST    No          After PLTE; before IDAT
''               tRNS    No          After PLTE; before IDAT
''               pHYs    No          Before IDAT
''               sPLT    Yes         Before IDAT
''               tIME    No          None
''               iTXt    Yes         None
''               tEXt    Yes         None
''               zTXt    Yes         None
    
    ' Write the PNG header
    If Write_IHDR(hFile, outStream, cHost, False) = False Then GoTo ExitRoutine
    If Write_tEXt(hFile, outStream, True) = False Then GoTo ExitRoutine ' write the Author & Title if needed
    If Write_PLTE(hFile, outStream, bSkipBKGD) = False Then GoTo ExitRoutine ' write the palette
    If Not bSkipBKGD Then   ' < may be set when bkgd color is not part of palette (Color Type 3 only)
        If Write_bKGD(hFile, outStream) = False Then GoTo ExitRoutine ' write bkgd color
    End If
    If Write_tRNS(hFile, outStream) = False Then GoTo ExitRoutine ' write transparency info
    ' Here we are going to filter & compress the DIB data & then write the IDAT chunk
    If FilterImage(hFile, outStream, cHost, m_Filter) = False Then GoTo ExitRoutine ' write data
    If Write_tIMe(hFile, outStream) = False Then GoTo ExitRoutine ' write last modified timestamp
    If Write_tEXt(hFile, outStream, False) = False Then GoTo ExitRoutine ' write other text (i.e., description, etc)
    If Write_zTXt(hFile, outStream) = True Then ' write any miscellaneous text
        ' Add the IEND termination to the PNG
        bSuccess = Write_IEND(hFile, outStream)   ' write the end flag
    End If
ExitRoutine:
    ' clean up as needed
    If Not tSA.cDims = 0 Then CopyMemory ByVal VarPtrArray(m_Stream), 0&, 4&
    If Not hFile = 0& Then CloseHandle hFile
    
    Erase m_transPal()
    Erase m_Palette()
    Erase m_Uncompressed()
    Set cCfunction = Nothing
    
    If Err Then Err.Clear
    On Error Resume Next
    If bSuccess = False Then
        If hFile = 0& Then Erase outStream() Else iparseDeleteFile FileName
    Else
        SavePNGex = bSuccess
    End If
    If Err Then Err.Clear
End Function
Private Function PropertyIndex(PropertyID As ePngProperties, Optional LargeBlockCaption As String) As Long
    ' Helper function. Returns the m_Captions() array index for the passed PropertyID
    Dim X As Long, CaptionID As Long
    
    If PropertyID = txtLargeBlockText Then
        For CaptionID = 11 To UBound(m_Captions)
            X = InStr(m_Captions(CaptionID), Chr$(0))
            If StrComp(Left$(m_Captions(CaptionID), X - 1&), LargeBlockCaption) = 0& Then Exit For
        Next
        If CaptionID > UBound(m_Captions) Then CaptionID = -1&
    Else
        X = PropertyID
        Do Until X = 1&
            X = X  2&
            CaptionID = CaptionID + 1&
        Loop
    End If
    PropertyIndex = CaptionID
End Function
Private Function OptimizeTrueColor(ByVal isAlpha As Boolean) As Boolean
    ' Function attempts to reduce 32bpp DIB to 24bpp DIB.
    ' Reduction to Palette already tried before this routine was called
    ' Reduction can occur when:
    '   1. No transparency is used
    '   2. Only one color is fully transparent (if alpha between 1 & 254 then no reduction)
    
    Dim X As Long, Y As Long
    Dim bAbort As Boolean, tOffset As Long
    Dim palAlpha(0 To 255) As Byte, palCount As Long
    Dim scanWidth As Long, Color As Long
    
    m_Trans = -1&       ' flag indicating no simple transparency. ColorType 6 implies transparency
    If isAlpha Then
        ' we will test if only full transparency is used, and only one color uses transparency.
        ' We don't need to determine which color is transparent, because with pre-multiplied
        ' DIBs, the color is always black: 0,0,0. But if another color is transparent, can't reduce
        
        m_ColorType = clrTrueAlpha  ' default color type for this DIB
        For Y = 0& To UBound(m_Stream, 2)
            For X = 3& To UBound(m_Stream, 1) Step 4&
                ' look at alpha values, if any are semi-transparent, abort
                If m_Stream(X, Y) = 0 Then ' full transparency
                    ' If color is not black, we abort
                    If Not (m_Stream(X - 3, Y) = 0) Then
                        bAbort = True: Exit For
                    ElseIf Not (m_Stream(X - 2, Y) = 0) Then
                        bAbort = True: Exit For
                    ElseIf Not (m_Stream(X - 1, Y) = 0) Then
                        bAbort = True: Exit For
                    End If
                
                ElseIf Not m_Stream(X, Y) = 255 Then   ' partial transparency, abort
                    bAbort = True: Exit For
                End If
            Next
            If bAbort Then Exit For
        Next
        If Not bAbort Then ' reduction to 24bpp can be done?
            ' now here's the catch. Black is always transparent in premultiplied DIBs, but if
            ' non-transparent black is used anywhere else in the image, then we can't leave
            ' black as the transparent color; we'll need to change it. This routine will run
            ' quickly. We will not make the effort to check every possible color in the 16 million
            ' color range, rather, we will be looking at just 1024 colors: 256 Reds, 256 Greens,
            ' & 256 Blues. If we find one we can use, bingo, else write as 32bpp
            For Color = 0& To 2&  ' Color = B, G, R
            
                tOffset = 3& - Color ' location of the alpha byte relative to "Color"
                palCount = 0&       ' number of "Color" shades used; from 1 to 256
                
                For Y = 0& To UBound(m_Stream, 2)
                    For X = Color To UBound(m_Stream, 1) Step 4&
                    
                        If Not m_Stream(X + tOffset, Y) = 0 Then    ' is this our transparent color?
                            If palAlpha(m_Stream(X, Y)) = 0 Then    ' no, but has it been counted?
                                palCount = palCount + 1&            ' up the count & abort if we maxed out
                                If palCount = 256& Then
                                    bAbort = True
                                    Exit For
                                End If
                                palAlpha(m_Stream(X, Y)) = 1        ' flag it
                            End If
                        End If
                    Next
                    
                    If bAbort Then Exit For ' all 256 shades of "Color" used
                    
                Next
                
                If palCount < 256& Then ' did we find a color we can use?
                    For X = 0& To 255&  ' lets find out which it is
                        If palAlpha(X) = 0 Then
                            ' since the X-shade of the R, G, or B isn't used in the image,
                            ' we can safely state that RGB(X,X,X) is also not in the image
                            m_Trans = X Or X * &H100& Or X * &H10000
                            Exit For
                        End If
                    Next
                    m_ColorType = clrTrueColor  ' reduce to 24bpp vs 32bpp
                    Exit For
                End If
                
                Erase palAlpha()    ' reset to zeros
                bAbort = False      ' reset
                
            Next
        End If
    Else
        m_ColorType = clrTrueColor      ' no transparency, reduction to 24bpp
    End If
    
    ' Use separate loops vs adding an IF statement for every pixel to test for color type
    If m_ColorType = clrTrueAlpha Then  ' 32bpp (ColorType 6)
        scanWidth = UBound(m_Stream, 1) + 1&
        ReDim m_Uncompressed(0 To scanWidth * (UBound(m_Stream, 2) + 1&) - 1&)
        For Y = 0& To UBound(m_Stream, 2)
            tOffset = Y * scanWidth
            For X = 0& To UBound(m_Stream, 1) Step 4&
                ' simultaneously remove pre-multiplication
                Select Case m_Stream(X + 3&, Y)
                Case 255
                    m_Uncompressed(tOffset) = m_Stream(X + 2&, Y)
                    m_Uncompressed(tOffset + 1&) = m_Stream(X + 1&, Y)
                    m_Uncompressed(tOffset + 2&) = m_Stream(X, Y)
                    m_Uncompressed(tOffset + 3&) = 255
                Case 0 ' do nothing
                Case Else
                    Color = m_Stream(X + 3&, Y)
                    m_Uncompressed(tOffset) = (255& * m_Stream(X + 2&, Y)  Color)
                    m_Uncompressed(tOffset + 1&) = (255& * m_Stream(X + 1&, Y)  Color)
                    m_Uncompressed(tOffset + 2&) = (255& * m_Stream(X, Y)  Color)
                    m_Uncompressed(tOffset + 3&) = Color
                End Select
                tOffset = tOffset + 4&
            Next
        Next
    Else            ' 24bpp (Color Type 2) with or without simple transparency
        scanWidth = iparseByteAlignOnWord(24, UBound(m_Stream, 1)  4 + 1&)
        ' convert BGR to RGB, the Filter function expects 1D arrays
        ReDim m_Uncompressed(0 To scanWidth * (UBound(m_Stream, 2) + 1&) - 1&)
        For Y = 0& To UBound(m_Stream, 2)
            tOffset = Y * scanWidth
            For X = 0& To UBound(m_Stream, 1) Step 4&
                ' simultaneously remove pre-multiplication. Don't carry over any alpha values
                Select Case m_Stream(X + 3&, Y)
                Case 255
                    m_Uncompressed(tOffset) = m_Stream(X + 2&, Y)
                    m_Uncompressed(tOffset + 1&) = m_Stream(X + 1&, Y)
                    m_Uncompressed(tOffset + 2&) = m_Stream(X, Y)
                Case 0 ' uses simple transparency (1 color is transparent)
                    CopyMemory m_Uncompressed(tOffset), m_Trans, 3&
                Case Else
                    Color = m_Stream(X + 3&, Y)
                    m_Uncompressed(tOffset) = (255& * m_Stream(X + 2&, Y)  Color)
                    m_Uncompressed(tOffset + 1&) = (255& * m_Stream(X + 1&, Y)  Color)
                    m_Uncompressed(tOffset + 2&) = (255& * m_Stream(X, Y)  Color)
                End Select
                tOffset = tOffset + 3&
            Next
        Next
    End If
End Function
Private Function PalettizeImage(isAlpha As Boolean) As Boolean
    ' Function determines if image can be palettized vs 24/32 bpp true color
    ' Once determined it can be paletted, it will optimize to include the following:
    ' 1. Convert to PNG grayscale palette if possible, saves at least 768 bytes vs color palette
    ' 2. Rearrange palette to reduce alpha/palette entries, saves up to 200+ bytes if alpha is used
    ' 3. Converts per-color grayscale to a modified color palette, reducing size at least 50%
    ' This modified version does not reduce to 1,2,or 4 bits per pixel
    '   -- Any paletted image is 256 colors, but only needed palette entries are cached in PNG
    
    Dim X As Long, Y As Long, scanWidth As Long
    Dim palCount As Long, Index As Long
    Dim Color As Long, newColor As Boolean
    Dim palXRef() As Byte, palAlpha() As Byte
    Dim tSortIndex() As Long, tPalette() As Long
    
    On Error GoTo ExitRoutine
    
    ' count unique colors (maximum of 256 if we are to palettize)
    ' Note that alphas are included in the tSortIndex. This is because any color
    ' using more than one alpha value would require separate palette entries:
    ' Example: Red @ Alpha 255 & Red @ Alpha 128 requires two palette entries
    ReDim m_transPal(1 To 256)          ' array to hold alpha values only
    ReDim tSortIndex(1 To 256)          ' sort indexes
    ReDim tPalette(1 To 256) As Long    ' palette
    For Y = 0& To UBound(m_Stream, 2)
        For X = 0& To UBound(m_Stream, 1) Step 4&
        
            CopyMemory Color, m_Stream(X, Y), 4&
            Index = FindColor(tSortIndex, Color, palCount, newColor)   ' use binary search routine
            If newColor = True Then
                If palCount = 256& Then Exit Function       ' exceeded palette entries limit
                palCount = palCount + 1&                    ' increment entry count & shift palette to maintain asc sort
                If Index < palCount Then
                    CopyMemory tSortIndex(Index + 1&), tSortIndex(Index), (palCount - Index) * 4&
                    CopyMemory tPalette(Index + 1&), tPalette(Index), (palCount - Index) * 4&
                End If
                tSortIndex(Index) = Color                    ' add new color to the palette
                CopyMemory tPalette(Index), Color, 3&
            End If
        
        Next
    Next
    
    ' if we got here, then image can be palettized, but to which of the following?
    ' 1. Palette - no transparency? like non-transparent GIFs (isAlpha=False)
    ' 2. Palette - simple transparency? like transparent GIFs (grayscale handled differently in PNGs)
    ' 3. Palette - per-color index transparency?
    
    Y = 0&
    If isAlpha Then
        ' separate alpha from color and count how many non-opaque alpha values
        For X = 1& To palCount
            If (tSortIndex(X) And &H7FFFFFFF) = tSortIndex(X) Then ' high bit not set
                m_transPal(X) = tSortIndex(X)  &H1000000
            Else                                                 ' high bit is set
                m_transPal(X) = ((tSortIndex(X) And &H7FFFFFFF)  &H1000000) Or &H80
            End If
            If Not m_transPal(X) = 255 Then
                Y = Y + 1&   ' count different levels of transparency
                Index = X    ' track last palette entry with alpha value <> 255
            End If
        Next
    Else
        FillMemory m_transPal(1), 256&, 255 ' all alphas are opaque
    End If
    
    Select Case Y
    Case 0&
    ' 1. Palette - no transparency? like non-transparent GIFs (isAlpha=False)
        m_Trans = -1& ' no transparency
    Case 1&
    ' 2. Palette - simple transparency? like transparent GIFs
        m_Trans = Index ' flag & may be changed later in this routine
    Case Else
    ' 3. Palette - per-color transparency?
        m_Trans = 0& ' > -1 means we have transparency at some level
        ' alphas are kept in the m_transPal() array
    End Select
    
'     Now for the last optimization attempt: check for grayscale but only for non per-color
'     alpha images. Why restrict grayscale to non per-color alpha when PNG can support grayscale
'     per-color alpha? Here's why: per-color grayscale alpha is ColorType 4. ColorType 4
'     always requires 16 bits per pixel (bpp), regardless of grayscale bit depth, but
'     ColorType 3 requires 8 bpp (max) + 768 palette bytes (max) + 256 bytes (max) for alpha info:
'       ColorType 4, 256x256 image: 256*256*2=131072 bytes for color information (grayscale has no palette in PNGs)
'       ColorType 3 (8bpp), 256x256 image: 256*256*1+768+256=66560 bytes for color information
'           note: ColorType 4 is always 16bpp, but ColorType 3 can be 1,2,4,8 bpp
'           and palette/alpha arrays can be reduced too
    
    m_ColorType = clrPalette    ' Color Type 3 (color palette)
    If Not m_Trans = 0& Then
        ' check each palette entry to see if grayscale or not. When not, abort loop
        For Index = 1& To palCount
            If Not (tPalette(Index) And &HFF) = ((tPalette(Index)  &H100&) And &HFF) Then ' compare B to G
                Exit For
            ElseIf Not (tPalette(Index) And &HFF) = ((tPalette(Index)  &H10000) And &HFF) Then ' compare B to R
                Exit For
            End If
        Next
        
        If Index > palCount Then    ' need to tweak transparency possibly
        
            m_ColorType = clrGrayScale ' Color Type 0
            
            If isAlpha = True Then
                ' we only got here because just 1 color was transparent & with a pre-multiplied DIB
                ' that color is always black. But if non-transparent black was used elsewhere in the
                ' grayscale then we need to change the transparency. Non-transparent black is very
                ' common in grayscales
                ReDim palXRef(1 To 256) ' track which grayscales are used
                For X = 1& To palCount
                    If tPalette(X) = 0& Then             ' this is black
                        If Not m_transPal(X) = 0& Then   ' and not our transparent black
                            palXRef(1) = 1     ' mark black as used
                        End If
                    Else
                        palXRef(Index + 1&) = 1 ' non-black, mark as used
                    End If
                Next
                If palXRef(1) = 1 Then
                    ' non-transparent black is used in the grayscale, so we must change our
                    ' tranparent black - Locate a grayscale not in use
                    For Index = 2& To palCount
                        If palXRef(Index) = 0 Then
                            ' bingo, we'll use this one
                            m_Trans = Index - 1&
                            Exit For
                        End If
                    Next
                Else    ' black was not in the image, we can use black as transparency
                    m_Trans = 0&
                End If
                Erase palXRef
            End If
        End If
    End If
    
    scanWidth = UBound(m_Stream, 1)  4& + 1&         ' width of image
    X = (UBound(m_Stream, 2) + 1) * scanWidth - 1&   ' calculate size of total image bytes
    ReDim m_Uncompressed(0 To X)    ' the Filter function expects 1D arrays
    
    If m_ColorType = clrGrayScale Then
        ' grayscale is easy enough, transfer 32bpp info to 8bpp info
        ' Remember, PNG grayscale color types do not use palettes.
        ' Grayscale palettes are PNG decoders responsibility
        Erase m_transPal()
        For Y = 0& To UBound(m_Stream, 2)
            Index = Y * scanWidth
            For X = 0& To UBound(m_Stream, 1) Step 4&
                If m_Stream(X + 3&, Y) = 0& Then     ' transparency index needed
                    m_Uncompressed(Index) = m_Trans ' use modified transparency index as necessary
                Else
                    m_Uncompressed(Index) = m_Stream(X, Y)  ' use grayscale index
                End If
                Index = Index + 1&
            Next
        Next
        
    Else
        ' for color palettes, we want to re-order entries when per-color alpha is used.
        ' Why the hassle? Shrink PNG a bit more. When color palettes have transparency,
        ' you must have a 1 byte Alpha value for each palette entry. But, that 1 byte
        ' alpha value, when = 255, is optional and implied. Therefore, if we move all
        ' palette entries with transparency to top of array, then all those 255s at the
        ' bottom of the array don't need to be cached in the PNG; not being there, PNG
        ' decoders must assume value is 255. We can save anywhere up to 200+ bytes
        ' depending on the image.
        ReDim palXRef(0 To 1, 0 To palCount - 1)
        
        If m_Trans = -1& Then   ' no transparencies and not grayscale
            Erase m_transPal
            For X = 0& To palCount - 1& ' all entries are opaque, no cross-referencing needed
                palXRef(0, X) = X
                palXRef(1, X) = X
            Next
        Else                    ' per-color alpha being used
            ' since we are re-ordering, we also need to build a cross-reference so
            ' we can reference palette locations, old to new and vice versa
            Y = 0&: X = palCount - 1&  ' starting points for top & bottom of array
            For Index = 0& To palCount - 1&
                If m_transPal(Index + 1&) = 255 Then
                    palXRef(1, X) = Index ' keep full opaque entries at bottom of array
                    palXRef(0, Index) = X ' double link reference
                    X = X - 1&
                Else
                    palXRef(0, Index) = Y ' move non-opaque entries near top of array
                    palXRef(1, Y) = Index ' double link reference
                    Y = Y + 1&
                End If
            Next
        End If
        
        ' now we build our 8 bpp paletted image, referencing the re-sorted palette entires
        For Y = 0& To UBound(m_Stream, 2)
            Index = Y * scanWidth
            For X = 0& To UBound(m_Stream, 1) Step 4&
                ' get 32bit color from DIB
                CopyMemory Color, m_Stream(X, Y), 4&
                ' locate it in our temp palette using binary search algorithm
                Color = FindColor(tSortIndex, Color, palCount, False)
                ' now cache its re-sorted reference
                m_Uncompressed(Index) = palXRef(0, Color - 1&)
                Index = Index + 1&
            Next
        Next
        
        ' good, now we need to build the palette the PNG will use,
        ' but we will be using 3 byte values, not 4 byte values & colors need to be RGB vs BGR
        ReDim m_Palette(1 To palCount * 3& + 4&) ' extra 4 bytes are used during Write_PLTE
        For X = 1& To palCount
            ' calculate new index for this palette entry
            Index = palXRef(0, X - 1&) * 3& + 5&   ' offset that extra 4 bytes too
            ' simultaneously remove pre-multiplication
            Select Case m_transPal(X)
            Case 255    ' full opaque
                m_Palette(Index) = (tPalette(X)  &H10000) And &HFF&
                m_Palette(Index + 1&) = (tPalette(X)  &H100&) And &HFF&
                m_Palette(Index + 2&) = tPalette(X) And &HFF&
            Case 0: ' do nothing, color is always 0,0,0
            Case Else
                m_Palette(Index) = (((tPalette(X)  &H10000) And &HFF&) * m_transPal(X)  255)
                m_Palette(Index + 1&) = (((tPalette(X)  &H100&) And &HFF&) * m_transPal(X)  255)
                m_Palette(Index + 2&) = ((tPalette(X) And &HFF&) * m_transPal(X)  255)
            End Select
        Next
        Erase tPalette()
        
        If Not m_Trans = -1& Then
            ' now we are going to double check how many non-opaque palette entries we have
            For X = 0& To palCount - 1&
                If m_transPal(palXRef(1, X) + 1&) = 255 Then
                    palCount = X    ' we saved 256-X bytes at least
                    Exit For
                End If
            Next
            ReDim palAlpha(1 To palCount + 4&)   ' extra 4 bytes used in Write_tRNS
            ' rewrite the m_transPal array, only caching non-opaque palette entries
            For X = 0& To palCount - 1&
                palAlpha(X + 5&) = m_transPal(palXRef(1, X) + 1&)
            Next
            m_transPal = palAlpha
        
        End If
    End If
    
    PalettizeImage = True
ExitRoutine:
End Function
Private Function FindColor(ByRef PaletteItems() As Long, ByVal Color As Long, ByVal Count As Long, ByRef isNew As Boolean) As Long
    ' MODIFIED BINARY SEARCH ALGORITHM -- Divide and conquer.
    ' Binary search algorithms are about the fastest on the planet, but
    ' its biggest disadvantage is that the array must already be sorted.
    ' Ex: binary search can find a value among 1 million values in less than 20 iterations
    
    ' [in] PaletteItems(). Long Array to search within. Array must be 1-bound
    ' [in] Color. A value to search for. Order is always ascending
    ' [in] Count. Number of items in PaletteItems() to compare against
    ' [out] isNew. If Color not found, isNew is True else False
    ' [out] Return value: The Index where Color was found or where the new Color should be inserted
    Dim UB As Long, LB As Long
    Dim newIndex As Long
    
    If Count = 0& Then
        FindColor = 1&
        isNew = True
        Exit Function
    End If
    
    UB = Count
    LB = 1&
    
    Do Until LB > UB
        newIndex = LB + ((UB - LB)  2&)
        If PaletteItems(newIndex) = Color Then
            Exit Do
        ElseIf PaletteItems(newIndex) > Color Then ' new color is lower in sort order
            UB = newIndex - 1&
        Else ' new color is higher in sort order
            LB = newIndex + 1&
        End If
    Loop
    If LB > UB Then  ' color was not found
            
        If Color > PaletteItems(newIndex) Then newIndex = newIndex + 1&
        isNew = True
        
    Else
        isNew = False
    End If
    
    FindColor = newIndex
End Function
Private Function ByteAlignOnByte(ByVal totalWidth As Long, ByVal 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)
    ByteAlignOnByte = (totalWidth * btsPerPixel + 7&)  8&
End Function
Private Function Write_IHDR(fileNum As Long, Stream() As Byte, Host As c32bppDIB, isInterlaced As Boolean) As Boolean
    Const png_Signature1 As Long = 1196314761
    Const png_Signature2 As Long = 169478669
    Const chnk_IHDR As Long = &H52444849 'Image header
    
    On Error GoTo eh
    Dim pngData(0 To 16) As Byte ' 13 byte header + 4 byte chunk name
    Dim gpLong As Long           ' general purpose variable
    Dim rwLen As Long
    
    ' build header
    CopyMemory pngData(0), chnk_IHDR, 4&    ' chunk name
    gpLong = iparseReverseLong(Host.Width)   ' png width
    CopyMemory pngData(4), gpLong, 4&
    gpLong = iparseReverseLong(Host.Height)  ' png height
    CopyMemory pngData(8), gpLong, 4&
    
    ' bit depth, 16bit (PNG 16 bytes per R,G,B element or 48 bytes per pixel)
    ' not supported via this class
    pngData(12) = 8 ' only 1,2,4,48 bpp are different, 8,24,32 bpp is 8
    
    pngData(13) = m_ColorType
    ' pngData(14) & (15) will always be zero (compression/filter methods)
    ' next byte is 1 if interlaced
    pngData(16) = Abs(isInterlaced)
    If fileNum = 0& Then ' writing to array vs file
        ReDim Stream(0 To 32) ' png signature, header len, header, crc value (33 bytes)
        CopyMemory Stream(0), png_Signature1, 4&
        CopyMemory Stream(4), png_Signature2, 4&
        gpLong = iparseReverseLong(13&) ' len of header
        CopyMemory Stream(8), gpLong, 4&
        CopyMemory Stream(12), pngData(0), 17&
        gpLong = zCreateCRC(VarPtr(pngData(0)), 17&)
        CopyMemory Stream(29), gpLong, 4&
        Write_IHDR = True
    Else
    
        WriteFile fileNum, png_Signature1, 4&, rwLen, ByVal 0&
        If rwLen = 4& Then
            WriteFile fileNum, png_Signature2, rwLen, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, iparseReverseLong(13&), rwLen, rwLen, ByVal 0&
                If rwLen = 4& Then
                    WriteFile fileNum, pngData(0), 17&, rwLen, ByVal 0&
                    If rwLen = 17& Then
                        WriteFile fileNum, zCreateCRC(VarPtr(pngData(0)), rwLen), 4&, rwLen, ByVal 0&
                        Write_IHDR = (rwLen = 4&)
                    End If
                End If
            End If
        End If
    End If
eh:
    If Err Then Err.Clear
End Function
Private Function Write_PLTE(fileNum As Long, Stream() As Byte, Invalid_bKGD As Boolean) As Boolean
    ' Note: the palette is preprocessed before it arrives here: BGR>RGB
    On Error GoTo eh
    
    If m_ColorType = clrPalette Then ' paletted images only
    
        Const chnk_PLTE As Long = &H45544C50 'Palette
        
        Dim gpLong As Long          ' general purpose variable
        Dim Index As Long
        Dim rwLen As Long
        
        ' when paletted, the bKGD chunk comes after the palette, but for palettes the
        ' bkgd chunk must be one of the palette entries, therefore, we will attempt to
        ' find the color in the palette, add it to the palette if possible, or skip
        ' the optional chunk if color is not in the palette
        If (m_PNGprops And ePngProperties.colorDefaultBkg) = ePngProperties.colorDefaultBkg Then
            Dim bkg(0 To 2) As Byte
            CopyMemory bkg(0), m_bKGD, 3&
            For Index = 5& To UBound(m_Palette) Step 3&
                If bkg(0) = m_Palette(Index) Then
                    If bkg(1) = m_Palette(Index + 1&) Then
                        If bkg(2) = m_Palette(Index + 2&) Then Exit For
                    End If
                End If
            Next
            If Index < UBound(m_Palette) Then   ' found it, ref the index
                m_bKGD = (Index - 5&)  3&
            ElseIf UBound(m_Palette) < 772& Then ' we can add it, let's do that
                ' ^^ 772 is 256*3+4
                ReDim Preserve m_Palette(1 To UBound(m_Palette) + 3&)
                m_bKGD = (UBound(m_Palette) - 5&)  3&
                CopyMemory m_Palette(UBound(m_Palette) - 2&), bkg(0), 3&
            Else
                Invalid_bKGD = True ' do not write the bkgd chunk
            End If
        End If
            
        CopyMemory m_Palette(1), chnk_PLTE, 4&
        gpLong = UBound(m_Palette)
        
        If fileNum = 0& Then 'writing to array vs file
            Index = UBound(Stream) + 1&
            ReDim Preserve Stream(0 To Index + gpLong + 7&)
            rwLen = iparseReverseLong(gpLong - 4&)
            CopyMemory Stream(Index), rwLen, 4&                 ' size of chunk
            CopyMemory Stream(Index + 4&), m_Palette(1), gpLong ' palette
            rwLen = zCreateCRC(VarPtr(m_Palette(1)), gpLong)
            CopyMemory Stream(Index + gpLong + 4&), rwLen, 4&   ' crc
            Write_PLTE = True
        Else
            WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, m_Palette(1), gpLong, rwLen, ByVal 0&
                If rwLen = gpLong Then
                    WriteFile fileNum, zCreateCRC(VarPtr(m_Palette(1)), gpLong), 4&, rwLen, ByVal 0&
                    Write_PLTE = (rwLen = 4&)
                End If
            End If
        End If
        Erase m_Palette()   ' no longer needed
    Else
        Write_PLTE = True
    End If
eh:
    If Err Then Err.Clear
End Function
Private Function Write_tEXt(fileNum As Long, Stream() As Byte, bTitleAuthorOnly As Boolean) As Boolean
    ' Function writes uncompressed standard Keywords & text to the PNG
    
    ' Note. Per PNG specs, some text should be written near top of the file while others
    ' should be written near the end. There is no requirement for text to appear in
    ' any specific location. The logic for writing some near the top is for search
    ' engines only. It would be faster to find that text if nearer the top.
    ' Therefore, this routine is called twice, once near the top of the PNG and
    ' and again just before the IEND chunk is written
    
    Const chnk_tEXt As Long = &H74584574 'Text - uncompressed
    
    On Error GoTo ExitRoutine
    
    Dim pngData() As Byte   ' data to be written to PNG file
    Dim txtData() As Byte
    Dim gpLong As Long
    Dim lenKeyword As Long
    Dim lenText As Long
    
    Dim Index As Long
    Dim CaptionID As Long
    Dim tProps As Long
    Dim lastCaption As Long
    Dim keyWord As String
    Dim rwLen As Long
    
    If bTitleAuthorOnly Then    ' called after writing IHDR
        CaptionID = ePngProperties.txtTitle
        lastCaption = ePngProperties.txtDescription
    Else                        ' called before writing IEND
        CaptionID = ePngProperties.txtDescription
        lastCaption = ePngProperties.txtLargeBlockText
    End If
    tProps = m_PNGprops
    Do Until CaptionID = lastCaption
        If (tProps And CaptionID) = CaptionID Then
            tProps = tProps And Not CaptionID
            Select Case CaptionID
            Case txtTitle: Index = 0
                keyWord = "Title" & Chr$(0)
            Case txtAuthor: Index = 1&
                keyWord = "Author" & Chr$(0)
            Case txtComment: Index = 9&
                keyWord = "Comment" & Chr$(0)
            Case txtCopyright: Index = 3&
                keyWord = "Copyright" & Chr$(0)
            Case txtCreationTime: Index = 4&
                keyWord = "Creation Time" & Chr$(0)
            Case txtDescription: Index = 2&
                keyWord = "Description" & Chr$(0)
            Case txtDisclaimer: Index = 6&
                keyWord = "Disclaimer" & Chr$(0)
            Case txtSoftware: Index = 5&
                keyWord = "Software" & Chr$(0)
            Case txtSource: Index = 8&
                keyWord = "Source" & Chr$(0)
            Case txtWarning: Index = 7&
                keyWord = "Warning" & Chr$(0)
            End Select
                
            ' tXTt chunk format::
            'Keyword 1-79 bytes (character string)
            'Null separator 1 byte (null character)
            'Text string 0 or more bytes (character string)
            
            lenKeyword = Len(keyWord)
            txtData() = StrConv(keyWord, vbFromUnicode)
            If Len(m_Captions(Index)) > 0& Then
                lenText = Len(m_Captions(Index))
                ReDim pngData(1 To lenKeyword + lenText + 4&)
                CopyMemory pngData(5), txtData(0), lenKeyword
                txtData() = StrConv(m_Captions(Index), vbFromUnicode)
                CopyMemory pngData(5& + lenKeyword), txtData(0), lenText
                
            Else ' handle zero-length chunks.
                ' Note: I would prefer to just skip these, but maybe you might
                ' decide to use one as a flag for something else?
                ReDim pngData(1 To lenKeyword + 4&)
                CopyMemory pngData(5), txtData(0), lenKeyword
            End If
            CopyMemory pngData(1), chnk_tEXt, 4&
            gpLong = lenKeyword + lenText + 4&
            
            If fileNum = 0& Then ' writing to stream
                Index = UBound(Stream) + 1&
                ReDim Preserve Stream(0 To Index + gpLong + 7&)
                rwLen = iparseReverseLong(gpLong - 4&)
                CopyMemory Stream(Index), rwLen, 4&
                CopyMemory Stream(Index + 4), pngData(1), gpLong
                rwLen = zCreateCRC(VarPtr(pngData(1)), gpLong)
                CopyMemory Stream(Index + 4& + gpLong), rwLen, 4&
                Write_tEXt = True
            Else
                WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
                If rwLen = 4& Then
                    WriteFile fileNum, pngData(1), gpLong, rwLen, ByVal 0&
                    If rwLen = gpLong Then
                        WriteFile fileNum, zCreateCRC(VarPtr(pngData(1)), gpLong), 4&, rwLen, ByVal 0&
                        Write_tEXt = (rwLen = 4&)
                    End If
                End If
            End If
        End If
        CaptionID = CaptionID * 2&
    Loop
    
ExitRoutine:
    If Err Then
        Err.Clear
    Else
        If lenKeyword = 0& Then Write_tEXt = True
    End If
End Function
Private Function Write_tIMe(fileNum As Long, Stream() As Byte) As Boolean
    ' Note: the time stamp should be Universal Time, not local area
    
    If (m_PNGprops And ePngProperties.dateTimeModified) = ePngProperties.dateTimeModified Then
        Const chnk_tIME As Long = &H454D4974 'Timestamp
        
        On Error GoTo eh
        Dim pngData(0 To 10) As Byte ' 7 byte date/time + 4 byte chunk name
        Dim gpLong As Long
        Dim gpInt As Integer
        Dim dtStamp As Date
        Dim rwLen As Long
        
        dtStamp = CDate(m_Captions(10))
        
        CopyMemory pngData(0), chnk_tIME, 4&
            gpInt = Year(dtStamp)
        CopyMemory pngData(5), gpInt, 2&
        pngData(4) = pngData(6)             ' swap endian of integer
            gpInt = Month(dtStamp)
        CopyMemory pngData(6), gpInt, 1&
            gpInt = Day(dtStamp)
        CopyMemory pngData(7), gpInt, 1&
            gpInt = Hour(dtStamp)
        CopyMemory pngData(8), gpInt, 1&
            gpInt = Minute(dtStamp)
        CopyMemory pngData(9), gpInt, 1&
            gpInt = Second(dtStamp)
        CopyMemory pngData(10), gpInt, 1&
        
        If fileNum = 0& Then ' writing to stream
            gpLong = UBound(Stream) + 1&
            ReDim Preserve Stream(0 To gpLong + 18&)
            rwLen = iparseReverseLong(7)
            CopyMemory Stream(gpLong), rwLen, 4&
            CopyMemory Stream(gpLong + 4&), pngData(0), 11&
            rwLen = zCreateCRC(VarPtr(pngData(0)), 11&)
            CopyMemory Stream(gpLong + 15&), rwLen, 4&
            Write_tIMe = True
        Else
            WriteFile fileNum, iparseReverseLong(7), 4&, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, pngData(0), 11&, rwLen, ByVal 0&
                If rwLen = 11& Then
                    WriteFile fileNum, zCreateCRC(VarPtr(pngData(0)), rwLen), 4&, rwLen, ByVal 0&
                    Write_tIMe = (rwLen = 4&)
                End If
            End If
        End If
    Else
        Write_tIMe = True
    End If
eh:
    If Err Then Err.Clear
End Function
Private Function Write_tRNS(fileNum As Long, Stream() As Byte) As Boolean
    ' For paletted/grayscale images, tRNS is the palette index, otherwise RGB value
    On Error GoTo eh
        
    If m_Trans = -1& Then
        Write_tRNS = True
    
    Else ' transparency not used
    
        Const chnk_tRNS As Long = &H534E5274 'Simple Transparency & palette transparency
        Dim Index As Long
        Dim gpLong As Long
        Dim rwLen As Long
    
        Select Case m_ColorType
            
            Case clrPalette ' Paletted (palette count * 3 + 4 byte chunk name)
                ' nothing to do; done during PalettizeImage
            
            Case clrGrayScale ' grayscale
                ReDim m_transPal(1 To 6)   ' 2 bytes + 4 byte chunk name
                m_transPal(6) = m_Trans
                ' Note: m_transPal(5) used with 48bit per pixel images (not supported)
            
            Case clrTrueColor ' we have simple transparency for true color
                ReDim m_transPal(1 To 10)   ' 6 bytes + 4 byte chunk name
                m_transPal(6) = m_Trans And &HFF
                m_transPal(8) = (m_Trans  &H100&) And &HFF
                m_transPal(10) = (m_Trans  &H10000) And &HFF
                ' Note: m_transPal(5,7,9) used with 48bit per pixel images (not supported)
        
            Case Else
                ' Color Types 4 & 6 are prohibited from having a tRNS chunk
                Write_tRNS = True
                Exit Function
        End Select
        
        CopyMemory m_transPal(1), chnk_tRNS, 4&
        gpLong = UBound(m_transPal)
    
        ' write the chunk
        If fileNum = 0& Then ' writing to array vs file
            Index = UBound(Stream) + 1&
            ReDim Preserve Stream(0 To Index + gpLong + 7&)
            rwLen = iparseReverseLong(gpLong - 4&)
            CopyMemory Stream(Index), rwLen, 4&                 ' chunk size
            CopyMemory Stream(Index + 4&), m_transPal(1), gpLong ' palette
            gpLong = zCreateCRC(VarPtr(m_transPal(1)), gpLong)
            CopyMemory Stream(Index + UBound(m_transPal) + 4&), gpLong, 4&       ' crc value
            Write_tRNS = True
        Else
            WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, m_transPal(1), gpLong, rwLen, ByVal 0&
                If rwLen = gpLong Then
                    WriteFile fileNum, zCreateCRC(VarPtr(m_transPal(1)), gpLong), 4&, rwLen, ByVal 0&
                    Write_tRNS = (rwLen = 4&)
                End If
            End If
        End If
        Erase m_transPal()
    End If
eh:
    If Err Then Err.Clear
End Function
Private Function Write_zTXt(fileNum As Long, Stream() As Byte) As Boolean
    ' Function writes non-reserved keyword compressed/uncompressed text to the PNG
    
    If (m_PNGprops And ePngProperties.txtLargeBlockText) = ePngProperties.txtLargeBlockText Then
        On Error GoTo eh
        Const chnk_tEXt As Long = &H74584574 'Text - uncompressed
        Const chnk_zTXt As Long = &H7458547A 'Text - compressed
        
        Dim txtData() As Byte   ' comments/text in bytes
        Dim pngData() As Byte   ' data to be written to PNG file
        Dim sText As String
        Dim gpLong As Long
        Dim Index As Long
        Dim rwLen As Long
        Dim lenKeyword As Long
        Dim lenText As Long
        Dim bWritten As Boolean
    
        For Index = 11& To UBound(m_Captions)
            ' convert keyword to bytes
            lenKeyword = InStr(m_Captions(Index), Chr$(0))
            lenText = Len(m_Captions(Index)) - lenKeyword
            txtData() = StrConv(m_Captions(Index), vbFromUnicode)
            
            ' per PNG specs....
            ' It is recommended that text items less than 1K (1024 bytes)
            ' in size should be output using uncompressed text chunks
            If lenText > 1024& Then
            
                ' IMPORTANT: This portion of the routine is not equipped to write
                ' zero-length text block. That is only handled above where the
                ' .Text length is < 1025... DO NOT modify that IF statement to
                ' allow zero-length chunks to fall thru to this portion of IF
                
                ' zTXt chunk format::
                'Keyword 1-79 bytes (character string)
                'Null separator 1 byte (null character)
                'Compression method 1 byte
                'Compressed text datastream n bytes
                
                ' Note that the compression byte of zero needs to be included too,
                ' but we don't add it to the txtData conversion above cause zero
                ' would be converted to 48 -- Asc("0").
                
                gpLong = lenText * 0.01 + 12& + lenText
                '^^ Text won't always compress smaller; it should, but may not
                ' That is why it is recommended to allow 1024 bytes as uncompressed
                ReDim pngData(1 To gpLong + (lenKeyword + 5&))
                ' ^^ include 4 bytes for chunk name + keyword length + 1 byte compression method
                    
                If zDeflate(VarPtr(pngData(6& + lenKeyword)), gpLong, VarPtr(txtData(lenKeyword)), lenText) = True Then
                    ' ^^ store compression after chunk name, after keyword and after compression method
                    ' ^^ begin compression on 1st byte of the text, not the caption or compression method
                    
                    CopyMemory pngData(1), chnk_zTXt, 4&
                    CopyMemory pngData(5), txtData(0), lenKeyword
                    gpLong = gpLong + lenKeyword + 5&
                    If fileNum = 0& Then    ' writing to array
                        Index = UBound(Stream) + 1&
                        ReDim Preserve Stream(0 To Index + gpLong + 7&)
                        rwLen = iparseReverseLong(gpLong - 4&)
                        CopyMemory Stream(Index), rwLen, 4&
                        CopyMemory Stream(Index + 4&), pngData(1), gpLong
                        rwLen = zCreateCRC(VarPtr(pngData(1)), gpLong)
                        CopyMemory Stream(Index + gpLong + 4&), rwLen, 4&
                        Write_zTXt = True
                    Else
                        WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
                        If rwLen = 4& Then
                            WriteFile fileNum, pngData(1), gpLong, rwLen, ByVal 0&
                            If rwLen = gpLong Then
                                WriteFile fileNum, zCreateCRC(VarPtr(pngData(1)), gpLong), 4&, rwLen, ByVal 0&
                                Write_zTXt = (rwLen = 4&)
                            End If
                        End If
                    End If
                    bWritten = True
                Else    ' failed to compress. Which means our buffer was too small
                        ' Therefore we will add it as uncompressed instead of
                        ' making the buffer even bigger
                End If
            End If
            
            If Not bWritten Then 'either len<1025 or compression failed
                ' tXTt chunk format::
                'Keyword 1-79 bytes (character string)
                'Null separator 1 byte (null character)
                'Text string 0 or more bytes (character string)
                gpLong = lenText + lenKeyword + 4&  ' size of chunk
                ReDim pngData(1 To gpLong)
                CopyMemory pngData(1), chnk_tEXt, 4&
                CopyMemory pngData(5), txtData(0), lenKeyword
                
                If Not lenText = 0& Then ' zero-length text; not prohibited by PNG specs
                    CopyMemory pngData(5 + lenKeyword), txtData(lenKeyword), lenText
                End If
                
                If fileNum = 0& Then ' writing to array
                    Index = UBound(Stream) + 1&
                    ReDim Preserve Stream(0 To Index + gpLong + 7&)
                    rwLen = iparseReverseLong(gpLong - 4&)
                    CopyMemory Stream(Index), rwLen, 4&
                    CopyMemory Stream(Index + 4&), pngData(1), gpLong
                    rwLen = zCreateCRC(VarPtr(pngData(1)), gpLong)
                    CopyMemory Stream(Index + gpLong + 4&), rwLen, 4&
                    Write_zTXt = True
                Else
                    WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
                    If rwLen = 4& Then
                        WriteFile fileNum, pngData(1), gpLong, rwLen, ByVal 0&
                        If rwLen = gpLong Then
                            WriteFile fileNum, zCreateCRC(VarPtr(pngData(1)), gpLong), 4&, rwLen, ByVal 0&
                            Write_zTXt = (rwLen = 4&)
                        End If
                    End If
                End If
            End If
        Next
    Else
        Write_zTXt = True
    End If
    
eh:
    If Err Then Err.Clear
End Function
Private Function Write_bKGD(fileNum As Long, Stream() As Byte) As Boolean
    ' For paletted/grayscale images, this is the palette index, otherwise RGB value
    On Error GoTo eh
    Const chnk_bKGD As Long = &H44474B62 'Window Background Color
    
    If (m_PNGprops And ePngProperties.colorDefaultBkg) = ePngProperties.colorDefaultBkg Then
    
        Dim pngData() As Byte
        Dim gpLong As Long
        Dim rwLen As Long
        Dim Index As Long
            
        ' Per PNG specs, bKGD chunk must come before IDAT and after PLTE
        Select Case m_ColorType
        Case clrPalette  ' 1 byte + 4 byte chunk name
            ReDim pngData(0 To 4)
            pngData(4) = CByte(m_bKGD)
        
        Case clrGrayScale, clrGrayAlpha   ' grayscales, 2 bytes + 4 byte chunk name
            ReDim pngData(0 To 6)
            pngData(5) = (m_bKGD And &HFF)
            ' pngData(4) used with 48bit per pixel images (not supported)
            
        Case Else ' true color, RGB format
            ReDim pngData(0 To 9)   ' 6 bytes + 4 byte chunk name
            pngData(5) = m_bKGD And &HFF
            pngData(7) = (m_bKGD  &H100&) And &HFF
            pngData(9) = (m_bKGD  &H10000) And &HFF
            ' Note: pngData(4,6,8) used with 48bit per pixel images (not supported)
        End Select
        
        CopyMemory pngData(0), chnk_bKGD, 4&
        gpLong = UBound(pngData) + 1&
        
        If fileNum = 0& Then 'writing to array
            Index = UBound(Stream) + 1&
            ReDim Preserve Stream(0 To Index + gpLong + 7&)
            rwLen = iparseReverseLong(gpLong - 4&)
            CopyMemory Stream(Index), rwLen, 4&
            CopyMemory Stream(Index + 4&), pngData(0), gpLong
            rwLen = zCreateCRC(VarPtr(pngData(0)), gpLong)
            CopyMemory Stream(Index + gpLong + 4&), rwLen, 4&
            Write_bKGD = True
        Else
            WriteFile fileNum, iparseReverseLong(gpLong - 4&), 4&, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, pngData(0), gpLong, rwLen, ByVal 0&
                If rwLen = gpLong Then
                    WriteFile fileNum, zCreateCRC(VarPtr(pngData(0)), gpLong), 4&, rwLen, ByVal 0&
                    Write_bKGD = (rwLen = 4&)
                End If
            End If
        End If
    Else
        Write_bKGD = True
    End If
eh:
    If Err Then Err.Clear
        
End Function
Private Function Write_IDAT(fileNum As Long, outStream() As Byte, imgData() As Byte, filterLen As Long) As Boolean
    ' Function writes the IDAT chunk(s). If more than one, they must be back to back
    ' Note: IDATs can be written in multiple chunks; if so, chunks must be consecutive
    Const chnk_IDAT As Long = &H54414449 'Image data
    
    On Error GoTo eh
    Dim gpLong As Long, Index As Long
    Dim rwLen As Long
    
    CopyMemory imgData(0), chnk_IDAT, 4&
    If fileNum = 0& Then ' writing to array vs file
        Index = UBound(outStream) + 1&
        ReDim Preserve outStream(0 To Index + filterLen + 11&)
        gpLong = iparseReverseLong(filterLen)
        CopyMemory outStream(Index), gpLong, 4&  ' add chunk size
        CopyMemory outStream(Index + 4&), imgData(0), filterLen + 4& ' add compressed data
        gpLong = zCreateCRC(VarPtr(imgData(0)), filterLen + 4&)
        CopyMemory outStream(Index + 8& + filterLen), gpLong, 4& ' add crc value
        Write_IDAT = True
    Else
        
        WriteFile fileNum, iparseReverseLong(filterLen), 4&, rwLen, ByVal 0&
        If rwLen = 4& Then
            WriteFile fileNum, imgData(0), filterLen + 4&, rwLen, ByVal 0&
            If rwLen = filterLen + 4& Then
                WriteFile fileNum, zCreateCRC(VarPtr(imgData(0)), rwLen), 4&, rwLen, ByVal 0&
                Write_IDAT = (rwLen = 4&)
            End If
        End If
    End If
eh:
    If Err Then Err.Clear
End Function
Private Function Write_IEND(fileNum As Long, Stream() As Byte) As Boolean
    Const chnk_IEND As Long = &H444E4549 'End of Image
    
    On Error GoTo eh
    Dim Index As Long
    Dim gpLong As Long
    Dim rwLen As Long
    
    If fileNum = 0 Then ' writing to array vs file
    
        Index = UBound(Stream) + 1&
        ReDim Preserve Stream(0 To Index + 11&)
        CopyMemory Stream(Index), 0&, 4&
        CopyMemory Stream(Index + 4), chnk_IEND, 4&   ' chunk name, chunk length is zero
        gpLong = zCreateCRC(VarPtr(chnk_IEND), 4&)
        CopyMemory Stream(Index + 8&), gpLong, 4&    ' crc value
        Write_IEND = True
    Else
    
        WriteFile fileNum, rwLen, 4&, rwLen, ByVal 0&
        If rwLen = 4& Then
            WriteFile fileNum, chnk_IEND, 4&, rwLen, ByVal 0&
            If rwLen = 4& Then
                WriteFile fileNum, zCreateCRC(VarPtr(chnk_IEND), 4&), 4&, rwLen, ByVal 0&
                Write_IEND = (rwLen = 4&)
            End If
        End If
    End If
eh:
    If Err Then Err.Clear
End Function
Private Sub EncodeFilter_None(pngData() As Byte, _
                        ByVal RowNr As Long, dibRowNr As Long, _
                        ByVal scanLineDIB As Long, scanLinePNG As Long, _
                        stepVal As Byte, AdptValue As Long)
    ' this routine is only called when adapative filter method is used
    
    Dim X As Long
    Dim startByte As Long, locDIB As Long
    Dim lTest As Long
    
    If scanLineDIB > -1 Then ' processing interlaced image
        ' for interlaced, m_Uncompressed will be a top-down calculated array
        ' and the scanLineDIB parameter is an offset into the interlaced array
        startByte = scanLineDIB + 1
        locDIB = startByte
    Else
        ' for non-interlaced, m_Uncompressed will be a bottom-up DIB
        locDIB = dibRowNr * -scanLineDIB
        startByte = RowNr * scanLinePNG + RowNr + 1
   End If
    
    For X = locDIB To locDIB + scanLinePNG - 1
        lTest = lTest + m_Uncompressed(X)
        If lTest > AdptValue Then Exit Sub
    Next
    
    If lTest = 0 Then lTest = 1
    AdptValue = lTest
    pngData(startByte - 1) = 0
End Sub
Private Sub EncodeFilter_Up(pngData() As Byte, _
                        ByVal RowNr As Long, dibRowNr As Long, _
                        ByVal scanLineDIB As Long, scanLinePNG As Long, _
                        stepVal As Byte, AdptValue As Long)
' this is Filter Type 2
'http://www.w3.org/TR/PNG/#9-table91
    
    Dim ppTop As Integer
    Dim X As Long
    Dim startByte As Long, locDIB As Long
    Dim lTest As Long, prevRow As Long
    
    If scanLineDIB > -1 Then ' processing interlaced image
        ' for interlaced, m_Uncompressed will be a top-down calculated array
        ' and the scanLineDIB parameter is an offset into the interlaced array
        startByte = scanLineDIB + 1
        scanLineDIB = scanLinePNG + 1
        locDIB = startByte
    Else
        ' for non-interlaced, m_Uncompressed will be a bottom-up DIB
        locDIB = dibRowNr * -scanLineDIB
        startByte = RowNr * scanLinePNG + RowNr + 1
    End If
        
    If AdptValue Then
        
        If RowNr Then
            For X = locDIB To locDIB + scanLinePNG - 1
                lTest = lTest + Abs(0 + m_Uncompressed(X) - m_Uncompressed(X - scanLineDIB))
                If lTest > AdptValue Then Exit Sub
            Next
            
            If lTest = 0 Then lTest = 1
            AdptValue = lTest
            pngData(startByte - 1) = 2
        End If
        
    Else
        For X = 0 To scanLinePNG - 1
            If RowNr Then ppTop = m_Uncompressed(locDIB + X - scanLineDIB)
            ' VB workaround for C++ unsigned math
            If ppTop > m_Uncompressed(locDIB + X) Then
                pngData(startByte + X) = 256 - ppTop + m_Uncompressed(locDIB + X)
            Else
                pngData(startByte + X) = m_Uncompressed(locDIB + X) - ppTop
            End If
        Next
        pngData(startByte - 1) = 2
    End If
End Sub
Private Sub EncodeFilter_Sub(pngData() As Byte, _
                        ByVal RowNr As Long, dibRowNr As Long, _
                        ByVal scanLineDIB As Long, scanLinePNG As Long, _
                        stepVal As Byte, AdptValue As Long)
' This is Filter Type 1
'http://www.w3.org/TR/PNG/#9-table91
    Dim X As Long
    Dim startByte As Long, locDIB As Long
    Dim lTest As Long
    
    If scanLineDIB > -1 Then ' processing interlaced image
        ' for interlaced, m_Uncompressed will be a top-down calculated array
        ' and the scanLineDIB parameter is an offset into the interlaced array
        startByte = scanLineDIB + 1
        scanLineDIB = scanLinePNG + 1
        locDIB = startByte
    Else
        ' for non-interlaced, m_Uncompressed will be a bottom-up DIB
        locDIB = dibRowNr * -scanLineDIB
        startByte = RowNr * scanLinePNG + RowNr + 1
    End If
        
    If AdptValue Then
    
        ' 1st n bytes for 1st pixel are unfiltered
        For X = locDIB To stepVal + locDIB - 1
            lTest = lTest + m_Uncompressed(X)
        Next
        
        For X = locDIB + stepVal To scanLinePNG - 1
            lTest = lTest + Abs(0 + m_Uncompressed(X) - m_Uncompressed(X - stepVal))
            If lTest > AdptValue Then Exit Sub
        Next
        
        If lTest = 0 Then lTest = 1
        AdptValue = lTest
        
    Else
        ' 1st n bytes for 1st pixel are unfiltered
        CopyMemory pngData(startByte), m_Uncompressed(locDIB), stepVal
        
        For X = stepVal To scanLinePNG - 1
            ' VB workaround for C++ unsigned math
            If m_Uncompressed(locDIB + X - stepVal) > m_Uncompressed(locDIB + X) Then
                pngData(startByte + X) = 256 - m_Uncompressed(locDIB + X - stepVal) + m_Uncompressed(locDIB + X)
            Else
                pngData(startByte + X) = m_Uncompressed(locDIB + X) - m_Uncompressed(locDIB + X - stepVal)
            End If
        Next
    End If
    pngData(startByte - 1) = 1
End Sub
Private Sub EncodeFilter_Avg(pngData() As Byte, _
                        ByVal RowNr As Long, dibRowNr As Long, _
                        ByVal scanLineDIB As Long, scanLinePNG As Long, _
                        stepVal As Byte, AdptValue As Long)
' This is Filter Type 3
'http://www.w3.org/TR/PNG/#9-table91
    Dim ppLeft As Integer, ppTop As Integer
    Dim X As Long, pReturn As Integer
    Dim locDIB As Long, startByte As Long
    Dim lTest As Long
    
    If scanLineDIB > -1 Then ' processing interlaced image
        ' for interlaced, m_Uncompressed will be a top-down calculated array
        ' and the scanLineDIB parameter is an offset into the interlaced array
        startByte = scanLineDIB + 1
        scanLineDIB = scanLinePNG + 1
        locDIB = startByte
    Else
        ' for non-interlaced, m_Uncompressed will be a bottom-up DIB
        locDIB = dibRowNr * -scanLineDIB
        startByte = RowNr * scanLinePNG + RowNr + 1
    End If
    
    If AdptValue Then
    
        If RowNr Then
        
            For X = locDIB To locDIB + scanLinePNG - 1
                ppTop = m_Uncompressed(X - scanLineDIB)
                If X >= locDIB + stepVal Then ppLeft = m_Uncompressed(X - stepVal)
                lTest = lTest + Abs((m_Uncompressed(X) - (ppLeft + ppTop)  2))
                If lTest > AdptValue Then Exit Sub
            Next
            If lTest = 0 Then lTest = 1
            AdptValue = lTest
            pngData(startByte - 1) = 3
            
        End If
        
    Else
    
        For X = 0 To scanLinePNG - 1
        
            If RowNr Then ppTop = m_Uncompressed(locDIB - scanLineDIB + X)
            If X >= stepVal Then ppLeft = m_Uncompressed(locDIB - stepVal + X)
            
            pReturn = (ppLeft + ppTop)  2
            ' VB workaround for C++ unsigned math
            If pReturn > m_Uncompressed(locDIB + X) Then
                pngData(X + startByte) = 256 - pReturn + m_Uncompressed(X + locDIB)
            Else
                pngData(X + startByte) = m_Uncompressed(X + locDIB) - pReturn
            End If
        
        Next
        pngData(startByte - 1) = 3
    
    End If
    
End Sub
Private Sub EncodeFilter_Paeth(pngData() As Byte, _
                        ByVal RowNr As Long, dibRowNr As Long, _
                        ByVal scanLineDIB As Long, scanLinePNG As Long, _
                        stepVal As Byte, AdptValue As Long)
' This is Filter Type 4
'http://www.w3.org/TR/PNG/#9-table91
    Dim ppLeft As Integer, ppTop As Integer, ppTopLeft As Integer
    Dim X As Long, pReturn As Integer
    Dim startByte As Long, locDIB As Long
    Dim lTest As Long, prevRow As Long
    
    If scanLineDIB > -1 Then ' processing interlaced image
        ' for interlaced, m_Uncompressed will be a top-down calculated array
        ' and the scanLineDIB parameter is an offset into the interlaced array
        startByte = scanLineDIB + 1
        scanLineDIB = scanLinePNG + 1
        locDIB = startByte
    Else
        ' for non-interlaced, m_Uncompressed will be a bottom-up DIB
        locDIB = dibRowNr * -scanLineDIB
        startByte = RowNr * scanLinePNG + RowNr + 1
    End If
        
    If AdptValue Then
    
        If RowNr Then
            
            For X = locDIB To locDIB + scanLinePNG - 1
                If X >= stepVal + locDIB Then ' we are not on the 1st pixel
                    ppLeft = m_Uncompressed(X - stepVal)
                    ppTopLeft = m_Uncompressed(X - scanLineDIB - stepVal)
                End If
                ppTop = m_Uncompressed(X - scanLineDIB)
                ' get the Paeth closest neighbor
                lTest = lTest + Abs((m_Uncompressed(X) - PaethPredictor(ppLeft, ppTop, ppTopLeft)))
                If lTest > AdptValue Then Exit Sub
            Next
            
            If lTest = 0 Then lTest = 1
            AdptValue = lTest
            pngData(startByte - 1) = 4
        End If
    Else
    
        For X = 0 To scanLinePNG - 1
            
            If X >= stepVal Then ' we are not on the 1st pixel
                ppLeft = m_Uncompressed(locDIB + X - stepVal)
                If RowNr Then
                    prevRow = locDIB + X - scanLineDIB
                    ppTop = m_Uncompressed(prevRow)
                    ppTopLeft = m_Uncompressed(prevRow - stepVal)
                End If
            Else
                If RowNr Then ppTop = m_Uncompressed(locDIB + X - scanLineDIB)
            End If
            ' get the Paeth closest neighbor
            pReturn = PaethPredictor(ppLeft, ppTop, ppTopLeft)
            
            ' VB workaround for C++ unsigned math
            If pReturn > m_Uncompressed(locDIB + X) Then
                pngData(startByte + X) = 256 - pReturn + m_Uncompressed(locDIB + X)
            Else
                pngData(startByte + X) = m_Uncompressed(locDIB + X) - pReturn
            End If
            
        Next
        pngData(startByte - 1) = 4
    End If
End Sub
Private Function PaethPredictor(Left As Integer, Above As Integer, UpperLeft As Integer) As Integer
' http://www.w3.org/TR/PNG/#9-table91
' algorithm is used for both encoding & decoding the png paeth 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 = 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 Function FilterImage(fileNum As Long, Stream() As Byte, Host As c32bppDIB, ByVal FilterMethod As eFilterMethods) As Boolean
    ' Routine will Filter the image in one of the 5 types of authorized PNG Filters.
    ' The Adaptive filter approach will select a best-guess filter to use for each
    ' scan line of the image. Otherwise, the same filter is applied to every scan line.
    
    ' Note about filters. Binary data compresses very poorly. Filters are a way to
    '   rewrite the binary data so that it will compress better. That is its only purpose.
    Dim scanWidth_DIB As Long, scanWidth_PNG As Long    ' scanwidths of 2 images
    Dim compressedData() As Byte          ' filtered PNG data
    Dim filteredData() As Byte           ' unfiltered PNG data
    Dim gpLong As Long              ' general purpose Long value
    Dim arrayPtr As Long, pIndex As Long    ' array/loop variables
    Dim bytePP As Byte              ' DIB/PNG bytes per pixel
    
    If FilterMethod < filterDefault Or FilterMethod > filterAdaptive Then FilterMethod = filterDefault
    Select Case m_ColorType
    Case clrGrayScale, clrPalette
        scanWidth_DIB = Host.Width
        scanWidth_PNG = scanWidth_DIB
        ' paletted images. Almost always, filter type zero is best (no filters)
        If FilterMethod = filterDefault Then FilterMethod = filterNone
        bytePP = 1
        
    Case Else ' true color, true color w/alpha (grayscale w/Alpha is converted to clrPalette in PalettizeImage)
        ' the best, non-adapative method for 24/32 bit is usually Paeth
        If FilterMethod = filterDefault Then FilterMethod = filterPaeth
        If m_ColorType = clrTrueAlpha Then
            ' get scan width for PNG file: byte aligned
            scanWidth_DIB = Host.scanWidth
            scanWidth_PNG = scanWidth_DIB
            bytePP = 4
        Else
            scanWidth_DIB = iparseByteAlignOnWord(24, Host.Width)
            scanWidth_PNG = ByteAlignOnByte(Host.Width, 24)
            bytePP = 3
        End If
    End Select
    
    ' Size raw data to be compressed and include 1 filter byte per line of image
    ReDim filteredData(0 To scanWidth_PNG * Host.Height + Host.Height - 1)
    If Err Then
        ' about the only possible error would be not enough memory to process the image file
        Err.Clear
        Exit Function
    End If
    
    
        For pIndex = 0 To Host.Height - 1
            
            arrayPtr = pIndex * scanWidth_PNG + pIndex   ' position of scanline
            
            If FilterMethod = filterAdaptive Then
                ' adaptive filtering
                ' although this can sequeeze an extra couple kb out of the png, I am finding
                ' that using Paeth appears to be either better or very close to adaptive filtering
                ' in most cases. Paeth is slowest of the top 5 filters (0-4). But adaptive filtering
                ' is significantly slower than Paeth. The deciding factor for adapative
                ' outdoing the others is the number of colors in the image. The more colors,
                ' the better chances adaptive has of being smaller size. The least amount
                ' of colors, the better chances Paeth has of being smaller.
                
                ' More testing needed though. I wouldn't imagine the PNG specs would recommend
                ' adaptive filtering unless it had some huge advantage over Paeth. What
                ' I am avoiding at all costs is a brute force routine to definitively
                ' find the best scanline filter method. That brute force can literally
                ' take minutes on full size 24/32bpp images.
                
                filteredData(arrayPtr) = 0
                gpLong = scanWidth_PNG * 254&  ' max value
                
                ' listed in order of quickest
                EncodeFilter_None filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, gpLong
                EncodeFilter_Sub filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, gpLong
                EncodeFilter_Up filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, gpLong
                EncodeFilter_Avg filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, gpLong
                EncodeFilter_Paeth filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, gpLong
                ' ^^ the -scanWidth_DIB is a flag indicating we are not filtering interlaced PNG
            Else
                filteredData(arrayPtr) = FilterMethod - 1
            End If
                    
            Select Case filteredData(arrayPtr) + 1 ' cache filter method into PNG data
            Case filterNone
                gpLong = (Host.Height - pIndex - 1) * scanWidth_DIB ' get current row relative to upside down DIB
                CopyMemory filteredData(arrayPtr + 1), m_Uncompressed(gpLong), scanWidth_PNG
            Case filterAdjLeft
                EncodeFilter_Sub filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, 0
            Case filterAdjTop
                EncodeFilter_Up filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, 0
            Case filterAdjAvg
                EncodeFilter_Avg filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, 0
            Case filterPaeth
                EncodeFilter_Paeth filteredData, pIndex, Host.Height - pIndex - 1, -scanWidth_DIB, scanWidth_PNG, bytePP, 0
            End Select
            ' ^^ the -scanWidth_DIB is a flag indicating we are not filtering interlaced PNG
        
        Next
    
    Erase m_Uncompressed    ' no longer needed
    If Err Then
        Err.Clear
    Else
        gpLong = UBound(filteredData) + 1
        gpLong = gpLong * 0.01 + 12 + gpLong ' < sizing algorithm for compressed array per zLIB specs
        ReDim compressedData(0 To gpLong + 3) ' include 4 bytes for Write_IDAT
        If zDeflate(VarPtr(compressedData(4)), gpLong, VarPtr(filteredData(0)), UBound(filteredData) + 1) = True Then
            FilterImage = Write_IDAT(fileNum, Stream(), compressedData(), gpLong)
        End If
    
    End If
End Function
Private Function FormatText(txt2format As String) As String
    
    ' Function ensures text added to a PNG file meets PNG specs
    Dim Index As Integer
    Dim rtnString As String
    Const maxLength As Long = 32700&
    ' not a PNG restriction, but self-imposed. Keep text to Integer length
    
    ' per PNG specs, text and captions are limited to Latin1 character set and the line feed
    ' Latin1 character set is Chr$(32) & above.
    ' http://www.w3.org/TR/PNG/iso_8859-1.txt
    
    If txt2format = vbNullString Then
        rtnString = txt2format
    Else
        rtnString = Left$(txt2format, maxLength)
        
        ' per PNG specs, the only character allowed lower than a SPACE is the line feed character
        ' therefore we will replace vbCrLf with the line feed chr$(10)/vbLf
        rtnString = Replace$(rtnString, vbCrLf, vbLf)
        rtnString = Replace$(rtnString, vbCr, vbLf)
        
        For Index = 1 To Len(rtnString)
            Select Case Asc(Mid$(rtnString, Index, 1))
            Case 9, 10   ' lf is valid. Tab, depending on sources, is ok too
            Case Is < 32 ' all these are not allowed
                rtnString = vbNullString
                Exit For
            Case Else       ' otherwise, all other characters are allowed
            End Select
        Next
    End If
    
    FormatText = rtnString
End Function
Private Function FormatCaption(ByRef Caption As String) As Long
    ' per PNG specs, text and captions are limited to Latin1 character set and the line feed
    ' Latin1 character set is Chr$(32) & above.
    ' http://www.w3.org/TR/PNG/iso_8859-1.txt
    
    ' Return values
    ' If caption is a reserved caption,
    '       then FormatCaption=PropertyID of reserved caption
    '   else FormatCaption=-1 to indicate not reserved
    ' If caption is disqualified, then Caption is returned as vbNullString
    Dim Index As Long, CaptionID As Long
    
    If Not Caption = vbNullString Then
        
        ' we are formatting/validating a keyword/caption for LargeBlockText
            
        ' when adding txtLargeBlock, a keyword is required, but must meet specs
        Caption = Trim$(Left$(Caption, 79)) ' absolute requirement
        Do Until InStr(Caption, "  ") = 0   ' absolute requirement
            Caption = Replace$(Caption, "  ", " ") ' remove all double spaces
        Loop
        
        'only character codes 32-126 and 161-255 are allowed
        For Index = 1 To Len(Caption)
            Select Case Asc(Mid$(Caption, Index, 1))
            Case 160: Mid$(Caption, Index, 1) = Chr$(32) ' suggested: convert hard space to soft space
            Case 32 To 126  ' valid
            Case 161 To 255  ' valid
            Case Else       ' otherwise, all other characters are NOT allowed, invalidating caption
                Caption = vbNullString
                Exit For
            End Select
        Next
        
        ' now the last check, cannot use a reserved keyword
        If Not Caption = vbNullString Then CaptionID = isKeyWord(Caption)
    
    End If
    FormatCaption = CaptionID
End Function
Private Function isKeyWord(inCaption As String) As Long
    ' compares passed caption to PNG reserved keywords
    Dim Index As Long, keyWord As String, keyID As Long
        For Index = 1 To 11
            Select Case Index
            Case 1: keyWord = "Title": keyID = txtTitle
            Case 2: keyWord = "Author": keyID = txtAuthor
            Case 3: keyWord = "Description": keyID = txtDescription
            Case 4: keyWord = "Copyright": keyID = txtCopyright
            Case 5: keyWord = "Creation Time": keyID = txtCreationTime
            Case 6: keyWord = "Software": keyID = txtSoftware
            Case 7: keyWord = "Disclaimer": keyID = txtDisclaimer
            Case 8: keyWord = "Warning": keyID = txtWarning
            Case 9: keyWord = "Source'": keyID = txtSource
            Case 10: keyWord = "Comment": keyID = txtComment
            Case 11: keyID = -1: Exit For
            End Select
            If StrComp(keyWord, inCaption, vbTextCompare) = 0 Then Exit For
        Next
    isKeyWord = keyID   ' return value of -1 indicates caption is not reserved
    
End Function
Private Function IsValidProperty(PropertyID As ePngProperties) As Boolean
    Select Case PropertyID
    Case txtAuthor: IsValidProperty = True
    Case txtComment: IsValidProperty = True
    Case txtCopyright: IsValidProperty = True
    Case txtCreationTime: IsValidProperty = True
    Case txtDescription: IsValidProperty = True
    Case txtDisclaimer: IsValidProperty = True
    Case txtLargeBlockText: IsValidProperty = True
    Case txtSoftware: IsValidProperty = True
    Case txtSource: IsValidProperty = True
    Case txtTitle: IsValidProperty = True
    Case txtWarning: IsValidProperty = True
    Case colorDefaultBkg: IsValidProperty = True
    Case filterType: IsValidProperty = True
    Case dateTimeModified: IsValidProperty = True
    End Select
    
End Function
' =======================================
' FOLLOWING 3 FUNCTIONS ARE ZLIB RELATED
' =======================================
Private Function zValidateZLIBversion() As Boolean
    ' Test for zlib availability & compatibility
    ' see modParsers.iparseValidateZLib for details
    
    Dim b_cdecl As Boolean, bCompress2 As Boolean, DllName As String
    
    If iparseValidateZLIB(DllName, m_ZLIBver, b_cdecl, bCompress2) = True Then
        If b_cdecl = True Then
            Set cCfunction = New cCDECL
            cCfunction.DllLoad DllName
        End If
        If bCompress2 Then m_ZLIBver = m_ZLIBver Or 32 ' flag indicating can use better compression
        zValidateZLIBversion = True
    End If
            
    
End Function
Private Function zCreateCRC(crcSrcRef As Long, srcLength As Long) As Long
    ' function returns zLIB's CRC value for passed crcTestRef value.
    Dim lReturn As Long
    If cCfunction Is Nothing Then
        If (m_ZLIBver And 1&) = 1& Then
            lReturn = Zcrc32(0&, ByVal crcSrcRef, srcLength)
        ElseIf (m_ZLIBver And 2&) = 2& Then
            lReturn = Zcrc321(0&, ByVal crcSrcRef, srcLength)
        End If
    Else
        lReturn = cCfunction.CallFunc("crc32", 0&, crcSrcRef, srcLength)
    End If
    If Not lReturn = 0& Then zCreateCRC = iparseReverseLong(lReturn)
    
End Function
Private Function zDeflate(destRef As Long, destSize As Long, srcRef As Long, srcSizeRef As Long) As Boolean
    ' function compresses/deflates passed srcRef into passed destRef and modifies the destSizeRef to indicate byte count of destRef
    
    ' earliest versions of DLL do not have Compress2 which newer versions have.
    ' Newer versions allow a compression parameter to allow deeper compression.
    ' When compress is called in newer DLL it just reroutes to the compress2 method
    
    Dim lReturn As Long
    If cCfunction Is Nothing Then
        If m_ZLIBver = 34& Then ' 34 = 2 or 32                  ' double checked 3/1/2007
            ' use compress2 function
            zDeflate = (Zcompress21(ByVal destRef, destSize, ByVal srcRef, srcSizeRef, zlibMaxCompression) = 0&)
        ElseIf m_ZLIBver = 33& Then ' 33 = 1 or 32              ' double checked 3/1/2007
            ' use compress2 function
            zDeflate = (Zcompress2(ByVal destRef, destSize, ByVal srcRef, srcSizeRef, zlibMaxCompression) = 0&)
        ElseIf (m_ZLIBver And 1) = 1& Then                      ' double checked 3/1/2007
            ' use compress function
            zDeflate = (Zcompress(ByVal destRef, destSize, ByVal srcRef, srcSizeRef) = 0&)
        ElseIf m_ZLIBver = 2& Then                              ' double checked 3/1/2007
            ' use compress function
            zDeflate = (Zcompress1(ByVal destRef, destSize, ByVal srcRef, srcSizeRef) = 0&)
        End If
    Else
        If (m_ZLIBver And 32&) = 32& Then                       ' double checked 3/1/2007
            ' use compress2 function
            zDeflate = (cCfunction.CallFunc("compress2", destRef, VarPtr(destSize), srcRef, srcSizeRef, zlibMaxCompression) = 0&)
        Else                                                    ' double checked 3/1/2007
            ' use compress function
            zDeflate = (cCfunction.CallFunc("compress", destRef, VarPtr(destSize), srcRef, srcSizeRef) = 0&)
        End If
    End If
End Function

						