选择题答题卡图像自动剪切，识别能否实现？

592rmb

切割后程序自动扫描答题卡，将识别结果记录到excel中与标准答案进行比对判卷

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 UBound(arr)
        Cells(i, 1) = arr(i)
    Next i
Next
End Sub


bmp字节流.zip (377.52 KB, 下载次数: 12)

2018-8-14 10:04 上传

点击文件名下载附件

zopey

bmp 的数据存储格式，对比学习如下 ：
A 列为实际读取结果（按字节）

592rmb

zopey 发表于 2018-8-14 10:11
bmp 的数据存储格式，对比学习如下 ：
A 列为实际读取结果（按字节）

老师你这是要识别图像的像素点吗？能否根据需求写一下答题卡答案的识别程序？谢谢了

zopey

592rmb 发表于 2018-8-14 11:31
老师你这是要识别图像的像素点吗？能否根据需求写一下答题卡答案的识别程序？谢谢了

我之前发过一个关于图像色彩的提问，基础知识点整不明白，所以有机会要多学习。

http://club.excelhome.net/thread-1403768-1-1.html

你的问题只凭几行代码 能解决？
应该去找 有识图找色功能的 图像插件或api  处理。

592rmb

zopey 发表于 2018-8-14 11:47
我之前发过一个关于图像色彩的提问，基础知识点整不明白，所以有机会要多学习。

http://club.excelhom ...

老师麻烦看一下这个，我的需求和这个相似：

http://club.excelhome.net/thread-1415327-1-1.html

592rmb

顶一下，不要沉了，大神们加油啊

zopey

Sub test()
Dim Dm
Set Dm = CreateObject("dm.dmsoft")

p1 = Dm.FindPic(0, 0, 1042, 900, ThisWorkbook.Path & "\021.bmp", "000000", 0.9, 0, tx0, ty0)
If tx0 >= 0 And ty0 >= 0 Then
tx0 = tx0 + 24: ty0 = ty0 - 181

Do While True
For i = 1 To 5
For j = 1 To 4
   tx = tx0 + (j - 1) * 36
   ty = ty0 + (i - 1) * 32
   p2 = Dm.FindPic(tx, ty, tx + 26, ty + 19, ThisWorkbook.Path & "\block.bmp", "000000", 0.7, 0, intx, inty)
   If intx >= 0 And inty >= 0 Then Cells(8, k0 * 5 + i + 1) = Cells(8, k0 * 5 + i + 1) & ChrW(j + 64)
Next
Next

k0 = k0 + 1: If k0 = 5 Then Exit Sub
If k0 < 4 Then
   tx0 = tx0 + 181
Else
   tx0 = tx0 - 181 * 3
   ty0 = ty0 + 181
End If

Loop

End If

Set Dm = Nothing
End Sub


大漠识图.zip (1.47 MB, 下载次数: 35)

2018-8-15 17:14 上传

点击文件名下载附件

zopey

答题卡图片只要在屏幕上能完整显示 不遮挡，并不需要插入excel ，
vba 就可以 读取答案（包括多选）。

592rmb

老师，以下两个功能:
1.需要把选择题答题卡从一页试卷中自动裁切出来，然后再识别！
2.识别完了以后，还要点击表格任意一行时，能用红色文本框将选错的题的答案遮盖住（即用红色在原答题卡上将选错的题的答案标识出来）。
谢谢！