Basic VB6 PNG Compiler

[C_T_D]

Hi,

I'm trying to create a sub that can convert 16 bit/pixel data into a 16 bit grayscale .png image

I don't want to use the image/picture boxes in VB6 because they have a tendency to drop a lot of color depth

Just something that takes the raw data and compiles it directly to a (the most basic grayscale) .png file, without any of those gdi/gibit interfaces.

[LaVolpe]

Just for clarification. Can you define 16 bit in both the source and destination?

16 bit (in VB-like pics) is normally thought of as 5 bits per color component where rgb is usually 5-5-5, 5-6-5, or possibly 1-5-5-5 with an alpha bit.

16 bit PNG grayscale is defined as 16 bits for the color sample, where a standard bmp grayscale is 8 bits per sample

So, I think some clarification is needed.

Edited: Changed component and sample appropriately. Should've used proper terms to begin with

[C_T_D]

16 bit (in VB-like pics) is normally thought of as 5 bits per color component where rgb is usually 5-5-5, 5-6-5, or possibly 1-5-5-5 with an alpha bit.

That answers why VB6 messes up the colour: Which is why I want to avoid using the controls.
I'm looking to write directly to a file using 'Binary Access Write'

16 bit PNG grayscale is defined as 16 bits for the color sample

This is what I mean


What I'm trying to do is create a displacement map. Each pixel represents a point on the grid with a height value between 0-65535

The source data looks like T(0 to 1024, 0 to 1024) with a range of values from 0 to 65535 (I've Dimmed the data as long, but I converted it to integer(16 bits)
The destination .png File needs to have the pixels arranged in the same order with grayscale values from 0 to 65535

Essentially I'm looking for a sub example that uses "Open file For Binary Access Write As #1"
basically a direct write



So the program right now looks like

Dim T(1024,1024) as long
Dim T2(1024,1024) as integer

'insert data into T(x,y)

for x = 0 to 1024
for y = 0 to 1024  'convert data to 16 bits
T(x,y)=t(x,y)-32768
T2(x,y)=t(x,y):T(x,y)=t(x,y)+32768
next y
next x
T2 is now 16 bits/ point in grid(pixel)

What I need it to is something like

file="C:/SampleImage.png"

Open file For Binary Access Write As #1
Put #1,'insert PNG image compilation code here for 1025x1025 dimension grayscale image, header + body
close #1

[LaVolpe]

Though it is entirely possible to create an uncompressed PNG file using simple write statements, is that what you are after? Reason I ask is that there will be absolutely no compression at all. Your PNG file will be larger than your array data because the PNG file specs do require additional 'stuff', like a header, CRC values, a byte prefix for each scanline of the image, trailer, and maybe 1 or 2 other things.

Using GDI+, it does have a color constant for 16bit grayscale: Format16bppGrayScale, though I haven't attempted to write that format. GDI+ can read many formats, it won't always allow you to save in the same formats, not sure if one can save as Format16bppGrayScale. If not, GDI+ converts it to some other format. The bonus here, assuming GDI+ allows it, is that you get compression too. The downside, is that you are no longer using simple binary writing, now you will be using GDI+. That's a bit of a learning curve unless you are familiar with it.

Is this data required to be displayed as an image? If not, you may have other options for storing it.

[Schmidt]

Why would you want to save "not-really-image-data" into a 16Bit-PNG format?

Why not save your array directly to disk?
- Either as 1025x1025 Long-Array (resulting in ~4MB)
- Or as 1025x1025 Integer-Array (resulting in ~2MB)

Is it only because of the losless compression the PNG-format offers?

When you don't insist on PNG, you are free to use any losless algorithm you want,
to compress either your Long- or your Integer-Array before writing it to disk.

Edit: Yep, LaVolpe basically pointed out the same thing.

Olaf

[C_T_D]

Uncompressed .png is exactly what I'm looking for.

Seeing as 4097x4097 is the largest image size that'll be used, uncompressed doesn't exactly make a huge file at this point.

The data does need to be stored as a .png image, as it has become a standard to use the format for displacement maps. Not to mention the 2^[integer] - 1 squared graphic dimensions

[C_T_D]

Why would you want to save "not-really-image-data" into a 16Bit-PNG format?

Why not save your array directly to disk?
- Either as 1025x1025 Long-Array (resulting in ~4MB)
- Or as 1025x1025 Integer-Array (resulting in ~2MB)

Is it only because of the losless compression the PNG-format offers?

When you don't insist on PNG, you are free to use any losless algorithm you want,
to compress either your Long- or your Integer-Array before writing it to disk.

Edit: Yep, LaVolpe basically pointed out the same thing.

Olaf

When dealing with cross platforms, having a commonly available format is handy, plenty of Image/Photo Editors support the format, and are used quite often to edit such maps.

[LaVolpe]

I can show you how to write a 16bit grayscale PNG without any knowledge of GDI+. But, while you were thinking, I was doing a bit of research. It appears GDI+ doesn't support writing 16bit grayscale, it is converted to 32bpp RGB. Whether this restriction has been lifted in Win 7/8, I have no idea. I have a real simple idea of how to use GDI+ to create a 16bit grayscale bitmap and bypassing its limitations.

Since GDI+ doesn't seem to support writing 16bit grayscale, it may not display it properly either (may just display 8 of the 16 bits), but not sure about that since I haven't played with that format. Display is not an issue obviously. It appears you want the PNG format in 16bit grayscale cause other applications are designed to expect that format & therefore, are probably simply retrieving the byte values as data vs pixels.

Will post back later

[C_T_D]

[LaVolpe]

Ok, here's my workaround for GDI+ restriction to 16bpp grayscale. I'll talk a bit about the code below

Option Explicit

Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
    GdiplusVersion           As Long
    DebugEventCallback       As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs   As Long
End Type
Private Declare Function GdipCreateBitmapFromScan0 Lib "GdiPlus.dll" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, BITMAP As Long) As Long
Private Declare Function GdipDisposeImage Lib "GdiPlus.dll" (ByVal Image As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Function GdipSaveImageToFile Lib "GdiPlus.dll" (ByVal Image As Long, ByVal File As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipSetImagePalette Lib "GdiPlus.dll" (ByVal pImage As Long, ByRef Palette As ColorPalette) As Long
Private Declare Function GdipBitmapLockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mRect As RECTI, ByVal mFlags As Long, ByVal mPixelFormat As Long, ByRef mLockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapUnlockBits Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mLockedBitmapData As BitmapData) As Long
    
Private Const lvicColor8bpp = &H30803         'Specifies that the format is 8 bits per pixel, indexed.
Private Const ImageLockModeWrite = &H2
Private Const ImageLockModeUserInputBuf = &H4
Private Type ColorPalette            ' GDI+ palette object
   Flags As Long
   Count As Long
   Entries(0 To 255) As Long
End Type
Private Type BitmapData              ' GDI+ lock/unlock bits structure
    Width As Long
    Height As Long
    stride As Long
    PixelFormat As Long
    Scan0Ptr As Long
    ReservedPtr As Long
End Type
Private Type RECTI                   ' GDI+ rectangle w/Long vartypes
    nLeft As Long
    nTop As Long
    nWidth As Long
    nHeight As Long
End Type

Private m_Token As Long
Private CRC32LUT() As Long

Private Function SaveTo16bppPNG(sourceArray() As Integer, FileName As String) As Boolean

    ' sourceArray() is your 2D integer array
    ' width is the number of 16bit columns. 1 column = 1 integer
    ' height is the number of rows
    ' FileName is a path/file you have write access to
    
    On Error GoTo ExitRoutine
    
    Dim udtSI As GdiplusStartupInput
    udtSI.GdiplusVersion = 1
    Call GdiplusStartup(m_Token, udtSI)
    If m_Token = 0& Then
        Stop        ' gdi+ cannot be loaded
        Exit Function
    End If
    
    Dim hImage As Long, lb1 As Long, lb2 As Long, cx As Long, cy As Long
    Dim aGUID(0 To 3) As Long
    Dim udtPal As ColorPalette, udtRect As RECTI, udtBD As BitmapData
    
    For cx = 0 To 255
        udtPal.Entries(cx) = cx Or &HFF000000 ' create a grayscale palette
    Next
    udtPal.Count = cx
    
    lb1 = LBound(sourceArray, 1): lb2 = LBound(sourceArray, 2)
    cx = Abs(UBound(sourceArray, 1) - lb1) + 1&
    cy = Abs(UBound(sourceArray, 2) - lb2) + 1&
    
    udtRect.nWidth = cx * 2&    ' we are having GDI+ create 8bit PNG w/compression
    udtRect.nHeight = cy        ' and will go back & change it to 16bpp PNG afterwards
    ' create blank 8bpp bitmap
    Call GdipCreateBitmapFromScan0(udtRect.nWidth, udtRect.nHeight, 0&, lvicColor8bpp, ByVal 0&, hImage)
    GdipSetImagePalette hImage, udtPal  ' apply our palette
    
    With udtBD                          ' set up our transfer
        .PixelFormat = lvicColor8bpp
        .Scan0Ptr = VarPtr(sourceArray(lb1, lb2))
        .Width = udtRect.nWidth
        .Height = udtRect.nHeight
        .stride = .Width
    End With
    If GdipBitmapLockBits(hImage, udtRect, ImageLockModeWrite Or ImageLockModeUserInputBuf, udtBD.PixelFormat, udtBD) = 0& Then
        GdipBitmapUnlockBits hImage, udtBD
    End If
    
    ' clsid for PNG & save to temp file
    aGUID(0) = 1434252294: aGUID(1) = 299047428: aGUID(2) = 29594: aGUID(3) = 787685112
    GdipSaveImageToFile hImage, StrPtr(FileName & ".bak"), aGUID(0), ByVal 0&
    ' clean up & shut down GDI+
    GdipDisposeImage hImage: hImage = 0&
    Call GdiplusShutdown(m_Token)
    m_Token = 0&
    
    On Error GoTo 0
    SaveTo16bppPNG = pvConvert8to16bitGrayScale(udtRect.nWidth \ 2, udtRect.nHeight, FileName)
    On Error Resume Next
    Kill FileName & ".bak"
    If Err Then Err.Clear

ExitRoutine:
    If Err Then
        If Not hImage = 0& Then GdipDisposeImage hImage
        If Not m_Token = 0& Then Call GdiplusShutdown(m_Token)
        MsgBox "Error" & vbNewLine & Err.Description
        Stop
        Resume
    End If
End Function

Private Function pvConvert8to16bitGrayScale(Width As Long, Height As Long, FileName As String) As Boolean

    Const png_Signature1 As Long = 1196314761
    Const png_Signature2 As Long = 169478669
    Const chnk_IHDR As Long = &H52444849 'Image header
    Const chnk_IEND As Long = &H444E4549 'End of Image
    Const chnk_PLTE As Long = &H45544C50 'Palette

    On Error GoTo Eh
    Dim pngData() As Byte
    Dim gpLong As Long           ' general purpose variable
    Dim rwLen As Long, cLen As Long, cName As Long
    Dim fnrO As Integer, fnrI As Integer
    
    Call pvCreateCRC32LUT
    
    fnrO = FreeFile()
    Open FileName For Binary As #fnrO
    fnrI = FreeFile()
    Open FileName & ".bak" For Binary As #fnrI
    
    ' build header
    ReDim pngData(0 To 32)
    Get #fnrI, 1, pngData()
    
    gpLong = pvReverseLong(Width)   ' png width
    CopyMemory pngData(16), gpLong, 4&
    pngData(24) = 16 ' bits per pixel
    pngData(25) = 0 ' color type (grayscale); requires no palette
    gpLong = pvCRCArray(pngData(), 12&, 17&, 0&)
    CopyMemory pngData(29), gpLong, 4&
        
    Put #fnrO, 1, pngData()
    
    Do Until EOF(fnrI)
        Get #fnrI, , gpLong     ' length of the current chunk
        cLen = pvReverseLong(gpLong)
        Get #fnrI, , cName
        Select Case cName
        Case chnk_PLTE
            Seek #fnrI, Seek(fnrI) + cLen + 4&   'skip the palette
        Case Else
            Put #fnrO, , gpLong         ' write the chunk len
            Put #fnrO, , cName          ' write the chunk name
            ReDim pngData(0 To cLen + 3&) ' get the chunk data & crc value
            Get #fnrI, , pngData()      ' and write that
            Put #fnrO, , pngData()
            If cName = chnk_IEND Then Exit Do
        End Select
    Loop
    
Eh:
    If fnrI Then Close #fnrI
    If fnrO Then Close #fnrO
    If Err Then
        MsgBox "Error:" & vbNewLine & Err.Description
        Stop
    Else
        pvConvert8to16bitGrayScale = True
    End If
End Function

Private Sub pvCreateCRC32LUT()

    Const CRCpolynomial As Long = &HEDB88320
    ' &HEDB88320 is the official polynomial used by CRC32 in PKZip & zLIB.
    
    Dim i As Long, J As Long, lValue As Long
    
    If Not (Not CRC32LUT()) = 0& Then
        ReDim CRC32LUT(0 To 255)                            ' create a CRC lookup table (LUT)
        For i = 0& To 255&
            lValue = i
            For J = 8& To 1& Step -1&
                If (lValue And 1&) Then
                    lValue = (((lValue And &HFFFFFFFE) \ 2&) And &H7FFFFFFF) Xor CRCpolynomial
                Else
                    lValue = ((lValue And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                End If
            Next J
            CRC32LUT(i) = lValue
        Next i
    End If
    Debug.Assert App.hInstance  ' hack to prevent IDE calculation errors associated with NOT NOT call

End Sub
Private Function pvCRCArray(theArray() As Byte, StartPos As Long, CRCLen As Long, curCRCValue As Long) As Long

    ' Standard CRC algorithm, converting result to newtwork byte order
    ' Returns -1 failure or 0 success, or the CRC value depending on parameters...
    
    ' This has been specifically modified to replicate zLIB's CRC32 function
    ' Params:
    '   theArray(): any initialized byte array
    '   StartPos: the 1st byte position to begin CRC
    '   CRCLen: how many bytes to CRC
    '   curCRCValue: If provided, compare this to result for validation
    '                If not provided, return the CRC value
    
    Dim i As Long, J As Long, crc32val As Long, iLookup As Long
    
    crc32val = &HFFFFFFFF 'start with -1&
    For i = StartPos To StartPos + CRCLen - 1&
        iLookup = (crc32val And &HFF) Xor theArray(i)
        crc32val = (((crc32val And &HFFFFFF00) \ &H100&) And &HFFFFFF) Xor CRC32LUT(iLookup)
    Next i
    pvCRCArray = pvReverseLong(Not (crc32val)) ' change result to newtwork byte order
    If curCRCValue Then pvCRCArray = (pvCRCArray = curCRCValue) 'return either 0 or -1

End Function

Private Function pvReverseLong(ByVal inLong As Long) As Long

    ' fast function to reverse a long value from big endian to little endian
    ' PNG files contain reversed longs, as do ID3 v3,4 tags
    pvReverseLong = _
      (((inLong And &HFF000000) \ &H1000000) And &HFF&) Or _
      ((inLong And &HFF0000) \ &H100&) Or _
      ((inLong And &HFF00&) * &H100&) Or _
      ((inLong And &H7F&) * &H1000000)
    If (inLong And &H80&) Then pvReverseLong = pvReverseLong Or &H80000000
End Function

1st the logic. PNG grayscale images do not require a palette. They can range between 1 & 16 bits per pixel. GDI+ will read a 16bit grayscale, but not create one. Well it does create 8bit paletted images. So we can theoretically create a 8 bit image saying it is 2* the width of the 16 bit. Then let GDI+ save & compress the image. We then go back & minimally modify the file to make it read 16 vs 8 bit, change the color type from color image to grayscale, remove the palette & change the width to its real size. Sounds complicated but not really.

The key function for you is the SaveTo16bppPNG method. I stress that you should try to understand the basics of the routine. I see in your example you have array dimmed 1024,1024. Well, it is likely 1025,1025 unless you are using Option Base 1 in your code. Remember that by default, arrays are dim'd starting at zero, not 1. So, to avoid any ugliness, suggest you specifically declare the LBound of the array when you Dim or ReDim your arrays, i.e., (0 to 1023), (0 to 1024), (1 to 1025), whatever really applies. I wrote the SaveTo16bppPNG function to accept any LBound, but the passed array must be 2D as you showed in your sample code

The filename passed to that function must be accessible/creatable. No permission issues allowed else routine quits on the GdipSaveImageToFile() API call. The actual filename used is the one you pass & a ".bak" added to it. This will be the temp file that holds the 8 bit color png. The 16 bit PNG will be created from that .bak file & the .bak file will be deleted when done.

Test well before assuming all works. Strongly recommend you create a sample 16bpp PNG with the code above and pass to whatever application uses those PNGs. If that app doesn't choke & die, probably pretty safe

Edited: Some of the comments may seem out of place, cut & pasted from pieces of other projects. Regarding the support routines for CRC calcs, whether we went the GDI+ route or not, those would still be required to manually write a PNG file. When you look at the code, the 2 primary functions are listed first. The others are support functions

Who says GDI+ can't create 16bpp Grayscale PNGs? Well, it can with a little help. I use GDI+ to display animated PNG (APNG) files too, even though it can't. GDI+ is a nice tool, but has limitations & those usually can be overcome by creativity

Edited yet again... My bad. Had some typos & test code left behind. Fixed & reposted

Just FYI: in the routine that converts 8 to 16 bit, the PNG header starts with pngData(16) & looks like:

' IHDR structure
' Width As Long << cannot be negative
' Height As Long << cannot be negative
' BitDepth As Byte << must be 1,2,4,8,16
' ColorType As Byte << must be 0,2,3,4,6
' Compression As Byte << must be zero
' Filter As Byte << must be zero
' Interlacing As Byte << must be zero or one

[Tanner_H]

LaVolpe's answer above is excellent and comprehensive for GDI+. You'd be hard-pressed to find a cleaner solution that avoids the use of 3rd-party libraries.

If you don't mind 3rd-party libraries, the open-source FreeImage library provides excellent 16-bit grayscale support:

http://freeimage.sourceforge.net/

FreeImage includes a comprehensive VB6 module, and using the DLL from VB is simple. To create a 16-bit grayscale image, you basically do the following:

- Allocate a new 16-bit grayscale image at the same dimensions as your image
- Use CopyMemory to copy the bits of your displacement map over the bits of the allocated image. (FreeImage uses the same 4-byte alignment rule as Windows, so CopyMemory works without issue.)
- Save the completed image as a 16-bit PNG, TIFF, or any other format you can think up.

[Brenker]

Just something that takes the raw data and compiles it directly to a (the most basic grayscale) .png file, without any of those gdi/gibit interfaces.

Also, elsewhere C.I.D. specified that (1) due byte array of data would be supplied and (2) compression could be dispensed with.

As I see it, given the above conditions, it is possible to build a 16-bit grayscale PNG using pure VB only, if CRC checksum is not required. But, PNG does require CRC checksum.

[LaVolpe]

As I see it, given the above conditions, it is possible to build a 16-bit grayscale PNG using pure VB only, if CRC checksum is not required. But, PNG does require CRC checksum.

Yes and no. GDI+, for example, will ignore an invalid checksum. But bad practice to simply supply a bogus CRC and hope the PNG reader ignores it.

To build a 16bpp grayscale PNG, uncompressed, using just VB, it is simple enough. Need to know the IHDR, IDAT, IEND formats.

- Write the PNG signature & IHDR chunk
- Calculate the IDAT size which would be (picWidth*2*picHeight+picHeight)... Need 1 byte extra per scanline
- Write the IDAT header
- Write the uncompressed data, 1 scanline at a time. Each scanline must be prefixed with a zero byte to indicate no filter
- Write the IEND chunk

All chunks include reverse-byte-order values and CRC values

Edited: Writing uncompressed data is a bit more complicated. Without using ZLIB or GDI+, one needs to code the data using a zero-compression header. This means that the total data (raw data + 1 byte per scanline) must be written in formatted blocks to mimic ZLIB uncompressed. The formatted blocks contain a 4-7 byte header. So it's not as simple as one would think

[Brenker]

I know GDIplus would bypass CRC in processing PNGs (a bad practice of MS', very much against the design of PNG), but I wonder why one must stick one's gun to GDIplus when

(1) From the very beginning in posting #1, C_I_D had already specified

without any of those gdi/gibit interfaces.

(2) In posting #7, C_I_D explained what would be the use of such PNG,

that When dealing with cross platforms, having a commonly available format is handy, plenty of Image/Photo Editors support the format, and are used quite often to edit such maps.

How could the said "Image/Photo Editors" (which obviously are supposed to be capable of properly editing 16-bit grayscale PNG, as contrast to engaging GDIplus which is incapable of editing 16-bit grayscale PNG) handle PNG files all with bogus CRC check sum, if they validate CRC (all serious programs do)?