I made this class module to be able to support reading pixel arrays from from picture boxes, and write pixel arrays to pixel boxes. However, while it works for getting the pixel array from a picture box, it doesn't work putting the pixel array back into the picture box (for example after I've performed some operation on the image. Why isn't this working? Can you please explain to me where my code is wrong?
Code:
Dim MyPic As PictureBox
Dim Pix() As Byte
Dim DIBinfo As BitmapInfo
Public Enum RAlphaMode
No_Change = 0
Replace_with_Black = 1
Replace_with_White = 2
End Enum
Dim ReplaceAlphaMode As Byte
Public Enum EncodingType
Raw = 0
Raw_Bitfields = 3
End Enum
Public Enum BitsPerP
BPP_1 = 1
BPP_4 = 4
BPP_8 = 8
BPP_16 = 16
BPP_24 = 24
BPP_32 = 32
End Enum
Dim ByteWidth As Long
Private Declare Function GetDIBits Lib "GDI32.dll" ( _
ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, ByRef lpBits As Any, _
ByRef lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "GDI32.dll" ( _
ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, ByRef lpBits As Any, _
ByRef lpBI As BitmapInfo, ByVal wUsage As Long) As Long
Private Type BitmapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BitmapInfo
bmiHeader As BitmapInfoHeader
bmiColors(255) As Long
End Type
Public Property Let Width(ByVal PicW As Long)
DIBinfo.bmiHeader.biWidth = PicW
End Property
Public Property Get Width() As Long
Width = DIBinfo.bmiHeader.biWidth
End Property
Public Property Let Height(ByVal PicH As Long)
DIBinfo.bmiHeader.biHeight = PicH
End Property
Public Property Get Height() As Long
Height = DIBinfo.bmiHeader.biHeight
End Property
Public Property Let BitsPerPixel(ByVal BPP As BitsPerP)
DIBinfo.bmiHeader.biBitCount = BPP
If BPP < 16 Then DIBinfo.bmiHeader.biClrUsed = 2 ^ BPP Else DIBinfo.bmiHeader.biClrUsed = 0
End Property
Public Property Get BitsPerPixel() As BitsPerP
BitsPerPixel = DIBinfo.bmiHeader.biBitCount
End Property
Public Property Let Encoding(ByVal EType As EncodingType)
DIBinfo.bmiHeader.biCompression = EType
End Property
Public Property Get Encoding() As EncodingType
Encoding = DIBinfo.bmiHeader.biCompression
End Property
Public Property Let HResolution(ByVal HRes As Long)
DIBinfo.bmiHeader.biXPelsPerMeter = HRes
End Property
Public Property Get HResolution() As Long
HResolution = DIBinfo.bmiHeader.biXPelsPerMeter
End Property
Public Property Let VResolution(ByVal VRes As Long)
DIBinfo.bmiHeader.biYPelsPerMeter = VRes
End Property
Public Property Get VResolution() As Long
VResolution = DIBinfo.bmiHeader.biYPelsPerMeter
End Property
Public Property Get PaletteEntryCount() As Long
PaletteEntryCount = DIBinfo.bmiHeader.biClrUsed
End Property
Public Property Let Palette(ByRef PArray() As Long)
Dim temparray() As Long
temparray() = PArray()
For n = 0 To 255
DIBinfo.bmiColors(n) = 0
Next n
ReDim Preserve temparray(DIBinfo.bmiHeader.biClrUsed - 1)
For n = 0 To UBound(temparray)
If n > 255 Then Exit For
DIBinfo.bmiColors(n) = temparray(n)
Next n
Erase temparray()
End Property
Public Property Get Palette() As Long()
Dim temparray() As Long
ReDim temparray(DIBinfo.bmiHeader.biClrUsed - 1)
For n = 0 To UBound(temparray)
temparray(n) = DIBinfo.bmiColors(n)
Next n
Palette = temparray()
Erase temparray()
End Property
Public Property Let ReplaceAlphaWhenGettingPixels(ByVal RAlpha As RAlphaMode)
ReplaceAlphaMode = RAlpha
End Property
Public Property Get ReplaceAlphaWhenGettingPixels() As RAlphaMode
ReplaceAlphaWhenGettingPixels = ReplaceAlphaMode
End Property
Public Property Set PictBox(ByRef PicBox As PictureBox)
Set MyPic = PicBox
End Property
Public Property Get PictBox() As PictureBox
Set PictBox = MyPic
End Property
Public Sub GetPixels()
DIBinfo.bmiHeader.biSize = Len(DIBinfo.bmiHeader)
GetDIBits MyPic.hDC, MyPic.Image, 0, 0, ByVal 0&, DIBinfo, 0
ByteWidth = Int((DIBinfo.bmiHeader.biBitCount * DIBinfo.bmiHeader.biWidth + 31) / 32) * 4
ReDim Pix(ByteWidth - 1, DIBinfo.bmiHeader.biHeight - 1)
GetDIBits MyPic.hDC, MyPic.Image, 0, DIBinfo.bmiHeader.biHeight, Pix(0, 0), DIBinfo, 0
End Sub
Public Property Get PixelArray() As Byte()
Dim temparray() As Byte
If DIBinfo.bmiHeader.biBitCount > 8 Then ReDim temparray((DIBinfo.bmiHeader.biBitCount / 8) - 1, DIBinfo.bmiHeader.biWidth - 1, DIBinfo.bmiHeader.biHeight - 1) Else ReDim Pix(0, DIBinfo.bmiHeader.biWidth - 1, DIBinfo.bmiHeader.biHeight - 1)
For Y = 0 To UBound(temparray, 3)
For X = 0 To UBound(temparray, 2)
For z = 0 To UBound(temparray, 1)
temparray(z, X, Y) = Pix(X * (UBound(temparray) + 1) + z, Y)
Next z
If z = 4 Then
Select Case ReplaceAlphaMode
Case 1
temparray(3, X, Y) = 0
Case 2
temparray(3, X, Y) = 255
End Select
End If
Next X
Next Y
PixelArray = temparray()
Erase temparray()
End Property
Public Property Let PixelArray(ByRef Pixels() As Byte)
ByteWidth = 3 - (((UBound(Pixels, 1) + 1) * (UBound(Pixels, 2) + 1) - 1) Mod 4) + ((UBound(Pixels, 1) + 1) * (UBound(Pixels, 2) + 1))
ReDim Pix(ByteWidth - 1, UBound(Pixels, 3))
For Y = 0 To UBound(Pixels, 3)
For X = 0 To UBound(Pixels, 2)
For z = 0 To UBound(Pixels, 1)
Pix(z + X * (UBound(Pixels, 1) + 1), Y) = Pixels(z, X, Y)
Next z
Next X
Next Y
End Property
Public Property Get RawPixelArray() As Byte()
RawPixelArray = Pix()
End Property
Public Property Let RawPixelArray(ByRef Pixels() As Byte)
Pix() = Pixels()
End Property
Public Sub GetPicture()
SetDIBits MyPic.hDC, MyPic.Image, 0, DIBinfo.bmiHeader.biHeight, Pix(0, 0), DIBinfo, 0
End Sub