Attribute VB_Name = "modFileSupport" Option Explicit 'dynamic array support Public Const idxL As Long = 0 'index lower record Public Const idxU As Long = 1 'index upper record Public PlotPeakVal As Long Public PlotPeakChan As Long 'gets current index range of 1 dim array Public Function GetArrayIndex(varArray As Variant) As Variant Dim ArrayIndex(1) As Long ArrayIndex(idxL) = LBound(varArray) ArrayIndex(idxU) = UBound(varArray) GetArrayIndex = ArrayIndex End Function 'GetDataIndex "<>", "<>" 'GetROIIndex "<>", "<>" Public Function GetMCAIndex(strMCAData As Variant, strStartTag As String, strEndTag As String) As Variant Dim FileNum As Integer Dim iSize As Variant Dim DataIndex(1) As Long Dim I As Long 'On Error GoTo GetMCAIndexErr DataIndex(idxL) = -1 'indicates not found DataIndex(idxU) = -1 'indicates not found iSize = GetArrayIndex(strMCAData) 'get the indices of the array for For I = iSize(idxL) To iSize(idxU) If (StrComp(strMCAData(I), strStartTag, vbTextCompare) = 0) Then DataIndex(idxL) = I + 1 If (StrComp(strMCAData(I), strEndTag, vbTextCompare) = 0) Then DataIndex(idxU) = I - 1 Next GetMCAIndex = DataIndex ' Exit Function 'GetMCAIndexErr: ' DataIndex(idxL) = -1 'indicates not found ' DataIndex(idxU) = -1 'indicates not found ' GetMCAIndex = DataIndex ' MsgBox "GetMCAIndex " & Err.Description, vbCritical End Function Public Function GetMcaFile(ceFile As File, strFilename As String) As Variant Dim strFileArr() As String Dim iSize As Integer Dim TextLine As String Dim lRes As Long Dim I As Long iSize = 0 ceFile.Open strFilename, fsModeInput, fsAccessRead ' Open the list file. Do While Not ceFile.EOF ' Add the contents. ReDim Preserve strFileArr(iSize) strFileArr(iSize) = "" TextLine = ceFile.LineInputString strFileArr(iSize) = TextLine iSize = iSize + 1 Loop ceFile.Close 'old files have a linefeed (&H0A) vbLF as a line terminator 'only vbCR + vbLF or vbCR are valid line terminators 'files terminated with vbLF are read into one string only 'the string must be manually split up lRes = InStr(1, strFileArr(0), "<>", vbTextCompare) If ((iSize = 1) And (lRes > 0)) Then 'MsgBox "You can update old mca files by reading into wordpad and saving as text" lRes = 0 For I = 1 To Len(TextLine) If (Mid(TextLine, I, 1) = vbLf) Then lRes = lRes + 1 Next iSize = 0 Do While ((Len(TextLine) > 0) And (iSize < (lRes + 2))) ReDim Preserve strFileArr(iSize) strFileArr(iSize) = GetNextLine(TextLine, vbLf) iSize = iSize + 1 Loop End If GetMcaFile = strFileArr End Function 'get next var then remove from list Public Function GetNextLine(ByRef strList As String, strTerm As String) As String On Error Resume Next Dim strVar As String Dim VarPos As Long GetNextLine = "" VarPos = InStr(1, strList, strTerm) 'normal line terminator If (VarPos > 0) Then strVar = Trim(Left(strList, VarPos - 1)) If (Len(strVar) > 0) Then GetNextLine = strVar strList = Mid(strList, (VarPos + Len(strTerm))) Exit Function End If End If VarPos = Len(strList) If (VarPos > 0) Then strVar = Trim(strList) If (Len(strVar) > 0) Then GetNextLine = strVar strList = "" Exit Function End If End If End Function ' If (isStrFile) Then ' varMCAData = GetMcaFileFromStr(strFilename) 'read mca file data ' Else ' varMCAData = GetMcaFile(strFilename) 'read mca file data ' End If ' varMCAData = entire file contents in array of strings Public Function GetSpectrumData(varMCAData As Variant) As Variant Dim MCAData() As Double Dim idxFile As Long Dim idxData As Long Dim lastCh As Long Dim iData As Variant iData = GetMCAIndex(varMCAData, "<>", "<>") 'get location of spectrum data lastCh = iData(idxU) - iData(idxL) ReDim MCAData(lastCh) idxData = 0 For idxFile = iData(idxL) To iData(idxU) 'load the data into an array for processing MCAData(idxData) = CDbl(varMCAData(idxFile)) idxData = idxData + 1 Next GetSpectrumData = MCAData End Function Public Function GetSpectrumData2(varMCAData As Variant) As Variant Dim MCAData() As Double Dim idxFile As Long Dim idxData As Long Dim lastCh As Long Dim iData As Variant Dim MCAMax As Long Dim MCAPeak As Long iData = GetMCAIndex(varMCAData, "<>", "<>") 'get location of spectrum data lastCh = iData(idxU) - iData(idxL) ReDim MCAData(lastCh) idxData = 0 For idxFile = iData(idxL) To iData(idxU) 'load the data into an array for processing MCAData(idxData) = CDbl(varMCAData(idxFile)) If MCAData(idxData) > MCAMax Then MCAMax = MCAData(idxData) MCAPeak = idxData End If idxData = idxData + 1 Next MCAPeak = MCAPeak + 1 'channels have 1 based index PlotPeakVal = MCAMax PlotPeakChan = MCAPeak GetSpectrumData2 = MCAData End Function Public Function GetSpectrumStatus(varMCAData As Variant) As Variant Dim idxFile As Long Dim idxData As Long Dim strStatus As String Dim iData As Variant iData = GetMCAIndex(varMCAData, "<>", "<>") 'get location of spectrum data' If ((iData(idxL) = 0) Or (iData(idxU) = 0)) Then Exit Function For idxFile = iData(idxL) To iData(idxU) 'load the data into an array for processing strStatus = strStatus & varMCAData(idxFile) & vbNewLine Next GetSpectrumStatus = strStatus End Function Public Function GetSpectrumConfig(varMCAData As Variant) As Variant Dim idxFile As Long Dim idxData As Long Dim strConfig As String Dim iData As Variant iData = GetMCAIndex(varMCAData, "<>", "<>") 'get location of spectrum data If ((iData(idxL) = 0) Or (iData(idxU) = 0)) Then Exit Function For idxFile = iData(idxL) To iData(idxU) 'load the data into an array for processing strConfig = strConfig & varMCAData(idxFile) & vbNewLine Next GetSpectrumConfig = strConfig End Function