📄 d2xxaccess.vb
字号:
Imports System.Threading
Imports System.Text
Public Class D2XXAccess
Inherits System.Windows.Forms.Form
Friend WithEvents radDescription As System.Windows.Forms.RadioButton
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
End Sub
Protected dwListDescFlags As Integer
Protected m_hPort As Integer
Protected pThreadRead As Thread
Protected pThreadWrite As Thread
Protected fContinue As Boolean
'Form overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
MyBase.Dispose(disposing)
End Sub
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
Friend WithEvents radSerial As System.Windows.Forms.RadioButton
Friend WithEvents radNumber As System.Windows.Forms.RadioButton
Friend WithEvents cmbDevList As System.Windows.Forms.ComboBox
Friend WithEvents btnOpen As System.Windows.Forms.Button
Friend WithEvents btnClose As System.Windows.Forms.Button
Friend WithEvents btnWrite As System.Windows.Forms.Button
Friend WithEvents tbNumBytes As System.Windows.Forms.TextBox
Friend WithEvents Bytes As System.Windows.Forms.Label
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents lbDataBytes As System.Windows.Forms.ListBox
Private Sub InitializeComponent()
Me.radDescription = New System.Windows.Forms.RadioButton
Me.radSerial = New System.Windows.Forms.RadioButton
Me.radNumber = New System.Windows.Forms.RadioButton
Me.cmbDevList = New System.Windows.Forms.ComboBox
Me.btnOpen = New System.Windows.Forms.Button
Me.btnClose = New System.Windows.Forms.Button
Me.lbDataBytes = New System.Windows.Forms.ListBox
Me.btnWrite = New System.Windows.Forms.Button
Me.tbNumBytes = New System.Windows.Forms.TextBox
Me.Bytes = New System.Windows.Forms.Label
Me.Label1 = New System.Windows.Forms.Label
'
'radDescription
'
Me.radDescription.Location = New System.Drawing.Point(6, 2)
Me.radDescription.Size = New System.Drawing.Size(79, 14)
Me.radDescription.Text = "Description"
'
'radSerial
'
Me.radSerial.Location = New System.Drawing.Point(90, 3)
Me.radSerial.Size = New System.Drawing.Size(51, 13)
Me.radSerial.Text = "Serial"
'
'radNumber
'
Me.radNumber.Location = New System.Drawing.Point(143, 2)
Me.radNumber.Size = New System.Drawing.Size(67, 15)
Me.radNumber.Text = "Number"
'
'cmbDevList
'
Me.cmbDevList.Location = New System.Drawing.Point(6, 24)
Me.cmbDevList.Size = New System.Drawing.Size(127, 21)
'
'btnOpen
'
Me.btnOpen.Location = New System.Drawing.Point(149, 27)
Me.btnOpen.Size = New System.Drawing.Size(52, 18)
Me.btnOpen.Text = "Open"
'
'btnClose
'
Me.btnClose.Location = New System.Drawing.Point(149, 46)
Me.btnClose.Size = New System.Drawing.Size(52, 18)
Me.btnClose.Text = "Close"
'
'lbDataBytes
'
Me.lbDataBytes.Location = New System.Drawing.Point(6, 81)
Me.lbDataBytes.Size = New System.Drawing.Size(87, 132)
'
'btnWrite
'
Me.btnWrite.Location = New System.Drawing.Point(7, 55)
Me.btnWrite.Size = New System.Drawing.Size(52, 18)
Me.btnWrite.Text = "Write"
'
'tbNumBytes
'
Me.tbNumBytes.Location = New System.Drawing.Point(66, 55)
Me.tbNumBytes.Size = New System.Drawing.Size(32, 20)
Me.tbNumBytes.Text = "255"
'
'Bytes
'
Me.Bytes.Location = New System.Drawing.Point(104, 58)
Me.Bytes.Size = New System.Drawing.Size(34, 20)
Me.Bytes.Text = "Bytes"
'
'Label1
'
Me.Label1.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.0!, System.Drawing.FontStyle.Regular)
Me.Label1.Location = New System.Drawing.Point(106, 85)
Me.Label1.Size = New System.Drawing.Size(97, 93)
Me.Label1.Text = "Use Loopback Serial Cable to test application. Write upto 256 rolling count bytes" & _
" to port and display results in List."
'
'D2XXAccess
'
Me.ClientSize = New System.Drawing.Size(215, 221)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.Bytes)
Me.Controls.Add(Me.tbNumBytes)
Me.Controls.Add(Me.btnWrite)
Me.Controls.Add(Me.lbDataBytes)
Me.Controls.Add(Me.btnClose)
Me.Controls.Add(Me.btnOpen)
Me.Controls.Add(Me.cmbDevList)
Me.Controls.Add(Me.radNumber)
Me.Controls.Add(Me.radSerial)
Me.Controls.Add(Me.radDescription)
Me.Text = "D2XXAccess"
End Sub
Public Shared Sub Main()
Application.Run(New D2XXAccess)
End Sub
#End Region
Private Sub ReadThread()
Dim cBuf(1) As Byte
Dim dwRet As Long
Dim ftStatus As FT_STATUS
While fContinue = True
If m_hPort = 0 Then
Exit Sub
End If
ftStatus = FT_Read(m_hPort, cBuf, 1, dwRet)
If dwRet = 1 Then
lbDataBytes.Items.Add(BitConverter.ToString(cBuf, 0, 1))
End If
End While
End Sub
Private Sub btnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpen.Click
Dim dwOpenFlag As Integer
Dim iCurrentIndex As Integer
Dim ftStatus As FT_STATUS
If Not m_hPort Then
dwOpenFlag = dwListDescFlags And Not FT_LIST_BY_INDEX
dwOpenFlag = dwListDescFlags And Not FT_LIST_ALL
If dwOpenFlag = 0 Then
iCurrentIndex = cmbDevList.SelectedIndex()
ftStatus = FT_Open(iCurrentIndex, m_hPort)
Else
Dim ascii As New ASCIIEncoding
ftStatus = FT_OpenEx(ascii.GetBytes(cmbDevList.Text), dwOpenFlag, m_hPort)
End If
If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
' Set up the port
FT_SetBaudRate(m_hPort, 9600)
FT_Purge(m_hPort, D2XX_mod.FT_PURGE_.FT_PURGE_RX Or D2XX_mod.FT_PURGE_.FT_PURGE_TX)
FT_SetTimeouts(m_hPort, 3000, 3000)
' Start up the read and write thread
fContinue = True
pThreadRead = New Thread(AddressOf ReadThread)
pThreadRead.Start()
' Enable buttons that can be pressed
btnClose.Enabled = True
btnOpen.Enabled = False
btnWrite.Enabled = True
radDescription.Enabled = False
radSerial.Enabled = False
radNumber.Enabled = False
Else
MsgBox("Failed To Open Port")
End If
End If
End Sub
Private Function ListUnopenDevices() As Boolean
Dim ftStatus As FT_STATUS
Dim numDevs As Integer = 0
Dim i As Integer
Dim cBuf(64) As Byte
Dim iCurrentIndex As Integer
iCurrentIndex = cmbDevList.SelectedIndex()
cmbDevList.Items.Clear()
ftStatus = FT_ListDevices(numDevs, 0, FT_LIST_NUMBER_ONLY)
If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
If dwListDescFlags = FT_LIST_ALL Then
For i = 0 To numDevs - 1
cmbDevList.Items.Add(i)
Next
Else
For i = 0 To numDevs - 1
ftStatus = FT_ListDevices(i, cBuf, dwListDescFlags)
If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
Dim ascii As New ASCIIEncoding
Dim str As String
str = ascii.GetString(cBuf, 0, cBuf.Length)
cmbDevList.Items.Add(str)
Else
MsgBox("Error list devs " + Convert.ToString(ftStatus))
ListUnopenDevices = False
Exit Function
End If
Next
End If
ListUnopenDevices = True
Else
ListUnopenDevices = False
End If
cmbDevList.SelectedIndex = iCurrentIndex
End Function
Private Sub D2XXAccess_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
m_hPort = 0
fContinue = False
dwListDescFlags = FT_LIST_ALL
radNumber.Checked = True
btnClose.Enabled = False
btnOpen.Enabled = True
btnWrite.Enabled = False
radDescription.Enabled = True
radSerial.Enabled = True
radNumber.Enabled = True
If ListUnopenDevices() = False Then
MsgBox("Error Listing Devices")
End If
End Sub
Private Sub radSerial_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radSerial.CheckedChanged
dwListDescFlags = FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER
If ListUnopenDevices() = False Then
MsgBox("Error Listing Devices")
End If
End Sub
Private Sub radDescription_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radDescription.CheckedChanged
dwListDescFlags = FT_LIST_BY_INDEX Or FT_OPEN_BY_DESCRIPTION
If ListUnopenDevices() = False Then
MsgBox("Error Listing Devices")
End If
End Sub
Private Sub radNumber_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radNumber.CheckedChanged
dwListDescFlags = FT_LIST_ALL
If ListUnopenDevices() = False Then
MsgBox("Error Listing Devices")
End If
End Sub
Private Sub btnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWrite.Click
Dim dwRet As Long
Dim ftStatus As FT_STATUS
Dim i As Integer
Dim cBuf(255) As Byte
lbDataBytes.Items.Clear()
For i = 0 To cBuf.GetUpperBound(0)
cBuf(i) = i
Next
i = tbNumBytes.Text
ftStatus = FT_Write(m_hPort, cBuf, i + 1, dwRet)
If ftStatus <> D2XX_mod.FT_STATUS.FT_OK Then
MsgBox("Failed To Write")
End If
End Sub
Private Sub btnClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClose.Click
If m_hPort Then
fContinue = False
' it will stop in 3 seconds - not sure if this is proper
pThreadRead.CurrentThread().Sleep(3000)
FT_Close(m_hPort)
m_hPort = 0
End If
radNumber.Checked = True
btnClose.Enabled = False
btnOpen.Enabled = True
btnWrite.Enabled = False
radDescription.Enabled = True
radSerial.Enabled = True
radNumber.Enabled = True
End Sub
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -