Author |
Topic: COM Lighting Control. (Read 609 times) |
|
thefamouscash
New Member
member is offline
Posts: 17
|
 |
Re: COM Lighting Control.
« Reply #9 on: Aug 27th, 2010, 01:02am » |
|
Richard,
Trying to follow your advice within my limited knowledge.
I trust I am not contravening law by copying the sample below.
Hope this is what is required.
Bob.
Example – How to program the device
The following Visual Basic uses the FTDI DLL to directly interface the hardware.
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
|
|
 Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #10 on: Aug 27th, 2010, 09:05am » |
|
on Aug 27th, 2010, 01:02am, thefamouscash wrote:| Hope this is what is required. |
|
I asked you to use code tags to ensure that your listing was correctly formatted, yet you didn't do so. As a result many of the lines have 'wrapped', and indentation has been lost, making it much harder to read and interpret the code. Please make full use of the facilities of this board, such as being able to embed code within messages, so that people can help you more easily.
I'll get back to you when I've managed to unscramble the code you listed.
Richard.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #11 on: Aug 27th, 2010, 09:36am » |
|
I've managed to convert the code into BBC BASIC, with the help of VB2BBC, but really it's so massively overcomplicated for what you want to achieve it seems ridiculous.
Maybe using the virtual COM port interface would be easier after all. Please list any example code provided for that mode of operation. And don't forget those code tags!
Richard.
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #12 on: Aug 27th, 2010, 09:58am » |
|
I will try to obtain that code.
I noticed someone else had mentioned VB2BBC so I sent a direct email requesting a link for VB2BBC and still feel this may be of use. The code I attempted to give is (I believe) the entire code for communicating with the unit.
Sorry for inconvenience, I do not know how add code tags but will find out.
Bob.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #13 on: Aug 27th, 2010, 10:31am » |
|
on Aug 27th, 2010, 09:58am, thefamouscash wrote:| I noticed someone else had mentioned VB2BBC so I sent a direct email requesting a link for VB2BBC and still feel this may be of use. |
|
You were sent the 'Welcome to the VB2BBC user group' email yesterday, containing the download link. However your code caused VB2BBC to crash, therefore I had to modify it to produce any usable results. That's the trouble with experimental software!
I've had very little feedback from members of the VB2BBC User Group (I think none) so I am not motivated to put much effort into an application in which so few people seem to have any interest.
Quote:| I do not know how add code tags |
|
Do you not see Add tags: when you are entering your message? The 'insert code' tag is the one with a # symbol.
Richard.
|
| « Last Edit: Aug 27th, 2010, 10:34am by admin » |
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #14 on: Aug 27th, 2010, 2:03pm » |
|
Apologies that my lack of skill is causing undue effort. I now see the # to insert code and will use that if I can find suitable code.
I regret I do not appear to have received the welcome to BV2BBC email. Is it possible to resend?
I believe I may be able to translate a piece at a time and find relevant sections.
With thanks,
Bob.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #15 on: Aug 27th, 2010, 4:05pm » |
|
on Aug 27th, 2010, 2:03pm, thefamouscash wrote:| I regret I do not appear to have received the welcome to BV2BBC email. Is it possible to resend? |
|
OK, I've sent it again. Do note that your VB code is likely to crash VB2BBC (v0.06), so I apologise for any frustration this may cause.
Richard.
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #16 on: Aug 27th, 2010, 4:19pm » |
|
I cannot trace the alternative code at the moment and note you were going to try to read the corrupted data I sent.
In order to save some effort, I have re-tried to send correctly below.
Code:
UDIN - USB Relay / Digital Input, Output Example
To set a Relay / Digital Output, check the appropriate box and click the Set button.
To read a Digital Input, choose Read Inputs and click the Read button.
To read a Relay Status, choose Relay Status and click the Read button.
Visual Basic Example – How to program the device
The following Visual Basic uses the FTDI DLL to directly interface the hardware.
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
Code:
I hope this is correct.
Bob.
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #17 on: Aug 27th, 2010, 4:25pm » |
|
Code:
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
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #18 on: Aug 27th, 2010, 4:50pm » |
|
Please advise to which email address you sent the two emails containing VB2BBC link?
I cannot trace receipt in any of my emails.
Bob.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #19 on: Aug 27th, 2010, 5:55pm » |
|
on Aug 27th, 2010, 4:50pm, thefamouscash wrote:| Please advise to which email address you sent the two emails containing VB2BBC link? |
|
I sent both emails to thefamouscash@blueyonder.co.uk and have received no 'bounce' messages. Therefore I have no reason to think they weren't delivered successfully.
Richard.
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #20 on: Aug 28th, 2010, 11:39am » |
|
I think there must be something untoward going on.
I sent a second email directly to you and did not get a response either.
Perhaps try bobburt@blueyonder.co.uk requesting read receipt?
Still trying to find alternative code.
Bob.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #21 on: Aug 28th, 2010, 12:59pm » |
|
on Aug 28th, 2010, 11:39am, thefamouscash wrote:Perhaps try bobburt@blueyonder.co.uk requesting read receipt?
|
|
I really can't see much point, because I don't think VB2BBC is going to be much help:
Your code causes it to crash, and you won't have the experience to know what to do about that.
I have already translated the code you listed to BBC BASIC (using VB2BBC) so I could simply let you have the translation!
The code is so complex and specific to the demo environment (it seems to assume a UI with a listbox and checkboxes etc.) that I'm really not sure it will be all that useful anyway. If you want the BBC BASIC translation just let me know and I'll list it here.
Richard.
|
|
Logged
|
|
|
|
thefamouscash
New Member
member is offline
Posts: 17
|
|
Re: COM Lighting Control.
« Reply #22 on: Aug 28th, 2010, 1:11pm » |
|
Thank you very much. I would appreciate that translation.
My intention to use the VB2BBC was to input small pieces of the code for translation in the hope of determining which were relevant.
This is so frustrating. ALL I want to do is sent simple ASCII codes through a USB to the device which controls relays.
I thought it was my lack of programming skills which prevented me from following your instructions through "HELP" but a friend of mine, with some considerable programming knowledge, spent two full days with me and we still could not overcome the problem.
The SYS commands seem the way but nothing seems to work.
I appreciate all your efforts and patience.
All I know is, I WILL get this problem solved, no matter how long it takes!
Bob.
|
|
Logged
|
|
|
|
admin
Administrator
member is offline
Posts: 1145
|
|
Re: COM Lighting Control.
« Reply #23 on: Aug 28th, 2010, 1:58pm » |
|
on Aug 28th, 2010, 1:11pm, thefamouscash wrote:| Thank you very much. I would appreciate that translation |
|
OK, (partial) translation follows below:
Code: 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
Please note:
Constants are not declared (because I don't know what their values are!).
SYS routine names use the CHR$96 (`) convention because that's what I prefer in my own code.
I've not bothered to translate code you won't need (e.g. the UI code which isn't relevant). I can see how this code can be modified quite easily to do exactly what you want; can you? It's an easy task for an experienced BBC BASIC programmer, but quite daunting for a beginner.
It's frustrating that I don't have the actual device here, because I could almost certainly get everything working in a few minutes. I wish you luck in your endeavours!
Richard.
|
|
Logged
|
|
|
|
|
