blackd
10-22-2016, 21:00
This is a function for copying the deciphered pixels of a PNG image into a byte array.
Yes, This is an easy task for any modern language, however...
This is a very hard task for VB6 (Visual Basic 6) but... I finally managed to find a solution for it. A solution that will work with any Windows version. And I will share it with the world.
It only requires FreeImage, an open source library that lacks documentation for VB6.
FreeImage have a function for this task directly but it does not work (alawys crashes) so I found a way to do this task avoiding this bugged function.
Here is my VB6 function:
Option Explicit
Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As Any, ByVal numberOfBytes As Long)
' Powerfull VB6 Function By Blackd
' Requires FreeImage (MFreeImage.bas and FreeImage.dll)
'
' Purpose: This is a function for copying the deciphered pixels of a PNG image into a raw byte array.
'
' Paramaters:
' Input/Output: arr, the byte array. It can be empty or already filled. Function will resize it if required.
' Optional Input: atPosition. Function will start writing bytes at atPosition
' Optional Input: withRotation. Function will rotate the image by this angle (in degrees) in first place.
' Output: imageWidth,imageHeight,imageBytesPerPixel (ByRef)
'
' Returns: False if it detects any error. True in other case.
Private Function LoadPNGIntoByteArray(ByRef filePath As String, ByRef arr() As Byte, _
ByRef imageWidth As Long, _
ByRef imageHeight As Long, _
ByRef imageBytesPerPixel As Long, _
Optional ByVal atPosition As Long = 0, _
Optional ByVal withRotation As Double = 0) As Boolean
On Error GoTo gotErr
Dim imageRef As Long
Dim pRow As Long
Dim currentLine As Long
Dim imageBytesPerLine As Long
Dim totalBytes As Long
Dim currentPos As Long
Dim lastLine As Long
Dim imageBitsPerPixel As Long
Dim imageRef1 As Long
' Ensure our array is not an empty array, else we init it here.
ensureMinimumArray arr
' Load the image
imageRef = FreeImage_Load(FIF_PNG, filePath, FILO_PNG_DEFAULT)
If imageRef = 0 Then
' ERROR: filePath is not PNG, or it does not exist
LoadPNGIntoByteArray = False
Exit Function
End If
If Not (withRotation = 0) Then
imageRef1 = imageRef
imageRef = FreeImage_RotateClassic(imageRef, withRotation)
FreeImage_Unload imageRef1
If imageRef = 0 Then
' ERROR: unable to rotate this PNG
LoadPNGIntoByteArray = False
Exit Function
End If
End If
' Determine some information from the loaded image
imageWidth = FreeImage_GetWidth(imageRef)
imageHeight = FreeImage_GetHeight(imageRef)
imageBitsPerPixel = FreeImage_GetBPP(imageRef)
imageBytesPerPixel = imageBitsPerPixel / 8
imageBytesPerLine = FreeImage_GetLine(imageRef)
totalBytes = imageBytesPerLine * imageHeight
' Is our array ready to hold so many bytes?
If ((UBound(arr) - atPosition) < (totalBytes - 1)) Then
' If array is not big enough then we should increase it's size
ReDim Preserve arr(atPosition + totalBytes - 1)
End If
currentPos = atPosition
lastLine = imageHeight - 1
For currentLine = 0 To lastLine
pRow = FreeImage_GetScanline(imageRef, currentLine)
If (Not (pRow = 0)) Then
RtlMoveMemory arr(currentPos), ByVal pRow, imageBytesPerLine
End If
currentPos = currentPos + imageBytesPerLine
Next currentLine
' Release the image
FreeImage_Unload imageRef
' All looks OK. We return True
LoadPNGIntoByteArray = True
Exit Function
gotErr:
'... else, we return False
LoadPNGIntoByteArray = False
End Function
' If array is empty then init it to an array of 1 byte
Private Sub ensureMinimumArray(ByRef arr() As Byte)
On Error GoTo gotErr
Dim test As Long
test = UBound(arr)
Exit Sub
gotErr:
ReDim arr(0)
End Sub
Private Sub btnTest_Click()
Dim arrResult() As Byte
Dim w As Long
Dim h As Long
Dim bpp As Long
Dim res As Boolean
Dim desiredRotation As Double
desiredRotation = 90
res = LoadPNGIntoByteArray(App.Path & "\test.png", arrResult, w, h, bpp, 0, desiredRotation)
If (res) Then
Dim fnum As Integer
fnum = FreeFile
Open App.Path & "\test.map" For Binary As #fnum
Put #fnum, 1, arrResult
Close fnum
Debug.Print "TEST OK"
Else
Debug.Print "TEST FAILED"
End If
End Sub
Yes, This is an easy task for any modern language, however...
This is a very hard task for VB6 (Visual Basic 6) but... I finally managed to find a solution for it. A solution that will work with any Windows version. And I will share it with the world.
It only requires FreeImage, an open source library that lacks documentation for VB6.
FreeImage have a function for this task directly but it does not work (alawys crashes) so I found a way to do this task avoiding this bugged function.
Here is my VB6 function:
Option Explicit
Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As Any, ByVal numberOfBytes As Long)
' Powerfull VB6 Function By Blackd
' Requires FreeImage (MFreeImage.bas and FreeImage.dll)
'
' Purpose: This is a function for copying the deciphered pixels of a PNG image into a raw byte array.
'
' Paramaters:
' Input/Output: arr, the byte array. It can be empty or already filled. Function will resize it if required.
' Optional Input: atPosition. Function will start writing bytes at atPosition
' Optional Input: withRotation. Function will rotate the image by this angle (in degrees) in first place.
' Output: imageWidth,imageHeight,imageBytesPerPixel (ByRef)
'
' Returns: False if it detects any error. True in other case.
Private Function LoadPNGIntoByteArray(ByRef filePath As String, ByRef arr() As Byte, _
ByRef imageWidth As Long, _
ByRef imageHeight As Long, _
ByRef imageBytesPerPixel As Long, _
Optional ByVal atPosition As Long = 0, _
Optional ByVal withRotation As Double = 0) As Boolean
On Error GoTo gotErr
Dim imageRef As Long
Dim pRow As Long
Dim currentLine As Long
Dim imageBytesPerLine As Long
Dim totalBytes As Long
Dim currentPos As Long
Dim lastLine As Long
Dim imageBitsPerPixel As Long
Dim imageRef1 As Long
' Ensure our array is not an empty array, else we init it here.
ensureMinimumArray arr
' Load the image
imageRef = FreeImage_Load(FIF_PNG, filePath, FILO_PNG_DEFAULT)
If imageRef = 0 Then
' ERROR: filePath is not PNG, or it does not exist
LoadPNGIntoByteArray = False
Exit Function
End If
If Not (withRotation = 0) Then
imageRef1 = imageRef
imageRef = FreeImage_RotateClassic(imageRef, withRotation)
FreeImage_Unload imageRef1
If imageRef = 0 Then
' ERROR: unable to rotate this PNG
LoadPNGIntoByteArray = False
Exit Function
End If
End If
' Determine some information from the loaded image
imageWidth = FreeImage_GetWidth(imageRef)
imageHeight = FreeImage_GetHeight(imageRef)
imageBitsPerPixel = FreeImage_GetBPP(imageRef)
imageBytesPerPixel = imageBitsPerPixel / 8
imageBytesPerLine = FreeImage_GetLine(imageRef)
totalBytes = imageBytesPerLine * imageHeight
' Is our array ready to hold so many bytes?
If ((UBound(arr) - atPosition) < (totalBytes - 1)) Then
' If array is not big enough then we should increase it's size
ReDim Preserve arr(atPosition + totalBytes - 1)
End If
currentPos = atPosition
lastLine = imageHeight - 1
For currentLine = 0 To lastLine
pRow = FreeImage_GetScanline(imageRef, currentLine)
If (Not (pRow = 0)) Then
RtlMoveMemory arr(currentPos), ByVal pRow, imageBytesPerLine
End If
currentPos = currentPos + imageBytesPerLine
Next currentLine
' Release the image
FreeImage_Unload imageRef
' All looks OK. We return True
LoadPNGIntoByteArray = True
Exit Function
gotErr:
'... else, we return False
LoadPNGIntoByteArray = False
End Function
' If array is empty then init it to an array of 1 byte
Private Sub ensureMinimumArray(ByRef arr() As Byte)
On Error GoTo gotErr
Dim test As Long
test = UBound(arr)
Exit Sub
gotErr:
ReDim arr(0)
End Sub
Private Sub btnTest_Click()
Dim arrResult() As Byte
Dim w As Long
Dim h As Long
Dim bpp As Long
Dim res As Boolean
Dim desiredRotation As Double
desiredRotation = 90
res = LoadPNGIntoByteArray(App.Path & "\test.png", arrResult, w, h, bpp, 0, desiredRotation)
If (res) Then
Dim fnum As Integer
fnum = FreeFile
Open App.Path & "\test.map" For Binary As #fnum
Put #fnum, 1, arrResult
Close fnum
Debug.Print "TEST OK"
Else
Debug.Print "TEST FAILED"
End If
End Sub