Private Sub Command1_Click()
Dim ok As Boolean
Dim bm As BITMAP
Dim dot, bRed, bGreen, bBlue, Y As Long

For kuan = 0 To 49: For gao = 0 To 19
  a(kuan, gao).dot = 0
  a(kuan, gao).tag = 0
Next: Next
GetObject Picture1.Picture.Handle, Len(bm), bm

Picture2.Height = Picture1.Height

Picture2.Width = Picture1.Width
 For gao = 0 To bm.bmHeight - 1
 For kuan = 0 To bm.bmWidth - 1
        
        dot = GetPixel(Picture1.hdc, kuan, gao)
     bRed = Red(dot)
     bGreen = Green(dot)
     bBlue = Blue(dot)
     Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
    If Y < 128 Then
    dot = 1
    Else
    dot = 0
    End If
    If kuan < 6 Or kuan > 43 Or gao < 3 Or gao > 17 Then dot = 0
    a(kuan, gao).dot = dot
   
    Next kuan
   
Next gao



For kuan = 0 To 49: For gao = 0 To 19 '去掉孤立点
     
    If a(kuan, gao).dot = 1 Then
        a(kuan, gao).tag = a(kuan - 1, gao - 1).dot + a(kuan - 1, gao).dot + a(kuan - 1, gao + 1).dot + a(kuan, gao - 1).dot + a(kuan, gao + 1).dot + a(kuan + 1, gao - 1).dot + a(kuan + 1, gao).dot + a(kuan + 1, gao + 1).dot
        If a(kuan, gao).tag = 0 Then
        a(kuan, gao).dot = 0
        End If
    End If
 
Next: Next


For kuan = 0 To 49: For gao = 0 To 19 '去掉双子孤点
   
    If a(kuan, gao).dot = 1 And a(kuan, gao).tag = 1 Then
        a(kuan, gao).tag = a(kuan - 1, gao - 1).tag + a(kuan - 1, gao).tag + a(kuan - 1, gao + 1).tag + a(kuan, gao - 1).tag + a(kuan, gao + 1).tag + a(kuan + 1, gao - 1).tag + a(kuan + 1, gao).tag + a(kuan + 1, gao + 1).tag
        If a(kuan, gao).tag < 2 Then
        a(kuan, gao).dot = 0
        a(kuan, gao).tag = 0
        End If
    End If

Next: Next

'上边对整个图片初步处理,下边分块处理

Dim jieguo As String
jieguo = ""
For i = 1 To 4
FenGe (i)
QuBian
JianHua
QuQiao1
QuQiao2

If is2 Then
    jieguo = jieguo + Trim(Str(2))
ElseIf is1 Then
    jieguo = jieguo + Trim(Str(1))
ElseIf is3 Then
    jieguo = jieguo + Trim(Str(3))
ElseIf is4 Then
    jieguo = jieguo + Trim(Str(4))
ElseIf is5 Then
    jieguo = jieguo + Trim(Str(5))
ElseIf is6 Then
    jieguo = jieguo + Trim(Str(6))
ElseIf is7 Then
    jieguo = jieguo + Trim(Str(7))
ElseIf is9 Then
    jieguo = jieguo + Trim(Str(9))
ElseIf is8 Then
    jieguo = jieguo + Trim(Str(8))
Else
    jieguo = jieguo + Trim(Str(0))
End If

For kuan = 0 To 9: For gao = 0 To 19
Picture2.PSet (kuan + 10 * i - 10, gao), (1 - b(kuan, gao).dot) * 16777215
Next: Next
Next
'输出结果
SavePicture Picture2.Image, "c:\me2.bmp" '第二图
Label2.Caption = jieguo
Debug.Print jieguo
End Sub

Private Function Near(ByVal i As Integer, ByVal j As Integer) As Byte
 Near = a(i - 1, j - 1).dot * 1 + a(i, j - 1).dot * 2 + a(i + 1, j - 1).dot * 4 + a(i - 1, j).dot * 8 + a(i + 1, j).dot * 16 + a(i - 1, j + 1).dot * 32 + a(i, j + 1).dot * 64 + a(i + 1, j + 1).dot * 128
End Function

Private Sub JiSuan()
Dim kuan, gao  As Integer
For gao = 0 To 19: For kuan = 0 To 49
    If a(kuan, gao).dot = 1 Then
    a(kuan, gao).tag = Near(kuan, gao)
    End If
Next: Next
End Sub

Private Sub Form_Load()
webAuto.Navigate "http://etax.zjtax.
End Sub

Private Sub webAuto_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim X
    Dim CtrlRange
    For Each X In webAuto.Document.All
        If X.id = "yzmImg" Then
             Set CtrlRange = webAuto.Document.body.createControlRange()
             CtrlRange.Add (X)    '此处提示出错  对象不支持该属性或方法
             CtrlRange.execCommand ("Copy")
             Set Picture1.Picture = Clipboard.GetData
         End If
    Next
End Sub