A Serial Camera Test Program                                            

The current 54K version of my Camera Test program works but there are still some bugs. There is a glitch with saving JPGs at the biggest image size because the Mscomm input buffer can’t handle binary input of that size. It’s a low priority problem for me because the 320x240 image size loads much faster and that is what I will be using for my Smart Meter project. I am still thinking about the problem though. I did not include an option to change the Mscomm port because I only have one on my computer. I did not include a power saving control because my power source is hard wired. I included a text box that shows how long a picture takes to read, download, save to a JPG file and then load into a picturebox control. The time is under 2 seconds for a 320x240 image at 115200. The JPG is saved to the path\name in the textbox. You can use the drive/directory/file listboxes to change the path\name or you can just type it in. An invalid path\name crashes the program. Try to use the “End Program” control button instead of the red X close icon to shutdown the program.

Here is the code for the current version of the camera test program:

'A Test Program for the LinkSprite LS-Y201 Serial Camera

Dim CurrentImageSize As String

Private Sub Form_Load()

MSComm1.CommPort = 1

MSComm1.Settings = "38400,n,8,1"

MSComm1.InputMode = comInputModeBinary

MSComm1.InBufferSize = 25000

MSComm1.InputLen = 25000

MSComm1.PortOpen = True

CurrentImageSize = "160x120"

DoEvents

txtFileName.Text = "M:\Meter\new.jpg"

'send picture size instruction to camera

txtError.Text = SetCameraImageSize(MSComm1, CurrentImageSize)

Pause 100 'wait 100 ms

'send picture compression instruction to camera

hsbCompression.Value = 54 'calls setcompression and empties the input buffer

UpdateForm

End Sub

Private Sub cmdEnd_Click()

Dim S As String

S = ResetCamera(MSComm1) ' reset the camera

S = CameraHexOutputString(MSComm1) 'read and clear the input buffer.

MSComm1.PortOpen = False ' close MScomm1

DoEvents

End

End Sub

Private Sub UpdateForm() 'sets the background colors of the commamd buttons

Dim S As String

S = MSComm1.Settings ' going to extract baud rate string

S = Mid(S, 1, Len(S) - 6)

For I = 0 To 4 'set background colors on baud rate buttons

    cmdBaud(I).BackColor = &H8000000F

    If cmdBaud(I).Caption = S Then cmdBaud(I).BackColor = vbGreen

Next I

For I = 0 To 2 'set background colors on image size buttons

    cmdImageSize(I).BackColor = &H8000000F

    If cmdImageSize(I).Caption = CurrentImageSize Then cmdImageSize(I).BackColor = vbGreen

Next I

End Sub

Private Sub cmdReset_Click()

txtCameraOutput.Text = "Wait"

txtError.Text = ResetCamera(MSComm1)

txtCameraOutput.Text = CameraHexOutputString(MSComm1)

UpdateForm

End Sub

Private Sub cmdSaveJPG_Click()

t = Timer 'txtError.Text = ""

txtCameraOutput.Text = "Wait"

txtError.Text = SaveCameraJPG(MSComm1, txtFileName.Text)

txtCameraOutput.Text = CameraHexOutputString(MSComm1)

Set Picture1.Picture = LoadPicture(txtFileName.Text) '("M:\Meter\new.jpg")

txtTime.Text = Format(Timer - t, "0.00")

End Sub

Private Sub cmdBaud_Click(Index As Integer)

txtError.Text = ""

txtCameraOutput.Text = "Wait"

txtError.Text = SetCameraBaud(MSComm1, cmdBaud(Index).Caption)

txtCameraOutput.Text = CameraHexOutputString(MSComm1)

UpdateForm

End Sub

Private Sub cmdImageSize_Click(Index As Integer)

txtError.Text = ""

txtCameraOutput.Text = "Wait"

txtError.Text = SetCameraImageSize(MSComm1, cmdImageSize(Index).Caption)

txtCameraOutput.Text = CameraHexOutputString(MSComm1)

CurrentImageSize = cmdImageSize(Index).Caption

UpdateForm

End Sub

Private Sub hsbCompression_Change()

txtError.Text = ""

txtCameraOutput.Text = "Wait"

'send compression command to camera.

txtError.Text = SetCameraCompression(MSComm1, Str(hsbCompression.Value))

txtCameraOutput.Text = CameraHexOutputString(MSComm1)

End Sub

Private Sub hsbCompression_Scroll()

txtCompression.Text = Str(hsbCompression.Value) ' write compression value into a text box.

End Sub

‘***  I lifted the following code from somewhere else... It if left mostly as found. ****

Private Sub DirListBox_Change()

FileListBox.Path = DirListBox.Path

End Sub

Private Sub FileListBox_Click()

Dim S As String

S = FileListBox.Path

If Right(FileListBox.Path, 1) <> "\" Then S = FileListBox.Path + "\"

txtFileName.Text = S + FileListBox.FileName

End Sub

Private Sub cmdNew_Click()

Dim S As String

S = FileListBox.Path

If Right(FileListBox.Path, 1) <> "\" Then S = FileListBox.Path + "\"

txtFileName.Text = S + "new.jpg"

End Sub

Private Sub DriveListBox_Change()

Dim msg As String

Dim result As String

On Error GoTo Error

DirListBox.Path = DriveListBox.Drive

Exit Sub

Error: msg = "Error: " & Err.Number & ": " & Err.Description

result = MsgBox(msg, vbOKCancel + vbExclamation, "No Data")

If result = vbOK Then

Resume

Else

DriveListBox.Drive = DirListBox.Path

Err.Clear

Exit Sub

End If

End Sub