I am trying to convert a PictureBox image to a 2048 byte hex string and cannot seem to get the code right. I am needing to take a picture (black and white image) that is in a picturebox and then convert that to a 2048 byte hex string. The same function as this:
https://javl.github.io/image2cpp/
But in VB6.
The code I have been working with is below but it ends up with a huge 51,989 hex string. Can anyone help me out?
Thanks!
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Function GetPictureBytes(myImg As PictureBox) As Byte()
Dim PicBits() As Byte, PicInfo As BITMAP
'Get information (such as height and width) about the picturebox
Call GetObject(myImg.Image, Len(PicInfo), PicInfo)
'Reallocate storage space: a pixel needs 4 bytes
ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * 4) As Byte
'Copy the bitmapbits to the array
Call GetBitmapBits(myImg.Image, UBound(PicBits), PicBits(1))
Call SetBitmapBits(Picture2.Image, UBound(PicBits), PicBits(1))
GetPictureBytes = PicBits
End Function
Private Sub Form_Load()
Dim PicBits() As Byte, PicInfo As BITMAP
Call GetObject(Picture1.Image, Len(PicInfo), PicInfo)
'Reallocate storage space: a pixel needs 4 bytes
ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * 4) As Byte
'Copy the bitmapbits to the array
Call GetBitmapBits(Picture1.Image, UBound(PicBits), PicBits(1))
Call SetBitmapBits(Picture2.Image, UBound(PicBits), PicBits(1))
X = ByteArrayToHex(PicBits())
Stop
End Sub
Private Function ByteArrayToHex(ByRef ByteArray() As Byte) As String
Dim l As Long, strRet As String
For l = LBound(ByteArray) To UBound(ByteArray)
strRet = strRet & Hex$(ByteArray(l)) & ""
Next l
ByteArrayToHex = Left$(strRet, Len(strRet) - 1)
End Function
https://javl.github.io/image2cpp/
But in VB6.
The code I have been working with is below but it ends up with a huge 51,989 hex string. Can anyone help me out?
Thanks!
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Function GetPictureBytes(myImg As PictureBox) As Byte()
Dim PicBits() As Byte, PicInfo As BITMAP
'Get information (such as height and width) about the picturebox
Call GetObject(myImg.Image, Len(PicInfo), PicInfo)
'Reallocate storage space: a pixel needs 4 bytes
ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * 4) As Byte
'Copy the bitmapbits to the array
Call GetBitmapBits(myImg.Image, UBound(PicBits), PicBits(1))
Call SetBitmapBits(Picture2.Image, UBound(PicBits), PicBits(1))
GetPictureBytes = PicBits
End Function
Private Sub Form_Load()
Dim PicBits() As Byte, PicInfo As BITMAP
Call GetObject(Picture1.Image, Len(PicInfo), PicInfo)
'Reallocate storage space: a pixel needs 4 bytes
ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * 4) As Byte
'Copy the bitmapbits to the array
Call GetBitmapBits(Picture1.Image, UBound(PicBits), PicBits(1))
Call SetBitmapBits(Picture2.Image, UBound(PicBits), PicBits(1))
X = ByteArrayToHex(PicBits())
Stop
End Sub
Private Function ByteArrayToHex(ByRef ByteArray() As Byte) As String
Dim l As Long, strRet As String
For l = LBound(ByteArray) To UBound(ByteArray)
strRet = strRet & Hex$(ByteArray(l)) & ""
Next l
ByteArrayToHex = Left$(strRet, Len(strRet) - 1)
End Function