如何新建1个高度=height,宽=width的2色bmp位图

Question

谢谢

Answer 1

乱写了一下，也许是真的哦……Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End TypeFunction CreateMonoBMP(ByVal lHeight As Long, ByVal lWidth As Long) As Long
    Dim utBitmap As BITMAP
    Dim m_abBits() As Byte
    
    With utBitmap
        .bmType = 0
        .bmWidth = lWidth
        .bmHeight = lHeight
        .bmWidthBytes = lWidth / 8
        .bmWidthBytes = IIf(.bmWidthBytes Mod 2 = 0, .bmWidthBytes, .bmWidthBytes + 1)
        .bmPlanes = 1
        .bmBitsPixel = 1
        ReDim m_abBits(lHeight * .bmWidthBytes)
        .bmBits = VarPtr(m_abBits(0))
    End With
    
    CreateMonoBMP = CreateBitmapIndirect(utBitmap)
End FunctionPrivate Sub Command1_Click()
    Dim lBMPHeight As Long, lBMPWidth As Long
    lBMPHeight = 120
    lBMPWidth = 120
    Dim hCDC As Long
    Dim hBitmap As Long
    
    hCDC = CreateCompatibleDC(Me.hdc)
    hBitmap = CreateMonoBMP(lBMPHeight, lBMPWidth)
    SelectObject hCDC, hBitmap
    
    BitBlt Me.hdc, 0, 0, lBMPHeight - 1, lBMPWidth - 1, hCDC, 0, 0, vbSrcCopy
    
    DeleteObject hBitmap
    DeleteObject hCDC
End SubPrivate Sub Form_Load()
    Me.AutoRedraw = False
End Sub