Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public pnlStatus As Panel 'displays status
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public datStartAcqTime As Date
Private Sub cmdArmTrigger_Click()
SendCommand XMTPT_ARM_DIGITAL_OSCILLOSCOPE
End Sub
Private Sub cmdClearData_Click()
SendCommand XMTPT_SEND_CLEAR_SPECTRUM_STATUS
End Sub
Private Sub cmdClearMiscData_Click()
txtMiscData = ""
End Sub
Private Sub cmdEditConfiguration_Click()
Load frmDP5CFG
frmDP5CFG.Show vbModal
End Sub
Private Sub cmdReadMiscData_Click()
SendCommand XMTPT_SEND_512_BYTE_MISC_DATA
End Sub
Private Sub cmdShowConfiguration_Click()
If (s.isDppConnected) Then
s.DppConfig.DisplayCfg = True
SendCommand XMTPT_FULL_READ_CONFIG_PACKET
End If
End Sub
Public Sub cmdShowSCASettings_Click()
If (s.isDppConnected) Then s.DppConfig.DisplaySCA = True
RequestSCASettings
End Sub
Public Sub RequestSCASettings()
If (s.isDppConnected) Then
's.HwRdBkDP5Out = "SCAI=?;"
's.HwRdBkDP5Out = ""
s.HwRdBkDP5Out = "MCAC=?;SCAW=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=1;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=2;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=3;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=4;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=5;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=6;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=7;SCAL=?;SCAH=?;SCAO=?;"
s.HwRdBkDP5Out = s.HwRdBkDP5Out & "SCAI=8;SCAL=?;SCAH=?;SCAO=?;"
s.DppConfig.ScaReadReady = False
s.DppConfig.ScaReadBack = True
SendCommand XMTPT_READ_CONFIG_PACKET
End If
End Sub
Private Sub cmdStartAcquisition_Click()
datStartAcqTime = Now
SendCommand XMTPT_ENABLE_MCA_MCS
Timer2.Enabled = True
End Sub
Private Sub cmdColor_Click()
PlotColor = RgbToQbColor(PlotColor)
End Sub
Private Sub cmdDiagnostics_Click()
SendCommand XMTPT_SEND_DIAGNOSTIC_DATA
End Sub
Private Function GetMcaFileCfg() As String
Dim bDelay As Boolean
s.HwCfgDP5 = ""
's.DppConfig.bSpectrumCfg = True
s.DppConfig.CfgReadBack = True
SendCommand XMTPT_FULL_READ_CONFIG_PACKET
bDelay = msDelay(50)
GetMcaFileCfg = s.HwCfgDP5
End Function
Private Sub cmdSaveSpectrum_Click()
Dim strFilename As String
Dim strCfg As String
Dim strTag As String
Dim strDescription As String
Dim dateStart As Date
Dim bHaveFilename As Boolean
bHaveFilename = GetSpectrumFilename(strFilename, CommonDialog1)
If (bHaveFilename) Then
If (IsDate(datStartAcqTime)) Then
dateStart = datStartAcqTime
Else
dateStart = Now
End If
Set s.Dp5CmdList = New Collection
MakeDp5CmdList s.Dp5CmdList
strTag = Trim(txtSpectrumTag)
strDescription = Trim(txtSpectrumDescription)
strCfg = GetMcaFileCfg()
'MsgBox strCfg
strCfg = ProcessSpectrumCfgForFile(strCfg, s.Dp5CmdList)
Call SaveSpectrum(strFilename, SPECTRUM, strCfg, STATUS, strTag, strDescription, dateStart)
End If
End Sub
Private Sub cmdSingleUpdate_Click()
Timer2.Enabled = False
cmdSingleUpdate.Enabled = False
If (chkDeltaMode = vbChecked) Then
SendCommand XMTPT_SEND_CLEAR_SPECTRUM_STATUS
Else
SendCommand XMTPT_SEND_SPECTRUM_STATUS
End If
cmdSingleUpdate.Enabled = True
End Sub
Public Sub cmdRS232ComPortTest()
'SendCommand XMTPT_SEND_STATUS
SendCommand XMTPT_SEND_NETFINDER_PACKET
End Sub
Public Sub cmdUSBDeviceTest()
SendCommand XMTPT_SEND_NETFINDER_PACKET
End Sub
Private Sub cmdSelectCommunications_Click()
Dim bStatusDone As Boolean
On Error Resume Next
cmdSelectCommunications.Enabled = False
'start/clear netfinder search when form loaded
NewNetfinderRequest = True
NetfinderUnit = 0
InitAllEntries DppEntries
rtbStatus.Visible = False
Load frmDP5_Connect
frmDP5_Connect.Show vbModal
If (Not frmDP5_Connect.bDoNotConnect) Then
If (s.isDppConnected) Then
SendCommand XMTPT_SEND_STATUS
bStatusDone = msDelay(500)
End If
If (lblSelectCommunications.Caption <> "Select Communications") Then
EnableDppCmdControls True
If (s.CurrentInterface = USB) Then
rtbStatus.Visible = True
End If
Else
EnableDppCmdControls False
End If
Else
lblSelectCommunications.Caption = "Select Communications"
s.isDppConnected = False
EnableDppCmdControls False
End If
cmdSelectCommunications.Enabled = True
End Sub
Private Sub cmdStopAcquisition_Click()
SendCommand XMTPT_DISABLE_MCA_MCS
End Sub
Private Sub cmdWriteMiscData_Click()
SendCommandData XMTPT_WRITE_512_BYTE_MISC_DATA, txtMiscData.Text
End Sub
Private Sub Form_Initialize()
On Error Resume Next
LoadLibrary "shell32.dll"
InitCommonControls
On Error GoTo 0
End Sub
Private Sub Form_Load()
Dim bHaveComPort As Boolean
CurrentUSBDevice = 1
NumUSBDevices = 0
InitSCA
LoadApplicationSettings Me
' CloseDeviceHandle DppWinUSB
' If USBDeviceNotificationHandle <> 0 Then
' Call UnregisterDeviceNotification(USBDeviceNotificationHandle) 'Stop receiving notification messages.
' End If
' USBDeviceConnected = False
InitAllEntries NfPktEntries
s.DppConfig.CfgReadBack = False
s.DppConfig.DisplayCfg = False
s.DppConfig.ScaReadBack = False
s.DppConfig.ScaReadReady = False
s.DppConfig.DisplaySCA = False
Set s.Dp5CmdList = New Collection
MakeDp5CmdList s.Dp5CmdList
s.HwCfgDP5 = ""
EnableDppCmdControls False
RS232ComPortTest = False
USBDeviceTest = False
lblVersion.BorderStyle = vbBSNone
Set pnlStatus = StatusBar1.Panels(1) 'set the status panel to the status bar panel
Whitespace$ = Chr$(0) + Chr$(9) + Chr$(10) + Chr$(11) + Chr$(12) + Chr$(13) + Chr$(32)
'frmDP5_Connect.cboRS232Comm.ListIndex = 0
If (DppComm.PortOpen) Then DppComm.PortOpen = False
If (s.CurrentInterface = RS232) Then
bHaveComPort = isAnyComPort()
If (bHaveComPort) Then
If (isComPortAvailable(DppComm.CommPort)) Then
'ready to open port
Else 'open an existing port
DppComm.CommPort = GetFirstComPort()
End If
DppComm.PortOpen = True
DppComm.InputMode = comInputModeBinary
DppComm.RThreshold = 8 ' Call OnComm after header is received
s.CurrentInterface = RS232
Else
s.CurrentInterface = USB
End If
End If
PlotColor = &HFF&
USBDevicePathName = ""
USBDeviceConnected = False
USBDeviceNotificationHandle = 0
pnlStatus = "DP5 test application ready..."
lblVersion.Caption = "DP5 SDK vbDP5 v" + Right(str(App.Major), 1) + "." + Right(str(App.Minor), 2)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveApplicationSettings Me
CloseDeviceHandle DppWinUSB
If USBDeviceNotificationHandle <> 0 Then
Call UnregisterDeviceNotification(USBDeviceNotificationHandle) 'Stop receiving notification messages.
End If
'pass control back to previous windows
SetWindowLong Me.hwnd, GWL_WNDPROC, glngPrevWndProc
DppWinsock.Close
CloseProgram
End Sub
Public Sub CloseProgram()
Dim frm As Form
For Each frm In Forms
Unload frm
Next frm
End Sub
Private Sub DppComm_OnComm()
Dim PIN_LEN As Integer
Dim X As Long
Dim Temp() As Byte
Dim L As Integer
Select Case DppComm.CommEvent
Case comEventFrame ' framing error
CommError = True
Case comEventOverrun ' overrun error
CommError = True
Case comEventRxOver ' receive buffer overflow
CommError = True
Case comEvReceive ' at least RThreshold characters are in the receive buffer
If RS232HeaderReceived Then
DppComm.InputLen = 0 ' read the whole buffer - should be the rest of the transfer
Temp() = DppComm.Input
If ((UBound(Temp) + 8) > UBound(PacketIn)) Then
'the buffer is bigger than storage, this indicates an error
Exit Sub
End If
DppComm.RThreshold = 8
For X = 0 To UBound(Temp(), 1)
PacketIn(X + 8) = Temp(X) ' PacketIn should already have the header in it
Next X
RS232HeaderReceived = False
DppState.ReqProcess = ParsePacket(PacketIn(), PIN)
ParsePacketEx PIN, DppState
Else
DppComm.InputLen = 8 ' only read the first 8 bytes
Temp() = DppComm.Input
For X = 0 To 7
PacketIn(X) = Temp(X)
Next X
If (PacketIn(0) = SYNC1_) And (PacketIn(1) = SYNC2_) Then
PIN_LEN = (PacketIn(4) * 256) + PacketIn(5) ' temporarily save the length field
If PIN_LEN > 0 Then
DppComm.RThreshold = PIN_LEN ' additional bytes to read = data length
RS232HeaderReceived = True
Else
DppState.ReqProcess = ParsePacket(PacketIn(), PIN)
ParsePacketEx PIN, DppState
End If
Else
DppComm.InputLen = 0 ' read the whole buffer
Temp() = DppComm.Input ' flush the buffer by emptying it
End If
End If
End Select
End Sub
'1440
Private Function RightJustify(strParam As String, sTxtWidth As Single)
Dim sTxtLenSp As Single
Dim sTxtLen As Single
Dim sTxtFill As Single
Dim strText As String
Dim lSpace As Long
sTxtLen = TextWidth(strParam)
If (sTxtLen < sTxtWidth) Then
strText = strParam
sTxtLenSp = TextWidth(" ")
sTxtFill = sTxtWidth - sTxtLen
lSpace = sTxtFill \ sTxtLenSp
strText = Space(lSpace) & strText
RightJustify = strText
Else
RightJustify = strParam
End If
End Function
'can also use TextWidth to format display
Private Sub UpdateStatusDisplay(STATUS As Stat)
Dim H, m, s
Dim strStatus As String
Dim strParam As String
Dim strValue As String
Dim sTxtWidth As Single
strStatus = ""
sTxtWidth = lblStatusDisplay(0).Width - TextWidth(" ")
strParam = strParam & RightJustify("Device Type: ", sTxtWidth) & vbNewLine
strValue = STATUS.strDeviceID
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("Serial Number: ", sTxtWidth) & vbNewLine
strValue = CStr(STATUS.SerialNumber)
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("Firmware: ", sTxtWidth) & vbNewLine
strValue = "v" + Format(Fix(STATUS.Firmware / 16), "0") + "." + Format(STATUS.Firmware And 15, "00")
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("FPGA: ", sTxtWidth) & vbNewLine
strValue = "v" + Format(Fix(STATUS.FPGA / 16), "0") + "." + Format(STATUS.FPGA And 15, "00")
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("Fast Count: ", sTxtWidth) & vbNewLine
strValue = Format(STATUS.FastCount, "#,###,###,##0"),
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("SlowCount: ", sTxtWidth) & vbNewLine
strValue = Format(STATUS.SlowCount, "#,###,###,##0"),
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("Accumulation Time: ", sTxtWidth) & vbNewLine
If STATUS.AccumulationTime < 1000 Then
strValue = Format(STATUS.AccumulationTime, "##0.000s")
Else
H = Fix(STATUS.AccumulationTime / 3600)
m = Fix((STATUS.AccumulationTime - (H * 3600)) / 60)
s = STATUS.AccumulationTime - H * 3600 - m * 60
strValue = Format(H, "###0h ") + Format(m, "#0m ") + Format(s, "#0.0s")
End If
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("PC5 Serial Number: ", sTxtWidth) & vbNewLine
If STATUS.PC5_PRESENT Then
strValue = str(STATUS.PC5_SerialNumber)
Else
strValue = "N/A"
End If
strStatus = strStatus & strValue & vbNewLine
If (STATUS.DEVICE_ID <> dppDP5G) Then
strParam = strParam & RightJustify("Detector HV: ", sTxtWidth) & vbNewLine
strValue = Format(STATUS.HV, "###0V") ' round to nearest volt
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("Detector Temp: ", sTxtWidth) & vbNewLine
strValue = Format(STATUS.DET_TEMP, "##0�C") ' round to nearest degree
strStatus = strStatus & strValue & vbNewLine
End If
strParam = strParam & RightJustify("DP5 Temp: ", sTxtWidth) & vbNewLine
strValue = str(STATUS.DP5_TEMP) & "�C"
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("G.P. Counter: ", sTxtWidth) & vbNewLine
strValue = str(STATUS.GP_COUNTER)
strStatus = strStatus & strValue & vbNewLine
If (STATUS.DEVICE_ID = dppDP5) Then
strParam = strParam & RightJustify("PC5 Present: ", sTxtWidth) & vbNewLine
strValue = str(STATUS.PC5_PRESENT)
strStatus = strStatus & strValue & vbNewLine
If STATUS.PC5_PRESENT Then
strParam = strParam & RightJustify("PC5 HV Polarity: ", sTxtWidth) & vbNewLine
If (STATUS.PC5_HV_POL) Then
strValue = "Positive"
Else
strValue = "Negative"
End If
strStatus = strStatus & strValue & vbNewLine
strParam = strParam & RightJustify("PC5 Preamp: ", sTxtWidth) & vbNewLine
If (STATUS.PC5_8_5V) Then
strValue = "+/-8.5V"
Else
strValue = "+/-5V"
End If
strStatus = strStatus & strValue & vbNewLine
End If
strParam = strParam & RightJustify("DP5 Temp: ", sTxtWidth) & vbNewLine
strValue = str(STATUS.DP5_TEMP) & "�C"
strStatus = strStatus & strValue & vbNewLine
ElseIf (STATUS.DEVICE_ID = dppDP5G) Then
strParam = strParam & RightJustify("PC5G Present: ", sTxtWidth) & vbNewLine
strValue = str(STATUS.PC5_PRESENT)
strStatus = strStatus & strValue & vbNewLine
ElseIf (STATUS.DEVICE_ID = dppPX5) Then
' STATUS.DPP_options = 1
' STATUS.HPGe_HV_INH = True
' STATUS.HPGe_HV_INH_POL = True
If STATUS.DPP_options > 0 Then
'===============PX5 Options==================
strParam = strParam & RightJustify("PX5 Options: ", sTxtWidth) & vbNewLine
If (STATUS.DPP_options = 1) Then
strValue = "HPGe HVPS"
Else
strValue = "Unknown"
End If
strStatus = strStatus & strValue & vbNewLine
'===============HPGe HVPS HV Status==================
strParam = strParam & RightJustify("HPGe HV: ", sTxtWidth) & vbNewLine
If STATUS.HPGe_HV_INH Then
strValue = "not inhibited"
Else
strValue = "inhibited"
End If
strStatus = strStatus & strValue & vbNewLine
'===============HPGe HVPS Inhibit Status==================
strParam = strParam & RightJustify("INH Polarity: ", sTxtWidth) & vbNewLine
If STATUS.HPGe_HV_INH_POL Then
strValue = "high"
Else
strValue = "low"
End If
strStatus = strStatus & strValue & vbNewLine
Else
strParam = strParam & RightJustify("PX5 Options: ", sTxtWidth) & vbNewLine
strValue = "No Options Installed"
strStatus = strStatus & strValue & vbNewLine
End If
End If
If STATUS.ReBootFlag Then
strStatus = strStatus & "***Reboot detected***" & vbNewLine
End If
lblStatusDisplay(0) = strParam
lblStatusDisplay(1) = strStatus
End Sub
Private Sub picScope_DblClick()
picScope.Cls
End Sub
Private Sub rtbStatus_Click()
rtbStatus.Text = ""
End Sub
Private Sub Timer1_Timer()
DppComm.RThreshold = 8 ' 8 byte ACK packet expected
Timer1.Enabled = False
End Sub
Private Sub Timer2_Timer()
If (chkDeltaMode = vbChecked) Then
SendCommand XMTPT_SEND_CLEAR_SPECTRUM_STATUS
Else
SendCommand XMTPT_SEND_SPECTRUM_STATUS
End If
End Sub
Private Sub Timer3_Timer()
Timeout_flag = True
Netfinder_active = False
Timer3.Enabled = False ' is this right?
End Sub
'------------------------------------------------------------------------------
' Called when a WM_DEVICECHANGE message has arrived,
' indicating that a device has been attached or removed.
'------------------------------------------------------------------------------
' parameter "m" A public message with information about the device.
Public Sub OnDeviceChange(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim m As Message
m.hwnd = hwnd
m.Msg = Msg
m.wParam = wParam
m.lParam = lParam
On Error GoTo OnDeviceChangeErr
'Debug.Print " hWnd = " & hWnd & " Msg = " & Msg & " wParam = " & wParam & " lParam = " & lParam
If (m.wParam = DBT_DEVICEARRIVAL) Then
' If WParam contains DBT_DEVICEARRIVAL, a device has been attached.
' Find out if it's the device we're communicating with.
If DeviceNameMatch(m, USBDevicePathName) Then
UpdateStatusList rtbStatus, "Device attached.", vbBlue
UpdateStatusList rtbStatus, "Reconnecting to device...", RGB(128, 0, 128)
UpdateStatusList frmDP5_Connect.rtbStatus, "Device attached.", vbBlue
UpdateStatusList frmDP5_Connect.rtbStatus, "Reconnecting to device...", RGB(128, 0, 128)
frmDP5_Connect.cmdFindDevice_Click
USB_Default_Timeout = True ' flag that default timeout is in use
End If
ElseIf (m.wParam = DBT_DEVICEREMOVECOMPLETE) Then
' If WParam contains DBT_DEVICEREMOVAL, a device has been removed.
' Find out if it's the device we're communicating with.
If DeviceNameMatch(m, USBDevicePathName) Then
UpdateStatusList rtbStatus, "Device removed.", vbRed
UpdateStatusList frmDP5_Connect.rtbStatus, "Device removed.", vbRed
' Set DeviceConnected False so on the next data-transfer attempt,
' OpenDevice() will be called to look for the device
' and get a new handle.
USBDeviceConnected = False
End If
End If
Exit Sub
OnDeviceChangeErr:
Call ProcessError(Err)
End Sub
Public Sub RemCallParsePacket(ByRef PacketIn() As Byte)
DppState.ReqProcess = ParsePacket(PacketIn(), PIN)
ParsePacketEx PIN, DppState
End Sub
Private Sub ParsePacketEx(PIN As Packet_In, DppState As DppStateType)
Select Case DppState.ReqProcess
Case preqProcessStatus
ProcessStatusEx PIN, DppState
Case preqProcessSpectrum
ProcessSpectrumEx PIN, DppState
Case preqProcessScopeData
ProcessScopeDataEx PIN, DppState
Case preqProcessTextData
ProcessTextDataEx PIN, DppState
'====================================================================
' Case preqProcessScopeDataOverFlow
' ProcessScopeDataEx PIN, DppState
' 'ProcessScopeDataOverFlowEx PIN, DppState
' Case preqProcessInetSettings
' ProcessInetSettingsEx PIN, DppState
Case preqProcessDiagData
ProcessDiagDataEx PIN, DppState
' Case preqProcessHwDesc
' ProcessHwDescEx PIN, DppState
Case preqProcessCfgRead
ProcessCfgReadEx PIN, DppState
Case preqProcessNetFindRead
ProcessNetFindReadEx PIN, DppState
' Case preqProcessSCAData
' ProcessSCADataEx PIN, DppState
'====================================================================
Case preqProcessAck
ProcessAck PIN.PID2
Case preqProcessError
DisplayError PIN, DppState
Case Else
'do nothing
End Select
End Sub
Private Sub ProcessNetFindReadEx(PIN As Packet_In, DppState As DppStateType)
Dim Buffer(4095) As Byte '0-4095, 4096 bytes
Dim strDisplay As String
Dim idxNfInfo As Integer
For idxNfInfo = 0 To (PIN.LEN - 1)
Buffer(idxNfInfo) = PIN.DATA(idxNfInfo)
Next
InitEntry NfPktEntries(DppState.Interface)
AddEntry NfPktEntries(DppState.Interface), Buffer, 0
If (RS232ComPortTest) Then
RS232ComPortTest = False
strDisplay = EntryToStrRS232(NfPktEntries(DppState.Interface), "RS232 - COM" & DppComm.CommPort)
'MsgBox NfPktEntries(DppState.Interface).str_display
frmDP5_Connect.txtRS232Status = ""
frmDP5_Connect.txtRS232Status = strDisplay
isDppFound(RS232) = True
frmDP5_Connect.lblDppFound(RS232).Visible = True
pnlStatus = "RS232 NetFind Found" + vbCrLf
ElseIf (USBDeviceTest) Then
USBDeviceTest = False
strDisplay = EntryToStrUSB(NfPktEntries(DppState.Interface), "USB Device " & CurrentUSBDevice & " of " & NumUSBDevices)
frmDP5_Connect.rtbStatus = ""
frmDP5_Connect.rtbStatus = strDisplay
isDppFound(USB) = True
frmDP5_Connect.lblDppFound(USB).Visible = True
pnlStatus = "USB NetFind Found" + vbCrLf
End If
End Sub
Private Sub ProcessCfgReadEx(PIN As Packet_In, DppState As DppStateType)
Dim cstrRawCfgIn As String
'Dim cstrCh As String
Dim cstrCmdData As String
Dim cstrCmdD As String
Dim strCfg As String
Dim cstrDisplayCfgOut As String
Dim idxCfg As Long
Dim varCmd As Variant
Dim strHwCfgDP5 As String
cstrRawCfgIn = ""
strHwCfgDP5 = ""
' =============================
' === Create Raw Configuration Buffer From Hardware ===
For idxCfg = 0 To PIN.LEN - 1
cstrRawCfgIn = cstrRawCfgIn + Chr(PIN.DATA(idxCfg))
strHwCfgDP5 = strHwCfgDP5 + Chr(PIN.DATA(idxCfg))
If (PIN.DATA(idxCfg) = Asc(";")) Then
cstrRawCfgIn = cstrRawCfgIn + vbNewLine
End If
Next
'MsgBox cstrRawCfgIn
' =============================
If (s.DppConfig.DisplayCfg) Then
s.DppConfig.DisplayCfg = False
strCfg = cstrRawCfgIn
cstrDisplayCfgOut = cstrRawCfgIn
For Each varCmd In s.Dp5CmdList
cstrCmdD = CStr(varCmd)
If (Len(cstrCmdD) > 0) Then
cstrDisplayCfgOut = ReplaceCmdDesc(cstrCmdD, cstrDisplayCfgOut)
End If
Next
' CopyDp5CfgToClip(strCfg,cstrDisplayCfgOut);
frmDppConfigDisplay.m_strMessage = cstrDisplayCfgOut
'frmDppConfigDisplay.m_strMessage = cstrRawCfgIn
frmDppConfigDisplay.m_strDelimiter = ";"
Load frmDppConfigDisplay
frmDppConfigDisplay.m_strTitle = "DPP Configuration"
frmDppConfigDisplay.Show vbModal
'Exit Sub
ElseIf (s.DppConfig.CfgReadBack) Then
s.DppConfig.CfgReadBack = False
s.HwCfgDP5 = strHwCfgDP5
s.cstrRawCfgIn = cstrRawCfgIn
s.HwCfgReady = True
ElseIf (s.DppConfig.ScaReadBack) Then
s.DppConfig.ScaReadBack = False
s.HwScaCfgDP5 = strHwCfgDP5
s.cstrRawScaCfgIn = cstrRawCfgIn
s.HwScaCfgReady = True
If (s.DppConfig.DisplaySCA) Then
SCACfgParser sca, s.HwScaCfgDP5
MsgBox SCAStringALLDisplay(sca)
'MsgBox s.HwScaCfgDP5 & vbNewLine & "++++" & vbNewLine & s.cstrRawScaCfgIn & vbNewLine
End If
' ElseIf (s.DppConfig.bSpectrumCfg) Then
' s.DppConfig.bSpectrumCfg = False
' cstrDisplayCfgOut = cstrRawCfgIn
' For Each varCmd In s.Dp5CmdList
' cstrCmdD = CStr(varCmd)
' If (Len(cstrCmdD) > 0) Then
' cstrDisplayCfgOut = AppendCmdDesc(cstrCmdD, cstrDisplayCfgOut)
' End If
' Next
' s.HwCfgDP5 = cstrDisplayCfgOut
' cstrRawCfgIn = cstrRawCfgIn
' s.HwCfgReady = True
'MsgBox strHwCfgDP5 & vbNewLine & "++++" & vbNewLine & cstrRawCfgIn & vbNewLine
'MsgBox s.HwScaCfgDP5 & vbNewLine & "++++" & vbNewLine & s.cstrRawScaCfgIn & vbNewLine
'WriteTextFile App.Path & "\scacfg.hm", s.HwScaCfgDP5
'WriteTextFile App.Path & "\scacfg.hm", s.cstrRawScaCfgIn
s.DppConfig.DisplaySCA = False
s.DppConfig.ScaReadReady = True
End If
s.DppConfig.DisplayCfg = False
s.DppConfig.CfgReadBack = False
s.DppConfig.ScaReadBack = False
s.DppConfig.DisplaySCA = False
' cstrCmdData = GetCmdData("MCAS", cstrRawCfgIn) ' mca mode
' If (Not cstrCmdData.CompareNoCase("MCS")) Then
' s.profile->m_nAcquireMode = ACQ_MODE_MCS
' Else
' s.profile->m_nAcquireMode = ACQ_MODE_MCA
' End If
' If (S.DppConfig.isDeltaMode) Then
' s.profile->m_nAcquireMode = ACQ_MODE_DELTA
' End If
' cstrCmdData = GetCmdData("MCAC", cstrRawCfgIn) ' channels
' if ((atoi(cstrCmdData) > 0) && (atoi(cstrCmdData) <= 8192)) {
' s.DppConfig.mcaCH = atoi(cstrCmdData);
' else
' s.DppConfig.mcaCH = 1024;
' end if
'
' cstrCmdData = GetCmdData("THSL",cstrRawCfgIn); ' LLD thresh
' s.DppConfig.SlowThresholdPct = atof(cstrCmdData);
'
' cstrCmdData = GetCmdData("THFA",cstrRawCfgIn); ' fast thresh
' s.DppConfig.FastChThreshold = atoi(cstrCmdData);
'
' cstrCmdData = GetCmdData("TPEA",cstrRawCfgIn); ' peak time
' s.DppConfig.RiseUS = atof(cstrCmdData);
'
' cstrCmdData = GetCmdData("GAIN",cstrRawCfgIn); ' gain
' s.DppConfig.cstrGainDisplayValue = cstrCmdData + "x";
'
' s.DppConfig.strPresetCmd = "";
' s.DppConfig.strPresetVal = "";
'
' cstrCmdData = GetCmdData("PREC",cstrRawCfgIn); 'preset count
' s.DppConfig.PresetCount = atoi(cstrCmdData);
' if (s.DppConfig.PresetCount > 0) {
' if (s.DppConfig.strPresetCmd.GetLength() > 0) { s.DppConfig.strPresetCmd += "/"; }
' if (s.DppConfig.strPresetVal.GetLength() > 0) { s.DppConfig.strPresetVal += "/"; }
' s.DppConfig.strPresetCmd += "Cnt";
' s.DppConfig.strPresetVal += cstrCmdData;
' end if
'
' cstrCmdData = GetCmdData("PRET",cstrRawCfgIn); 'preset actual time
' s.DppConfig.PresetAcq = atof(cstrCmdData);
' if (s.DppConfig.PresetAcq > 0) {
' if (s.DppConfig.strPresetCmd.GetLength() > 0) { s.DppConfig.strPresetCmd += "/"; }
' if (s.DppConfig.strPresetVal.GetLength() > 0) { s.DppConfig.strPresetVal += "/"; }
' s.DppConfig.strPresetCmd += "Acq";
' s.DppConfig.strPresetVal += cstrCmdData;
' }
'
' cstrCmdData = GetCmdData("PRER",cstrRawCfgIn); ' preset real time
' s.DppConfig.PresetRt = atof(cstrCmdData);
' if (s.DppConfig.PresetRt > 0) {
' if (s.DppConfig.strPresetCmd.GetLength() > 0) { s.DppConfig.strPresetCmd += "/"; }
' if (s.DppConfig.strPresetVal.GetLength() > 0) { s.DppConfig.strPresetVal += "/"; }
' s.DppConfig.strPresetCmd += "Real";
' s.DppConfig.strPresetVal += cstrCmdData;
' end if
'
' if (s.DppConfig.strPresetCmd.GetLength() = 0) {
' s.DppConfig.strPresetCmd += "None";
' end if
' if (s.DppConfig.strPresetVal.GetLength() = 0) {
' 's.DppConfig.strPresetVal += "";
' end if
'
' cstrCmdData = GetCmdData("CLCK",cstrRawCfgIn); ' fpga clock mode
' if (atoi(cstrCmdData) = 80) {
' s.DppConfig.b80MHzMode = TRUE;
' else
' s.DppConfig.b80MHzMode = FALSE;
' end if
'
' ' DP5 oscilloscope support
' cstrCmdData = GetCmdData("INOF",cstrRawCfgIn); ' osc. Input offset
' s.DppConfig.cstrInputOffset = cstrCmdData;
'
' cstrCmdData = GetCmdData("DACO",cstrRawCfgIn); ' osc. DAC output
' s.DppConfig.cstrAnalogOut = cstrCmdData;
'
' cstrCmdData = GetCmdData("DACF",cstrRawCfgIn); ' osc. DAC offset
' s.DppConfig.cstrOutputOffset = cstrCmdData;
'
' cstrCmdData = GetCmdData("AUO1",cstrRawCfgIn); ' osc. AUX_OUT1
' s.DppConfig.cstrTriggerSource = cstrCmdData;
'
' cstrCmdData = GetCmdData("SCOE",cstrRawCfgIn); ' osc. Scope trigger edge
' s.DppConfig.cstrTriggerSlope = cstrCmdData;
'
' cstrCmdData = GetCmdData("SCOT",cstrRawCfgIn); ' osc. Scope trigger position
' s.DppConfig.cstrTriggerPosition = cstrCmdData;
'
' cstrCmdData = GetCmdData("SCOG",cstrRawCfgIn); ' osc. Scope gain
' s.DppConfig.cstrScopeGain = cstrCmdData;
'
' cstrCmdData = GetCmdData("MCAS",cstrRawCfgIn); ' Acq Mode
' s.DppConfig.AcqMode = 0;
' s.DppConfig.cstrMcaMode = "MCA";
' if (cstrCmdData = "NORM") {
' s.DppConfig.cstrMcaMode = "MCA";
' Elseif (cstrCmdData = "MCS") {
' s.DppConfig.cstrMcaMode = "MCS";
' s.DppConfig.AcqMode = 1;
' Elseif (cstrCmdData.GetLength() > 0) {
' s.DppConfig.cstrMcaMode = cstrCmdData;
' }
' s.DppConfig.UpdateScopeCfg = TRUE;
End Sub
Private Sub DisplayError(PIN As Packet_In, DppState As DppStateType)
pnlStatus = PID2_TextToString("Received packet", CByte(PIN.STATUS))
' bad PID, assigned by ParsePacket
If (PIN.STATUS = PID2_ACK_PID_ERROR) Then
pnlStatus = "Received packet: PID1=0x" + FmtHex(PIN.PID1, 2) + ", PID2=0x" + FmtHex(PIN.PID2, 2) + ", LEN=" + str(PIN.LEN) + vbCrLf,
End If
End Sub
Private Sub ProcessAck(PID2 As Byte)
pnlStatus = PID2_TextToString("ACK", PID2)
End Sub
Private Sub ProcessStatusEx(PIN As Packet_In, DppState As DppStateType)
Dim X As Integer
For X = 0 To 63
STATUS.RAW(X) = PIN.DATA(X)
Next X
Call Process_Status(STATUS)
RequestScopeData STATUS.SCOPE_DR
UpdateStatusDisplay STATUS
' If (RS232ComPortTest) Then
' frmDP5_Connect.txtRS232Status = ""
' RS232ComPortTest = False
' frmDP5_Connect.txtRS232Status = ShowStatusValueStrings(STATUS)
' If (STATUS.SerialNumber > 0) Then
' isDppFound(RS232) = True
' frmDP5_Connect.lblDppFound(RS232).Visible = True
' Else
' isDppFound(RS232) = False
' frmDP5_Connect.lblDppFound(RS232).Visible = False
' End If
' End If
pnlStatus = "Status Received" + vbCrLf
End Sub
Private Sub ProcessSpectrumEx(PIN As Packet_In, DppState As DppStateType)
Dim X As Integer
SPECTRUM.Channels = 256 * (2 ^ (((PIN.PID2 - 1) And 14) \ 2))
ReDim SPECTRUM.DATA(SPECTRUM.Channels)
For X = 0 To SPECTRUM.Channels - 1
SPECTRUM.DATA(X) = CLng(PIN.DATA(X * 3)) + CLng(PIN.DATA(X * 3 + 1)) * 256& + CLng(PIN.DATA(X * 3 + 2)) * 65536
Next X
If (PIN.PID2 And 1) = 0 Then ' spectrum + status
For X = 0 To 63
STATUS.RAW(X) = PIN.DATA(X + SPECTRUM.Channels * 3)
Next X
Call Process_Status(STATUS)
RequestScopeData STATUS.SCOPE_DR
End If
Call Plot_Spectrum(picMCAPlot, SPECTRUM, optScaleType(0).Value, optPlotType(1).Value)
cmdSaveSpectrum.Enabled = True
UpdateStatusDisplay STATUS
End Sub
Private Sub ProcessScopeDataEx(PIN As Packet_In, DppState As DppStateType)
Dim X As Integer
For X = 0 To 2047
Scope(X) = PIN.DATA(X)
Next X
'Scope_Packet_Received = True
Call Plot_Scope(picScope, Scope, PlotColor)
ArmScope
End Sub
Private Sub ProcessTextDataEx(PIN As Packet_In, DppState As DppStateType)
Dim X As Integer
txtMiscData.Text = ""
For X = 0 To 511
MiscData(X) = PIN.DATA(X)
txtMiscData.Text = txtMiscData.Text + Chr(MiscData(X))
Next X
End Sub
Private Sub ProcessInetSettingsEx(PIN As Packet_In, DppState As DppStateType)
''''' Ethernet settings
'''' If PIN.DATA(0) = &HFF Then
'''' btnIPDynamic.Value = True
'''' Else
'''' btnIPStatic.Value = True
'''' End If
''''
'''' For X = 0 To 11
'''' txtIP(X).Text = Trim(Str(PIN.DATA(X + 1)))
'''' Next X
''''
'''' ' Note: port isn't supported yet, but it's at PIN.DATA(17-18)
'''' txtMAC.Text = ""
'''' For X = 0 To 5
'''' 'txtMAC.Text = txtMAC.Text + H$(PIN.DATA(17 + X), 2)
'''' txtMAC.Text = txtMAC.Text + H$(PIN.DATA(19 + X), 2)
'''' If X < 5 Then
'''' txtMAC.Text = txtMAC.Text + ":"
'''' End If
'''' Next X
''' Dim X As Integer
''' For X = 0 To 2047
''' Scope(X) = PIN.DATA(X)
''' Next X
''' 'Scope_Packet_Received = True
''' Call Plot_Scope(picScope, Scope, PlotColor)
''' ArmScope
End Sub
Private Sub ProcessDiagDataEx(PIN As Packet_In, DppState As DppStateType)
Dim dd As DiagDataType
Dim strDiag As String
Call Process_Diagnostics(PIN, dd)
strDiag = DiagnosticsToString(dd)
txtRawStatus = strDiag
'''' Dim X As Integer
'''' For X = 0 To 2047
'''' Scope(X) = PIN.DATA(X)
'''' Next X
'''' 'Scope_Packet_Received = True
'''' Call Plot_Scope(picScope, Scope, PlotColor)
'''' ArmScope
End Sub
Private Sub ProcessSCADataEx(PIN As Packet_In, DppState As DppStateType)
'ElseIf ((PIN.PID1 = PID1_RCV_SCA) And (PIN.PID2 = RCVPT_SCA)) Then 'sca packet
'ParsePacket = preqProcessSCAData
' Case &H83 ' SCA packet
' If (PIN.PID2 = 1) Then
' For X = 0 To 15
' sca& = PIN.DATA(X * 4) + PIN.DATA(X * 4 + 1) * 256& + PIN.DATA(X * 4 + 2) * 65536 + PIN.DATA(X * 4 + 3) * 16777216
' txtSCACount(X).Text = Str(sca&)
' Next X
' End If
'Call Process_Diagnostics
'''' Dim X As Integer
'''' For X = 0 To 2047
'''' Scope(X) = PIN.DATA(X)
'''' Next X
'''' 'Scope_Packet_Received = True
'''' Call Plot_Scope(picScope, Scope, PlotColor)
'''' ArmScope
End Sub
Private Sub ArmScope()
If chkAutoRearm.Value = vbChecked Then SendCommand XMTPT_ARM_DIGITAL_OSCILLOSCOPE 'Call btnArmTrigger_Click
End Sub
Private Sub RequestScopeData(ScopeDataReady As Boolean)
If ScopeDataReady Then SendCommand XMTPT_SEND_SCOPE_DATA
End Sub
Public Sub SendCommand(XmtCmd As TRANSMIT_PACKET_TYPE)
Dim HaveBuffer As Boolean
Dim SentPkt As Boolean
HaveBuffer = DP5_CMD(BufferOUT, XmtCmd)
If (HaveBuffer) Then
Select Case s.CurrentInterface
Case RS232
SentPkt = SendPacketRS232(DppComm, BufferOUT, PacketIn())
Case USB
SentPkt = SendPacketUSB(DppWinUSB, BufferOUT, PacketIn())
If (s.CurrentInterface = USB) Then
If (SentPkt) Then
RemCallParsePacket PacketIn()
Else
Timer2.Enabled = False
End If
End If
Case ETHERNET
SentPkt = SendPacketInet(DppWinsock, BufferOUT, PacketIn())
End Select
End If
End Sub
Public Sub SendCommandData(XmtCmd As TRANSMIT_PACKET_TYPE, DataOut As Variant)
Dim HaveBuffer As Boolean
Dim SentPkt As Boolean
HaveBuffer = DP5_CMD_Data(BufferOUT, XmtCmd, DataOut)
If (HaveBuffer) Then
Select Case s.CurrentInterface
Case RS232
SentPkt = SendPacketRS232(DppComm, BufferOUT, PacketIn())
Case USB
SentPkt = SendPacketUSB(DppWinUSB, BufferOUT, PacketIn())
If (s.CurrentInterface = USB) Then
If (SentPkt) Then
RemCallParsePacket PacketIn()
Else
Timer2.Enabled = False
End If
End If
Case ETHERNET
SentPkt = SendPacketInet(DppWinsock, BufferOUT, PacketIn())
End Select
End If
End Sub
Private Sub DppWinsock_DataArrival(ByVal bytesTotal As Long)
Dim temp1() As Byte
Dim LEN_temp As Integer
Dim idxDataIn As Long
DppWinsock.GetData temp1()
If Netfinder_active Then
If (temp1(0) = 1) And (Netfinder_Seq = (temp1(2) * 256 + temp1(3))) Then
frmDP5_Connect.txtIP(0).Text = Trim(str(temp1(20)))
frmDP5_Connect.txtIP(1).Text = Trim(str(temp1(21)))
frmDP5_Connect.txtIP(2).Text = Trim(str(temp1(22)))
frmDP5_Connect.txtIP(3).Text = Trim(str(temp1(23)))
rtbStatus = "IP: " & str(temp1(20)) + "." & str(temp1(21)) + "." & str(temp1(22)) + "." & str(temp1(23)) & vbCrLf
Else
rtbStatus = "Bad version or Seq No" + vbCrLf
End If
Netfinder_active = False
Else
For idxDataIn = 0 To UBound(temp1()) '(bytesTotal - 1) - DppWinsock.BytesReceived
PacketIn(idxDataIn + UDP_offset) = temp1(idxDataIn)
Next idxDataIn
UDP_offset = UDP_offset + UBound(temp1()) + 1 ' now UDP_offset = index of next empty location, and total # of bytes rcvd
If DppWinsock.BytesReceived Then ' another packet to get?
DppWinsock.GetData temp1()
For idxDataIn = 0 To UBound(temp1()) '(bytesTotal - 1) - DppWinsock.BytesReceived
PacketIn(idxDataIn + UDP_offset) = temp1(idxDataIn)
Next idxDataIn
UDP_offset = UDP_offset + UBound(temp1()) + 1 ' now UDP_offset = index of next empty location, and total # of bytes rcvd
End If
If ((PacketIn(0) = &HF5) And (PacketIn(1) = &HFA)) Then
LEN_temp = CInt(PacketIn(4)) * 256 + CInt(PacketIn(5)) ' only use LEN field if sync bytes are OK
Else
UDP_offset = 0 ' if sync bytes not OK, restart packet
End If
If ((PacketIn(0) = &HF5) And (PacketIn(1) = &HFA) And (UDP_offset >= (LEN_temp + 8))) Then
DppState.ReqProcess = ParsePacket(PacketIn(), PIN)
ParsePacketEx PIN, DppState
End If
End If
End Sub
Private Sub NetFinderWinSock_DataArrival(ByVal bytesTotal As Long)
Dim idxEntry As Long
Dim NetFinderData() As Byte
Dim MoreNetfinder As Boolean
Dim destPort As Long
NetFinderWinSock.GetData NetFinderData()
destPort = NetFinderWinSock.RemotePort
If NewNetfinderRequest Then
NetfinderUnit = 0
NewNetfinderRequest = False
End If
Do
If (NetfinderUnit >= 4) Then Exit Do
If (NetFinderData(0) = 1) And (Netfinder_Seq = (NetFinderData(2) * 256 + NetFinderData(3))) Then
InitEntry DppEntries(NetfinderUnit)
AddEntry DppEntries(NetfinderUnit), NetFinderData, destPort
frmDP5_Connect.lblUnit(NetfinderUnit) = DppEntries(NetfinderUnit).str_display
frmDP5_Connect.lblUnit(NetfinderUnit).BackColor = AlertEntryToCOLORREF(DppEntries(NetfinderUnit))
frmDP5_Connect.cmdSelectIP(NetfinderUnit).Visible = True
If (SearchIp = DppEntries(NetfinderUnit).SockAddr) Then
isDppFound(ETHERNET) = True
frmDP5_Connect.lblDppFound(ETHERNET).Visible = True
s.CurrentInterface = ETHERNET
frmDP5_Connect.lblIpFound.Caption = IpAddrConvert(SearchIp)
End If
NetfinderUnit = NetfinderUnit + 1
Else
'TextLog txtLog, "Bad version or Seq No" + vbCrLf
End If
If NetFinderWinSock.BytesReceived > 0 Then
NetFinderWinSock.GetData NetFinderData()
MoreNetfinder = True
Else
MoreNetfinder = False
End If
Loop While MoreNetfinder And (NetfinderUnit < 4)
End Sub
Private Sub EnableDppCmdControls(EnableCmd As Boolean)
'---- Communications ----------------------------
'cmdSelectCommunications.Enabled = EnableCmd
'---- Configuration -----------------------------
'cmdEditConfiguration.Enabled = EnableCmd
cmdShowConfiguration.Enabled = EnableCmd
'---- Acquisition -------------------------------
cmdStartAcquisition.Enabled = EnableCmd
cmdStopAcquisition.Enabled = EnableCmd
cmdSingleUpdate.Enabled = EnableCmd
cmdClearData.Enabled = EnableCmd
'cmdColor.Enabled = EnableCmd
'---- MCA Spectrum File -------------------------
cmdSaveSpectrum.Enabled = EnableCmd
'cmdChangeSpectrumSavePath.Enabled = EnableCmd
'---- Digital Oscilloscope ----------------------
cmdArmTrigger.Enabled = EnableCmd
'---- DPP Diagnostic Data -----------------------
cmdDiagnostics.Enabled = EnableCmd
'---- 512-Byte Miscellaneous Data Block ---------
cmdReadMiscData.Enabled = EnableCmd
cmdWriteMiscData.Enabled = EnableCmd
cmdClearMiscData.Enabled = EnableCmd
s.isDppConnected = EnableCmd
End Sub