image - 将现有代码更改为基于位图单色的彩色像素

Question

我正在使用以下代码：

Sub LoadImageIntoExcel()
    
    Me.Activate
    
    Dim strFileName     As String
    
    Dim bmpFileHeader   As BITMAPFILEHEADER
    Dim bmpInfoHeader   As BITMAPINFOHEADER
    Dim ExcelPalette()  As PALETTE
    Dim Palette24       As PALETTE24Bit
    
    Dim i               As Integer
    Dim r As Integer, c As Integer
    Dim dAdjustedWidth  As Double
    Dim Padding         As Byte

   
    AutoSize
    On Error GoTo CloseFile
    strFileName = Application.GetOpenFilename

    Open strFileName For Binary As #1
        
    Get #1, , bmpFileHeader
    Get #1, , bmpInfoHeader


    If bmpInfoHeader.lngWidth Mod 4 > 0 Then
        dAdjustedWidth = (((Int((bmpInfoHeader.lngWidth * bmpInfoHeader.intBitCount) / 32) + 1) * 4#)) / _
                            (bmpInfoHeader.intBitCount / 8#)

        If dAdjustedWidth Mod 4 <> 0 Then dAdjustedWidth = Application.RoundUp(dAdjustedWidth, 0)

    Else
        dAdjustedWidth = bmpInfoHeader.lngWidth
    End If
    
    If bmpInfoHeader.intBitCount <= 8 Then
        ReDim ExcelPalette(0 To 255)
        

        For i = 0 To UBound(ExcelPalette)
            Get #1, , ExcelPalette(i)
        Next i
    
                
        Dim bytPixel As Byte
        
        For r = 1 To bmpInfoHeader.lngHeight
            For c = 1 To dAdjustedWidth
                
                If c <= bmpInfoHeader.lngWidth Then
                    Get #1, , bytPixel
                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _
                    RGB(ExcelPalette(bytPixel).red, _
                        ExcelPalette(bytPixel).green, _
                        ExcelPalette(bytPixel).blue)
                    DoEvents
                Else
                    Get #1, , Padding
                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _
                        RGB(255, 255, 255)
                End If
                


            Next c
        Next r
        
    Else
            
        For r = 1 To bmpInfoHeader.lngHeight
            For c = 1 To dAdjustedWidth
                
                If c <= bmpInfoHeader.lngWidth Then
                    Get #1, , Palette24
                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _
                        RGB(Palette24.red, _
                            Palette24.green, _
                            Palette24.blue)
                Else
                    Get #1, , Padding
                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _
                        RGB(255, 255, 255)
                End If
                DoEvents
            Next c
        Next r
        
    End If
    

    MsgBox "File loaded - program complete."

CloseFile:
    If Len(Err.Description) > 0 Then MsgBox Err.Description
    Close #1

End Sub

它按照 24 或 256 字节位图图像后的像素为单元着色。不幸的是，我是 VBA 和位图格式的新手，所以我无法更改代码以根据位图单色值（每像素 1（2？）字节）工作，这是我想要实现的。

到目前为止，我只是幸运地找到了一些 Python 指南，但我无法将这些信息应用于 VBA。

在位图的其他来源中，我找到了这个来源和这个来源，但我不知道如何在上面的代码中使用给定的信息。

我对与灰度或类似值相反的位图单色特别感兴趣。

是否有任何 VBA 支持的指南可以用来帮助我更改现有代码以用作单字节单色位图图像转换器？

谢谢你。

标签： image