dingxingszj的专栏

DynamipsGUI-v27破解版.rar

vb指纹比较图片比较识别 。。。。 If InStr(Text2.Text, Text1.Text) > 0 Then SetPixel Picture2.hdc, x, y, vbRed Print InStr(Text2.Text, Text1.Text), Print "ok" End If 。。。。。。。。。。。。

４窗口播放器realplay.rar，用于视频会议接收

2-10进制互相转换使用vb制作，供教学参考

鼠标模拟键盘.frm Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) 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 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 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 Dim mx, my Private Sub Command1_Click() x = Int(Rnd(1) * 500) y = Int(Rnd(1) * 500) Call SetCursorPos(x, y) '让鼠标移动到(10,20) 'mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0& '模拟鼠标点击 mouse_event LEFTDOWN_RIGHTDOWN, 0, 0, 0, 0 '//模拟按下鼠标右键。 End Sub Private Sub Command2_Click() Timer2.Interval = 0 mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击! End Sub Private Sub Command3_Click() End End Sub Private Sub Form_Load() '定义鼠标事件 '上面的是声明部分.只有声明了,才可以使用.. '代码部分 Call SetCursorPos(580, 20) '让鼠标移动到(10,20) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击! End Sub Private Sub Timer1_Timer() x = Int(Rnd(1) * 500) y = Int(Rnd(1) * 500) Call SetCursorPos(x, y) '让鼠标移动到(10,20) mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 '模拟鼠标的左键单击! mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击! End Sub ''为 了 指 定 那 些 与 SHIFT、 CTRL 及 ALT 等 按 键 结 合 的 组 合 键 ， 可 在 这 些 按 键 码 的 前 面 放 置 一 个 或 多 个 代 码 ， 这 些 代 码 列 举 如 下 ： '按 键 代 码 'SHIFT + 'CTRL ^ 'ALT % '{PRTSC} ' 为 了 说 明 在 按 下 其 它 按 键 时 应 同 时 按 下 SHIFT、 CTRL、 及 ALT 的 任 意 组 合 键 ， 请 把 那 些 按 键 的 码 放 在 括 号 当 中 。 例 如 ， 为 了 说 明 按 下 E 与 C 的 时 候 同 时 按 下 SHIFT 键 ， 请 使 用 "+(EC)"。 为 了 说 明 在 按 下 E 的 时 候 同 时 按 下 SHIFT 键 ， 但 接 着 按 C 而 不 按 SHIFT， 则 使 用 "+EC"。 '对 SendKeys 来 说 ， 加 号 (+)、 插 入 符 (^)、 百 分 比 符 号 (%)、 上 划 线 (~) 及 圆 括 号 ( ) 都 具 有 特 殊 意 义 。 为 了 指 定 上 述 任 何 一 个 字 符 ， 要 将 它 放 在 大 括 号 ({}) 当 中 。 例 如 ， 要 指 定 正 号 ， 可 用 {+} 表 示 。 方 括 号 ([ ]) 对 SendKeys 来 说 并 不 具 有 特 殊 意 义 ， 但 必 须 将 它 们 放 在 大 括 号 中 。 在 其 它 应 用 程 序 中 ， 方 括 号 有 特 殊 意 义 ， 在 出 现 动 态 数 据 交 换 (DDE) 的 时 候 ， 它 可 能 具 有 重 要 意 义 。 为 了 指 定 大 括 号 字 符 ， 请 使 用 {{} 及 {}}。 '另 外 ， 参 考 Sendkeys的 帮 助 ， 可 以 找 到 其 他 一 些 特 殊 键 的 传 递 方 法 。 'SendKeys "^B" 'SendKeys ("{PRTSC}") Private Sub Timer2_Timer() Dim a As Long Dim p As pointapi a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0) GetCursorPos p 'Command1.Caption = GetPixel(a, p.x, p.y) 'h获取颜色值 If p.x = mx Or p.y = my Then GoTo 50 If p.x > mx Then GoTo 10 If p.x < mx Then GoTo 20 GoTo 50 10 SendKeys "右" GoTo 50 20 SendKeys "左" GoTo 50 30 SendKeys "下" GoTo 60 40 SendKeys "上" GoTo 60 SendKeys "B" SendKeys p.x '坐标 SendKeys "a" SendKeys p.y 50 If p.y > my Then GoTo 30 If p.y < my Then GoTo 40 60 mx = p.x my = p.y End Sub

使用 vb 制作的 2次函数的图像 可以自己设置常量

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

可以定时采集窗口图片 保存在E:\system 没有请手动建立E:\system