[RESOLVED] ByteArray To a PictureBox with SetDIBitsToDevice = Messed Up Colors
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 2 of 2

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

  1. #1
    Join Date
    Feb 2009
    Posts
    245

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

    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:

    Code:
    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.
    Code:
    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.
    Last edited by Alphadan; February 11th, 2009 at 07:10 PM.

  2. #2
    Join Date
    Feb 2009
    Posts
    245

    Re: ByteArray To a PictureBox with SetDIBitsToDevice = Messed Up Colors

    Well i solved the problem using this function wich its fast i takes 1ms to load 1.7MB lenght of BMP image

    ill leave the code here so it can help others

    Code:
    Option Explicit
    Private Const GMEM_MOVEABLE = &H2
    Private Declare Function GlobalAlloc Lib "kernel32" _
      (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" _
      (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" _
      (ByVal hMem As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" _
      Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
      ByVal dwLength As Long)
    Private Declare Function CLSIDFromString Lib "ole32" _
      (ByVal lpsz As Any, pclsid As GUID) As Long
    Private Declare Function OleLoadPicture Lib "olepro32" _
      (pStream As Any, ByVal lSize As Long, _
      ByVal fRunmode As CBoolean, riid As GUID, _
      ppvObj As Any) As Long
    Private Type GUID    ' 16 bytes (128 bits)
      dwData1 As Long    ' 4 bytes
      wData2 As Integer  ' 2 bytes
      wData3 As Integer  ' 2 bytes
      abData4(7) As Byte ' 8 bytes, zero based
    End Type
    Public Enum CBoolean   ' enum members are Long data types
      CFalse = 0
      CTrue = 1
    End Enum
    Private Declare Function CreateStreamOnHGlobal Lib "ole32" _
      (ByVal hGlobal As Long, ByVal fDeleteOnRelease As _
      CBoolean, ppstm As Any) As Long
    Private Const S_OK = 0    ' indicates successful HRESULT
    Private Const sIID_IPicture = _
      "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
    Private b1() As Byte
    
    Private Function PictureFromBits(abPic() As Byte) _
      As IPicture  ' not a StdPicture!!
    Dim nLow As Long, cbMem  As Long, hMem  As Long
    Dim lpMem  As Long, IID_IPicture As GUID
    Dim istm As stdole.IUnknown, ipic As IPicture
    ' Get the size of the picture's bits
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
    ' Allocate a global memory object
    hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
    If hMem Then
      ' Lock the memory object and get a pointer to it.
      lpMem = GlobalLock(hMem)
      If lpMem Then
        ' Copy the picture file bytes to the memory pointer
        ' and unlock the handle.
        MoveMemory ByVal lpMem, abPic(nLow), cbMem
        Call GlobalUnlock(hMem)
        ' Create an ISteam from the pictures bits (we can
        ' explicitly free hMem below, but we'll have the
        ' call do it here...)
        If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
          If (CLSIDFromString(StrPtr(sIID_IPicture), _
            IID_IPicture) = S_OK) Then
            ' Create an IPicture from the IStream (the docs
            ' say the call does not AddRef its last param, but
            'it looks like the reference counts are correct..)
            Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, _
              CFalse, IID_IPicture, PictureFromBits)
          End If   ' CLSIDFromString
        End If   ' CreateStreamOnHGlobal
      End If   ' lpMem
    ' Call GlobalFree(hMem)
    End If   ' hMem
    Out:
    End Function
    
    Private Sub Command1_Click()
    ' Test Routine:
    ' First load a picture file (jpg or bmp and maybe others
    ' too)from a disk file into a byte array (the entire file)
    ' just to check that this stuff works.
    Open "c:\tulips.jpg" For Binary As #1
    ReDim b1(1 To LOF(1))
    Get 1, , b1
    Close 1
    ' Okay. picture is in byte array so now we can load it
    ' fcrom the byte array into a picture box
    Picture1.Picture = PictureFromBits(b1)
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center