Преобразовать байтовый массив в изображение (c # => VB6)

Question

У меня есть следующий код в C #, который преобразует данный массив байтов (FF 3C, FF ... и т. Д.) В растровое изображение.

Можете ли вы помочь мне получить версию этого кода для VB6?

Я уже попробовал методы здесь:

строка base64 в байтах для изображения

http://vb.mvps.org/samples/NetCam/

https://www.planet -source-code.com / VB / скрипты / ShowCode.asp? TxtCodeId = 29004 & lngWId = 1

Но я не могу заставить это работать. Я пытаюсь загрузить изображение напрямую в поле для картинок или записать его в файл .bmp, но в результате изображение не получается ...

Спасибо

public static Bitmap ByteArrayToBitmap(byte[] data, int width, int height)
        {

            Bitmap bmp = new Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format1bppIndexed);
            // Prepare a locked image memory area
            System.Drawing.Imaging.BitmapData bmpData = bmp.LockBits(new Rectangle(0, 0, bmp.Width, bmp.Height), System.Drawing.Imaging.ImageLockMode.WriteOnly, bmp.PixelFormat);
            // Move our data in
            System.Runtime.InteropServices.Marshal.Copy(data, 0, bmpData.Scan0, data.Length);
            bmp.UnlockBits(bmpData);

            return bmp;
        }

UPDATE: Это мой код VB6:

Private Sub UpdatePictureBox
Dim buff(1023) as byte

' fill the byte array ...

Set PictureLCD.Picture = PictureFromBits(buff)

End Sub

Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
        Dim nLow As Long
        Dim cbMem  As Long
        Dim hMem  As Long
        Dim lpMem  As Long
        Dim IID_IPicture As GUID
        Dim istm As stdole.IUnknown '  IStream
        Dim ipic As IPicture

        ' Get the size of the picture's bits

100     nLow = LBound(abPic)

110     cbMem = (UBound(abPic) - nLow) + 1

        ' Allocate a global memory object
120     hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)

130     If hMem Then

            ' Lock the memory object and get a pointer to it.
140         lpMem = GlobalLock(hMem)

150         If lpMem Then

                ' Copy the picture bits to the memory pointer and unlock the handle.
160             MoveMemory ByVal lpMem, abPic(nLow), cbMem
170             Call GlobalUnlock(hMem)

                ' Create an ISteam from the pictures bits (we can explicitly free hMem
                ' below, but we'll have the call do it...)
180             If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
190                 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..)
200                     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

    End Function

Код взят здесь: http://www.vbforums.com/showthread.php?287495-load-a-picture-box-control-from-memory

Я проверил, и байтовый массив заполнен правильно, но я не вижу изображения в графическом окне ...

ОБНОВЛЕНИЕ 2: Массив байтов:

