M:\Mike (latest)\Stub Programs\DumpImage\test.frm
File saved: 4/30/2006 2:51:40 PM
Generated: 4/30/2006 4:53:12 PM
Table of Contents (Designer Object Definition) Declarations SendCommand df_nomral_Click status_Change Timer1_Timer
VERSION 5.00 Table of Contents Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Begin VB.Form Form1 Caption = "Form1" ClientHeight = 4425 ClientLeft = 60 ClientTop = 345 ClientWidth = 5625 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4425 ScaleWidth = 5625 StartUpPosition = 3 'Windows Default Begin MSCommLib.MSComm Com Left = 4080 Top = 3240 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True BaudRate = 115200 End Begin VB.Frame Frame3 Caption = "Status/Results" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1815 Left = 0 TabIndex = 3 Top = 2520 Width = 5535 Begin VB.Timer Timer1 Interval = 7000 Left = 3360 Top = 840 End Begin VB.TextBox status Height = 1455 Left = 120 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 4 Top = 240 Width = 5295 End End Begin VB.Frame Frame2 Caption = "Select Test" 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 = 2520 TabIndex = 2 Top = 120 Width = 3015 Begin VB.TextBox dir Height = 285 Left = 840 TabIndex = 6 Text = "C:\" Top = 1560 Width = 2055 End Begin VB.CommandButton df_nomral Caption = "DF --> Normal (RGB)" Height = 615 Left = 960 TabIndex = 5 Top = 480 Width = 1215 End Begin VB.Label Label1 Caption = "Directory:" Height = 255 Left = 120 TabIndex = 7 Top = 1560 Width = 735 End End Begin VB.Frame Frame1 Caption = "Dumped Image" 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 = 0 TabIndex = 0 Top = 120 Width = 2415 Begin VB.PictureBox Pic Height = 1815 Left = 120 ScaleHeight = 1755 ScaleWidth = 2115 TabIndex = 1 Top = 240 Width = 2175 End 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) ' 'This program simply dumps an image out to the specified directory. 'From there the java applet will pick it up and redisplay it on the website. 'Works kinda like streaming video. ' '****************************************** '********************************************************* '************************************************************************ Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long) Dim server_numer As Integer 'how many images have been uploaded
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 Long Dim total As Long Dim end_time As Long On Error GoTo err1 'Send the actual command to the CMUcam Com.Output = cmd & Chr(13) 'get the frame If cmd = "DF" Then status.Text = status.Text & "Sending Command & Starting Frame Dump..." & vbCrLf status.Refresh Do DoEvents RcvBytes = RcvBytes & Com.Input Sleep (50) Loop Until Com.InBufferCount <= 0 status.Text = status.Text & "Frame Dumped...ok " & vbCrLf status.Refresh 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 SendCommand = RcvBytes 'Didnt get and ACK from CMUcam Else 'got a nck (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: status.Text = status.Text & "COMPort Error Getting Frame" & vbCrLf End Function
Private Sub df_nomral_Click() Table of Contents '************************************************* ' Dumps a frame from the COMPort using the standard ' DF which is the full RGB data '************************************************* '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 Dim start As Long Dim ender As Long Dim total As Long 'open the comport Com.CommPort = 1 'our comport holding the CMUcam Com.InBufferSize = 32764 'input buffer size Com.PortOpen = True 'open the port for communication Sleep (100) status.Text = "Starting DF Test using direct connection (RGB)" & vbCrLf status.Text = status.Text & "Opening Comport..." & vbCrLf status.Refresh 'Send the blank command to check for status, used for ping ret = SendCommand("", 50) 'check the result and inform user If ret = "-1" Then status.Text = status.Text & "Ping....FAILED" & vbCrLf Else status.Text = status.Text & "Ping....OK" & vbCrLf End If 'Send the command to the camera ret = SendCommand("DF", 6000) 'error check the results If ret = "-1" Then status.Text = status.Text & "Error Dumping Frame" & vbCrLf Else status.Text = status.Text & "Dumping Frame..." & vbCrLf Pic.ScaleMode = vbPixels Pic.Cls '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 End If server_numer = server_numer + 1 status.Text = status.Text & "Total Frames Dumped = " & server_numer & vbCrLf SavePicture Pic.Image, dir & "\vis.jpg" Com.PortOpen = False Sleep (1000) End Sub
Private Sub status_Change() Table of Contents status.SelStart = Len(status.Text) End Sub
Private Sub Timer1_Timer() Table of Contents Call df_nomral_Click End Sub