Public Class AudonUSB
Private Sub SetUSB_Click(ByVal sender As System.Object, ByVal e
As System.EventArgs) Handles SetUSB.Click
Dim BytesWritten As Integer
Dim TempStringData As String
Dim BytesRead As Integer
'Open device by serial number
FT_Status = FT_OpenBySerialNumber(FT_Serial_Number, 1,
FT_Handle)
If FT_Status <> FT_OK Then
MsgBox("Failed to open device.", , )
Exit Sub
End If
' Reset device
FT_Status = FT_ResetDevice(FT_Handle)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Purge buffers
FT_Status = FT_Purge(FT_Handle, FT_PURGE_RX Or FT_PURGE_TX)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set Baud Rate
FT_Status = FT_SetBaudRate(FT_Handle, 9600)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set parameters
FT_Status = FT_SetDataCharacteristics(FT_Handle,
FT_DATA_BITS_8, FT_STOP_BITS_1, FT_PARITY_NONE)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set Flow Control
FT_Status = FT_SetFlowControl(FT_Handle, FT_FLOW_NONE, 0, 0)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Display in a message box all the items that are checked.
Dim indexChecked As Integer
Dim iRelays As Integer = 0
' First show the index and check state of all selected items.
For Each indexChecked In SetBits.CheckedIndices
iRelays = iRelays + 2 ^ Val(indexChecked.ToString())
Next
' Write string data to device
Dim sOutput As String
'If iRelays < 16 Then
'sOutput = "r0" + Hex(iRelays) + Chr(13)
'Else
'sOutput = "r" + Hex(iRelays) + Chr(13)
'End If
'sOutput = Me.TextBox1.Text + Chr(13)
sOutput = "r" + Trim(Str(iRelays)) + Chr(13)
FT_Status = FT_Write_String(FT_Handle, sOutput, Len(sOutput),
BytesWritten)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Wait
Sleep(100)
' Get number of bytes waiting to be read
FT_Status = FT_GetQueueStatus(FT_Handle, FT_RxQ_Bytes)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Read number of bytes waiting
' Allocate string to recieve data
TempStringData = Space(FT_RxQ_Bytes + 1)
FT_Status = FT_Read_String(FT_Handle, TempStringData,
FT_RxQ_Bytes, BytesRead)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Close device
FT_Status = FT_Close(FT_Handle)
If FT_Status <> FT_OK Then
Exit Sub
End If
End Sub
Private Sub AudonUSB_Load(ByVal sender As System.Object, ByVal e
As System.EventArgs) Handles MyBase.Load
Dim DeviceCount As Integer
Dim DeviceIndex As Integer
Dim TempDevString As String
' Get the number of device attached
FT_Status = FT_GetNumberOfDevices(DeviceCount, vbNullChar,
FT_LIST_NUMBER_ONLY)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Exit if no device connected
If DeviceCount = 0 Then
MsgBox("No Device Connected", MsgBoxStyle.Critical)
Exit Sub
End If
' Clear device list
DeviceList.Items.Clear()
' List devices in dropdown
For DeviceIndex = 0 To DeviceCount - 1
' Get serial number of device with index 0
' Allocate space for string variable
TempDevString = Space(16)
FT_Status = FT_GetDeviceString(DeviceIndex,
TempDevString, FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER)
If FT_Status <> FT_OK Then
Exit Sub
End If
FT_Serial_Number =
Microsoft.VisualBasic.Left(TempDevString, InStr(1, TempDevString,
vbNullChar) - 1)
' Get description of device with index 0
' Allocate space for string variable
TempDevString = Space(64)
FT_Status = FT_GetDeviceString(DeviceIndex,
TempDevString, FT_LIST_BY_INDEX Or FT_OPEN_BY_DESCRIPTION)
If FT_Status <> FT_OK Then
Exit Sub
End If
FT_Description =
Microsoft.VisualBasic.Left(TempDevString, InStr(1, TempDevString,
vbNullChar) - 1)
' Add to dropdown
DeviceList.Items.Add(FT_Description + " " +
FT_Serial_Number)
Next
' Set first device
DeviceList.SelectedIndex = 0
End Sub
Private Sub DeviceList_SelectedIndexChanged(ByVal sender As
System.Object, ByVal e As System.EventArgs) Handles
DeviceList.SelectedIndexChanged
Dim sDevice As String
Dim iSpace As Integer
sDevice =
DeviceList.Items.Item(DeviceList.SelectedIndex).ToString
iSpace = InStrRev(sDevice, " ")
If iSpace > 0 Then
FT_Description = Trim(Microsoft.VisualBasic.Left(sDevice,
iSpace - 1))
FT_Serial_Number =
Trim(Microsoft.VisualBasic.Mid(sDevice, iSpace + 1))
End If
End Sub
Private Sub ReadUSB_Click(ByVal sender As System.Object, ByVal e
As System.EventArgs) Handles ReadUSB.Click
Dim BytesWritten As Integer
Dim TempStringData As String
Dim BytesRead As Integer
'Open device by serial number
FT_Status = FT_OpenBySerialNumber(FT_Serial_Number, 1,
FT_Handle)
If FT_Status <> FT_OK Then
MsgBox("Failed to open device.", , )
Exit Sub
End If
' Reset device
FT_Status = FT_ResetDevice(FT_Handle)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Purge buffers
FT_Status = FT_Purge(FT_Handle, FT_PURGE_RX Or FT_PURGE_TX)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set Baud Rate
FT_Status = FT_SetBaudRate(FT_Handle, 9600)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set parameters
FT_Status = FT_SetDataCharacteristics(FT_Handle,
FT_DATA_BITS_8, FT_STOP_BITS_1, FT_PARITY_NONE)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Set Flow Control
FT_Status = FT_SetFlowControl(FT_Handle, FT_FLOW_NONE, 0, 0)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Write string data to device
Dim sOutput As String
If ReadInputs.Checked = True Then
' Read inputs
sOutput = "i0" + Chr(13)
Else
' Relay Status
sOutput = "s0" + Chr(13)
End If
FT_Status = FT_Write_String(FT_Handle, sOutput, Len(sOutput),
BytesWritten)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Wait
Sleep(100)
' Get number of bytes waiting to be read
FT_Status = FT_GetQueueStatus(FT_Handle, FT_RxQ_Bytes)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Read number of bytes waiting
' Allocate string to recieve data
TempStringData = Space(FT_RxQ_Bytes + 1)
FT_Status = FT_Read_String(FT_Handle, TempStringData,
FT_RxQ_Bytes, BytesRead)
If FT_Status <> FT_OK Then
Exit Sub
End If
' Change LED color depending on input
Dim iInput As Integer
TempStringData = Replace(TempStringData, "i0", " ")
TempStringData = Replace(TempStringData, "s0", " ")
TempStringData = Replace(TempStringData, Chr(13), " ")
TempStringData = Trim(Replace(TempStringData, Chr(10), " "))
iInput = Val(TempStringData)
If (iInput And 1) Then
LED0.BackColor = Color.LightGreen
Else
LED0.BackColor = Color.DarkGreen
End If
If (iInput And 2) Then
LED1.BackColor = Color.LightGreen
Else
LED1.BackColor = Color.DarkGreen
End If
If (iInput And 4) Then
LED2.BackColor = Color.LightGreen
Else
LED2.BackColor = Color.DarkGreen
End If
If (iInput And 8) Then
LED3.BackColor = Color.LightGreen
Else
LED3.BackColor = Color.DarkGreen
End If
If (iInput And 16) Then
LED4.BackColor = Color.LightGreen
Else
LED4.BackColor = Color.DarkGreen
End If
If (iInput And 32) Then
LED5.BackColor = Color.LightGreen
Else
LED5.BackColor = Color.DarkGreen
End If
If (iInput And 64) Then
LED6.BackColor = Color.LightGreen
Else
LED6.BackColor = Color.DarkGreen
End If
If (iInput And 128) Then
LED7.BackColor = Color.LightGreen
Else
LED7.BackColor = Color.DarkGreen
End If
' Close device
FT_Status = FT_Close(FT_Handle)
If FT_Status <> FT_OK Then
Exit Sub
End If
End Sub
End Class
REM Program partially translated from Visual BASIC to BBC BASIC
REM using VB2BBC utility ver 0.07 on Fri.27 Aug 2010,10:25:35
INSTALL @lib$+"STRINGLIB"
DEF PROCSetUSB_Click(FT_Serial_Number%)
LOCAL FT_Status%, FT_Handle%, indexCheck%, iRelays%
LOCAL FT_RxQ_Bytes%, BytesRead%, BytesWritten%
REM Open device by serial number
SYS `FT_OpenBySerialNumber`, FT_Serial_Number%, 1, ^FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN
SYS "MessageBox", @hwnd%, ("Failed to open device."), 0, 0
ENDPROC
ENDIF
REM Reset device
SYS `FT_ResetDevice`, FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Purge buffers
SYS `FT_Purge`, FT_Handle%, FT_PURGE_RX OR FT_PURGE_TX TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set Baud Rate
SYS `FT_SetBaudRate`, FT_Handle%, 9600 TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set parameters
SYS `FT_SetDataCharacteristics`, FT_Handle%, FT_DATA_BITS_8, FT_STOP_BITS_1, FT_PARITY_NONE TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set Flow Control
SYS `FT_SetFlowControl`, FT_Handle%, FT_FLOW_NONE, 0, 0 TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Display in a message box all the items that are checked.
REM First show the index and check state of all selected items.
FOR indexCheck% = MIN_INDEX TO MAX_INDEX
iRelays% = iRelays% + 2 ^ VAL(FN_isboxchecked(indexCheck%))
NEXT
REM Write string data to device
sOutput$ = "r" + FN_trim(STR$(iRelays%)) + CHR$(13)
SYS `FT_Write_String`, FT_Handle%, sOutput$, LEN(sOutput$), ^BytesWritten% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Wait
SYS "Sleep", 100
REM Get number of bytes waiting to be read
SYS `FT_GetQueueStatus`, FT_Handle%, ^FT_RxQ_Bytes% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Read number of bytes waiting
REM Allocate string to receive data
TempStringData$ = STRING$(FT_RxQ_Bytes% + 1, " ")
SYS `FT_Read_String`, FT_Handle%, !^TempStringData$, FT_RxQ_Bytes%, ^BytesRead% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Close device
SYS `FT_Close`, FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
ENDPROC
DEF PROCAudonUSB_Load
LOCAL DeviceIndex%, FT_Serial_Number%, TempDevString$, FT_Status%
LOCAL DeviceCount%, FT_Description%
REM Get the number of device attached
SYS `FT_GetNumberOfDevices`, ^DeviceCount%, "", FT_LIST_NUMBER_ONLY TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Exit if no device connected
IF DeviceCount% = 0 THEN
SYS "MessageBox", @hwnd%, "No Device Connected", 0, 0
ENDPROC
ENDIF
REM Clear device list
DeviceList.Items.Clear()
REM List devices in dropdown
FOR DeviceIndex% = 0 TO DeviceCount% - 1
REM Get serial number of device with index 0
REM Allocate space for string variable
TempDevString$ = STRING$(16, " ")
SYS `FT_GetDeviceString`, DeviceIndex%, !^TempDevString$, FT_LIST_BY_INDEX OR FT_OPEN_BY_SERIAL_NUMBER TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
FT_Serial_Number$ = LEFT$(TempDevString$, INSTR(TempDevString$, CHR$(0)) - 1)
REM Get description of device with index 0
REM Allocate space for string variable
TempDevString$ = STRING$(64, " ")
SYS `FT_GetDeviceString`, DeviceIndex%, !^TempDevString$, FT_LIST_BY_INDEX OR FT_OPEN_BY_DESCRIPTION TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
FT_Description$ = LEFT$(TempDevString$, INSTR(TempDevString$, CHR$0) - 1)
REM Add to dropdown
PROCaddtolistbox(FT_Description$ + " " + FT_Serial_Number$)
NEXT
REM Set first device
DeviceList.SelectedIndex% = 0
ENDPROC
DEF PROCReadUSB_Click(FT_Serial_Number%)
LOCAL sOutput$, TempStringData$, iInput%, FT_Status%, FT_Handle%
LOCAL BytesWritten%, BytesRead%, FT_RxQ_Bytes%
REM Open device by serial number
SYS `FT_OpenBySerialNumber`, FT_Serial_Number%, 1, ^FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN
SYS "MessageBox", @hwnd%, "Failed to open device", 0, 0
ENDPROC
ENDIF
REM Reset device
SYS `FT_ResetDevice`, FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Purge buffers
SYS `FT_Purge`, FT_Handle%, FT_PURGE_RX OR FT_PURGE_TX TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set Baud Rate
SYS `FT_SetBaudRate`, FT_Handle%, 9600 TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set parameters
SYS `FT_SetDataCharacteristics`, FT_Handle%, FT_DATA_BITS_8, FT_STOP_BITS_1, FT_PARITY_NONE TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Set Flow Control
SYS `FT_SetFlowControl`, FT_Handle%, FT_FLOW_NONE, 0, 0 TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Write string data to device
IF ReadInputs.Checked = TRUE THEN
REM Read inputs
sOutput$ = "i0" + CHR$(13)
ELSE
REM Relay Status
sOutput$ = "s0" + CHR$(13)
ENDIF
SYS `FT_Write_String`, FT_Handle%, sOutput$, LEN(sOutput$), ^BytesWritten% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Wait
SYS "Sleep", 100
REM Get number of bytes waiting to be read
SYS `FT_GetQueueStatus`, FT_Handle%, ^FT_RxQ_Bytes% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Read number of bytes waiting
REM Allocate string to recieve data
TempStringData$ = STRING$(FT_RxQ_Bytes% + 1, " ")
SYS `FT_Read_String`, FT_Handle%, !^TempStringData$, FT_RxQ_Bytes%, ^BytesRead% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
REM Change LED color depending on input
TempStringData$ = FN_findreplace(TempStringData$, "i0", " ", 0)
TempStringData$ = FN_findreplace(TempStringData$, "s0", " ", 0)
TempStringData$ = FN_findreplace(TempStringData$, CHR$(13), " ", 0)
TempStringData$ = FN_trim(FN_findreplace(TempStringData$, CHR$(10), " ", 0))
iInput% = VAL(TempStringData$)
IF (iInput% AND 1) THEN
LED0.BackColor = Color.LightGreen
ELSE
LED0.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 2) THEN
LED1.BackColor = Color.LightGreen
ELSE
LED1.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 4) THEN
LED2.BackColor = Color.LightGreen
ELSE
LED2.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 8) THEN
LED3.BackColor = Color.LightGreen
ELSE
LED3.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 16) THEN
LED4.BackColor = Color.LightGreen
ELSE
LED4.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 32) THEN
LED5.BackColor = Color.LightGreen
ELSE
LED5.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 64) THEN
LED6.BackColor = Color.LightGreen
ELSE
LED6.BackColor = Color.DarkGreen
ENDIF
IF (iInput% AND 128) THEN
LED7.BackColor = Color.LightGreen
ELSE
LED7.BackColor = Color.DarkGreen
ENDIF
REM Close device
SYS `FT_Close`, FT_Handle% TO FT_Status%
IF FT_Status% <> FT_OK THEN ENDPROC
ENDPROC