桌面16色、32色的16进制颜色值转换

zopey

Sub 按钮1_Click()
Dim fn, f
Dim arr() As Byte, H, i
Range("a:a").Clear
fn = Application.GetOpenFilename("图像文件,*.bmp", , "请选文件", , MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
For Each f In fn
    Open f For Binary As #1
    H = LOF(1)
    ReDim arr(1 To H)
    Get #1, , arr
    Close #1
    For i = 1 To 54
        Cells(i, 1) = arr(i)
    Next
   
    k0 = [g11]
    For i = 1 To [g23]
    For j = 1 To [g19]
       b = arr(k * 3 + k0 + 1)
       g = arr(k * 3 + k0 + 2)
       r = arr(k * 3 + k0 + 3)
       k = k + 1
       Worksheets("sheet1").Cells([g23] - i + 1, j).Interior.Color = RGB(r, g, b)
    Next
    Next
Next
End Sub

02761752696

zopey 发表于 2018-8-14 16:38
24位bmp图片 读取像素到工作表单元格，效果如图

用什么做的 啊 真不错

zopey

02761752696 发表于 2018-8-20 11:24
用什么做的 啊 真不错

了解24位bmp文件的标准格式后，按字节直接读取 像素。
代码见11楼，有瑕疵。

zopey

下面的代码 适用范围更大，如果 put #1 则输出为 图片 1.jpg。

Sub 按钮1_Click()
Dim fn, f
Dim arr() As Byte, H, i
Range("a:a").Clear
fn = Application.GetOpenFilename("图像文件,*.bmp", , "请选文件", , MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
For Each f In fn
    Open f For Binary As #1
    H = LOF(1)
    ReDim arr(1 To H)
    Get #1, , arr
    Close #1
    For i = 1 To 54
        Cells(i, 1) = arr(i)
    Next

    'Open ThisWorkbook.Path & "\1.jpg" For Binary As #1
    'Put #1, , arr
    'Close #1

    For i = 0 To 3
        PixelCol = PixelCol + arr(i + 19) * 256 ^ i
    Next
    For i = 0 To 3
        PixelRow = PixelRow + arr(i + 23) * 256 ^ i
    Next
    '获取图片的像素高和宽。宽度不是4的倍数时需补零
    If PixelCol Mod 4 <> 0 Then Zeroize = PixelCol Mod 4

    Worksheets("sheet1").Activate
    Cells.Clear
    With Worksheets("sheet1")
    For i = PixelRow To 1 Step -1
        CellRow = CellRow + 1
        CellCol = 0
        For j = 1 To PixelCol * 3 Step 3
            CellCol = CellCol + 1
            lngPos = arr(11) + j + (i - 1) * (PixelCol * 3 + Zeroize)
            .Cells(CellRow, CellCol).Interior.Color = RGB(arr(lngPos + 2), arr(lngPos + 1), arr(lngPos))
        Next
    Next
    End With
Next
End Sub

02761752696

zopey 发表于 2018-8-20 17:39
下面的代码 适用范围更大，如果 put #1 则输出为 图片 1.jpg。

Sub 按钮1_Click()

一运行无响应了 试了几次都这样，同时开两个工作薄  这个无响应  另外一个可以正常使用

zopey

02761752696 发表于 2018-8-21 10:40
一运行无响应了 试了几次都这样，同时开两个工作薄  这个无响应  另外一个可以正常使用

调试通过

24位标准图片.zip (129.25 KB, 下载次数: 126)

2018-8-21 11:31 上传

点击文件名下载附件

02761752696

zopey 发表于 2018-8-21 11:31
调试通过

谢谢老师  我再看看  

02761752696

zopey 发表于 2018-8-21 11:31
调试通过

谢谢老师   问题找到了  应该是我电脑问题，我吧图片像素缩小后   就正常了，虽然还是慢  但是没有出现无响应的情况，谢谢了

zopey

可见光波长 380-780 纳米(nm)

可见光色谱.zip (49.73 KB, 下载次数: 93)

2018-9-13 15:25 上传

点击文件名下载附件