Answer 1

        Private Const BI_RGB = 0&
        Private Const CBM_INIT = &H4
        Private Const DIB_RGB_COLORS = 0
        Private Const SRCCOPY = &HCC0020

        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 RGBQUAD
            rgbBlue As Byte
            rgbGreen As Byte
            rgbRed As Byte
            rgbReserved As Byte
        End Type
        Private Type BITMAPINFO_256
            bmiHeader As BITMAPINFOHEADER
            bmiColors(0 To 255) As RGBQUAD
        End Type

        Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
        Private Declare Function CreateDIBitmap Lib "gdi32" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_256, ByVal wUsage As Long) As Long
        Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
        Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
        Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
        Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

        Dim Pixels() As Byte          ' Pixel data.
        Dim bm_info As BITMAPINFO_256 ' DIB bitmap info.
        Dim hDIB As Long              ' Bitmap handle.
        Dim wid As Integer            ' Size of the bitmap.
        Dim hgt As Integer

    Private Sub UpdatePictureBox
    Dim buff(1023) as byte

    ' fill the byte array ...

            SetColorTable
            SetPixels buff
            CreateDIB
            PictureLCD.Refresh

    End Sub


    Private Sub CreateDIB()
    Dim screen_hdc As Long

        With bm_info.bmiHeader
            .biSize = Len(bm_info.bmiHeader)
            .biWidth = wid          ' Width in pixels.
            .biHeight = hgt         ' Height in pixels.
            .biPlanes = 1           ' 1 color plane.
            .biBitCount = 8         ' 8 bits per pixel.
            .biCompression = BI_RGB ' No compression.
            .biSizeImage = 0        ' Unneeded with no compression.
            .biXPelsPerMeter = 0    ' Unneeded.
            .biYPelsPerMeter = 0    ' Unneeded.
            .biClrUsed = 256        ' # colors in color table that are used by the image. 0 means all.
            .biClrImportant = 256   ' # important colors. 0 means all.
        End With

        ' Get the screen's device context.
        screen_hdc = GetDC(0)

        ' Create the DIB.
        hDIB = CreateDIBitmap(screen_hdc, _
            bm_info.bmiHeader, CBM_INIT, Pixels(0, 0), _
            bm_info, DIB_RGB_COLORS)
    End Sub


    ' Draw the DIB onto the form.

    Private Sub DrawDIB()
    Dim compat_dc As Long

        ' Create a compatible device context.
        compat_dc = CreateCompatibleDC(hdc)

        ' Select the DIB into the compatible DC.
        SelectObject compat_dc, hDIB

        ' Copy the compatible DC's image onto the form.

        StretchBlt PictureLCD.hdc, 0, PictureLCD.ScaleHeight, PictureLCD.ScaleWidth, PictureLCD.ScaleHeight * -1, compat_dc, 0, 0, wid, hgt, SRCCOPY

        ' Destroy the compatible DC.
        DeleteDC compat_dc
    End Sub


    ' Initialize 256 shades of blue.

    Private Sub SetColorTable()
    Dim i As Integer

        For i = 0 To 255
            bm_info.bmiColors(i).rgbRed = i
            bm_info.bmiColors(i).rgbGreen = i
            bm_info.bmiColors(i).rgbBlue = i
            bm_info.bmiColors(i).rgbReserved = 0
        Next i
    End Sub

    ' Create a drawing.
    Private Sub SetPixels(buff() As Byte)
        Dim x As Integer
        Dim Y As Integer
        Dim counter As Integer
        counter = 0
        Dim tempCounter As Integer
        tempCounter = 0

        On Error GoTo ErrorHandler

        wid = 128
        hgt = 64
        ReDim Pixels(0 To wid - 1, 0 To hgt - 1)
        For Y = 0 To hgt - 1

            Dim byteBits As String
            For x = 0 To wid - 1
                If tempCounter = 0 Then

                    byteBits = ByteToBit(buff(counter))

                    If (CByte(Mid(byteBits, tempCounter + 1, 1)) = 1) Then
                        Pixels(x, Y) = 0
                    Else
                        Pixels(x, Y) = 255
                    End If

                    tempCounter = tempCounter + 1
                Else

                    If tempCounter = 7 Then
                        If (CByte(Mid(byteBits, tempCounter + 1, 1)) = 1) Then
                            Pixels(x, Y) = 0
                        Else
                            Pixels(x, Y) = 255
                        End If
                        tempCounter = 0
                        counter = counter + 1
                    Else
                        If (CByte(Mid(byteBits, tempCounter + 1, 1)) = 1) Then
                            Pixels(x, Y) = 0
                        Else
                            Pixels(x, Y) = 255
                        End If
                        tempCounter = tempCounter + 1
                    End If

                End If

            Next
        Next

        ErrorHandler:
        Dim str As String
        str = Err.Description
        Dim a As Single
        a = 0

    End Sub

    Private Function ByteToBit(myByte As Byte) As String

    'Bit  ==  32103210
    '         --------
    '&HF0 == "11110000"
    '&H0A == "00001010"

        Dim k As Integer
        Dim x As Integer

        Dim valofbyte As Integer
        Dim mybytetobit As String

        valofbyte = val(CStr(myByte))
        mybytetobit = ""

        For k = 0 To 7
            x = 2 ^ k
            If valofbyte And x Then
                mybytetobit = "1" & mybytetobit
            Else
                mybytetobit = "0" & mybytetobit
            End If

        Next k

        ByteToBit = mybytetobit

    End Function


    Private Sub Picture1_Paint()
    'Picture1 is the PIctureBox
        DrawDIB
    End Sub