Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Declare Function CreateDCA& Lib "gdi32" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Type pointapi
X As Long
Y As Long
End Type
Private Sub Command1_Click()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Me.BackColor = GetPixel(a, p.X, p.Y)
Command1.Caption = GetPixel(a, p.X, p.Y)
DeleteDC a
End Sub
Private Sub Command2_Click()
'Shell "C:\WINDOWS\Pbrush.exe c:\9.bmp", 1
'SendKeys ("%{f}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%a")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
'SendKeys ("%{F4}")
End Sub
Private Sub Command3_Click()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Label3.Caption = GetPixel(a, Text2.Text, Text3.Text)
Label4.Caption = GetPixel(a, Text4.Text, Text5.Text)
End Sub
Private Sub Command4_Click()
Form2.Show
End Sub
Private Sub Command5_Click()
Cls
For i = 1 To 85
Print ti(i)
Next i
End Sub
Private Sub Command6_Click()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Public kaohao, haowei(10), kh(10, 10) As Integer
Public kemu As String
10:
'读取答题卡信息点作标
Dim fileso As New Scripting.FileSystemObject
Dim ts As TextStream
Set ts = fileso.OpenTextFile("\\teacher\记录$\a卡zuobiao.txt", ForReading, 1)
'识别a 卡
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then GoTo 100 '如果是b卡则专到100执行
'识别科目
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "综文"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "数学"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "外语"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "理综"
'识别10位考号
For i = 0 To 10
For j = 0 To 10
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then haowei(i) = j
Next j
Next i
For i = 0 To 10
kaohao = kaohao & haowei(i)
Next
'识别80道判断题
For i = 1 To 80
X = ts.ReadLine
Y = ts.ReadLine
a(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
b(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
c(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
d(i) = GetPixel(a, X, Y)
If ti(i) = a(i) * 1 + b(i) * 2 + c(i) * 4 + d(i) * 8 Then fenshu = fenshu + 1
Next i
100: '识别b卡
Set ts = fileso.OpenTextFile("\\teacher\记录$\b卡zuobiao.txt", ForReading, 1)
'识别b卡
X = ts.ReadLine
Y = ts.ReadLine
'If GetPixel(a, x, y) = 0 Then GoTo 100 '如果是a卡则专到50执行
'识别科目
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "综文"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "数学"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "外语"
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then kemu = "理综"
'识别10位考号
For i = 0 To 10
For j = 0 To 10
X = ts.ReadLine
Y = ts.ReadLine
If GetPixel(a, X, Y) = 0 Then haowei(i) = j
Next j
Next i
For i = 0 To 10
kaohao = kaohao & haowei(i)
Next
'识别80道判断题
For i = 1 To 80
X = ts.ReadLine
Y = ts.ReadLine
a(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
b(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
c(i) = GetPixel(a, X, Y)
X = ts.ReadLine
Y = ts.ReadLine
d(i) = GetPixel(a, X, Y)
If ti(i) = a(i) * 1 + b(i) * 2 + c(i) * 4 + d(i) * 8 Then fenshu = fenshu + 1
Next i
Set shuju = zhuce.OpenTextFile("\\teacher\记录$\fenshu.txt", ForAppending, True)
shuju.WriteLine xingming
shuju.WriteLine xuehao
shuju.WriteLine fenshu
shuju.WriteLine kemu
If fenshu = 0 Then GoTo 500 '如果部分为0则专到结束
shuju.WriteLine "@@@@@@@@@@"
GoTo 10
500: MsgBox "识别结束,请查看\\teacher\记录$\fenshu.txt"
End Sub
Private Sub Command7_Click()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
'GetCursorPos p
'Me.BackColor = GetPixel(a, p.X, p.Y)
'Command1.Caption = GetPixel(a, p.X, p.Y)
For j = 1 To Int(Text6.Width / 22)
For i = 1 To Int(Text6.Height / 22)
X = i
Y = j
m = m + 1
'a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
'GetCursorPos p
If GetPixel(a, X, Y) > 0 Then Print " ";
If GetPixel(a, X, Y) = 0 Then Print "a";
Print "";
';If m > 15 Then Print: m = 0
Next i
Print
Next j
'Dim a As Long
'Dim p As pointapi
'Me.BackColor = GetPixel(a, p.X, p.Y)
'Command1.Caption = GetPixel(a, p.X, p.Y)
Label1.Caption = X
Label2.Caption = Y
DeleteDC a
End Sub
Private Sub Command8_Click()
End
End Sub
Private Sub Form_Load()
Set Image1 = LoadPicture("c:\9.bmp")
'Shell "C:\WINDOWS\Pbrush.exe c:\9.bmp", 1
End Sub
Private Sub Image1_Click()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Me.BackColor = GetPixel(a, p.X, p.Y)
Command1.Caption = GetPixel(a, p.X, p.Y)
Label1.Caption = p.X
Label2.Caption = p.Y
DeleteDC a
Dim fileso As New Scripting.FileSystemObject
Dim ts As TextStream
Set ts = fileso.OpenTextFile("\\teacher\记录$\zuobiao.txt", ForAppending, 1)
ts.Write " x:"
ts.Write Label1.Caption
For i = 0 To 5 - Len(Label1.Caption)
ts.Write " "
Next i
ts.Write " y:"
ts.Write Label2.Caption
For i = 0 To 5 - Len(Label2.Caption)
ts.Write " "
Next i
ts.WriteLine
End Sub
Private Sub Text1_DblClick()
Cls
Text6.Text = Text1.Text
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Cls
Text6.Text = Text1.Text
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
'GetCursorPos p
'Me.BackColor = GetPixel(a, p.X, p.Y)
'Command1.Caption = GetPixel(a, p.X, p.Y)
jc = Text6.Width / 16
ic = Text6.Height / 16
For j = 1 To Int(Text6.Width / jc)
For i = 1 To Int(Text6.Height / ic)
X = i
Y = j
m = m + 1
'a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
'GetCursorPos p
If GetPixel(a, X, Y) > 0 Then Print " ";
If GetPixel(a, X, Y) = 0 Then Print "a";
Print "";
';If m > 15 Then Print: m = 0
Next i
Print
Next j
'Dim a As Long
'Dim p As pointapi
'Me.BackColor = GetPixel(a, p.X, p.Y)
'Command1.Caption = GetPixel(a, p.X, p.Y)
Label1.Caption = X
Label2.Caption = Y
DeleteDC a
End Sub
Private Sub Text6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Me.BackColor = GetPixel(a, p.X, p.Y)
Command1.Caption = GetPixel(a, p.X, p.Y)
DeleteDC a
End Sub
Private Sub Text7_Change()
Cls
End Sub
Private Sub Timer1_Timer()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
Me.BackColor = GetPixel(a, p.X, p.Y)
Command1.Caption = GetPixel(a, p.X, p.Y)
Label1.Caption = p.X
Label2.Caption = p.Y
DeleteDC a
'SendKeys "你好"
'SendKeys "{enter}"
''Shell ("C:\显示桌面.scf")
'Shell "C:\WINDOWS\Pbrush.exe c:\3333.bmp", 1
'SendKeys ("%{F4}")
'SendKeys "a"
End Sub
Private Sub Timer2_Timer()
'SendKeys ("%{F4}")
'SendKeys ("%{f}")
'Timer2.Interval = 0
'SendKeys "你好"
'SendKeys "{enter}"
''Shell ("C:\显示桌面.scf")
'Shell "C:\WINDOWS\Pbrush.exe c:\3333.bmp", 1
'SendKeys ("%{F4}")
'Shell "C:\WINDOWS\Pbrush.exe c:\3333.bmp", 1
End Sub
Private Sub Timer3_Timer()
'SendKeys ("{a}")
Timer3.Interval = 0
End Sub
Private Sub Timer4_Timer()
'SendKeys ("{tab}")
'SendKeys ("{单}")
'SendKeys ("{tab}")
'SendKeys ("{s}")
'SendKeys ("{y}")
'SendKeys ("{y}")
'SendKeys ("%{F4}")
Timer4.Interval = 0
End Sub
Fu Xianjun. All Rights Reserved
最低0.47元/天 解锁文章
565
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
