Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private bFormLoading As Boolean
Private Sub cboControl_Click(Index As Integer)
Dim idxTxt As Long
Dim isVisible As Boolean
If (IsEmpty(varCmdCtrls)) Then Exit Sub
idxTxt = GetTextBoxIndexByTag(varCmdCtrls, cboControl(Index).Tag)
If (idxTxt >= 0) Then
isVisible = ClickTxtComboGroup(cboControl(Index), txtControl(idxTxt))
CboTxtCtrlVis Me, cboControl(Index).Tag, isVisible
End If
'update the fpga clock labels
If (cboControl(Index).Tag = "CLCK") Then cboCLCK_Update Index
If (STATUS.DEVICE_ID = dppMCA8000D) Then
If ("PURE" = cboControl(Index).Tag) Then 'set the MCA8000D PUR Control
SetMCA8000D_PUR_From_ShapingPUR
End If
End If
End Sub
Private Sub cboCLCK_Update(Index As Integer)
Dim cstrClck As String
Dim cstrOldClck As String
Dim lClck As Long
cstrClck = cboControl(Index).Text
lClck = CLng(Val(cstrClck))
If (lClck = 20) Then
b80MHzModeCfg = False
ElseIf (lClck = 80) Then
b80MHzModeCfg = True
End If
lblFPGAClk(1).Visible = False
lblFPGAClk(2).Visible = False
If (b80MHzModeCfg_old <> b80MHzModeCfg) Then
If (s.isDppConnected) Then
lblFPGAClk(1).Visible = True
Else
lblFPGAClk(2).Visible = True
End If
End If
End Sub
Private Sub cboFlatTop_Click()
Dim idxCtrl As Long
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", "TFLA")
txtControl(idxCtrl) = cboFlatTop.Text
End Sub
Private Sub cboInputRange_Click()
'GAIA -> one plus the combobox index (1=1V,2=10V)
'GAIF -> ignored
'---- OR
'GAIN -> 1 or 10 only
SetGainFromInputRangeControl
'MsgBox "cboInputRange_Click"
End Sub
Private Sub cboPUR_MCA8000D_Click()
SetShapingPUR_From_MCA8000D_PUR
'MsgBox "cboPUR_MCA8000D_Click"
End Sub
Private Sub cboRise_Click()
Dim idxCtrl As Long
cboRiseUpdate cboRise, cboFlatTop, b80MHzModeCfg
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", "TPEA")
txtControl(idxCtrl) = cboRise.Text
End Sub
Private Sub chkEnableSCA_Click()
s.SCAEnabled = CBool(chkEnableSCA.Value = vbChecked)
fraSingleChannelAnalyzer.Visible = s.SCAEnabled
If (bFormLoading) Then Exit Sub
If (Not s.isDppConnected) Then Exit Sub
If (s.SCAEnabled) Then
' LoadingCfg = False
' s.HwScaCfgReady = False 'clear cfg ready flag
' s.HwScaCfgDP5 = "" 'clear config readback string
' s.cstrRawScaCfgIn = ""
' TimeExpired = False
' lblPleaseWait.Visible = True
' 'curStart = msTimeStart() 'keep using the old 5sec timer
' s.DppConfig.ScaReadBack = True 'set request config readback flag
' frmDP5.cmdShowSCASettings_Click
' 'frmDP5.SendCommand XMTPT_FULL_READ_CONFIG_PACKET 'request dpp config
' Do 'wait until s.HwCfgReady or timeout
' DoEvents
' curElapsed = msTimeDiff(curStart)
' TimeExpired = msTimeExpired(curStart, 5000) '1000 milliseconds max wait
' Loop Until (TimeExpired Or s.HwScaCfgReady)
' If ((Len(s.HwScaCfgDP5) = 0) Or (Not s.HwScaCfgReady)) Then
' strMsg = ""
' MsgBox "Please try again."
' lblPleaseWait.Visible = False
' Exit Sub
' Else
' MsgBox s.HwScaCfgDP5 & vbNewLine & "++++" & vbNewLine & s.cstrRawScaCfgIn & vbNewLine
' End If
End If
End Sub
Private Sub cmdApply_Click()
'
End Sub
Private Sub BLRQuickSet(cstrMode As String, cstrDown As String, cstrUp As String)
Dim idxCtrl As Long
Dim idxList As Long
Dim cstrVal As String
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", "BLRM")
cstrVal = cstrMode
idxList = FindCboIdxExact(cboControl(idxCtrl), cstrVal)
If (idxList = LB_ERR) Then
idxList = FindCboIdx(cboControl(idxCtrl), cstrVal)
End If
If (idxList = LB_ERR) Then 'not found default to 0
idxList = 0
End If
cboControl(idxCtrl).ListIndex = idxList
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", "BLRD")
If (idxCtrl >= 0) Then txtControl(idxCtrl) = cstrDown
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", "BLRU")
If (idxCtrl >= 0) Then txtControl(idxCtrl) = cstrUp
End Sub
' this function replaces blr quickset 20110504, 20140813 vb version
Private Sub cmdBLRQuickset_Click()
Call BLRQuickSet("1", "3", "0")
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdEnterFineGain_Click()
End Sub
Private Sub cmdFindCmd_Click()
Dim btn As Button
If (Len(strFindTab) = 0) Then Exit Sub
If (Len(strFindCtrl) = 0) Then Exit Sub
If (Len(strFindIdx) = 0) Then Exit Sub
Set btn = Toolbar1.Buttons(strFindTab)
Toolbar1_ButtonClick btn
Controls(strFindCtrl)(strFindIdx).SetFocus
End Sub
Private Sub cmdGainCfToTotal_Click()
End Sub
Private Sub cmdGainTotalToCf_Click()
End Sub
Private Sub cmdHelp_Click()
'
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
'Read a configuration.
Private Sub cmdReadCfg_Click()
Dim strCLCK As String
Dim strTPEA As String
Dim strTFLA As String
Dim strTPFA As String
If (dlgOpen(cmnDlg, dlgTXT_Filter)) Then
strIniFilename = cmnDlg.filename
'=========================
EnableCommandsByDeviceType
'=========================
LoadingCfg = True
varValues = GetDP5ConfigSection(strIniFilename, IniSectionVal, varValComments) 'get saved values
UpdateDP5TextCtrls Me, lstDP5Commands, varCmdCtrls, varValues, varUnitsArray
varConfig = GetDP5ConfigSection(strIniFilename, IniSectionCfg, varComments) 'get config
UpdateDP5Ctrls Me, lstDP5Commands, varCmdCtrls, varConfig, varUnitsArray
'if reading cfg from file, will base all controls on file info
strCLCK = GetValByCmd("CLCK", varConfig)
strTPEA = GetValByCmd("TPEA", varConfig)
strTFLA = GetValByCmd("TFLA", varConfig)
strTPFA = GetValByCmd("TPFA", varConfig)
b80MHzModeCfg = GetFPGAClockMode(strCLCK, strTPEA)
b80MHzModeCfg_old = b80MHzModeCfg
'update TPEA
LoadPeakingValues cboRise, cboFlatTop, b80MHzModeCfg
SetShapingIndex cboRise, strTPEA
cboRiseUpdate cboRise, cboFlatTop, b80MHzModeCfg
SetShapingIndex cboFlatTop, strTFLA
'Set the Fast Channel Threshold
InitFastPeakCombo
SetFastPeakCombo strTPFA
If (b80MHzModeCfg) Then
lblFPGAClk(0) = "80MHz"
b80MHzModeCfg_old = True
Else
lblFPGAClk(0) = "20MHz"
b80MHzModeCfg_old = False
End If
lblFPGAClk(1).Visible = False
lblFPGAClk(2).Visible = False
LoadingCfg = False
EnableCfgControls True
If (s.SCAEnabled) Then
ReadSCACfgFromINI strIniFilename
End If
SetCfgInstructions False ' hide configuration dialog start instructions
Else
'a file was not selected
End If
End Sub
'Purpose: Read String configuration data and comments array from dpp config string.
'Returns INI configuration data array as return value and comments array as parameter.
'Parameter: strConfig hardware configuration string.
'Parameter: varComments INI comment data array.
Public Function GetDP5ConfigString(strConfig As String, ByRef varComments As Variant) As Variant
Dim varConfig As Variant
Dim idxCmd As Long
Dim DppCfg() As HwConfigType
Dim lPos As Long
Dim lCmd As Long
Dim lSep As Long
Dim cfgLen As Long
Dim strHwCfg As String
Dim strItem As String
Dim strData() As String
strHwCfg = strConfig
cfgLen = Len(strHwCfg) 'extract all config data, append comments
If (cfgLen < 7) Then Exit Function 'must be at least CCCC=V; (7 chars long)
idxCmd = -1
Do
lPos = InStr(strHwCfg, ";")
If (lPos > 0) Then
strItem = ""
strItem = Trim(Left(strHwCfg, lPos))
lCmd = Len(strItem)
lSep = InStr(strItem, "=")
If ((lCmd >= 7) And (5 = lSep)) Then 'test for CCCC=V; (7 chars long)
idxCmd = idxCmd + 1 'inc index
ReDim Preserve DppCfg(idxCmd) 'create storage
DppCfg(idxCmd).Command = Left(strItem, 4)
DppCfg(idxCmd).Value = Trim(Mid(strItem, 6))
DppCfg(idxCmd).Comment = GetCmdDesc(DppCfg(idxCmd).Command)
strHwCfg = Mid(strHwCfg, lPos + 1)
Else
strHwCfg = Mid(strHwCfg, lPos + 1) 'skip this command
End If
End If
Loop Until ((lPos = 0) Or (idxCmd > (cfgLen / 5)) Or (Len(strHwCfg) = 0))
ReDim strData(UBound(DppCfg), 1)
For idxCmd = 0 To UBound(DppCfg)
strData(idxCmd, 0) = DppCfg(idxCmd).Command
strData(idxCmd, 1) = DppCfg(idxCmd).Value & " " & DppCfg(idxCmd).Comment
Next
varConfig = GetDP5Commands(strData) 'remove the comments
varComments = GetDP5Comments(strData) 'save the comments
GetDP5ConfigString = varConfig
End Function
Private Sub cmdReadHwCfg_Click()
Dim curStart As Currency 'start time from system time in milliseconds
Dim TimeExpired As Boolean 'time expired flag
Dim curElapsed As Currency 'Elapsed time from start time in milliseconds
Dim varCmd As Variant
Dim cstrDisplayCfgOut As String
Dim strMsg As String
If (Not s.isDppConnected) Then Exit Sub 'exit if no dpp connect
LoadingCfg = False
s.HwCfgReady = False 'clear cfg ready flag
s.HwCfgDP5 = "" 'clear config readback string
s.cstrRawCfgIn = ""
TimeExpired = False
lblPleaseWait.Visible = True
curStart = msTimeStart()
s.DppConfig.CfgReadBack = True 'set request config readback flag
frmDP5.SendCommand XMTPT_FULL_READ_CONFIG_PACKET 'request dpp config
Do 'wait until s.HwCfgReady or timeout
DoEvents
curElapsed = msTimeDiff(curStart)
TimeExpired = msTimeExpired(curStart, 5000) '1000 milliseconds max wait
Loop Until (TimeExpired Or s.HwCfgReady)
'read cfg in s.HwCfgDP5
If ((Len(s.HwCfgDP5) = 0) Or (Not s.HwCfgReady)) Then
strMsg = ""
' If (TimeExpired) Then strMsg = strMsg & "Config Readback Time Expired" & vbNewLine
' If (Len(s.HwCfgDP5) = 0) Then strMsg = strMsg & "No Config Readback Received" & vbNewLine
' If (Not s.HwCfgReady) Then strMsg = strMsg & "Config Readback No Ready" & vbNewLine
' MsgBox strMsg
MsgBox "Please try again."
lblPleaseWait.Visible = False
Exit Sub
End If
'' Dim strTestFile As String
'' strTestFile = App.Path & "\_TestCfgIn.hm"
'' WriteTextFile strTestFile, s.HwCfgDP5
If (s.SCAEnabled And s.isDppConnected) Then
LoadingCfg = False
s.HwScaCfgReady = False 'clear cfg ready flag
s.HwScaCfgDP5 = "" 'clear config readback string
s.cstrRawScaCfgIn = ""
TimeExpired = False
lblPleaseWait.Visible = True
'curStart = msTimeStart() 'keep using the old 5sec timer
s.DppConfig.ScaReadBack = True 'set request config readback flag
frmDP5.RequestSCASettings
'frmDP5.SendCommand XMTPT_FULL_READ_CONFIG_PACKET 'request dpp config
Do 'wait until s.HwCfgReady or timeout
DoEvents
curElapsed = msTimeDiff(curStart)
TimeExpired = msTimeExpired(curStart, 5000) '1000 milliseconds max wait
Loop Until (TimeExpired Or s.HwScaCfgReady)
If ((Len(s.HwScaCfgDP5) = 0) Or (Not s.HwScaCfgReady)) Then
strMsg = ""
MsgBox "Please try again."
lblPleaseWait.Visible = False
Exit Sub
Else
'MsgBox SCAStringALL(sca, True)
'MsgBox s.HwScaCfgDP5 & vbNewLine & "++++" & vbNewLine & s.cstrRawScaCfgIn & vbNewLine
SCACfgParser sca, s.HwScaCfgDP5
cboMCAC.ListIndex = varValueToIndex(sca.Channels)
cboSCAW.ListIndex = varValueToIndex(sca.PulseWidth)
cboSCAI.ListIndex = varValueToIndex(sca.Index)
cboSCAI_Click
UpdateSCAEdit
sca.Index = 1
cboSCAI.ListIndex = varValueToIndex(sca.Index)
UpdateSCAEdit
'MsgBox SCAStringALL(sca, True)
End If
End If
If (chkDisplayConfigurationOnRead.Value = vbChecked) Then
''===========================================================================
''uncomment the following block to display the configuration on dpp readback
''===========================================================================
cstrDisplayCfgOut = s.cstrRawCfgIn
For Each varCmd In s.Dp5CmdList
cstrDisplayCfgOut = ReplaceCmdDesc(CStr(varCmd), cstrDisplayCfgOut)
Next
frmDppConfigDisplay.m_strMessage = cstrDisplayCfgOut
frmDppConfigDisplay.m_strDelimiter = ";"
Load frmDppConfigDisplay
frmDppConfigDisplay.m_strTitle = "DPP Configuration"
frmDppConfigDisplay.Show vbModal
''===========================================================================
End If
'convert config string to control data
Dim strCLCK As String
Dim strTPEA As String
Dim strTFLA As String
Dim strTPFA As String
'=========================
EnableCommandsByDeviceType
'=========================
LoadingCfg = True
varConfig = GetDP5ConfigString(s.HwCfgDP5, varComments) 'get config
UpdateDP5Ctrls Me, lstDP5Commands, varCmdCtrls, varConfig, varUnitsArray
'if reading cfg from file, will base all controls on file info
strCLCK = GetValByCmd("CLCK", varConfig)
strTPEA = GetValByCmd("TPEA", varConfig)
strTFLA = GetValByCmd("TFLA", varConfig)
strTPFA = GetValByCmd("TPFA", varConfig)
b80MHzModeCfg = GetFPGAClockMode(strCLCK, strTPEA)
b80MHzModeCfg_old = b80MHzModeCfg
'update TPEA
LoadPeakingValues cboRise, cboFlatTop, b80MHzModeCfg
SetShapingIndex cboRise, strTPEA
cboRiseUpdate cboRise, cboFlatTop, b80MHzModeCfg
SetShapingIndex cboFlatTop, strTFLA
'Set the Fast Channel Threshold
InitFastPeakCombo
SetFastPeakCombo strTPFA
If (b80MHzModeCfg) Then
lblFPGAClk(0) = "80MHz"
b80MHzModeCfg_old = True
Else
lblFPGAClk(0) = "20MHz"
b80MHzModeCfg_old = False
End If
lblFPGAClk(1).Visible = False
lblFPGAClk(2).Visible = False
LoadingCfg = False
lblPleaseWait.Visible = False
SetCfgInstructions False ' hide configuration dialog start instructions
EnableCfgControls True
End Sub
Private Sub cmdSaveCfg_Click()
Dim varNotEmptyVal As Variant
If (dlgSave(cmnDlg, dlgTXT_Filter)) Then
strIniFilename = cmnDlg.filename
'-------- Save Text Values To Section --------------------------------------------------------------
ReadDP5Text Me, lstDP5Commands, varCmdCtrls, varValues '1. Scan all TextBoxes for Values
varNotEmptyVal = CopyIniArr(varValues, False) '2. Remove Empty Values
Call DeleteIniSetting(strIniFilename, IniSectionVal) '3. Clear the Value Section
Call SaveDP5ConfigSection(strIniFilename, IniSectionVal, varNotEmptyVal, varValComments) '4. Save Values with comments
'---------------------------------------------------------------------------------------------------
ReadDP5Settings Me, lstDP5Commands, varCmdCtrls, varConfig '1. Scan all TextBoxes for Values
Call SaveDP5ConfigSection(strIniFilename, IniSectionCfg, varConfig, varComments) '2. Save Values with comments
If (s.SCAEnabled) Then
SaveSCACfgToINI strIniFilename
End If
Else
'a file was not selected
End If
End Sub
Private Sub cmdSendCfgToHw_Click()
Dim idxCmd As Long
Dim strCfg As String
Dim strDisplay As String
Dim strCmd As String
Dim curStart As Currency 'start time from system time in milliseconds
Dim TimeExpired As Boolean 'time expired flag
Dim curElapsed As Currency 'Elapsed time from start time in milliseconds
Dim lCfgLen As Long 'ASCII Configuration Command String Length
Dim idxSplitCfg As Long 'Configuration split position, only if necessary
Dim bSplitCfg As Boolean 'Configuration split flag
Dim strSplitCfg As String 'Configuration split string second buffer
bSplitCfg = False
If (Not s.isDppConnected) Then Exit Sub 'exit if no dpp connect
ReadDP5Settings Me, lstDP5Commands, varCmdCtrls, varConfig '1. Scan all TextBoxes for Values
strDisplay = ""
If (IsEmpty(varConfig)) Then Exit Sub 'not initialized
strCfg = TypeName(varConfig) 'test variant data type
If (strCfg = "String()") Then ('have data
strCfg = "" 'clear cfg storage
Else
Exit Sub 'no data
End If
For idxCmd = 0 To UBound(varConfig, 1)
strCmd = varConfig(idxCmd, 0) & "=" & varConfig(idxCmd, 1) & ";"
If (Not (InStr(strCmd, "RESC") > 0)) Then
If (Len(Trim(varConfig(idxCmd, 1))) > 0) Then
strCfg = strCfg & strCmd
strDisplay = strDisplay & strCmd & vbNewLine
Else
strDisplay = strDisplay & ";" & strCmd & vbNewLine
End If
End If
Next
strCfg = "RESC=YES;" & strCfg
strCfg = UCase(strCfg)
strCfg = RemoveCmdByDeviceType(strCfg, STATUS.PC5_PRESENT, STATUS.DEVICE_ID, STATUS.isDP5_RevDxGains, STATUS.DPP_ECO)
Clipboard.SetText strCfg
strDisplay = "RESC=YES;" & vbNewLine & strDisplay
strDisplay = UCase(strDisplay)
txtSendCfgToHwNoEdit = strDisplay
'Test configuration size
lCfgLen = Len(strCfg)
If (lCfgLen > 512) Then 'configuration is too large, try to reduce
strCfg = ReplaceText(strCfg, "US;", ";")
strCfg = ReplaceText(strCfg, "OFF;", "OF;")
strCfg = ReplaceText(strCfg, "RISING;", "RI;")
strCfg = ReplaceText(strCfg, "FALLING;", "FA;")
lCfgLen = Len(strCfg)
If (lCfgLen > 512) Then 'configuration is still too large, split cfg
bSplitCfg = True
idxSplitCfg = GetCmdChunk(strCfg)
strSplitCfg = Mid(strCfg, idxSplitCfg + 1)
strCfg = Left(strCfg, idxSplitCfg)
End If
End If
'MsgBox strCfg
'MsgBox strSplitCfg
lblCfgLenValue = CStr(Len(strCfg))
s.HwCfgReady = False
s.HwCfgExReady = False
s.HwCfgDP5Out = strCfg
If (Len(strCfg) > 0) Then
s.HwCfgReady = True
frmDP5.SendCommand XMTPT_SEND_CONFIG_PACKET_TO_HW
s.HwCfgReady = False
End If
If (bSplitCfg) Then 'send second configuration block
TimeExpired = False
lblPleaseWait.Visible = True
curStart = msTimeStart()
Do 'wait for cfg packet to be processed
DoEvents
curElapsed = msTimeDiff(curStart)
TimeExpired = msTimeExpired(curStart, 200) '200 milliseconds wait
Loop Until (TimeExpired)
lblPleaseWait.Visible = False
s.HwCfgReady = False
s.HwCfgExReady = False
s.HwCfgDP5Out = strSplitCfg
If (Len(strCfg) > 0) Then
s.HwCfgReady = True
frmDP5.SendCommand XMTPT_SEND_CONFIG_PACKET_TO_HW
s.HwCfgReady = False
End If
End If
If (s.SCAEnabled And s.isDppConnected) Then
TimeExpired = False
lblPleaseWait.Visible = True
curStart = msTimeStart()
Do 'wait for cfg packet to be processed
DoEvents
curElapsed = msTimeDiff(curStart)
TimeExpired = msTimeExpired(curStart, 200) '200 milliseconds wait
Loop Until (TimeExpired)
lblPleaseWait.Visible = False
strCfg = SCAStringALL(sca, True)
s.HwCfgReady = False
s.HwCfgExReady = False
s.HwCfgDP5Out = strCfg
If (Len(strCfg) > 0) Then
s.HwCfgReady = True
frmDP5.SendCommand XMTPT_SEND_CONFIG_PACKET_TO_HW
s.HwCfgReady = False
End If
End If
End Sub
'Function InstrCount(StringToSearch As String, StringToFind As String) As Long
' If Len(StringToFind) Then
' InstrCount = UBound(Split(StringToSearch, StringToFind))
' End If
'End Function
Private Sub cmdSendCfgToHwNoEdit_Click()
Dim idxCfg As Integer
Dim varCfgHw As Variant
Dim varCommentsHw As Variant
Dim strCfg As String
Dim strDisplay As String
Dim strCmd As String
strDisplay = ""
On Error GoTo cmdSendCfgToHwNoEditErr
If (dlgOpen(cmnDlg, dlgTXT_Filter)) Then
strIniFilename = cmnDlg.filename
varCfgHw = GetDP5ConfigSection(strIniFilename, IniSectionCfg, varCommentsHw) 'read ini config from file
If (IsEmpty(varCfgHw)) Then Exit Sub 'not initialized
strCfg = TypeName(varCfgHw) 'test variant data type
If (strCfg = "String()") Then ('have data
strCfg = "" 'clear cfg storage
Else
Exit Sub 'no data
End If
For idxCfg = 0 To UBound(varCfgHw, 1)
strCmd = varCfgHw(idxCfg, 0) & "=" & varCfgHw(idxCfg, 1) & ";"
strCfg = strCfg & strCmd
strDisplay = strDisplay & strCmd & vbNewLine
Next
txtSendCfgToHwNoEdit = strDisplay
lblCfgLenValue = CStr(Len(strCfg))
Else
'a file was not selected
End If
Exit Sub
cmdSendCfgToHwNoEditErr:
End Sub
'Enable XP Styles Manifest for VB5/VB6 Controls
Private Sub Form_Initialize()
On Error Resume Next
LoadLibrary "shell32.dll"
InitCommonControls
On Error GoTo 0
End Sub
'tell the operator how to start the configuration dialog
Private Sub SetCfgInstructions(Optional bDisplay As Boolean = True)
Dim strStart As String
strStart = "To begin, Read Hardware Configuration OR " & vbNewLine
strStart = strStart & "Select DPP Device Type, then Open Configuration File"
lblStartCfg = strStart
lblStartCfg.Visible = bDisplay
End Sub
Private Sub Form_Load()
Dim idxTab As Long
bFormLoading = True
SetCfgInstructions ' display configuration dialog start instructions
lblPleaseWait.Visible = False
fraPREL.Top = fraPRET.Top
fraPREL.Left = fraPRET.Left
LoadApplicationSettings Me, True, False, False
'===========================================================================
'==== This Configuration Dialog has controls to configure GAIN only
'===========================================================================
's.profile.SendCoarseFineGain = True 'removes GAIN cmd (sends GAIA,GAIF)
s.profile.SendCoarseFineGain = False 'removes GAIA,GAIF cmd (sends GAIN)
If (s.SCAEnabled) Then
chkEnableSCA.Value = vbChecked
Else
chkEnableSCA.Value = vbUnchecked
End If
fraSingleChannelAnalyzer.Visible = s.SCAEnabled
If (Not s.isDppConnected) Then
fraDppDeviceType.Enabled = True 'enable select device type
optDppDeviceType(0).Enabled = True
optDppDeviceType(1).Enabled = True
optDppDeviceType(2).Enabled = True
optDppDeviceType(3).Enabled = True
optDppDeviceType(4).Enabled = True
If ((STATUS.DEVICE_ID >= dppDP5) And (STATUS.DEVICE_ID <= dppTB5)) Then 'set device type
'value is ok
Else
STATUS.DEVICE_ID = CByte(dppDP5)
End If
optDppDeviceType(STATUS.DEVICE_ID).Value = True
Else
fraDppDeviceType.Enabled = False 'disable select device type
optDppDeviceType(0).Enabled = False
optDppDeviceType(1).Enabled = False
optDppDeviceType(2).Enabled = False
optDppDeviceType(3).Enabled = False
optDppDeviceType(4).Enabled = False
If ((STATUS.DEVICE_ID >= dppDP5) And (STATUS.DEVICE_ID <= dppTB5)) Then 'set device type
optDppDeviceType(STATUS.DEVICE_ID).Value = True 'value is ok
End If
End If
EnableCommandsByDeviceType
lblFPGAClk(0).BackColor = colorLightSteelBlue
lblFPGAClk(0).ForeColor = colorLightSlateGray
lblFPGAClk(1).BackColor = &H8000000F
lblFPGAClk(1).ForeColor = colorRed
lblFPGAClk(2).BackColor = &H8000000F
lblFPGAClk(2).ForeColor = colorBlue
Toolbar1.Buttons("General").Value = tbrPressed
Toolbar1.Top = 0
Toolbar1.Left = 0
For idxTab = 0 To SSTab1.Tabs - 1
lblTab(idxTab).BorderStyle = vbBSNone
lblTab(idxTab).Caption = SSTab1.TabCaption(idxTab)
Next
SSTab1.Tab = 0
varUnitsArray = MakeUnitsArray()
LoadingCfg = True
varCmdCtrls = SetupCmdCtrls(Me, lstDP5Commands)
Timer1.Enabled = True 'run GetDP5CmdGroups
LoadingCfg = False
SSTab1.Tab = 0
' Shape1.Move 60, 360, SSTab1.Width - 60 - 60, SSTab1.Height - 360 - 60
' Shape1.ZOrder 1
For idxTab = 0 To SSTab1.Tabs - 1
Shape_ssTabBg(idxTab).Move 60, 360, SSTab1.Width - 60 - 60, SSTab1.Height - 360 - 60
Shape_ssTabBg(idxTab).ZOrder 1
Next
SetComboRight Me
'update all combo txt control groups
SetupStartupCboTxt Me, varCmdCtrls
SSTab1.Enabled = True
EnableCfgControls False 'disable all controls to start
txtSendCfgToHwNoEdit.Enabled = s.isDppConnected
cmdSendCfgToHwNoEdit.Enabled = s.isDppConnected
lblCfgToHwLength.Enabled = s.isDppConnected
lblCfgLenValue.Enabled = s.isDppConnected
cmdReadHwCfg.Enabled = s.isDppConnected
cmdSendCfgToHw.Enabled = s.isDppConnected
bFormLoading = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveApplicationSettings Me, True, True, False
End Sub
Private Sub lstDP5Commands_Click()
Dim idxLst As Long
cmdFindCmd.Enabled = False
If LoadingCfg Then Exit Sub
idxLst = lstDP5Commands.ListIndex
'Debug.Print GetDP5CmdCtrtType(lstDP5Commands, idxLst)
txtCmdInfo = GetDP5CmdCtrlInfo(Me, lstDP5Commands, varCmdCtrls, idxLst)
If (Len(strFindTab) = 0) Then Exit Sub
If (Len(strFindCtrl) = 0) Then Exit Sub
If (Len(strFindIdx) = 0) Then Exit Sub
cmdFindCmd.Enabled = True
End Sub
Private Sub optDppDeviceType_Click(Index As Integer)
'set the status flags for configuration without a DPP Device
Dim idxButton As Long
STATUS.DEVICE_ID = CByte(Index)
EnableCommandsByDeviceType
' If (STATUS.DEVICE_ID = dppMCA8000D) Then
' For idxButton = 2 To Toolbar1.Buttons.Count
' Toolbar1.Buttons(idxButton).Enabled = False
' Next
' End If
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
Dim btn As Button
If LoadingCfg Then Exit Sub
If (Toolbar1.Buttons(SSTab1.Tab + 1).Value <> tbrPressed) Then
Set btn = Toolbar1.Buttons(SSTab1.Tab + 1)
Toolbar1_ButtonClick btn
End If
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
LoadingCfg = True
GetDP5CmdGroups Me, varCmdCtrls, SSTab1
LoadingCfg = False
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
UnPressButtons Toolbar1
Button.Value = tbrPressed
SSTab1.Tab = Button.Index - 1
End Sub
Private Function strSOFF_INFO()
Dim cstrSoffInfo As String
cstrSoffInfo = " SOFF - Set Spectrum Offset (Default=OFF)" & vbNewLine & vbNewLine
cstrSoffInfo = cstrSoffInfo & " Range Depends on MCA/MCS Channels (MCAC): " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 256 ch: -256 to +255.992 ch; 1/128 ch precision " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 512 ch: -512 to +511.984 ch; 1/64 ch precision " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 1024 ch: -1024 to +1023.969 ch; 1/32 ch precision " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 2048 ch: -2048 to +2047.937 ch; 1/16 ch precision " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 4096 ch: -4096 to +4095.875 ch; 1/8 ch precision " & vbNewLine
cstrSoffInfo = cstrSoffInfo & Space(16) & " 8192 ch: -8192 to +8191.75 ch; 1/4 ch precision " & vbNewLine
strSOFF_INFO = cstrSoffInfo
End Function
'============================================================
'============================================================
'==== SCA Start =============================================
'============================================================
'============================================================
Private Sub cboMCAC_Click()
sca.Channels = cboMCAC.Text
sca.HaveChannels = False
fix_sca_limits
End Sub
Private Sub cboSCAI_Click()
If (sca.Index <> (cboSCAI.ListIndex + 1)) Then
sca.Index = (cboSCAI.ListIndex + 1)
UpdateSCAEdit
End If
End Sub
Private Sub UpdateSCAEdit()
If (sca.Index < 1) Then sca.Index = 1
lblSCAGroupIndex = "SCA " & sca.Index
txtSCAL_Edit = sca.sca(sca.Index - 1).Low
txtSCAH_Edit = sca.sca(sca.Index - 1).High
If (sca.Index <= 8) Then
cboSCAO_Select.ListIndex = varValueToIndex(sca.sca(sca.Index - 1).OutPut)
End If
End Sub
Private Sub cboSCAO_Select_Click()
If (cboSCAO_Select.ListIndex >= 0) Then sca.sca(sca.Index - 1).OutPut = cboSCAO_Select.Text
End Sub
Private Sub cboSCAW_Click()
If (cboSCAW.ListIndex >= 0) Then sca.PulseWidth = cboSCAW.Text
End Sub
Private Sub cmdDefaults_Click(Index As Integer)
Select Case Index
Case 0
init_sca
Case 1
reset_sca_low
Case 2
reset_sca_high
Case Else
End Select
UpdateSCAEdit
End Sub
Private Sub ReadSCACfgFromINI(strFilename As String)
Dim idxSCA As Long
sca.strIniFilename = strFilename
GetSCASetupINI sca
cboMCAC.ListIndex = varValueToIndex(sca.Channels)
cboSCAW.ListIndex = varValueToIndex(sca.PulseWidth)
cboSCAI.ListIndex = varValueToIndex(sca.Index)
For idxSCA = 1 To 8
GetSCASettingsINI sca, idxSCA
Next
cboSCAI_Click
UpdateSCAEdit
End Sub
Private Sub SaveSCACfgToINI(strFilename As String)
Dim idxSCA As Long
sca.strIniFilename = strFilename
SaveSCASetupINI sca
For idxSCA = 1 To 8
SaveSCASettingsINI sca, idxSCA
Next
End Sub
Private Sub init_sca()
Dim idxSCA As Long
sca.strIniFilename = ""
sca.HaveChannels = False
cboMCAC.ListIndex = 2
sca.Channels = cboMCAC.Text
cboSCAI.ListIndex = 0
sca.Index = cboSCAI.ListIndex + 1
cboSCAW.ListIndex = 0
sca.PulseWidth = cboSCAW.Text
For idxSCA = 0 To 15
sca.sca(idxSCA).Low = 0
sca.sca(idxSCA).High = 8191
If (idxSCA < 8) Then
sca.sca(idxSCA).OutPut = "OFF"
End If
Next
End Sub
Private Sub reset_sca_low()
Dim idxSCA As Long
For idxSCA = 0 To 15
sca.sca(idxSCA).Low = 0
Next
End Sub
Private Sub reset_sca_high()
Dim idxSCA As Long
For idxSCA = 0 To 15
sca.sca(idxSCA).High = sca.Channels - 1
Next
End Sub
Private Sub fix_sca_limits()
Dim idxSCA As Long
For idxSCA = 0 To 15
If (Val(sca.sca(idxSCA).Low) > Val(sca.Channels)) Then
sca.sca(idxSCA).Low = 1
End If
If (Val(sca.sca(idxSCA).High) > Val(sca.Channels)) Then
sca.sca(idxSCA).High = sca.Channels
End If
Next
End Sub
Private Sub txtSCAL_Edit_Change()
sca.sca(sca.Index - 1).Low = txtSCAL_Edit
End Sub
Private Sub txtSCAH_Edit_Change()
sca.sca(sca.Index - 1).High = txtSCAH_Edit
End Sub
'============================================================
'============================================================
'==== SCA End ===============================================
'============================================================
'============================================================
Public Function VersionToDbl(bVersion As Byte, bBuild As Byte) As Double
Dim VersionToStr As String
VersionToStr = Trim(str((bVersion And &HF0) / 16)) + "." + Format((bVersion And &HF), "00") + Format(bBuild, "00")
VersionToDbl = Val(VersionToStr)
End Function
'Enable/Disable all controls
Private Sub EnableCfgControls(isEnabled As Boolean)
Dim idxTab As Long
For idxTab = 0 To SSTab1.Tabs - 1
Toolbar1.Buttons(idxTab + 1).Enabled = isEnabled
Next
If (STATUS.DEVICE_ID = dppMCA8000D) Then
For idxTab = 3 To Toolbar1.Buttons.Count
Toolbar1.Buttons(idxTab).Enabled = False
Next
fraCmdInfo.Visible = False
Else
fraCmdInfo.Visible = True
End If
fraResetConfiguration.Enabled = isEnabled
lstDP5Commands.Enabled = isEnabled
lblCmdList(0).Enabled = isEnabled
fraCmdInfo.Enabled = isEnabled
If (Not isEnabled) Then SSTab1.Tab = 0
End Sub
'Enable/Disable controls by DPP Device Type
Private Sub EnableCommandsByDeviceType()
Dim dblFirmware As Double
Dim bEnable As Boolean
dblFirmware = 6#
If (s.isDppConnected) Then
dblFirmware = VersionToDbl(STATUS.Firmware, STATUS.Build)
End If
If (STATUS.DEVICE_ID = dppDP5G) Then
b80MHzModeCfg = False
End If
fraFPGAClock.Visible = Not CBool(STATUS.DEVICE_ID = dppDP5G)
fraHV.Visible = Not CBool(STATUS.DEVICE_ID = dppDP5G)
'==========================================================================
'Enable ASCII Command Editing By Firmware Version and DPP Device Type
'Command Firmware DPP Device Enable Reason SDK/DppMCA Supported
'==========================================================================
'[x] SCTC 6.08.01 G:T FW:Device Yes 20140805
fraScintillatorTimeConstant.Visible = False
If (dblFirmware >= 6.0801) Then
bEnable = CBool(STATUS.DEVICE_ID = dppDP5G) Or CBool(STATUS.DEVICE_ID = dppTB5)
fraScintillatorTimeConstant.Visible = bEnable
End If
'[x] TPFA <6.07.05 FW Yes 20140805
'[x] TPFA 6.07.05 FW Yes 20140805
'InitFastPeakCombo - Changes Control Selections
'[x] INOF ALL D:P Device Yes 20140805
fraInputOffset.Visible = False
If (STATUS.DEVICE_ID <= dppPX5) Then
fraInputOffset.Visible = True
End If
'[] AUO1 <6.08.02 FW Yes
'[] AUO1 6.08.02 FW Yes
'[] AUO2 <6.08.02 FW Yes
'[] AUO2 6.08.02 FW Yes
InitAUX
'LoadListAUO1
'LoadListAUO2
'[] BOOT ALL D Device Yes
'[] PAPS ALL D:P Device:DP5 Yes
'[] PAPS ALL D:P Device:NotHPGe Yes
'[] PAPS ALL D:P Device:HPGeOnly Yes ' removed using fraPC5Control for BOOT and PAPS
InitPreampVoltageCombo STATUS.DEVICE_ID
'[] CON1 6.03 P:G FW:Device Yes
'[] CON2 6.03 P:G FW:Device Yes
InitCON
'[] GATE ALL D Device Yes
InitGATE
'[] PAPZ 6.05 P FW:Device:NotHPGe Yes
'[] PAPZ 6.05 P FW:Device:HPGeOnly Yes
InitPAPZ
'[] PDMD ALL D:P:G Device Yes
'[] PDMD ALL M Device Yes
InitPeakDetectModeCombo
'[] PRER '0-4294967.29
'[] PREL 6.07.00 M FW:Device Yes
'[] PRET ALL D:P:G Device Yes
If ((CBool(STATUS.DEVICE_ID = dppMCA8000D)) And (dblFirmware >= 6.07)) Then
fraPREL.Visible = True
fraPRET.Visible = False
Else
fraPREL.Visible = False
fraPRET.Visible = True
End If
'[] PURE ALL D:P:G:T Device Yes '[ON|OF{F}|MA{X}|###.###] uS
'[] PURE ALL M Device Yes '[HI{GH}| LO{W}|OF{F}]
'fraPileUpReject ***** needs full selections for all device types
InitPURE
'[] TECS ALL D:P Device:PC5Only Yes
fraCoolerTemperature.Visible = False
If ((STATUS.DEVICE_ID = dppDP5) Or (STATUS.DEVICE_ID = dppPX5)) Then
fraCoolerTemperature.Visible = True 'cooler and hv if not dp5g
End If
'[] VOLU ALL P Device Yes
fraPX5Speaker.Visible = CBool(STATUS.DEVICE_ID = dppPX5)
If (STATUS.DEVICE_ID = dppMCA8000D) Then 'setup MCA8000D controls on MCA Tab
fraSOFF.Top = 2400
cboInputRange.ListIndex = 0
fraInputRange.Visible = True
fraPUR_MCA8000D.Visible = True
Else
fraSOFF.Top = 4920
fraInputRange.Visible = False
fraPUR_MCA8000D.Visible = False
End If
End Sub
Private Sub InitPURE()
Dim idxCtrlPURE As Long
Dim idxCtrlPURELBL As Long
Dim idxCtrlPUREUnits As Long
Dim idxCtrlPUREText As Long
Dim m_PileUpRejectCombo As ComboBox
Dim m_PileUpRejectLabel As Label
Dim m_PileUpRejectUnits As Label
Dim m_PileUpRejectText As TextBox
idxCtrlPURE = GetCtrlIdxByNameTag(Me, "cboControl", "PURE")
Set m_PileUpRejectCombo = cboControl(idxCtrlPURE)
idxCtrlPURELBL = GetCtrlIdxByNameTag(Me, "lblValueLimits", "PURE")
Set m_PileUpRejectLabel = lblValueLimits(idxCtrlPURELBL)
idxCtrlPUREUnits = GetCtrlIdxByNameTag(Me, "lblValueUnits", "PURE")
Set m_PileUpRejectUnits = lblValueUnits(idxCtrlPUREUnits)
' idxCtrlPUREText = GetCtrlIdxByNameTag(Me, "txtControl", "PURE")
' Set m_PileUpRejectText = txtControl(idxCtrlPUREText)
m_PileUpRejectCombo.Clear
If (STATUS.DEVICE_ID = dppMCA8000D) Then
m_PileUpRejectCombo.AddItem "HIGH"
m_PileUpRejectCombo.AddItem "LOW"
m_PileUpRejectCombo.AddItem "OFF"
m_PileUpRejectCombo.ListIndex = 2
m_PileUpRejectUnits.Visible = False
Else
m_PileUpRejectCombo.AddItem "ON"
m_PileUpRejectCombo.AddItem "OFF"
m_PileUpRejectCombo.AddItem "Max"
m_PileUpRejectCombo.AddItem "###.###"
m_PileUpRejectCombo.ListIndex = 1
m_PileUpRejectUnits.Visible = True
m_PileUpRejectLabel.Caption = ""
End If
End Sub
Private Sub InitPeakDetectModeCombo()
Dim idxCtrl As Long
Dim m_PeakDetectModeCombo As ComboBox
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", "PDMD")
Set m_PeakDetectModeCombo = cboControl(idxCtrl)
m_PeakDetectModeCombo.Clear
If (CBool(STATUS.DEVICE_ID = dppMCA8000D)) Then
m_PeakDetectModeCombo.AddItem "NORM"
m_PeakDetectModeCombo.AddItem "MIN"
m_PeakDetectModeCombo.AddItem "ABS"
m_PeakDetectModeCombo.AddItem "CLK"
m_PeakDetectModeCombo.AddItem "INT"
m_PeakDetectModeCombo.ListIndex = 0
Else
m_PeakDetectModeCombo.AddItem "NORM"
m_PeakDetectModeCombo.AddItem "MIN"
m_PeakDetectModeCombo.ListIndex = 0
End If
End Sub
Private Sub InitPAPZ()
Dim idxCtrlPAPZ As Long
Dim idxCtrlPAPZLBL As Long
Dim idxCtrlPAPZUnits As Long
Dim idxCtrlPAPZText As Long
Dim m_PreampPoleZeroCombo As ComboBox
Dim m_PreampPoleZeroLabel As Label
Dim m_PreampPoleZeroUnits As Label
Dim m_PreampPoleZeroText As TextBox
Dim isHPGe As Boolean
idxCtrlPAPZ = GetCtrlIdxByNameTag(Me, "cboControl", "PAPZ")
Set m_PreampPoleZeroCombo = cboControl(idxCtrlPAPZ)
idxCtrlPAPZLBL = GetCtrlIdxByNameTag(Me, "lblValueLimits", "PAPZ")
Set m_PreampPoleZeroLabel = lblValueLimits(idxCtrlPAPZLBL)
idxCtrlPAPZUnits = GetCtrlIdxByNameTag(Me, "lblValueUnits", "PAPZ")
Set m_PreampPoleZeroUnits = lblValueUnits(idxCtrlPAPZUnits)
idxCtrlPAPZText = GetCtrlIdxByNameTag(Me, "txtControl", "PAPZ")
Set m_PreampPoleZeroText = txtControl(idxCtrlPAPZText)
m_PreampPoleZeroCombo.Enabled = False
m_PreampPoleZeroLabel.Enabled = False
m_PreampPoleZeroUnits.Enabled = False
m_PreampPoleZeroText.Enabled = False
If (STATUS.DEVICE_ID = dppPX5) Then
m_PreampPoleZeroCombo.Enabled = True
m_PreampPoleZeroLabel.Enabled = True
m_PreampPoleZeroUnits.Enabled = True
m_PreampPoleZeroText.Enabled = True
isHPGe = False
If (s.isDppConnected) Then
If ((STATUS.DPP_options And 15) = 1) Then '"PX5 HPGe"
isHPGe = True
End If
End If
m_PreampPoleZeroCombo.ListIndex = 1
If (isHPGe) Then
m_PreampPoleZeroText.Text = "34.5-103.5 uS"
Else
m_PreampPoleZeroText.Text = "34.5-4387 uS"
End If
End If
End Sub
Private Sub InitGATE()
Dim idxCtrlGATE As Long
Dim m_GATECombo As ComboBox
idxCtrlGATE = GetCtrlIdxByNameTag(Me, "cboControl", "GATE")
Set m_GATECombo = cboControl(idxCtrlGATE)
m_GATECombo.Enabled = False
fraGateControl.Enabled = False
If ((STATUS.DEVICE_ID = dppDP5) Or (STATUS.DEVICE_ID = dppMCA8000D)) Then
m_GATECombo.Enabled = True
fraGateControl.Enabled = True
m_GATECombo.ListIndex = 0
End If
End Sub
Private Sub InitCON()
Dim idxCtrl1 As Long
Dim m_CON1Combo As ComboBox
Dim idxCtrl1Label As Long
Dim m_CON1Label As Label
Dim idxCtrl2 As Long
Dim m_CON2Combo As ComboBox
Dim idxCtrl2Label As Long
Dim m_CON2Label As Label
Dim dblFirmware As Double
Dim isInitCON As Boolean
idxCtrl1 = GetCtrlIdxByNameTag(Me, "cboControl", "CON1")
Set m_CON1Combo = cboControl(idxCtrl1) '[DAC|AUXOUT1|AUXIN1]
idxCtrl1Label = GetCtrlIdxByNameTag(Me, "lblControlName", "CON1")
Set m_CON1Label = lblControlName(idxCtrl1Label)
idxCtrl2 = GetCtrlIdxByNameTag(Me, "cboControl", "CON2")
Set m_CON2Combo = cboControl(idxCtrl2) '[AUXOUT2|AUXIN2|GATEH|GATEL]
idxCtrl2Label = GetCtrlIdxByNameTag(Me, "lblControlName", "CON2")
Set m_CON2Label = lblControlName(idxCtrl2Label)
m_CON1Combo.Enabled = False
m_CON1Label.Enabled = False
m_CON2Combo.Enabled = False
m_CON2Label.Enabled = False
dblFirmware = 6#
If (s.isDppConnected) Then
isInitCON = CBool(STATUS.DEVICE_ID = dppPX5) Or CBool(STATUS.DEVICE_ID = dppDP5G) Or CBool(STATUS.DEVICE_ID = dppTB5)
dblFirmware = VersionToDbl(STATUS.Firmware, STATUS.Build)
If ((dblFirmware >= 6.03) And isInitCON) Then
m_CON1Combo.Enabled = True
m_CON1Label.Enabled = True
m_CON2Combo.Enabled = True
m_CON2Label.Enabled = True
If (STATUS.DEVICE_ID = dppPX5) Then 'set defaults
m_CON1Combo.ListIndex = 0 'DAC (PX5)
m_CON2Combo.ListIndex = 0 'AUXOUT2 (PX5)
Else
m_CON1Combo.ListIndex = 2 'AUXIN1 (DP5G,TB5)
m_CON2Combo.ListIndex = 1 'AUXIN2 (DP5G,TB5)
End If
End If
End If
End Sub
Private Sub InitPreampVoltageCombo(DeviceType As Byte)
Dim idxCtrlPAPS As Long
Dim idxCtrlPAPSLBL As Long
Dim idxCtrlPAPSUnits As Long
Dim idxCtrlBOOT As Long
Dim idxCtrlBOOTLBL As Long
Dim m_PreampVoltageCombo As ComboBox
Dim m_PreampVoltageLabel As Label
Dim m_PreampVoltageUnits As Label
Dim m_PC5OnAtStartUpCombo As ComboBox
Dim m_PC5OnAtStartUpLabel As Label
Dim isHPGe As Boolean
isHPGe = False
If (s.isDppConnected) Then
If (STATUS.DEVICE_ID = dppPX5) Then
If ((STATUS.DPP_options And 15) = 1) Then '"PX5 HPGe"
isHPGe = True
End If
End If
End If
idxCtrlPAPS = GetCtrlIdxByNameTag(Me, "cboControl", "PAPS")
Set m_PreampVoltageCombo = cboControl(idxCtrlPAPS)
idxCtrlPAPSLBL = GetCtrlIdxByNameTag(Me, "lblControlName", "PAPS")
Set m_PreampVoltageLabel = lblControlName(idxCtrlPAPSLBL)
idxCtrlPAPSUnits = GetCtrlIdxByNameTag(Me, "lblValueUnits", "PAPS")
Set m_PreampVoltageUnits = lblValueUnits(idxCtrlPAPSUnits)
idxCtrlBOOT = GetCtrlIdxByNameTag(Me, "cboControl", "BOOT")
Set m_PC5OnAtStartUpCombo = cboControl(idxCtrlBOOT)
idxCtrlBOOTLBL = GetCtrlIdxByNameTag(Me, "lblControlName", "BOOT")
Set m_PC5OnAtStartUpLabel = lblControlName(idxCtrlBOOTLBL)
m_PreampVoltageUnits.Enabled = False
If (DeviceType = dppPX5) Then
fraPC5Control.Visible = True
If (isHPGe) Then '[OFF|ON] [PX5 with HPGe HVPS option]
m_PreampVoltageCombo.Clear
m_PreampVoltageCombo.AddItem "OFF"
m_PreampVoltageCombo.AddItem "ON"
m_PreampVoltageUnits.Enabled = False
'm_PreampVoltageCombo.ListIndex = 1
Else '[8.5|5|OFF] [PX5]
m_PreampVoltageCombo.Clear
m_PreampVoltageCombo.AddItem "8.5"
m_PreampVoltageCombo.AddItem "5"
m_PreampVoltageCombo.AddItem "OFF"
m_PreampVoltageUnits.Enabled = True
'm_PreampVoltageCombo.ListIndex = 1
End If
m_PC5OnAtStartUpCombo.Enabled = False
m_PC5OnAtStartUpLabel.Enabled = False
ElseIf (DeviceType = dppDP5) Then '[8.5|5|OFF|ON] [DP5]
fraPC5Control.Visible = True
m_PC5OnAtStartUpCombo.Enabled = True
m_PC5OnAtStartUpLabel.Enabled = True
m_PreampVoltageUnits.Enabled = True
m_PreampVoltageCombo.Clear
m_PreampVoltageCombo.AddItem "8.5"
m_PreampVoltageCombo.AddItem "5"
m_PreampVoltageCombo.AddItem "OFF"
m_PreampVoltageCombo.AddItem "ON"
'm_PreampVoltageCombo.ListIndex = 1
Else
m_PC5OnAtStartUpCombo.Enabled = False
m_PC5OnAtStartUpLabel.Enabled = False
m_PreampVoltageCombo.Enabled = False
m_PreampVoltageLabel.Enabled = False
m_PreampVoltageUnits.Enabled = False
End If
End Sub
Private Sub InitAUX()
Dim idxCtrl1 As Long
Dim idxCtrl2 As Long
Dim m_AUO1Combo As ComboBox
Dim m_AUO2Combo As ComboBox
Dim dblFirmware As Double
Dim isNewList As Boolean
dblFirmware = 6#
If (s.isDppConnected) Then
dblFirmware = VersionToDbl(STATUS.Firmware, STATUS.Build)
End If
isNewList = False
If (dblFirmware >= 6.0802) Then isNewList = True
idxCtrl1 = GetCtrlIdxByNameTag(Me, "cboControl", "AUO1")
Set m_AUO1Combo = cboControl(idxCtrl1)
m_AUO1Combo.Clear
idxCtrl2 = GetCtrlIdxByNameTag(Me, "cboControl", "AUO2")
Set m_AUO2Combo = cboControl(idxCtrl2)
LoadListAUO1 m_AUO1Combo, isNewList
LoadListAUO2 m_AUO2Combo, isNewList
End Sub
Private Sub LoadListAUO1(m_AUO1Combo As ComboBox, isNewList As Boolean)
m_AUO1Combo.Clear
If (isNewList) Then
m_AUO1Combo.AddItem "ICR"
m_AUO1Combo.AddItem "PILEUP"
m_AUO1Combo.AddItem "MCSTB"
m_AUO1Combo.AddItem "ONESH"
m_AUO1Combo.AddItem "DETRES"
m_AUO1Combo.AddItem "MCAEN"
m_AUO1Combo.AddItem "PEAKH"
m_AUO1Combo.AddItem "SCA8"
m_AUO1Combo.AddItem "RTDOS"
m_AUO1Combo.AddItem "RTDREJ"
m_AUO1Combo.AddItem "VETO"
m_AUO1Combo.AddItem "LIVE"
m_AUO1Combo.ListIndex = 0
Else
m_AUO1Combo.AddItem "#"
m_AUO1Combo.AddItem "ICR"
m_AUO1Combo.AddItem "PILEUP"
m_AUO1Combo.AddItem "MCSTB"
m_AUO1Combo.AddItem "ONESH"
m_AUO1Combo.AddItem "DETRES"
m_AUO1Combo.AddItem "MCAEN"
m_AUO1Combo.AddItem "PEAKH"
m_AUO1Combo.AddItem "SCA8"
m_AUO1Combo.ListIndex = 1
End If
End Sub
Private Sub LoadListAUO2(m_AUO2Combo As ComboBox, isNewList As Boolean)
m_AUO2Combo.Clear
If (isNewList) Then
m_AUO2Combo.AddItem "ICR"
m_AUO2Combo.AddItem "PILEUP"
m_AUO2Combo.AddItem "MCSTB"
m_AUO2Combo.AddItem "ONESH"
m_AUO2Combo.AddItem "DETRES"
m_AUO2Combo.AddItem "MCAEN"
m_AUO2Combo.AddItem "PEAKH"
m_AUO2Combo.AddItem "SCA8"
m_AUO2Combo.AddItem "RTDOS"
m_AUO2Combo.AddItem "RTDREJ"
m_AUO2Combo.AddItem "VETO"
m_AUO2Combo.AddItem "LIVE"
m_AUO2Combo.AddItem "STREAM"
m_AUO2Combo.ListIndex = 0
Else
m_AUO2Combo.AddItem "#"
m_AUO2Combo.AddItem "ICR"
m_AUO2Combo.AddItem "DIAG"
m_AUO2Combo.AddItem "PEAKH"
m_AUO2Combo.AddItem "ONESH"
m_AUO2Combo.AddItem "RTDOS"
m_AUO2Combo.AddItem "RTDREJ"
m_AUO2Combo.AddItem "LIVE"
m_AUO2Combo.AddItem "VETO"
m_AUO2Combo.AddItem "STREAM"
m_AUO2Combo.ListIndex = 1
End If
End Sub
Private Sub InitFastPeakCombo()
Dim idxCtrl As Long
Dim m_FastPeakCombo As ComboBox
Dim dblFirmware As Double
dblFirmware = 6#
If (s.isDppConnected) Then
dblFirmware = VersionToDbl(STATUS.Firmware, STATUS.Build)
End If
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", "TPFA")
Set m_FastPeakCombo = cboControl(idxCtrl)
m_FastPeakCombo.Clear
If (b80MHzModeCfg) Then
m_FastPeakCombo.AddItem "50"
m_FastPeakCombo.AddItem "100"
If (dblFirmware >= 6.0705) Then m_FastPeakCombo.AddItem "200"
m_FastPeakCombo.AddItem "400"
If (dblFirmware >= 6.0705) Then m_FastPeakCombo.AddItem "800"
m_FastPeakCombo.ListIndex = 1
Else
m_FastPeakCombo.AddItem "200"
m_FastPeakCombo.AddItem "400"
If (dblFirmware >= 6.0705) Then m_FastPeakCombo.AddItem "800"
m_FastPeakCombo.AddItem "1600"
If (dblFirmware >= 6.0705) Then m_FastPeakCombo.AddItem "3200"
m_FastPeakCombo.ListIndex = 1
End If
End Sub
Private Sub SetFastPeakCombo(strTPFA As String)
Dim idxCtrl As Long
Dim m_FastPeakCombo As ComboBox
Dim ListIndex As Long
If (Not IsNumeric(strTPFA)) Then Exit Sub
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", "TPFA")
Set m_FastPeakCombo = cboControl(idxCtrl)
ListIndex = FindCboIdxExact(m_FastPeakCombo, strTPFA) 'search for exact value
If (ListIndex = LB_ERR) Then
ListIndex = FindCboIdx(m_FastPeakCombo, strTPFA) 'search for similar value
End If
If (ListIndex <> LB_ERR) Then 'if found set the value
m_FastPeakCombo.ListIndex = ListIndex
End If
End Sub
Private Sub SetCboItem(strID As String, strVal As String)
Dim idxCtrl As Long
Dim m_Combo As ComboBox
Dim ListIndex As Long
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", strID)
Set m_Combo = cboControl(idxCtrl)
ListIndex = FindCboIdxExact(m_Combo, strVal) 'search for exact value
If (ListIndex = LB_ERR) Then
ListIndex = FindCboIdx(m_Combo, strVal) 'search for similar value
End If
If (ListIndex <> LB_ERR) Then 'if found set the value
m_Combo.ListIndex = ListIndex
End If
End Sub
Private Sub SetTxtItem(strID As String, strVal As String)
Dim idxCtrl As Long
Dim m_Text As TextBox
Dim ListIndex As Long
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", strID)
Set m_Text = txtControl(idxCtrl)
m_Text.Text = strVal
End Sub
Private Function GetTxtItem(strID As String) As String
Dim idxCtrl As Long
Dim m_Text As TextBox
Dim ListIndex As Long
Dim strVal As String
idxCtrl = GetCtrlIdxByNameTag(Me, "txtControl", strID)
Set m_Text = txtControl(idxCtrl)
strVal = m_Text.Text
GetTxtItem = strVal
End Function
Private Sub OutputQuickset(strDAC As String, _
strOutputOffset As String, _
strAUX2 As String, _
strAUX1 As String, _
strCONN1 As String, _
strCONN2 As String)
SetCboItem "DACO", strDAC
SetTxtItem "DACF", strOutputOffset
SetCboItem "AUO2", strAUX2
SetCboItem "AUO1", strAUX1
SetCboItem "CON1", strCONN1
SetCboItem "CON2", strCONN2
End Sub
Private Sub cmdOutputQuickset_Click(Index As Integer)
Select Case Index
Case 0
'1. Shaped Output: DAC=SHAPED, output offset=50 mV, AUX2 = ICR, AUX1 = SCA8, CONN1 = DAC, CONN2 = AUXOUT2
Call OutputQuickset("SHAPED", "50", "ICR", "SCA8", "DAC", "AUXOUT2")
Case 1
'2. ADC Input: DAC=INPUT, output offset=0 mV, AUX2 = ICR, AUX1 = SCA8, CONN1 = DAC, CONN2 = AUXOUT2
Call OutputQuickset("INPUT", "0", "ICR", "SCA8", "DAC", "AUXOUT2")
Case 2
'3. Pile-Up: DAC=FAST, output offset=50 mV, AUX2 = ICR, AUX1 = PILEUP, CONN1 = DAC, CONN2 = AUXOUT2
Call OutputQuickset("FAST", "50", "ICR", "PILEUP", "DAC", "AUXOUT2")
End Select
End Sub
Private Sub txtControl_Change(Index As Integer)
If (STATUS.DEVICE_ID = dppMCA8000D) Then
If ("GAIN" = txtControl(Index).Tag) Then 'set the MCA8000D Input Range Control
SetInputRangeControlFromGain
End If
End If
End Sub
Private Sub SetInputRangeControlFromGain()
Dim strRange As String
Dim lngRange As Long
Dim idxRange As Long
Dim idxRangeNew As Long
idxRange = cboInputRange.ListIndex
strRange = GetTxtItem("GAIN")
lngRange = CLng(Val(strRange))
If (lngRange < 10) Then
idxRangeNew = 0
Else
idxRangeNew = 1
End If
'only set if necessary
'setting cbo will trigger cbo click event
'setting txt will trigger txt change event
'limit here to avoid recursive loop
If (idxRange <> idxRangeNew) Then
cboInputRange.ListIndex = idxRangeNew
End If
End Sub
Private Sub SetGainFromInputRangeControl()
Dim strRange As String
Dim lngRangeNew As Long
Dim lngRange As Long
Dim idxRangeNew As Long
Dim idxRange As Long
lngRangeNew = 1 'get new range
idxRangeNew = cboInputRange.ListIndex
If (idxRangeNew <> 0) Then lngRangeNew = 10
strRange = GetTxtItem("GAIN")
lngRange = CLng(Val(strRange))
'only set if necessary
'setting cbo will trigger cbo click event
'setting txt will trigger txt change event
'limit here to avoid recursive loop
If (lngRange <> lngRangeNew) Then
strRange = CStr(lngRangeNew)
SetTxtItem "GAIN", strRange
End If
End Sub
Private Function GetCboIndex(strID As String, Optional lDefault As Long = 0, Optional bNumeric As Boolean = False) As Long
Dim idxCtrl As Long
Dim m_Combo As ComboBox
Dim ListIndex As Long
Dim strMask As String
ListIndex = lDefault
idxCtrl = GetCtrlIdxByNameTag(Me, "cboControl", strID)
Set m_Combo = cboControl(idxCtrl)
ListIndex = m_Combo.ListIndex
If (ListIndex = LB_ERR) Then
ListIndex = lDefault
Else
If (Not bNumeric) Then
strMask = m_Combo.List(ListIndex)
If (InStr(strMask, "#") > 0) Then
ListIndex = lDefault
End If
End If
End If
GetCboIndex = ListIndex
End Function
Private Sub SetMCA8000D_PUR_From_ShapingPUR()
Dim idxPileUp As Long
Dim idxPileUpNew As Long
idxPileUp = cboPUR_MCA8000D.ListIndex
idxPileUpNew = GetCboIndex("PURE", 2, False) 'default 2-OFF
'only set if necessary
'setting cbo will trigger cbo click event
'setting txt will trigger txt change event
'limit here to avoid recursive loop
If (idxPileUp <> idxPileUpNew) Then
cboPUR_MCA8000D.ListIndex = idxPileUpNew
End If
End Sub
Private Sub SetShapingPUR_From_MCA8000D_PUR()
Dim idxPileUpNew As Long
Dim idxPileUp As Long
Dim strPileUp As String
idxPileUpNew = cboPUR_MCA8000D.ListIndex
idxPileUp = GetCboIndex("PURE", 2, False) 'default 2-OFF
'only set if necessary
'setting cbo will trigger cbo click event
'setting txt will trigger txt change event
'limit here to avoid recursive loop
If (idxPileUp <> idxPileUpNew) Then
strPileUp = cboPUR_MCA8000D.List(idxPileUpNew)
SetCboItem "PURE", strPileUp
End If
End Sub