如何把一个位图数组显示在Picture控件里？

Question

一个字节数组(假设是BMP1())包含了一张位图的完整信息，如何把这张位图显示在Picture控件里呢？
当然我可以先把二进制数组写到一个文件里test.bmp，然后再用Picture控件的loadpiture方法去加载test.bmp，但我不想这样做。怎样才能把位图在内存中直接显示在Picture控件上？有办法的朋友麻烦代码写的详细点，谢谢，100分。

Answer 1

CreateDIBSection
然后拷贝数据到DIBSection的地址中
然后在BitBlt你的控件上 你试下 http://www.vbgood.com/viewthread.php?tid=53287&extra=page%3D1 这个东西
，CreateFromByteArray 是从字节数组然后显示图片的函数，支持二维和三维的数组，然后添加类似如下代码，
Private Sub Command1_Click()
Dim a(300, 400, 2) As Byte
For i = 1 To 300
    For j = 1 To 400
        For k = 0 To 2
            a(i, j, k) = Rnd * 255
        Next
    Next
Next
img.CreateFromByteArray a
img.OutPut Picture2.hDC
Picture2.Refresh
End Sub如果符合你的要求在详细的说细节

Answer 2

1个窗体上添加1个按钮command1 和图片框 picture1 再添加1个模块
模块代码Option ExplicitDeclare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Global Const DIB_RGB_COLORS = &H0
Global Const SRCCOPY = &HCC0020'Bitmap file format structures
Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type
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
Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(0 To 255) As RGBQUAD
End TypeGlobal gudtBMPFileHeader As BITMAPFILEHEADER 'Holds the file header
Global gudtBMPInfo As BITMAPINFO 'Holds the bitmap info
Global gudtBMPData() As Byte 'Holds the pixel dataSub ExtractData(strFileName As String, lngOffset As Long)Dim intBMPFile As Integer
Dim i As Integer    'Init variables
    Erase gudtBMPInfo.bmiColors
    'Open the bitmap
    intBMPFile = FreeFile()
    Open strFileName For Binary Access Read Lock Write As intBMPFile
        'Fill the File Header structure
        Get intBMPFile, lngOffset, gudtBMPFileHeader
        'Fill the Info structure
        Get intBMPFile, , gudtBMPInfo.bmiHeader
        If gudtBMPInfo.bmiHeader.biClrUsed <> 0 Then
            For i = 0 To gudtBMPInfo.bmiHeader.biClrUsed - 1
                Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbBlue
                Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbGreen
                Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbRed
                Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbReserved
            Next i
        ElseIf gudtBMPInfo.bmiHeader.biBitCount = 8 Then
            Get intBMPFile, , gudtBMPInfo.bmiColors
        End If
        'Size the BMPData array
        If gudtBMPInfo.bmiHeader.biBitCount = 8 Then
            ReDim gudtBMPData(FileSize(gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight))
        Else
            ReDim gudtBMPData(gudtBMPInfo.bmiHeader.biSizeImage - 1)
        End If
        'Fill the BMPData array
        Get intBMPFile, , gudtBMPData
        'Ensure info is correct
        If gudtBMPInfo.bmiHeader.biBitCount = 8 Then
            gudtBMPFileHeader.bfOffBits = 1078
            gudtBMPInfo.bmiHeader.biSizeImage = FileSize(gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight)
            gudtBMPInfo.bmiHeader.biClrUsed = 0
            gudtBMPInfo.bmiHeader.biClrImportant = 0
            gudtBMPInfo.bmiHeader.biXPelsPerMeter = 0
            gudtBMPInfo.bmiHeader.biYPelsPerMeter = 0
        End If
    Close intBMPFileEnd SubPrivate Function FileSize(lngWidth As Long, lngHeight As Long) As Long    'Return the size of the image portion of the bitmap
    If lngWidth Mod 4 > 0 Then
        FileSize = ((lngWidth \ 4) + 1) * 4 * lngHeight - 1
    Else
        FileSize = lngWidth * lngHeight - 1
    End IfEnd Function窗体代码
Private Sub Command1_Click()
  ExtractData "e:\1.bmp", 1
  StretchDIBits Picture1.hdc, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, 0, 0, gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight, gudtBMPData(0), gudtBMPInfo, DIB_RGB_COLORS, SRCCOPY
End Sub以上代码网上转载 经整理后测试成功显示图片至 picture1 图片框

Answer 3

1楼朋友的有点接近，但我要的是源码，而不是别人封装的DLL。
2楼朋友的代码已经不符合我的要求了，用了临时文件。
不过还是谢谢2位。

Answer 4

一种方法是直接用SETPIXEL一个一个点画上去，
另一种方法是用DIB直接一次性画

Answer 5

    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 Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal xz As Long, ByVal yz As Long) As Long
SetBitmapBits pic1.Image, UBound(PicBits), PicBits(1)  '得到数组
    SetBitmapBits pic2.Image, UBound(PicBits), PicBits(1)  '显示到PIC2