我的代码是这样的m_hdc1 = CreateCompatibleDC(0)
m_dib1 = CreateDIBSection(m_hdc1, bmpinfo, 0, m_ptr1, 0, 0)
...
BitBlt m_hdc1, 0, 0, 64, 64, Picture2.hdc, 0, 0, vbSrcCopy
Dim Data() As Byte, a As Long
ReDim Data(m_pitch1 * m_height - 1)
GetBitmapBits m_dib1, m_pitch1 * m_height, Data(0)
Dim Data1() As Byte
ReDim Data1(m_pitch1 * m_height - 1)
CopyMemory Data1(0), m_ptr1, m_pitch1 * m_height
用GetBitmapBits 方法得到的数组是正确的,但是CopyMemory 从ptr1里得到的数组缺不正确。
求教这个createdibsection 的指针参数是怎么用的啊?

解决方案 »

  1.   


    'Example Name:DIB
    Private Const BI_RGB = 0&
    Private Const DIB_RGB_COLORS = 0 '  color table in RGBs
    Private Type BITMAPINFOHEADER '40 bytes
            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
            bmiHeader As BITMAPINFOHEADER
            bmiColors As RGBQUAD
    End Type
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) 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 SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Dim iBitmap As Long, iDC As Long
    Private Sub Form_Paint()
        'KPD-Team 2000
        'URL: http://www.allapi.net/
        'E-Mail: [email protected]
        '-> Compile this code for better performance
        Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
        With bi24BitInfo.bmiHeader
            .biBitCount = 24
            .biCompression = BI_RGB
            .biPlanes = 1
            .biSize = Len(bi24BitInfo.bmiHeader)
            .biWidth = 100
            .biHeight = 100
        End With
        ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
        iDC = CreateCompatibleDC(0)
        iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
        SelectObject iDC, iBitmap
        BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, GetDC(0), 0, 0, vbSrcCopy
        GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
        For Cnt = LBound(bBytes) To UBound(bBytes)
            If bBytes(Cnt) < 50 Then
                bBytes(Cnt) = 0
            Else
                bBytes(Cnt) = bBytes(Cnt) - 50
            End If
        Next Cnt
        SetDIBitsToDevice Me.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
        DeleteDC iDC
        DeleteObject iBitmap
    End Sub