?? module1.bas
字號:
Case FT_DEVICE_NOT_OPENED
Str = ErrStr & " - Device Not Opened"
Case FT_IO_ERROR
Str = ErrStr & " - General IO Error"
Case FT_INSUFFICIENT_RESOURCES
Str = ErrStr & " - Insufficient Resources"
Case FT_INVALID_PARAMETER
Str = ErrStr & " - Invalid Parameter"
Case FT_INVALID_BAUD_RATE
Str = ErrStr & " - Invalid Baud Rate"
Case FT_DEVICE_NOT_OPENED_FOR_ERASE
Str = ErrStr & " - Device not opened for Erase"
Case FT_DEVICE_NOT_OPENED_FOR_WRITE
Str = ErrStr & " - Device not opened for Write"
Case FT_FAILED_TO_WRITE_DEVICE
Str = ErrStr & " - Failed to write Device"
Case FT_EEPROM_READ_FAILED
Str = ErrStr & " - EEPROM read failed"
Case FT_EEPROM_WRITE_FAILED
Str = ErrStr & " - EEPROM write failed"
Case FT_EEPROM_ERASE_FAILED
Str = ErrStr & " - EEPROM erase failed"
Case FT_EEPROM_NOT_PRESENT
Str = ErrStr & " - EEPROM not present"
Case FT_EEPROM_NOT_PROGRAMMED
Str = ErrStr & " - EEPROM not programmed"
Case FT_INVALID_ARGS
Str = ErrStr & " - Invalid Arguments"
Case FT_NOT_SUPPORTED
Str = ErrStr & " - not supported"
Case FT_OTHER_ERROR
Str = ErrStr & " - other error"
End Select
Form1.shpOK.BackColor = Red ' turn status indicator red
StopReading = True ' turn off continuous readings
Form1.lblStatus.Caption = Str ' show the message in the status area
MsgBox Str ' display the message
End Sub
Public Function Get_USB_Device_QueueStatus() As Long
' return the number of bytes waiting to be read
FT_Result = FT_GetQueueStatus(FT_HANDLE, FT_Q_Bytes)
If FT_Result <> FT_OK Then
FT_Error_Report "FT_GetQueueStatus", FT_Result
End If
Get_USB_Device_QueueStatus = FT_Result
End Function
Public Function GetDeviceString() As String
' get the device name
GetDeviceString = Left(FT_Device_String_Buffer, InStr(FT_Device_String_Buffer, Chr(0)) - 1)
End Function
Public Function GetFTDeviceCount() As Long
' get the number of connected devices
FT_Result = FT_GetNumDevices(FT_Device_Count, 0, FT_LIST_NUMBER_ONLY)
If FT_Result = FT_OK Then
GetFTDeviceCount = FT_Device_Count ' return the number of devices
Else
FT_Error_Report "GetFTDeviceCount", FT_Result ' show error message
GetFTDeviceCount = 0 ' return 0 devices
End If
End Function
Public Function GetFTDeviceDescription(DeviceIndex As Long) As String
' get the device description of a specific device
FT_Result = FT_ListDevices(DeviceIndex, FT_Device_String_Buffer, (FT_OPEN_BY_DESCRIPTION Or FT_LIST_BY_INDEX))
If FT_Result = FT_OK Then
FT_Device_String = GetDeviceString ' strip off trailing nulls
GetFTDeviceDescription = FT_Device_String ' return the character part
Else
FT_Error_Report "GetFTDeviceDescription", FT_Result
GetFTDeviceDescription = "" ' init to null
End If
End Function
Public Function GetFTDeviceSerialNo(DeviceIndex As Long) As String
' get the serial number of a specific device
FT_Result = FT_ListDevices(DeviceIndex, FT_Device_String_Buffer, (FT_OPEN_BY_SERIAL_NUMBER Or FT_LIST_BY_INDEX))
If FT_Result = FT_OK Then
FT_Device_String = GetDeviceString ' strip off trailing nulls
GetFTDeviceSerialNo = FT_Device_String ' return the character part
Else
FT_Error_Report "GetFTDeviceSerialNo", FT_Result
GetFTDeviceSerialNo = "" ' init to null
End If
End Function
Public Function Init_Controller(DName As String) As Boolean
' initialise the controller on port DName
Init_Controller = OpenPort(DName) ' open the port
End Function
Public Sub InitialiseVariables()
' initialise variables
RegKey = "FTBMeter"
OurDevice = "DLP2232M A" ' set the name of our DLP2232M
ZerodBmHF = GetSetting(RegKey, "Settings", "ZerodBmHF", 2556)
ZerodBmVHF = GetSetting(RegKey, "Settings", "ZerodBmVHF", 2519)
ZerodBmUHF = GetSetting(RegKey, "Settings", "ZerodBmUHF", 2501)
Minus40dBmHF = GetSetting(RegKey, "Settings", "Minus40dBmHF", 915)
Minus40dBmVHF = GetSetting(RegKey, "Settings", "Minus40dBmVHF", 913)
Minus40dBmUHF = GetSetting(RegKey, "Settings", "Minus40dBmUHF", 872)
ZerodBm = ZerodBmVHF
Minus40dBm = Minus40dBmVHF
Slope = (ZerodBm - Minus40dBm) / 40
Form1.cmdHF.BackColor = ButtonFace
Form1.cmdVHF.BackColor = Green
Form1.cmdUHF.BackColor = ButtonFace
End Sub
Public Function Open_USB_Device_By_Description(Device_Description As String) As Long
SetDeviceString Device_Description
FT_Result = FT_OpenEx(FT_Device_String_Buffer, FT_OPEN_BY_DESCRIPTION, FT_HANDLE)
If FT_Result <> FT_OK Then
FT_Error_Report "Open_USB_Device_By_Description", FT_Result
End If
End Function
Public Sub OpenDevice()
' open the DLP2232M module by name. The A port is the only one that can be used for MPSSE SPI
' communications.
Dim I As Long
Dim X As Long
Dim DeviceDescription As String
Dim FoundDevice As Boolean
Dim Res As Long
' if the port is already open then close it
If PortAIsOpen Then
Res = Close_USB_Device
If FT_Result <> FT_OK Then
PortAIsOpen = False
Form1.shpOK.BackColor = Red
Form1.lblStatus.Caption = "Attempt to close DLP2232M failed."
StopReading = True
Exit Sub
End If
End If
' set port A not open
PortAIsOpen = False
' see if anything connected
X = GetFTDeviceCount
If X = 0 Then
Form1.shpOK.BackColor = Yellow
Form1.lblStatus.Caption = "No FTDI devices found. Please connect the meter and re-try"
Exit Sub
End If
' get the descriptions and look for DLP module channel A
For I = 0 To FT_Device_Count - 1
DeviceDescription = GetFTDeviceDescription(I)
If FT_Result = FT_OK Then
If DeviceDescription = OurDevice Then
FoundDevice = True
Exit For
End If
End If
Next
' check we have a DLP A module found
If Not (FoundDevice) Then
Form1.shpOK.BackColor = Yellow
Form1.lblStatus.Caption = "No DLP2232M A device found. Please re-connect the meter and re-try"
Exit Sub
End If
' open by the device description
Open_USB_Device_By_Description DeviceDescription
If FT_Result <> FT_OK Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "The open for the meter did not complete successfully."
Exit Sub
End If
' try a command
Res = Get_USB_Device_QueueStatus
If FT_Result <> FT_OK Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "Get USB Device QueuStatus command failed in procedure OpenDevice"
Exit Sub
End If
PortAIsOpen = True
' set the latency
FT_Result = Set_USB_Device_LatencyTimer(16)
If FT_Result <> FT_OK Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "Set USB Device Latency Timer failed"
Exit Sub
End If
' reset the controller
FT_Result = Set_USB_Device_BitMode(&H0, &H0) ' reset the controller
If FT_Result <> FT_OK Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "Device reset failed in procedure OpenDevice."
Exit Sub
End If
' set the module to MPSSE mode
FT_Result = Set_USB_Device_BitMode(&H0, &H2) ' set to MPSSE mode
If FT_Result <> FT_OK Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "Set to MPSSE mode failed in procedure OpenDevice."
Exit Sub
End If
' sync MPSSE mode
If Not (Sync_To_MPSSE) Then
Form1.shpOK.BackColor = Red
StopReading = True
Form1.lblStatus.Caption = "Unable to synchronise the MPSSE write/read cycle in procedure OpenDevice."
Exit Sub
End If
' initialise the port
OutIndex = 0 ' point to the start of output buffer
Saved_Port_Value = &H8 ' set the initial state of the first 8 lines
' set the low byte
AddToBuffer &H80 ' Set data bits low byte command
AddToBuffer &H8 ' set CS=high, DI=low, DO=low, SK=low
AddToBuffer &HB ' CS=output, DI=input, DO=output, SK=output
' set the clock divisor
AddToBuffer &H86 ' set clock divisor command to 1MHz
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -