Printable View
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.
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
That answers why VB6 messes up the colour: Which is why I want to avoid using the controls.Quote:
Originally Posted by LaVolpe
I'm looking to write directly to a file using 'Binary Access Write'
This is what I meanQuote:
Originally Posted by LaVolpe
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
What I need it to is something likeCode: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 bitsT(x,y)=t(x,y)-32768T2(x,y)=t(x,y):T(x,y)=t(x,y)+32768next ynext x
T2 is now 16 bits/ point in grid(pixel)
Code: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
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.
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
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
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.Quote:
Originally Posted by Schmidt
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
:thumb:
Ok, here's my workaround for GDI+ restriction to 16bpp grayscale. I'll talk a bit about the code below
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.Code: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
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:Quote:
' 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
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.
Also, elsewhere C.I.D. specified that (1) due byte array of data would be supplied and (2) compression could be dispensed with.Quote:
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.
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.Quote:
Originally Posted by Brenker
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
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(2) In posting #7, C_I_D explained what would be the use of such PNG,Quote:
without any of those gdi/gibit interfaces.
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)?Quote:
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.