Guest User

Untitled

a guest
Jun 19th, 2013
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 9.15 KB | None | 0 0
  1. 'https://www.youtube.com/watch?v=HiOCy1w0Ey4
  2.  
  3. Imports TouchlessLib
  4.  
  5. Public Class Form1
  6. Public Touchless As New TouchlessLib.TouchlessMgr
  7. Public Camera1 As TouchlessLib.Camera = Touchless.Cameras.ElementAt(0)
  8. Dim camw As Integer = 1280 'mine is a 720P webcam, yours might be 640x480
  9. Dim camh As Integer = 720
  10. Dim boximage As New Bitmap(camw, camh)
  11. Dim boxgfx As Graphics
  12. Dim mouselocation As Point = New Point(0, 0)
  13. Dim box1 As Rectangle
  14. Dim box2 As Rectangle
  15. Dim box1set As Boolean
  16. Dim box2set As Boolean
  17. Dim box1active As Boolean
  18. Dim box2active As Boolean
  19. Dim box1on As Boolean
  20. Dim box2on As Boolean
  21. Dim box1on2 As Boolean
  22. Dim box2on2 As Boolean
  23. Dim box1checksum As Integer
  24. Dim box2checksum As Integer
  25. Dim box1newchecksum As Integer
  26. Dim box2newchecksum As Integer
  27. Dim differencepercent As Integer = 20
  28.  
  29. 'Form Load
  30. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  31.  
  32. Touchless.CurrentCamera = Camera1
  33.  
  34. Touchless.CurrentCamera.CaptureWidth = camw 'Tell camera what size to get
  35. Touchless.CurrentCamera.CaptureHeight = camh
  36. PictureBox1.Size = New Size(camw, camh) 'Set size of picturebox and program
  37. Me.Size = New Size(camw, camh)
  38. PictureBox1.Location = New Point(0, 0)
  39.  
  40. End Sub
  41.  
  42. 'Timer Tick
  43. Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
  44.  
  45. 'Setup the image
  46. boximage = Touchless.CurrentCamera.GetCurrentImage
  47. If boximage IsNot Nothing Then
  48. boxgfx = Graphics.FromImage(boximage)
  49.  
  50. 'Draw boxes, and clear appropriate checksums
  51. If box1active = True Then
  52. boxgfx.DrawRectangle(New Pen(Brushes.Red, 2), New Rectangle(box1.X, box1.Y, mouselocation.X - box1.X, mouselocation.Y - box1.Y))
  53. box1checksum = 0
  54. End If
  55. If box2active = True Then
  56. boxgfx.DrawRectangle(New Pen(Brushes.Blue, 2), New Rectangle(box2.X, box2.Y, mouselocation.X - box2.X, mouselocation.Y - box2.Y))
  57. box2checksum = 0
  58. End If
  59. If box1set = True Then
  60. If box1on = True Then
  61. boxgfx.DrawRectangle(New Pen(Brushes.Pink, 2), box1)
  62. Else
  63. boxgfx.DrawRectangle(New Pen(Brushes.Red, 2), box1)
  64. End If
  65. box1newchecksum = 0
  66. End If
  67. If box2set = True Then
  68. If box2on = True Then
  69. boxgfx.DrawRectangle(New Pen(Brushes.LightBlue, 2), box2)
  70. Else
  71. boxgfx.DrawRectangle(New Pen(Brushes.Blue, 2), box2)
  72. End If
  73. box2newchecksum = 0
  74. End If
  75.  
  76. 'Call pixel checksum checker
  77. imagediff()
  78.  
  79. 'Draw the differences to the image
  80. If box1set = True And box1newchecksum <> 0 Then
  81. Dim diff1 As Integer = (box1checksum / box1newchecksum) * 100
  82. boxgfx.DrawString(diff1.ToString & "%", SystemFonts.DefaultFont, Brushes.Red, box1.X, box1.Y)
  83. If diff1 > 100 + differencepercent Or diff1 < 100 - differencepercent Then
  84. box1on = True
  85. Else
  86. box1on = False
  87. End If
  88. End If
  89. If box2set = True And box2newchecksum <> 0 Then
  90. Dim diff2 As Integer = (box2checksum / box2newchecksum) * 100
  91. boxgfx.DrawString(diff2.ToString & "%", SystemFonts.DefaultFont, Brushes.Blue, box2.X, box2.Y)
  92. If diff2 > 100 + differencepercent Or diff2 < 100 - differencepercent Then
  93. box2on = True
  94. Else
  95. box2on = False
  96. End If
  97. End If
  98.  
  99. 'Send arrow commands
  100. If box1on = True And box1on2 = False Then 'On2 is for doing a one-shot, as we don't want to hold the key down
  101. box1on2 = True
  102. SendKeys.Send("{RIGHT}")
  103. End If
  104. If box2on = True And box2on2 = False Then
  105. box2on2 = True
  106. SendKeys.Send("{PGDN}")
  107. End If
  108. If box1on = False Then
  109. box1on2 = False
  110. End If
  111. If box2on = False Then
  112. box2on2 = False
  113. End If
  114.  
  115. 'Send image to the picturebox
  116. PictureBox1.Image = boximage
  117. End If
  118.  
  119. End Sub
  120.  
  121. 'Mouse controls for box draws
  122. Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
  123. If e.Button = Windows.Forms.MouseButtons.Left And box2active = False Then
  124. box1set = False
  125. box1.X = e.X
  126. box1.Y = e.Y
  127. box1active = True
  128. End If
  129. If e.Button = Windows.Forms.MouseButtons.Right And box1active = False Then
  130. box2set = False
  131. box2.X = e.X
  132. box2.Y = e.Y
  133. box2active = True
  134. End If
  135.  
  136. End Sub
  137. Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
  138. If box1active = True Then
  139. box1.Width = e.X - box1.X
  140. box1.Height = e.Y - box1.Y
  141. box1active = False
  142. box1set = True
  143. End If
  144. If box2active = True Then
  145. box2.Width = e.X - box2.X
  146. box2.Height = e.Y - box2.Y
  147. box2active = False
  148. box2set = True
  149. End If
  150.  
  151. End Sub
  152. Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
  153. mouselocation.X = e.X
  154. mouselocation.Y = e.Y
  155. End Sub
  156.  
  157. Private Sub imagediff()
  158. Dim rect As New Rectangle(0, 0, camw, camh)
  159. Dim bmpData As System.Drawing.Imaging.BitmapData = boximage.LockBits(rect, _
  160. Drawing.Imaging.ImageLockMode.ReadWrite, boximage.PixelFormat)
  161. Dim ptr As IntPtr = bmpData.Scan0
  162. Dim bytes As Integer = bmpData.Stride * camh
  163. Dim rgbValues(bytes - 1) As Byte
  164. System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)
  165.  
  166. Dim secondcounter As Integer
  167. Dim tempred As Integer
  168. Dim tempblue As Integer
  169. Dim tempgreen As Integer
  170. Dim tempalpha As Integer
  171. Dim tempx As Integer
  172. Dim tempy As Integer
  173. secondcounter = 0
  174.  
  175. While secondcounter < rgbValues.Length
  176. tempblue = rgbValues(secondcounter)
  177. tempgreen = rgbValues(secondcounter + 1)
  178. tempred = rgbValues(secondcounter + 2)
  179. tempalpha = rgbValues(secondcounter + 3)
  180. tempalpha = 255
  181.  
  182. tempy = ((secondcounter * 0.25) / camw)
  183. tempx = (secondcounter * 0.25) - (tempy * camw)
  184. If tempx < 0 Then
  185. tempx = tempx + camw
  186. End If
  187.  
  188. If box1active = True Then
  189. If tempx >= box1.X And tempx <= mouselocation.X And tempy >= box1.Y And tempy <= mouselocation.Y Then
  190. box1checksum = box1checksum + tempred
  191. box1checksum = box1checksum + tempgreen
  192. box1checksum = box1checksum + tempblue
  193. End If
  194. End If
  195. If box2active = True Then
  196. If tempx >= box2.X And tempx <= mouselocation.X And tempy >= box2.Y And tempy <= mouselocation.Y Then
  197. box2checksum = box2checksum + tempred
  198. box2checksum = box2checksum + tempgreen
  199. box2checksum = box2checksum + tempblue
  200. End If
  201. End If
  202. If box1set = True Then
  203. If tempx >= box1.X And tempx <= (box1.X + box1.Width) And tempy >= box1.Y And tempy <= (box1.Y + box1.Height) Then
  204. box1newchecksum = box1newchecksum + tempred
  205. box1newchecksum = box1newchecksum + tempgreen
  206. box1newchecksum = box1newchecksum + tempblue
  207. End If
  208. End If
  209. If box2set = True Then
  210. If tempx >= box2.X And tempx <= (box2.X + box2.Width) And tempy >= box2.Y And tempy <= (box2.Y + box2.Height) Then
  211. box2newchecksum = box2newchecksum + tempred
  212. box2newchecksum = box2newchecksum + tempgreen
  213. box2newchecksum = box2newchecksum + tempblue
  214. End If
  215. End If
  216.  
  217. rgbValues(secondcounter) = tempblue
  218. rgbValues(secondcounter + 1) = tempgreen
  219. rgbValues(secondcounter + 2) = tempred
  220. rgbValues(secondcounter + 3) = tempalpha
  221.  
  222. secondcounter = secondcounter + 4
  223. End While
  224. ' Copy the RGB values back to the bitmap
  225. System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, bytes)
  226.  
  227. ' Unlock the bits.
  228. boximage.UnlockBits(bmpData)
  229. End Sub
  230.  
  231. End Class
Advertisement
Add Comment
Please, Sign In to add comment