| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1815 人关注过本帖, 1 人收藏
标题:下面VB获取识别验证码出错,提示下标越界,怎么改
只看楼主 加入收藏
rogersgb
Rank: 1
等 级:新手上路
帖 子:73
专家分:0
注 册:2016-2-3
结帖率:47.37%
收藏(1)
 问题点数:0 回复次数:0 
下面VB获取识别验证码出错,提示下标越界,怎么改
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
搜索更多相关主题的帖子: For tag Next If Then 
2017-11-04 10:38
快速回复:下面VB获取识别验证码出错,提示下标越界,怎么改
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017829 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved