图片转换成字符图

dongdonggege

在网上看到一个帖子，说的是《图片转换成字符图》。好像是python语言，但是我不懂，哪位高手要是懂这个语言，把它改编成vba的《图片转换成字符图》就好了。
链接：https://blog.csdn.net/darren817/article/details/79824823
另外有一篇《简单实现图片转彩色字符画》，链接：https://blog.csdn.net/kongfu_cat/article/details/79511087
第一篇文章大致编程如下，或者请看第一个链接。

#-*- coding:utf-8 -*-from PIL import Imageimport argparse#命令行输入参数处理parser = argparse.ArgumentParser()parser.add_argument('file')     #输入文件parser.add_argument('-o', '--output')   #输出文件parser.add_argument('--width', type = int, default = 80) #输出字符画宽parser.add_argument('--height', type = int, default = 80) #输出字符画高#获取参数args = parser.parse_args()IMG = args.fileWIDTH = args.widthHEIGHT = args.heightOUTPUT = args.output#这里的list可以自己定义ascii_char = list("$@B%8&WM#*oahkbdpqwmZO0QLCJUYXzcvunxrjft/\|()1{}[]?-_+~<>i!lI;:,\"^`'. ")# 将256灰度映射到70个字符上def get_char(r,g,b,alpha = 256):    if alpha == 0:        return ' '    length = len(ascii_char)    gray = int(0.2126 * r + 0.7152 * g + 0.0722 * b)    unit = (256.0 + 1)/length    return ascii_char[int(gray/unit)]if __name__ == '__main__':    im = Image.open(IMG)    im = im.resize((WIDTH,HEIGHT), Image.NEAREST)    txt = ""    for i in range(HEIGHT):        for j in range(WIDTH):            txt += get_char(*im.getpixel((j,i)))        txt += '\n'    print txt    #字符画输出到文件    if OUTPUT:        with open(OUTPUT,'w') as f:            f.write(txt)    else:        with open("output.txt",'w') as f:            f.write(txt)
因为看不懂，不知如何下手，麻烦高手，能否实现？vba如何编写，谢谢。

zopey

bits(0,2,3)代表从图形左下角数起横向第2个纵向第3个像素的Blue值，而bits(1,2,3)和bits(2,2,3)分别的Green值和Red值

bytTarget = bits(0, ix, iy) * 0.11 + bits(1, ix, iy) * 0.59 + bits(2, ix, iy) * 0.3 '这是传统的根据三原色亮度加权得到灰阶的算法

dongdonggege

zopey 发表于 2018-10-15 16:27
bits(0,2,3)代表从图形左下角数起横向第2个纵向第3个像素的Blue值，而bits(1,2,3)和bits(2,2,3)分别的Green ...

能做出附件吗？

dongdonggege

zopey 发表于 2018-10-15 16:27
bits(0,2,3)代表从图形左下角数起横向第2个纵向第3个像素的Blue值，而bits(1,2,3)和bits(2,2,3)分别的Green ...

你说的是小fisher写的，http://club.excelhome.net/forum. ... 986&pid=2561266，我也曾经改编过这个程序，直接在窗体改变黑白度和灰度，但这个做不好。

zopey

dongdonggege 发表于 2018-10-15 20:53
你说的是小fisher写的，http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=400986&p ...

得出了 图片灰度的 二维数组，再 建立横竖坐标 和字符置换表（255灰度-70字符） ，输出到 txt 。

参考 16楼文档
http://club.excelhome.net/thread-1403768-2-1.html

dongdonggege

zopey 发表于 2018-10-15 23:13
得出了 图片灰度的 二维数组，再 建立横竖坐标 和字符置换表（255灰度-70字符） ，输出到 txt 。

参考 ...

1、你说的16楼文件，我这显示丢失Microsoft Windows Common Controls 6.0 (SP6)
2、字符置换表，我这第125行，不知道怎么输出txt？
3、我打包，另有图片，请看怎么改。
我这已经做出半成品了，麻烦帮我修改，谢谢。

zopey

Sub 按钮1_Click()
Cells.Clear
Dim fn, f
Dim arr() As Byte, H, i
fn = Application.GetOpenFilename("图像文件,*.*", , "请选文件", , 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

    '获取图片的像素高和宽。宽度不是4的倍数时需补零
    PixelCol = 0: PixelRow = 0: Zeroize = 0
    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
    If PixelCol Mod 4 <> 0 Then Zeroize = PixelCol Mod 4

    Dim brr()
    ReDim brr(1 To PixelRow, 1 To PixelCol)

    ascii_char = "$@B%8&WM#*oahkbdpqwmZO0QLCJUYXzcvunxrjft/\|()1{}[]?-_+~<>i!lI;:,\^`'. "
    pLength = Len(ascii_char)
    unit = (256# + 1) / pLength

    CellRow = 0
    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)
            bytTarget = arr(lngPos) * 0.299 + arr(lngPos + 1) * 0.587 + arr(lngPos + 2) * 0.114

            brr(CellRow, CellCol) = Mid(ascii_char, Int(bytTarget / unit) + 1, 1)
        Next
    Next

    [a1].Resize(PixelRow, PixelCol) = brr
Next
End Sub


24位图片.zip (42.25 KB, 下载次数: 30)

2018-10-16 14:24 上传

点击文件名下载附件

dongdonggege

zopey 发表于 2018-10-16 14:25
Sub 按钮1_Click()
Cells.Clear
Dim fn, f

不好意思，我刚上了两节课，
1、你这个还是提示丢失Microsoft Windows Common Controls 6.0 (SP6)，什么原因？能否解说下。
2、能不能做成窗体的，麻烦你，谢谢。

dongdonggege

zopey 发表于 2018-10-16 14:25
Sub 按钮1_Click()
Cells.Clear
Dim fn, f

有时22行和25行，会提示溢出。

zopey

dongdonggege 发表于 2018-10-16 16:24
有时22行和25行，会提示溢出。

图像像素 要事先压缩到100 *100左右