M:\Mike (4-19)\Stub Programs\Follow Me\vidcap test.frm
File saved: 4/24/2006 6:43:56 PM
Generated: 4/24/2006 6:54:02 PM
Table of Contents (Designer Object Definition) Declarations SendCommand Move_Servo HandlePacket pollme GetBinary Center_Click Command3_Click Forward_Click Left1_Click left4_Click Reverse_Click Right1_Click right4_Click STOP_Click threesixtyleft_Click threesixtyright_Click Form_Activate Form_Unload Build_Combos Form_Load Lock_Buttons Restore_Buttons Command5_Click Command1_Click command_middle_mass_on_servo_to_Click command_middle_mass_off_Click command_middle_mass_on_Click Command2_Click Command4_Click Reg_Update_Click Reset_regs_Click RGB_OFF_Click RGB_ON_Click Ser_In_Change stop_loop_Click unlock_movement_Click YcrCb_off_Click YcrCb_on_Click DIR_Change Output_Change
VERSION 5.00 Table of Contents Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "Richtx32.ocx" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "Form1" ClientHeight = 8565 ClientLeft = 45 ClientTop = 1680 ClientWidth = 15255 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 571 ScaleMode = 3 'Pixel ScaleWidth = 1017 Begin VB.Frame Frame11 Caption = "Line Mode Data" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1935 Left = 9960 TabIndex = 68 Top = 3600 Width = 3015 Begin VB.PictureBox pic_hi Height = 1455 Left = 840 ScaleHeight = 1395 ScaleWidth = 1155 TabIndex = 69 Top = 360 Width = 1215 End End Begin VB.Frame Frame10 Caption = "Directions to Move" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 8415 Left = 13080 TabIndex = 62 Top = 120 Width = 2055 Begin RichTextLib.RichTextBox DIR Height = 8055 Left = 120 TabIndex = 63 Top = 240 Width = 1815 _ExtentX = 3201 _ExtentY = 14208 _Version = 393217 Enabled = -1 'True ReadOnly = -1 'True ScrollBars = 2 TextRTF = $"vidcap test.frx":0000 End End Begin VB.Frame Frame6 Caption = "Robot Controls" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3015 Left = 9960 TabIndex = 48 Top = 5520 Width = 3015 Begin VB.CommandButton right4 Caption = "Right 4" Height = 495 Left = 2040 TabIndex = 66 Top = 1920 Width = 735 End Begin VB.CommandButton left4 Caption = "Left 4" Height = 495 Left = 120 TabIndex = 65 Top = 1920 Width = 735 End Begin VB.CommandButton unlock_movement BackColor = &H0000FF00& Caption = "Unlock Robot" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 MaskColor = &H0080FFFF& Style = 1 'Graphical TabIndex = 64 Top = 240 Width = 2655 End Begin VB.CommandButton Stop BackColor = &H000000FF& Caption = "Stop" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 240 Style = 1 'Graphical TabIndex = 56 Top = 2520 Width = 2415 End Begin VB.CommandButton threesixtyright Caption = "360 Right" Height = 495 Left = 2040 TabIndex = 55 Top = 720 Width = 735 End Begin VB.CommandButton threesixtyleft Caption = "360 Left" Height = 495 Left = 120 TabIndex = 54 Top = 720 Width = 735 End Begin VB.CommandButton Right1 Caption = "Right 2" Height = 495 Left = 2040 TabIndex = 53 Top = 1320 Width = 735 End Begin VB.CommandButton Left1 Caption = "Left 2" Height = 495 Left = 120 TabIndex = 52 Top = 1320 Width = 735 End Begin VB.CommandButton Reverse Caption = "Reverse" Height = 495 Left = 1080 TabIndex = 51 Top = 1920 Width = 735 End Begin VB.CommandButton forward Caption = "Forward" Height = 495 Left = 1080 TabIndex = 50 Top = 720 Width = 735 End Begin VB.CommandButton center Caption = "Center" Height = 495 Left = 1080 TabIndex = 49 Top = 1320 Width = 735 End End Begin VB.Frame Frame9 Caption = "Looping Raw Data" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 6960 TabIndex = 46 Top = 6960 Width = 2895 Begin VB.Label Label12 Caption = "None" Height = 255 Left = 240 TabIndex = 61 Top = 480 Width = 2415 End Begin VB.Label Label25 Caption = "None" Height = 255 Left = 240 TabIndex = 47 Top = 240 Width = 2535 End End Begin VB.CommandButton stop_loop BackColor = &H000000FF& Caption = "STOP LOOP" BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 6960 MaskColor = &H000000FF& Style = 1 'Graphical TabIndex = 44 Top = 7920 Width = 2895 End Begin VB.Frame Frame5 Caption = "Program Status" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2295 Left = 120 TabIndex = 23 Top = 6240 Width = 6735 Begin VB.Line Line3 BorderWidth = 2 X1 = 3960 X2 = 3960 Y1 = 240 Y2 = 2160 End Begin VB.Line Line2 BorderWidth = 2 X1 = 0 X2 = 3960 Y1 = 1080 Y2 = 1080 End Begin VB.Line Line1 BorderWidth = 2 X1 = 2040 X2 = 2040 Y1 = 240 Y2 = 2160 End Begin VB.Shape MM_Status BorderColor = &H00000000& FillColor = &H000000FF& FillStyle = 0 'Solid Height = 495 Left = 3000 Shape = 3 'Circle Top = 360 Width = 855 End Begin VB.Shape tracking_Status FillColor = &H000000FF& FillStyle = 0 'Solid Height = 495 Left = 1200 Shape = 3 'Circle Top = 1320 Width = 855 End Begin VB.Label Label22 Caption = "Tracking Status" Height = 255 Left = 120 TabIndex = 37 Top = 1440 Width = 1215 End Begin VB.Label Label1 Alignment = 2 'Center Caption = "Program Messages (status)" Height = 255 Left = 4080 TabIndex = 26 Top = 120 Width = 2415 End Begin VB.Shape Command_Status BorderColor = &H00000000& FillColor = &H000000FF& FillStyle = 0 'Solid Height = 495 Left = 1200 Shape = 3 'Circle Top = 360 Width = 855 End Begin VB.Label Frame_Status BorderStyle = 1 'Fixed Single Height = 1815 Left = 4080 TabIndex = 24 Top = 360 Width = 2415 End Begin VB.Label Label4 Caption = "Program Status" Height = 255 Left = 120 TabIndex = 25 Top = 480 Width = 1095 End Begin VB.Label Label23 Caption = "MiddleMass Status" Height = 375 Left = 2280 TabIndex = 42 Top = 360 Width = 975 End Begin VB.Shape looping_status BorderColor = &H00000000& FillColor = &H000000FF& FillStyle = 0 'Solid Height = 495 Left = 3000 Shape = 3 'Circle Top = 1320 Width = 855 End Begin VB.Label Label24 Caption = "Looping Input" Height = 375 Left = 2400 TabIndex = 43 Top = 1320 Width = 855 End End Begin VB.Frame Frame8 Caption = "Middle Mass (centroids)" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 975 Left = 6960 TabIndex = 38 Top = 120 Width = 2895 Begin VB.CommandButton command_middle_mass_on_servo_to Caption = "MM With Servo" Height = 615 Left = 2040 TabIndex = 41 Top = 240 Width = 735 End Begin VB.CommandButton command_middle_mass_on Caption = "MM on" Height = 615 Left = 1080 TabIndex = 40 Top = 240 Width = 735 End Begin VB.CommandButton command_middle_mass_off Caption = "MM off" Height = 615 Left = 120 TabIndex = 39 Top = 240 Width = 735 End End Begin VB.Frame Frame7 Caption = "Commands" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1455 Left = 6960 TabIndex = 30 Top = 3960 Width = 2895 Begin VB.CommandButton Command3 BackColor = &H0000FF00& Caption = "Line Mood" Height = 495 Left = 120 Style = 1 'Graphical TabIndex = 67 Top = 840 Width = 1335 End Begin VB.CommandButton Command5 BackColor = &H0000FF00& Caption = "Track Center Object" Height = 495 Left = 120 Style = 1 'Graphical TabIndex = 45 Top = 240 Width = 1335 End Begin VB.CommandButton Command2 Caption = "Ping Camera" Height = 255 Left = 1560 TabIndex = 33 Top = 240 Width = 1215 End Begin VB.CommandButton Command1 BackColor = &H0000FFFF& Caption = "Dump Frame" Height = 255 Left = 1560 MaskColor = &H0000FFFF& Style = 1 'Graphical TabIndex = 32 Top = 960 Width = 1215 End Begin VB.CommandButton Command4 Caption = "Reset Board" Height = 255 Left = 1560 TabIndex = 31 Top = 600 Width = 1215 End End Begin VB.Frame Frame4 Caption = "Serial Output" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3015 Left = 120 TabIndex = 21 Top = 120 Width = 6735 Begin RichTextLib.RichTextBox Output Height = 2655 Left = 120 TabIndex = 22 Top = 240 Width = 6495 _ExtentX = 11456 _ExtentY = 4683 _Version = 393217 ReadOnly = -1 'True ScrollBars = 2 TextRTF = $"vidcap test.frx":0082 End End Begin VB.Frame Frame3 Caption = "Serial Input" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2895 Left = 120 TabIndex = 19 Top = 3240 Width = 6735 Begin RichTextLib.RichTextBox Ser_In Height = 2535 Left = 120 TabIndex = 20 Top = 240 Width = 6495 _ExtentX = 11456 _ExtentY = 4471 _Version = 393217 ReadOnly = -1 'True ScrollBars = 2 TextRTF = $"vidcap test.frx":0104 End End Begin VB.Frame Frame2 Caption = "Image Dump" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3375 Left = 9960 TabIndex = 17 Top = 120 Width = 3015 Begin MSComctlLib.Slider tolerance_slider Height = 255 Left = 120 TabIndex = 70 Top = 3000 Width = 2775 _ExtentX = 4895 _ExtentY = 450 _Version = 393216 LargeChange = 4 Min = 3 Max = 35 SelStart = 8 Value = 8 End Begin VB.PictureBox PIC Height = 2175 Left = 240 ScaleHeight = 132.019 ScaleMode = 0 'User ScaleWidth = 150.414 TabIndex = 18 Top = 240 Width = 2535 End Begin VB.Label Robo_Size Caption = "0" Height = 255 Left = 1680 TabIndex = 60 Top = 2760 Width = 855 End Begin VB.Label Label10 Caption = "Base Size of Object:" Height = 255 Left = 120 TabIndex = 59 Top = 2760 Width = 1575 End Begin VB.Label Label9 Caption = "0" Height = 255 Left = 1440 TabIndex = 58 Top = 2520 Width = 1335 End Begin VB.Label Label8 Caption = "Distance Guess:" Height = 255 Left = 120 TabIndex = 57 Top = 2520 Width = 1215 End End Begin VB.Frame Frame1 Caption = "Color Modes" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1335 Left = 6960 TabIndex = 12 Top = 5520 Width = 2895 Begin VB.OptionButton YcrCb_on Caption = "YCrCb White Balance On" Height = 255 Left = 360 TabIndex = 16 Top = 240 Width = 2295 End Begin VB.OptionButton YcrCb_off Caption = "YCrCb White Balance Off" Height = 255 Left = 360 TabIndex = 15 Top = 480 Width = 2295 End Begin VB.OptionButton RGB_ON Caption = "RGB White Balance On" Height = 255 Left = 360 TabIndex = 14 Top = 720 Width = 2295 End Begin VB.OptionButton RGB_OFF Caption = "RGB White Balance Off" Height = 255 Left = 360 TabIndex = 13 Top = 960 Width = 2295 End End Begin MSCommLib.MSComm COM Left = 3480 Top = 1560 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = 0 'False BaudRate = 115200 End Begin VB.Frame Registers_Frame Caption = "Registers" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2655 Left = 6960 TabIndex = 0 Top = 1200 Width = 2895 Begin VB.ComboBox HM_Combo Height = 315 Left = 1200 TabIndex = 34 Text = "0" Top = 1680 Width = 975 End Begin VB.ComboBox Combo_FPS Height = 315 Left = 1200 TabIndex = 28 Text = "17" Top = 1320 Width = 975 End Begin VB.CommandButton Reset_regs Caption = "Reset Registers" Height = 495 Left = 1440 TabIndex = 11 Top = 2040 Width = 1215 End Begin VB.ComboBox noise_combo Height = 315 Left = 1200 TabIndex = 10 Text = "0" Top = 960 Width = 975 End Begin VB.ComboBox brightness_combo Height = 315 Left = 1200 TabIndex = 9 Text = "0" Top = 600 Width = 975 End Begin VB.ComboBox contrast_combo Height = 315 Left = 1200 TabIndex = 8 Text = "0" Top = 240 Width = 975 End Begin VB.CommandButton Reg_Update Caption = "Update Registers" Height = 495 Left = 120 TabIndex = 3 Top = 2040 Width = 1215 End Begin VB.Label Label21 Caption = "HM Mode" Height = 255 Left = 120 TabIndex = 36 Top = 1680 Width = 975 End Begin VB.Label Label3 Caption = "0-off" Height = 255 Left = 2280 TabIndex = 35 Top = 1680 Width = 495 End Begin VB.Label Label16 Caption = "FPS" Height = 255 Left = 2280 TabIndex = 29 Top = 1320 Width = 495 End Begin VB.Label Label2 Caption = "Clock Speed" Height = 255 Left = 120 TabIndex = 27 Top = 1320 Width = 975 End Begin VB.Label Label15 Caption = "0-off" Height = 255 Left = 2280 TabIndex = 7 Top = 960 Width = 495 End Begin VB.Label Label14 Caption = "0 - 255" Height = 255 Left = 2280 TabIndex = 6 Top = 600 Width = 495 End Begin VB.Label Label13 Caption = "0 - 255" Height = 255 Left = 2280 TabIndex = 5 Top = 240 Width = 495 End Begin VB.Label Label7 Caption = "Noise Filter" Height = 255 Left = 120 TabIndex = 4 Top = 960 Width = 975 End Begin VB.Label Label6 Caption = "Brightness" Height = 255 Left = 120 TabIndex = 2 Top = 600 Width = 735 End Begin VB.Label Label5 Caption = "Contrast" Height = 255 Left = 120 TabIndex = 1 Top = 240 Width = 735 End End Begin MSCommLib.MSComm Comm Left = 0 Top = 0 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True End End
Attribute VB_Name = "Form1" Table of Contents Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '************************************************************************ '********************************************************* '****************************************** ' Created By: Michael Konicki ' Date: 4/19/2006 (last edit) ' 'The project no uses constant motion which means that the program 'no longer tries to do an action and then stop that action and get 'input to do the next action. Now all that happens is the program determines 'what action is needed and does that action until a different actions is required 'so if the program says move forward the robot does that until the program says 'to do something else. This eliminates all the bottleneck issues in dealing 'with the comport and sleep ' ' To Use: certain rules must be obeyed. ' 1. You cant lift the object to follow over or below the field ' of view of the CMUcam. It has no servo to control up and down ' movement of the camera ' 2. The cmucam and robot obviously can't move as fast as a ' person moving and object, while fast it isnt that fast ' be gentle with her when doing movements '****************************************** '********************************************************* '************************************************************************ Option Explicit Dim Stop_Looping As Boolean 'Used to Signify and end to data looping Dim Object_size As Integer 'Size of the object Dim Avg_Pos As Integer 'the position of the object according to cmucam Dim userlock As Boolean 'Prevents the sending of commands if the user sends a command to the robot using the joystick Dim First_Run As Boolean 'First run of loop trackin g Dim BusY As Boolean 'used as a lock on some code that shouldnt be run Dim moving As Boolean 'Are we moving Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '************************************************************************ '********************************************************* '****************************************** ' CUSTOM FUNCTIONS (SENDCOMMAND, MOVE SERVO) '****************************************** '********************************************************* '************************************************************************
Private Function SendCommand(cmd As String, sleeptime As Integer) As String Table of Contents '********************************************** ' Sends a command to the board then checks for ' the ack command '********************************************** Dim RcvBytes As String 'Stores bytes from the input buffer Dim CheckBytes As String 'used to check for an ack meaning good command Dim temp As String 'dump unused input buffer into here Dim start_time As Integer Dim cur_time As Integer On Error GoTo err1 'Set the status flag to yellow Command_Status.FillColor = RGB(255, 255, 0) Frame_Status.Caption = "Talking with CMUcam..." Me.Refresh 'Send data out on serial port and clear the input textbox Ser_In.Text = Ser_In.Text & "-----------------------------" & vbCrLf If cmd = "" Then Output.Text = Output.Text & "Sending Command: \r" & vbCrLf Else Output.Text = Output.Text & "Sending Command: " & cmd & vbCrLf End If 'Send the actual command to the CMUcam COM.Output = cmd & Chr(13) 'Do loop to rip the data out of the com.input buffer if it is a DF 'the other commands are all smaller then 8 chars, no need to loop actually is slower If cmd = "DF" Then Do DoEvents RcvBytes = RcvBytes & COM.Input Sleep (50) Loop Until COM.InBufferCount <= 0 Else Sleep (sleeptime) RcvBytes = COM.Input End If 'Check for ack or nck or somethign else (which is bad) CheckBytes = Left(RcvBytes, 3) If CheckBytes = "ACK" Then 'found an ack Command_Status.FillColor = RGB(0, 255, 0) 'Display the command in the history If cmd = "" Then Ser_In.Text = Ser_In.Text & "ACK: \r" & cmd & vbCrLf Else Ser_In.Text = Ser_In.Text & "ACK: " & cmd & vbCrLf End If 'Return the info SendCommand = RcvBytes 'Didnt get and ACK from CMUcam Else 'got a nck (error) Command_Status.FillColor = RGB(255, 0, 0) 'Display command in window If cmd = "" Then Ser_In.Text = Ser_In.Text & "NCK: \r" & cmd & vbCrLf Else Ser_In.Text = Ser_In.Text & "NCK: " & cmd & vbCrLf End If 'Return -1 = error SendCommand = "-1" 'send error back to caller End If 'Turn off error handeling and exit function before getting to the error On Error GoTo 0 Exit Function err1: MsgBox "Fatal Error(1): Error Sending To CMUcam", vbCritical, "FATAL ERROR" End Function
Private Sub Move_Servo(command As String, from As String) Table of Contents '*********************************************************** ' Controls all the data going to the servo board '*********************************************************** Dim ret As String If from = 0 Then 'came from user click so its ok to send whenever 'Send the command to the robot to do whatever built in movement is required Comm.Output = "11" + " " + command + " " + " " + "0" + " " + "22" + " " Sleep (60) ElseIf from = 1 Then 'came from program control we want to check it to make sure controls arent locked down If userlock = False Then Do Loop Until moving = False moving = True 'Send the command to the robot to do whatever built in movement is required Comm.Output = "11" + " " + command + " " + " " + "0" + " " + "22" + " " Sleep (80) ret = Comm.Input 'do nothing everything worked moving = False End If End If End Sub
Private Sub HandlePacket(InputString As String) Table of Contents '****************************************** ' One fucntion that handles all of the other ' packet processing features. And robot following ' for all the packet recieving functiosn '****************************************** Dim ret As String 'return strign from sendcommand Dim mark As Integer 'mark for ripping up packet Dim WhatPacket As String 'Whatpacket are we on Dim Mx As String, My As String 'centroid coordinates Dim X1 As String, Y1 As String, X2 As String, Y2 As String 'box coordinates Dim PixCnt As String, ObjConf As String 'Pixcount and object confidence Dim spos As String 'servo position Dim spinner As Boolean 'tell us if we are spinning Dim cur_size As Integer Dim Pic_Mid As Integer 'middle of the picture (central spot on x plane) Dim Cur_Mid As Integer 'current middle of the object according to CMUCam Dim Cur_Direction As String 'what direction the robot is going 'Need to be able to handle both C & M packets here, 'will send either or depending on the settings the use selected WhatPacket = Left(InputString, 1) If WhatPacket = "M" Then If Right(InputString, 1) = Chr(13) Then 'Find the M and drop them mark = InStr(1, InputString, " ") InputString = Right(InputString, Len(InputString) - mark) 'Get the MMx out mark = InStr(1, InputString, " ") Mx = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the MMy out mark = InStr(1, InputString, " ") My = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the x1 out mark = InStr(1, InputString, " ") X1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y1 out mark = InStr(1, InputString, " ") Y1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the x2 out mark = InStr(1, InputString, " ") X2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y2 out mark = InStr(1, InputString, " ") Y2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the pixcnt out mark = InStr(1, InputString, " ") PixCnt = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the Bdev out mark = InStr(1, InputString, "M") If mark = 0 Then mark = 1 End If ObjConf = Mid(InputString, 1, 2) If ObjConf = "" Or ObjConf = " " Then ObjConf = InputString End If 'display the data we got to the user Label25 = "M: " & Mx & My & X1 & Y1 & X2 & Y2 & PixCnt & ObjConf If First_Run = True Then Object_size = (X1 - X2) * (Y1 - Y2) First_Run = False Robo_Size.Caption = Object_size Else cur_size = (X1 - X2) * (Y1 - Y2) Label9.Caption = cur_size End If 'Clear the picture out PIC.Cls Pic_Mid = PIC.ScaleWidth / 2 Robo_Size.Caption = Object_size 'Determine the Robot Direction and move it thusly 'first check objectconfidence to see if it is our object according to the cmucam If ObjConf > tolerance_slider.Value Then '( <10 horrible, >50 amazing, well settle for inbetween) PIC.BackColor = RGB(0, 255, 0) 'Handle movement side to side now If Mx * 2 > Pic_Mid + 42 Then 'go right 'if we are going backwards we have to backup the other way If Cur_Direction = "r" Then GoTo end_jump 'no need to resend the command End If Cur_Direction = "r" Call Move_Servo(6, 1) spinner = True DIR.Text = DIR.Text & "Moving Right" & vbCrLf GoTo end_jump ElseIf Mx * 2 < Pic_Mid - 42 Then 'go left If Cur_Direction = "l" Then GoTo end_jump 'no need to resend the command End If Call Move_Servo(7, 1) Cur_Direction = "l" spinner = True DIR.Text = DIR.Text & "Moving Left" & vbCrLf GoTo end_jump End If 'Move forward and backwards If Object_size > cur_size + 1000 Then If spinner = True Then Call Move_Servo(0, 1) 'stop them as well spinner = False End If Cur_Direction = "f" Call Move_Servo(1, 1) 'forward DIR.Text = DIR.Text & "Moving Forward" & vbCrLf ElseIf Object_size < cur_size - 1000 Then If spinner = True Then Call Move_Servo(0, 1) 'center the wheels after a 360 spinner = False End If Cur_Direction = "b" Call Move_Servo(3, 1) 'GO BACKWARDS DIR.Text = DIR.Text & "Moving Backwards" & vbCrLf Else DIR.Text = DIR.Text & "Stoping" & vbCrLf Call Move_Servo(0, 1) 'STOP THE ROBOT Cur_Direction = "-1" End If Else 'Bad packet so we should stop the robot in case 'the object is really lost Call Move_Servo(0, 1) PIC.BackColor = RGB(255, 0, 0) End If 'Draw the middle mass coordinates PIC.Circle (Mx * 2, My), 5, RGB(0, 0, 255) 'Draw the box that shows where the object is PIC.Line (X1 * 2, Y1)-(X2 * 2, Y1), RGB(255, 0, 0) PIC.Line (X2 * 2, Y1)-(X2 * 2, Y2), RGB(255, 0, 0) PIC.Line (X2 * 2, Y2)-(X1 * 2, Y2), RGB(255, 0, 0) PIC.Line (X1 * 2, Y2)-(X1 * 2, Y1), RGB(255, 0, 0) Frame_Status.Caption = "Recieving Loop..." & vbCrLf & vbCrLf Frame_Status.Caption = Frame_Status.Caption & "Pixels in Box: " & PixCnt & vbCrLf & "Confidence: " & ObjConf Frame_Status.Caption = Frame_Status.Caption & vbCrLf & "Numbers Cap at 255" End If 'same as above for a C packet (slgihtly different) ElseIf WhatPacket = "C" Then If Right(InputString, 1) = Chr(13) Then 'Find the M and drop them mark = InStr(1, InputString, " ") InputString = Right(InputString, Len(InputString) - mark) 'Get the x1 out mark = InStr(1, InputString, " ") X1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y1 out mark = InStr(1, InputString, " ") Y1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the x2 out mark = InStr(1, InputString, " ") X2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y2 out mark = InStr(1, InputString, " ") Y2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the pixcnt out mark = InStr(1, InputString, " ") PixCnt = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the Bdev out mark = InStr(1, InputString, "C") If mark = 0 Then mark = 1 End If ObjConf = Mid(InputString, 1, 2) If ObjConf = "" Or ObjConf = " " Then ObjConf = InputString End If Label25 = "C: " & X1 & Y1 & X2 & Y2 & PixCnt & ObjConf If First_Run = True Then Object_size = (X1 - X2) * (Y1 - Y2) First_Run = False Pic_Mid = PIC.ScaleWidth / 2 Else cur_size = (X1 - X2) * (Y1 - Y2) Label9.Caption = cur_size End If 'Clear the picture out PIC.Cls Robo_Size.Caption = Object_size Cur_Mid = (X2 - X1) + PIC.ScaleWidth 'Determine the Robot Direction and move it thusly 'first check objectconfidence to see if it is our object according to the cmucam 'Because this is a C packet we only forwards or backwards If ObjConf > tolerance_slider.Value Then '( <10 horrible, >50 amazing, well settle for inbetween) PIC.BackColor = RGB(0, 255, 0) If Object_size > cur_size + 1000 Then DIR.Text = DIR.Text & "Moving Forward" & vbCrLf Call Move_Servo(1, 1) 'forward Cur_Direction = "f" ElseIf Object_size < cur_size - 1000 Then DIR.Text = DIR.Text & "Moving Backwards" & vbCrLf Call Move_Servo(3, 1) 'GO BACKWARDS Cur_Direction = "b" Else DIR.Text = DIR.Text & "Stoping" & vbCrLf Call Move_Servo(0, 1) 'STOP THE ROBOT End If Else Call Move_Servo(0, 1) PIC.BackColor = RGB(255, 0, 0) End If 'Draw the box that shows where the object is PIC.Line (X1 * 2, Y1)-(X2 * 2, Y1), RGB(255, 0, 0) PIC.Line (X2 * 2, Y1)-(X2 * 2, Y2), RGB(255, 0, 0) PIC.Line (X2 * 2, Y2)-(X1 * 2, Y2), RGB(255, 0, 0) PIC.Line (X1 * 2, Y2)-(X1 * 2, Y1), RGB(255, 0, 0) Frame_Status.Caption = "Recieving Loop..." & vbCrLf & vbCrLf Frame_Status.Caption = Frame_Status.Caption & "Pixels in Box: " & PixCnt & vbCrLf & "Confidence: " & ObjConf & vbCrLf & vbCrLf Frame_Status.Caption = Frame_Status.Caption & vbCrLf & "Numbers Cap at 255" End If 'Same cept its an N packet ElseIf WhatPacket = "N" Then If Right(InputString, 1) = Chr(13) Then 'Find the N and drop them mark = InStr(1, InputString, " ") InputString = Right(InputString, Len(InputString) - mark) 'Get the spos out mark = InStr(1, InputString, " ") spos = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the MMx out mark = InStr(1, InputString, " ") Mx = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the MMy out mark = InStr(1, InputString, " ") My = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the x1 out mark = InStr(1, InputString, " ") X1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y1 out mark = InStr(1, InputString, " ") Y1 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the x2 out mark = InStr(1, InputString, " ") X2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the y2 out mark = InStr(1, InputString, " ") Y2 = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the pixcnt out mark = InStr(1, InputString, " ") PixCnt = Mid(InputString, 1, mark) InputString = Right(InputString, Len(InputString) - mark) 'Get the Bdev out mark = InStr(1, InputString, "N") If mark = 0 Then mark = 1 End If ObjConf = Mid(InputString, 1, 2) If ObjConf = "" Or ObjConf = " " Then ObjConf = InputString End If Label25 = "N: " & spos & X1 & Y1 & X2 & Y2 & PixCnt & ObjConf 'Servo Pos Label12.Caption = "Servo Pos: " & spos If First_Run = True Then Object_size = (X1 - X2) * (Y1 - Y2) First_Run = False Else cur_size = (X1 - X2) * (Y1 - Y2) Label9.Caption = cur_size End If 'Clear the picture out PIC.Cls Robo_Size.Caption = Object_size 'Determine the Robot Direction and move it thusly 'first check objectconfidence to see if it is our object according to the cmucam If ObjConf > tolerance_slider.Value Then '( <10 horrible, >50 amazing, well settle for inbetween) PIC.BackColor = RGB(0, 255, 0) 'now check to see if we are going to need to move left right or whatever based on servo position If spos > 70 And spos < 95 Then 'Have to ensure that if we were in a 360 spin 'we stop the tires when we come out of it If spinner = True Then Call Move_Servo(0, 1) spinner = False End If 'if we are going backwards we have to go the opposite 'direction since backwards movement is reversed If Cur_Direction = "b" Then Call Move_Servo(5, 1) Else Call Move_Servo(4, 1) 'Left End If DIR.Text = DIR.Text & "Going Left" & vbCrLf GoTo end_jump 'jump out since we are turning ElseIf spos > 94 Then Call Move_Servo(6, 1) 'Turn left 360 DIR.Text = DIR.Text & "Going Left 360" & vbCrLf spinner = True GoTo end_jump 'jump out since we are turning ElseIf spos < 57 And spos > 24 Then 'Have to ensure that if we were in a 360 spin 'we stop the tires when we come out of it If spinner = True Then Call Move_Servo(0, 1) spinner = False End If 'if we are going backwards we have to go the opposite 'direction since backwards movement is reversed If Cur_Direction = "b" Then Call Move_Servo(4, 1) Else Call Move_Servo(5, 1) 'Turn Right End If DIR.Text = DIR.Text & "Going Right" & vbCrLf GoTo end_jump 'jump out since we are turning ElseIf spos < 25 Then spinner = True Call Move_Servo(7, 1) '360 Right DIR.Text = DIR.Text & "Going Right 360" & vbCrLf GoTo end_jump 'jump out since we are turning End If If Object_size > cur_size + 1000 Then DIR.Text = DIR.Text & "Moving Forward" & vbCrLf 'Check to make sure we arent coming from a spin 'if we are we have to stop the back tires If spinner = True Then Call Move_Servo(0, 1) spinner = False End If Call Move_Servo(1, 1) 'forward Cur_Direction = "f" ElseIf Object_size < cur_size - 1000 Then DIR.Text = DIR.Text & "Moving Backwards" & vbCrLf 'Check to make sure we arent coming from a spin 'if we are we have to stop the back tires If spinner = True Then Call Move_Servo(0, 1) spinner = False End If Call Move_Servo(3, 1) 'GO BACKWARDS Cur_Direction = "b" Else DIR.Text = DIR.Text & "Stoping" & vbCrLf Call Move_Servo(0, 1) 'STOP THE ROBOT End If Else 'Bad packet so we should stop the robot in case 'the object is really lost Call Move_Servo(0, 1) PIC.BackColor = RGB(255, 0, 0) End If 'Draw the box that shows where the object is PIC.Line (X1 * 2, Y1)-(X2 * 2, Y1), RGB(255, 0, 255) PIC.Line (X2 * 2, Y1)-(X2 * 2, Y2), RGB(255, 0, 255) PIC.Line (X2 * 2, Y2)-(X1 * 2, Y2), RGB(255, 0, 255) PIC.Line (X1 * 2, Y2)-(X1 * 2, Y1), RGB(255, 0, 255) 'Update some stuff for the user Frame_Status.Caption = "Recieving Loop..." & vbCrLf & vbCrLf Frame_Status.Caption = Frame_Status.Caption & "Pixels in Box: " & PixCnt & vbCrLf & "Confidence: " & ObjConf & vbCrLf & vbCrLf Frame_Status.Caption = Frame_Status.Caption & vbCrLf & "Numbers Cap at 255" End If Else 'do nothign bad packet Frame_Status.Caption = "Unknown/Bad Packet" End If 'Sleep or we start having collision issues end_jump: BusY = False End Sub
Private Sub pollme() Table of Contents '***************************************************** ' Process all of the incoming linemode data. That is the ' binary representation of what the CMUCam is tracking ' This also displays it to the user and sends the packet ' that comes with the image to handlepacket '***************************************************** Dim ret As String Dim str As String Dim num As String Dim s As String Dim binstr As String Dim temp As String Dim i As Integer Dim k As Integer Dim start1 As Integer Dim col As Long Dim row As Long Dim cnt As Long Dim startpos As Integer Dim packet As String 'Issue the command to get one packet out COM.Output = "TW" & Chr(13) Sleep (250) 'Read the packet in before processing Do str = str & COM.Input Sleep (75) Loop Until COM.InBufferCount >= 0 start1 = 0 col = 0 row = 0 cnt = 0 'PIC.Cls PIC.ScaleMode = vbPixels pic_hi.ScaleMode = vbPixels startpos = InStr(1, str, "ACK") If startpos = 0 Then Exit Sub End If 'Display the image for the user For i = startpos To Len(str) - 1 temp = Mid(str, i, 1) s = GetBinary(Asc(temp)) 'get the data into binary '10101010 = start or terminating string If s = "10101010" Then start1 = start1 + 1 If cnt = 1 Then GoTo done 'ElseIf start1 > 1 Then ' GoTo badpacket End If cnt = 1 Else If start1 = 0 Then 'do nothing Else cnt = 0 For k = 1 To 9 - 1 temp = Mid(s, k, 1) If temp = 1 Then pic_hi.PSet (col, row), RGB(0, 0, 255) pic_hi.PSet (col, row + 1), RGB(0, 0, 255) Else pic_hi.PSet (col, row), RGB(0, 0, 0) pic_hi.PSet (col, row + 1), RGB(0, 0, 0) End If col = col + 1 If col = 80 Then col = 0 row = row + 2 End If Next k End If End If Next i done: 'Should process the packet data here If start1 = 3 Then 'do nothing good image Else 'hide it if we have a bad picture pic_hi.Cls End If 'Get the packet stripped off the end of the data so we can update the servo 'and move the robot packet = Mid(str, i + 1, Len(str) - i) packet = packet & Chr(13) HandlePacket (packet) Sleep (75) End Sub
Function GetBinary(ByVal iInput As Integer) As String Table of Contents '********************************************* ' Returns the 8-bit binary representation ' of an integer iInput where 0 <= iInput <= 255 '********************************************* Dim s As String, i As Integer If iInput < 0 Or iInput > 255 Then GetBinary = "" Exit Function End If s = "" For i = 1 To 8 s = CStr(iInput Mod 2) & s iInput = iInput \ 2 Next GetBinary = s End Function '************************************************************************ '********************************************************* '****************************************** ' ROBOT SERVO FUNCTIONS '****************************************** '********************************************************* '************************************************************************
Private Sub Center_Click() Table of Contents 'Center all 8 servos userlock = True unlock_movement.Enabled = True Call Move_Servo(2, 0) End Sub
Private Sub Command3_Click() Table of Contents '****************************************** ' Enable pollmode for the cmucam '****************************************** Dim ret As String 'start pollmode ret = SendCommand("PM 1", 50) If ret = "-1" Then Exit Sub End If 'Start linemode ret = SendCommand("LM 1", 50) If ret = "-1" Then Exit Sub End If Stop_Looping = False PIC.Cls pic_hi.Cls pic_hi.Visible = True stop_loop.Visible = True While Stop_Looping = False DoEvents Call pollme Wend stop_loop.Visible = False pic_hi.Visible = False Call Command4_Click End Sub
Private Sub Forward_Click() Table of Contents 'move the wheels forward 'NEED FIX WITHIN THE BASIC CODE userlock = True unlock_movement.Enabled = True Call Move_Servo(1, 0) End Sub
Private Sub Left1_Click() Table of Contents 'move the wheel into a turn left userlock = True unlock_movement.Enabled = True Call Move_Servo(4, 0) End Sub
Private Sub left4_Click() Table of Contents 'move all 4 left wheels right userlock = True unlock_movement.Enabled = True Call Move_Servo(8, 0) End Sub
Private Sub Reverse_Click() Table of Contents 'move the wheels backwards userlock = True unlock_movement.Enabled = True Call Move_Servo(3, 0) End Sub
Private Sub Right1_Click() Table of Contents 'move the front 2 wheels into a righthave turn userlock = True unlock_movement.Enabled = True Call Move_Servo(5, 0) End Sub
Private Sub right4_Click() Table of Contents 'move all 4 wheels right userlock = True unlock_movement.Enabled = True Call Move_Servo(9, 0) End Sub
Private Sub STOP_Click() Table of Contents 'stop all 8 servos userlock = True unlock_movement.Enabled = True Call Move_Servo(0, 0) End Sub
Private Sub threesixtyleft_Click() Table of Contents 'setup wheels to 360 left userlock = True unlock_movement.Enabled = True Call Move_Servo(6, 0) End Sub
Private Sub threesixtyright_Click() Table of Contents 'setup wheels to 360 right userlock = True unlock_movement.Enabled = True Call Move_Servo(7, 0) End Sub '************************************************************************ '********************************************************* '****************************************** ' FORM LOAD, UNLOAD, AND SETUP FUNCTIONS '****************************************** '********************************************************* '************************************************************************
Private Sub Form_Activate() Table of Contents '**************************************** 'activate some initial commands 'to make sure the CMUCam is responding '**************************************** Sleep (100) 'sleep for a sec Call Command2_Click 'call the reset command Call RGB_ON_Click 'set the RGB white on mode to selected on the form tolerance_slider.Value = 10 End Sub
Private Sub Form_Unload(Cancel As Integer) Table of Contents '**************************************** ' Shutdowns all the comports and ' exits the programs. shutdown can't ' occur is a packet stream is open though '**************************************** If Stop_Looping = False Then Cancel = MsgBox("Please Close Any Packet Streams Before Exiting", vbCritical, "Closing Error") Exit Sub End If On Error GoTo er1 Me.BackColor = RGB(0, 0, 0) 'change background so user knows whats up COM.PortOpen = False 'close the port Comm.PortOpen = False Sleep (2000) 'wait to make sure it died Unload Me On Error GoTo 0 Exit Sub er1: MsgBox "Error Closing comports, using forced exit", vbCritical, "ERROR" Unload Me End Sub
Private Function Build_Combos() Table of Contents '***************************************** ' Fill in some of the combo boxes '***************************************** Dim X As Integer 'Build the contrast box For X = 0 To 255 contrast_combo.AddItem str(X) Next X 'Build the brightness box For X = 0 To 255 brightness_combo.AddItem str(X) Next X 'Build the noise filter box noise_combo.AddItem str(0) noise_combo.AddItem str(1) 'Build the HM Mode box HM_Combo.AddItem str(0) HM_Combo.AddItem str(1) 'Build the FPS combo Combo_FPS.AddItem str(17) Combo_FPS.AddItem str(13) Combo_FPS.AddItem str(11) Combo_FPS.AddItem str(9) Combo_FPS.AddItem str(8) Combo_FPS.AddItem str(7) Combo_FPS.AddItem str(6) Combo_FPS.AddItem str(5) Combo_FPS.AddItem str(4) End Function
Private Sub Form_Load() Table of Contents '**************************************** ' Initializes all the comports and other ' settings required for the follow me to ' run properly '**************************************** On Error GoTo err1 stop_loop.Visible = False COM.CommPort = 1 'our comport holding the CMUcam COM.InBufferSize = 32764 'input buffer size COM.PortOpen = True 'open the port for communication 'Set up joystick form Comm.CommPort = 3 Comm.PortOpen = True 'build and fill all the combobox data for the registers Call Build_Combos 'Lock the Robot movement until the user really wants it to drive itself userlock = True unlock_movement.Enabled = True Stop_Looping = True Exit Sub err1: MsgBox "Couldn't Resolve Robot or CMU device, Terminating Program", vbCritical Unload Me End Sub
Private Sub Lock_Buttons() Table of Contents '************************************ ' Locks all the buttons during ' looping input '************************************ command_middle_mass_off.Enabled = False command_middle_mass_on.Enabled = False command_middle_mass_on_servo_to.Enabled = False Command1.Enabled = False Command2.Enabled = False Command4.Enabled = False Command5.Enabled = False Reg_Update.Enabled = False Reset_regs.Enabled = False Command3.Enabled = False End Sub
Private Sub Restore_Buttons() Table of Contents '************************************ ' Restore all input '************************************ command_middle_mass_off.Enabled = True command_middle_mass_on.Enabled = True command_middle_mass_on_servo_to.Enabled = True Command1.Enabled = True Command2.Enabled = True Command4.Enabled = True Command5.Enabled = True Reg_Update.Enabled = True Reset_regs.Enabled = True Command3.Enabled = True End Sub '************************************************************************ '********************************************************* '****************************************** ' FORM CLICKS SECTION '****************************************** '********************************************************* '************************************************************************
Private Sub Command5_Click() Table of Contents '***************************************** ' track the object in the center of the ' cameras view '***************************************** Dim ret As String 'return strign from sendcommand Dim InputString As String 'the packet Dim mark As Integer 'mark for ripping up packet Dim WhatPacket As String 'Whatpacket are we on Dim Mx As String, My As String 'centroid coordinates Dim X1 As String, Y1 As String, X2 As String, Y2 As String 'box coordinates Dim PixCnt As String, ObjConf As String 'Pixcount and object confidence Dim spos As String 'servo position ret = SendCommand("TW", 150) If ret = "-1" Then Frame_Status.Caption = "Couldn't Init Object Tracking Mode" Exit Sub Else Ser_In.Text = Ser_In.Text & "TC --> Object Tracking Mode Initialized" & vbCrLf tracking_Status.FillColor = RGB(0, 255, 0) End If 'Init variables for the data loop Stop_Looping = False stop_loop.Visible = True DIR.Text = "" looping_status.FillColor = RGB(0, 255, 0) First_Run = True Call Lock_Buttons BusY = False moving = False Call Move_Servo(2, 1) 'Loop and send the data into the robot Do DoEvents 'without this bad things happen InputString = COM.Input If BusY = False Then BusY = True Call HandlePacket(InputString) End If Sleep (50) Loop Until Stop_Looping = True 'Shutdown loop Call Restore_Buttons 'Restore Buttons Upon Loop Termination Call Command4_Click 'call board reset stop_loop.Visible = False 'hide the stop loop End Sub
Private Sub Command1_Click() Table of Contents 'Send dumpframe command Dim ret As String Dim Left As Long Dim col As Integer, row As Integer Dim r As String, b As String, g As String Dim started As Boolean Dim Y As String Dim Cr As String Dim Cb As String 'Send the command to the camera ret = SendCommand("DF", 6000) On Error GoTo err1 'error check the results If ret = "-1" Then Frame_Status.Caption = "Error Dumping Frame" Else Command_Status.FillColor = RGB(255, 255, 0) Frame_Status.Caption = "Dumping Frame..." PIC.ScaleMode = vbPixels PIC.Cls pic_hi.Visible = False 'set up our flags and coutners started = False Left = 1 row = 0 col = 0 While Left < Len(ret) DoEvents 'Check for new column If Asc(Mid(ret, Left, 1)) = 2 Then 'Frame_Status.Caption = "New Col Found" col = col + 2 Left = Left + 1 row = 0 'Check for new frame ElseIf Asc(Mid(ret, Left, 1)) = 1 Then 'Frame_Status.Caption = "New Frame Found" row = 0 started = True Left = Left + 1 col = 0 'Check for end of frame ElseIf Asc(Mid(ret, Left, 1)) = 3 Then 'Frame_Status.Caption = "End of Frame Found" started = False Else 'make sure we are in an image and then dump If started = True Then r = Mid(ret, Left, 1) g = Mid(ret, Left + 1, 1) b = Mid(ret, Left + 2, 1) PIC.PSet (col, row), RGB(Asc(r), Asc(g), Asc(b)) 'have to double each column PIC.PSet (col + 1, row), RGB(Asc(r), Asc(g), Asc(b)) row = row + 1 Left = Left + 3 End If End If 'if we havent started yet inc by 1 until we find the start If started = False Then Left = Left + 1 End If Wend Command_Status.FillColor = RGB(0, 255, 0) Frame_Status.Caption = "Done Recieving Frames(" & col & ")" End If On Error GoTo 0 Exit Sub err1: Frame_Status.Caption = "Error Dumping Frame" Command_Status.FillColor = RGB(255, 0, 0) Ser_In.Text = Ser_In.Text & "Error Reading Image From Comport (try again)" & vbCrLf End Sub
Private Sub command_middle_mass_on_servo_to_Click() Table of Contents '***************************************** 'Sets the cam into MiddleMass mode off '***************************************** Dim ret As String 'send command ret = SendCommand("MM 14", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Middle Mass Mode To On with Servo Support" Else Ser_In.Text = Ser_In.Text & " --> Middle Mass Mode Set To (Servo On)" & vbCrLf MM_Status.FillColor = RGB(0, 0, 255) End If End Sub
Private Sub command_middle_mass_off_Click() Table of Contents '***************************************** 'Sets the cam into MiddleMass mode off '***************************************** Dim ret As String 'send command ret = SendCommand("MM 0", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Middle Mass Mode To Off" Else Ser_In.Text = Ser_In.Text & " --> Middle Mass Mode Set To (Off)" & vbCrLf MM_Status.FillColor = RGB(255, 0, 0) End If End Sub
Private Sub command_middle_mass_on_Click() Table of Contents '***************************************** 'Sets the cam into MiddleMass mode Normal (on) '***************************************** Dim ret As String 'send command ret = SendCommand("MM 1", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Middle Mass Mode To On" Else Ser_In.Text = Ser_In.Text & " --> Middle Mass Mode Set To (on)" & vbCrLf MM_Status.FillColor = RGB(0, 255, 0) End If End Sub
Private Sub Command2_Click() Table of Contents '***************************************** 'Sen default command '***************************************** Dim ret As String 'Send the blank command to check for status, used for ping ret = SendCommand("", 50) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Could Not Find Camera" Ser_In.Text = Ser_In.Text & "CMUcam not found" & vbCrLf ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Could Not Find Camera" Ser_In.Text = Ser_In.Text & "CMUcam not found" & vbCrLf Else 'Did get the command so parse it Frame_Status.Caption = "Found the CMUcam" Ser_In.Text = Ser_In.Text & "Ping Successful" & vbCrLf End If End Sub
Private Sub Command4_Click() Table of Contents '***************************************** ' Sends the reset command '***************************************** Dim ret As String 'send command ret = SendCommand("RS", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Reset Camera" Ser_In.Text = Ser_In.Text & "Couldn't Reset Camera, Retrying" & vbCrLf Call Command4_Click Exit Sub ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Reset Camera" Ser_In.Text = Ser_In.Text & "Couldn't Reset Camera, Retrying" & vbCrLf Call Command4_Click Exit Sub Else 'Did get the command so parse it Frame_Status.Caption = "Camera Reset" Ser_In.Text = Ser_In.Text & Mid(ret, 6, Len(ret) - 6) & vbCrLf 'reset status markers tracking_Status.FillColor = RGB(255, 0, 0) MM_Status.FillColor = RGB(255, 0, 0) looping_status.FillColor = RGB(255, 0, 0) Me.Refresh End If End Sub
Private Sub Reg_Update_Click() Table of Contents '****************************************** ' Update the brightness and contrast regs '****************************************** Dim temp As String Dim ret As String Dim val As String Dim bool As Boolean 'Flag to see if any of the reg updates fail bool = True 'Send the brightness command temp = brightness_combo.Text ret = SendCommand("CR 6 " & temp, 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Brightness" Ser_In.Text = Ser_In.Text & "Couldn't Set Brightness" & vbCrLf bool = False ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Set Brightness" Ser_In.Text = Ser_In.Text & "Couldn't Set Brightness" & vbCrLf bool = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Brightness Register set to " & temp & vbCrLf End If 'Send the Contrast Command temp = contrast_combo.Text ret = SendCommand("CR 5 " & temp, 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Contrast" Ser_In.Text = Ser_In.Text & "Couldn't Set Contrast" & vbCrLf bool = False ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Set Contrast" Ser_In.Text = Ser_In.Text & "Couldn't Set Contrast" & vbCrLf bool = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Contrast Register set to " & temp & vbCrLf End If 'Send the Contrast Command temp = noise_combo.Text ret = SendCommand("NF " & temp, 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Noise Filter" Ser_In.Text = Ser_In.Text & "Couldn't Set Noise Filter" & vbCrLf bool = False ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Set Noise Filter" Ser_In.Text = Ser_In.Text & "Couldn't Set Noise Filter" & vbCrLf bool = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Noise Filter Set to " & temp & vbCrLf End If 'Send the Contrast Command temp = HM_Combo.Text ret = SendCommand("HM " & temp, 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set HM Mode" Ser_In.Text = Ser_In.Text & "Couldn't Set HM Mode" & vbCrLf bool = False ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Set HM Mode" Ser_In.Text = Ser_In.Text & "Couldn't Set HM Mode" & vbCrLf bool = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> HM Mode Set To " & temp & vbCrLf End If 'Send the FPS command temp = Combo_FPS.Text If temp = 17 Then val = 2 ElseIf temp = 13 Then val = 3 ElseIf temp = 11 Then val = 4 ElseIf temp = 9 Then val = 5 ElseIf temp = 8 Then val = 6 ElseIf temp = 7 Then val = 7 ElseIf temp = 6 Then val = 8 ElseIf temp = 5 Then val = 10 ElseIf temp = 4 Then val = 12 Else bool = False End If 'send command ret = SendCommand("CR 17 " & val, 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set Clock Speed (FPS)" Ser_In.Text = Ser_In.Text & "Couldn't Set Clock Speed (FPS)" & vbCrLf bool = False ElseIf Not Right(ret, 1) = ":" Then Frame_Status.Caption = "Couldn't Set Clock Speed (FPS)" Ser_In.Text = Ser_In.Text & "Couldn't Set Clock Speed (FPS)" & vbCrLf bool = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Clock Speed Set (FPS = " & temp & " )" & vbCrLf End If 'Check to see if any of the updates failed and inform the user If bool = False Then Frame_Status.Caption = "One or more reg updates failed" Else Frame_Status.Caption = "Reg updates successful" End If End Sub
Private Sub Reset_regs_Click() Table of Contents '****************************************** ' Reset all Regs to factory default '****************************************** Dim ret As String Dim flag As Boolean flag = True 'send command ret = SendCommand("CR", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Reset Registers" flag = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Registers Reset" & vbCrLf End If 'send command ret = SendCommand("HM 0", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Reset Registers" flag = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Registers Reset" & vbCrLf End If 'send command ret = SendCommand("NF 0", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Reset Registers" flag = False Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> Registers Reset" & vbCrLf End If If flag = False Then Frame_Status.Caption = "Reseting Registers Failed" Else Frame_Status.Caption = "Registers Reset" End If End Sub
Private Sub RGB_OFF_Click() Table of Contents '********************************************* ' User wants to set RGB White Balance off '********************************************* Dim ret As String 'send command ret = SendCommand("CR 18 40", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set RGB White Balance Off Mode" Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> RGB White Off Mode Set" & vbCrLf End If End Sub
Private Sub RGB_ON_Click() Table of Contents '********************************************* ' User wants to set RGB White Balance on '********************************************* Dim ret As String 'send command ret = SendCommand("CR 18 44", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set RGB White Balance On Mode" Else 'Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> RGB White On Mode Set" & vbCrLf End If End Sub
Private Sub Ser_In_Change() Table of Contents Ser_In.SelStart = Len(Ser_In.Text) End Sub
Private Sub stop_loop_Click() Table of Contents Stop_Looping = True unlock_movement.Enabled = True End Sub
Private Sub unlock_movement_Click() Table of Contents userlock = False unlock_movement.Enabled = False End Sub
Private Sub YcrCb_off_Click() Table of Contents '********************************************* ' User wants to set YCrCb White Balance off '********************************************* Dim ret As String 'send command ret = SendCommand("CR 18 32", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set YCrCb White Balance Off Mode" Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> YCrCb White Off Mode Set" & vbCrLf End If End Sub
Private Sub YcrCb_on_Click() Table of Contents '********************************************* ' User wants to set YCrCb White Balance On '********************************************* Dim ret As String 'send command ret = SendCommand("CR 18 36", 100) 'check the result and inform user If ret = "-1" Then Frame_Status.Caption = "Couldn't Set YCrCb White Balance On Mode" Else Ser_In.Text = Ser_In.Text & Mid(ret, 5, Len(ret) - 5) & " --> YCrCb White On Mode Set" & vbCrLf End If End Sub
Private Sub DIR_Change() Table of Contents DIR.SelStart = Len(DIR.Text) End Sub
Private Sub Output_Change() Table of Contents Output.SelStart = Len(Output.Text) End Sub