[RESOLVED] ByteArray To a PictureBox with SetDIBitsToDevice = Messed Up Colors

[Alphadan]

Hi

Wel im having this problem i have a ByteArray containing the bytes of the pixels from a image which its a 8bit image (256 Colors).

well i have the header info stored on this structure BITMAPINFO and im using this:

SetDIBitsToDevice Picture2.hdc, 0, 0, BmInfo.bmiHeader.biWidth, BmInfo.bmiHeader.biHeight, 0, 0, 0, BmInfo.bmiHeader.biHeight, PixelBArr(0), BmInfo, 0

it works fine but it has one trouble the colours get messed up it turns darker and there its a excess red

i think the picture box its configured as 24 bit color so it doesnt uses palette as i understand.

i have the right palette on a Byte Array too i ve tried for the whole day and i fail to make it work, theres a property on the picturebox hpal but kinda hard to understand.

i also tried with SetBitmapBits but the image appears like a total mess i can see some shapes from the original image but its really messed up.

Option Explicit
Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDIBits256 Lib "gdi32" Alias "GetDIBits" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO256, ByVal wUsage As Long) As Long

Public 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

Public 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

Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type


Public Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type



Public Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As Long
End Type

Public Type BITMAPINFO256
  bmiHeader As BITMAPINFOHEADER
  bmiColors(255) As Long
End Type

Function SaveBitmap_AllRes(ByRef hdc As Long, ByRef handle As Long, ByRef BitsPerPixel As Byte, ByRef Barr() As Byte, BmInfo() As Byte, Optional ByRef NewPal As Variant) As Byte
On Error Resume Next
Dim bmp As Bitmap
Dim i As Integer
Dim bInfo As BITMAPINFO256
Dim FileHeader As BITMAPFILEHEADER
Dim bArray() As Byte
Dim nLines As Long
Dim WidthArray As Long
Dim Palette() As Long
Dim newP As Long
Dim nCol As Long
'Dim TempScrLen As Integer
'Dim TempScr As String
Call GetObject(handle, Len(bmp), bmp)
    
    Select Case BitsPerPixel
    Case 1, 4, 8, 16, 24, 32
        ' kein Fehler. weiter gehts!
    Case Else
        SaveBitmap_AllRes = 1
        Exit Function
    End Select
    If IsMissing(NewPal) = 0 Then
        newP = UBound(NewPal)
    End If
    bInfo.bmiHeader.biHeight = bmp.bmHeight
    bInfo.bmiHeader.biWidth = bmp.bmWidth
    bInfo.bmiHeader.biPlanes = bmp.bmPlanes
    bInfo.bmiHeader.biBitCount = BitsPerPixel
    bInfo.bmiHeader.biSize = Len(bInfo.bmiHeader)
    bInfo.bmiHeader.biCompression = 0

    nLines = GetDIBits256(hdc, handle, 0, bmp.bmHeight, ByVal 0, bInfo, DIB_RGB_COLORS)
    If nLines = 0 Then         ' Falls ein Fehler auftrat wird nLines 0,
        SaveBitmap_AllRes = 2 ' sonst ist es die Zahl der Zeilen.
        Exit Function
    End If

    WidthArray = bInfo.bmiHeader.biSizeImage / bInfo.bmiHeader.biHeight
    ReDim bArray(WidthArray * bInfo.bmiHeader.biHeight)
    nLines = GetDIBits256(hdc, handle, 0, bmp.bmHeight, bArray(0), bInfo, DIB_RGB_COLORS)



    If nLines = 0 Then
        SaveBitmap_AllRes = 3 ' Tja, dann ist wohl was schiefgelaufen.
         Exit Function

    End If
    Select Case BitsPerPixel

    Case 1
        bInfo.bmiHeader.biClrUsed = 2
        bInfo.bmiHeader.biClrImportant = 2
        bInfo.bmiHeader.biCompression = DIB_RGB_COLORS
        nCol = 1
    Case 4
        bInfo.bmiHeader.biClrUsed = 16
        bInfo.bmiHeader.biClrImportant = 16
        bInfo.bmiHeader.biCompression = DIB_RGB_COLORS
        nCol = 15
    Case 8
        bInfo.bmiHeader.biClrUsed = 256
        bInfo.bmiHeader.biClrImportant = 256
        bInfo.bmiHeader.biCompression = DIB_RGB_COLORS
        nCol = 255
    Case 16, 24, 32
        nCol = 0
    End Select

    ReDim Palette(nCol)

    If nCol > 0 Then
        If newP = nCol Then
            For i = 0 To nCol
                Palette(i) = SwapRedBlue(NewPal(i)) ' Rot und Blau sind
                ' in normalen Longs vertauscht. Wir korrigieren das hier.
            Next i
        Else
            For i = 0 To nCol
                Palette(i) = bInfo.bmiColors(i)
            Next i
        End If
    Else
        Palette(0) = 0
    End If
    
    FileHeader.bfType = 19778 ' entspricht "BM"
    FileHeader.bfOffBits = Len(FileHeader) + Len(bInfo.bmiHeader)
    FileHeader.bfOffBits = FileHeader.bfOffBits + (UBound(Palette) + 1) * 4
    FileHeader.bfSize = Len(FileHeader) + Len(bInfo.bmiHeader) + (UBound(Palette) + 1) * 4
    
    'Dim fno As Long
    'fno = FreeFile
    'Open "C:\Prueba.bmp" For Binary As #fno
    ' und wieder Ausspucken...
    'Put #fno, , FileHeader
    'Put #fno, , bInfo.bmiHeader
    'Put #fno, , Palette()
    'Put #fno, , bArray()
    'Close #fno
    
err1:
    Select Case Err
    Case 999
    SaveBitmap_AllRes = 4
    Case Else
    SaveBitmap_AllRes = 4
    End Select
End Function

this is the module im using found on net all it does its take a picture from a picturebox then it changes it BitPerPixel and saves the result to a BMP file the file opens just perfect but when it comes to input the data directly to the picturebox i get the colors messed up.

i would just save to a file and then load it using Loadpicture but it would be pretty inefficient and i need to achieve highest fps posible.

i will use anything else u can reocmend any method all what i need its to reduce the bit per pixel from a picture box from to 16B/8B/4B get the data on a byte array and then show on the same picturebox.

Thx in advance Daniel G.