1,502
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Declare Sub mouse_event Lib "User32" (ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal dwData As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function ClientToScreen Lib "User32" ( _
ByVal hWnd As Long, _
ByRef lpPoint As POINTAPI) As Long
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Type POINTAPI
cx As Long
cy As Long
End Type
Private arrData(199, 99) As Long
Private mlGrayVal As Long
Private mlBlockX As Long
Private mlBlockY As Long
Private mlBaseX As Long
Private mlBaseY As Long
Private Sub GetImageData()
Dim cp#, cm As Double
Dim wx&, wy As Long
Dim i&, k&, w As Long
wx = 275 + (WebBrowser1.Width \ 15 - 817) \ 2 ' X坐标
wy = 436 ' 网页中“图片”位置在窗口客户区的 Y坐标
mlBaseX = wx
mlBaseY = wy
cm = 0
Call BitBlt(Picture1.hDC, 0&, 0&, 200&, 100&, Me.hDC, wx, wy, vbSrcCopy)
For wx = 0 To 199
For wy = 0 To 99
k = Picture1.Point(wx, wy)
w = 2775& * (255& And k): k = k \ 256&
w = w + 5448& * (255& And k): k = k \ 256&
cp = (w + 1058 * k) / 9281
cm = cm + cp
arrData(wx, wy) = cp
Next
Next
mlGrayVal = cm / 20000
End Sub
Private Sub MouseDrag()
Const MOUSEEVENTF_ABSOLUTE As Long = &H8000
Const MOUSEEVENTF_LEFTDOWN As Long = 2
Const MOUSEEVENTF_LEFTUP As Long = 4
Const MOUSEEVENTF_MOVE As Long = 1
Dim stcCP As POINTAPI
Dim w&, u As Long
Dim k As Double
stcCP.cx = 16& + mlBaseX
stcCP.cy = 111& + mlBaseY
Call ClientToScreen(Me.hWnd, stcCP)
k = 983040 / Screen.Width
w = stcCP.cx * k
u = stcCP.cy * 983040 / Screen.Height
DoEvents
Call mouse_event(MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, w, u, 0&, 0&)
DoEvents
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0&)
DoEvents
w = w + k * mlBlockX
Call mouse_event(MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, w, u, 0&, 0&)
DoEvents
Call mouse_event(MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0&)
End Sub
Private Sub ScanPostion()
Dim arrBuffer(199, 99) As Long
Dim px&, py As Long
Dim wx&, wy As Long
Dim w&, u&, i&, k&, m As Long
mlBlockX = -1
u = mlGrayVal + 0.3 * (255& - mlGrayVal)
If (&HEC& < u) Then u = &HEC&
For wx = 0 To 199
For wy = 0 To 99
arrBuffer(wx, wy) = (u < arrData(wx, wy))
Next
Next
For wy = 20 To 75 Step 25
w = 0
For wx = 0 To 160
Do
m = arrBuffer(wx, wy)
If (w And Not m) Then
u = 39 + wx
For i = wx To u
If (arrBuffer(i, wy)) Then Exit For
Next
If (u > i) Then m = -1&: wx = i: Exit Do
w = wy - 25
If (0 > w) Then w = 0
For i = wy To w Step -1
If (arrBuffer(wx, i)) Then Exit For
Next
If (w > i) Then wx = u: Exit Do
w = 38& + wx
For k = wx - 1& To w
If (Not arrBuffer(k, i)) Then Exit For
Next
If (w > k) Then wx = u: Exit Do
u = wx - 1&
w = 39& + i
For k = i To w
If (Not arrBuffer(u, k)) Then Exit For
Next
If (w > k) Then Exit Do
mlBlockY = i
mlBlockX = u
wy = 100
Exit For
End If
Exit Do
Loop
w = m
Next ' Next wx
Next ' Next wy
End Sub
Private Sub Command1_Click()
WebBrowser1.Navigate "http://gkcf.jxedu.gov.cn/"
End Sub
Private Sub Command2_Click()
Call GetImageData
Call ScanPostion
If (-1& = mlBlockX) Then
Call MsgBox("识别失败。", 64)
Else
Picture1.Line (mlBlockX - 2, mlBlockY)-(mlBlockX - 20, mlBlockY), vbRed
Picture1.Line (mlBlockX, mlBlockY - 2)-(mlBlockX, mlBlockY - 20), vbRed
Picture1.Line (mlBlockX + 2, mlBlockY)-(mlBlockX + 20, mlBlockY), vbRed
Picture1.Line (mlBlockX, mlBlockY + 20)-(mlBlockX, mlBlockY + 2), vbRed
Call MouseDrag
End If
End Sub
Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
End Sub
Private Sub Form_Resize()
WebBrowser1.Width = Me.ScaleWidth
WebBrowser1.Height = Me.ScaleHeight
End Sub