Attribute VB_Name = "modXLConfig"
Option Explicit

'=====================================================
'uses xlAppCls - excel application class
'=====================================================


Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const REG_SZ As Long = 1
Private Const KEY_ALL_ACCESS = &H3F
Private Const HKEY_LOCAL_MACHINE = &H80000002

Public xlAppCls1 As xlAppCls
Public colCfgFile As New Collection
Public colCfgDesc As New Collection

Public Enum XLCfgEntry
    xlcfgNone
    xlcfgFilename
    xlcfgDescription
    xlcfgCurrent_COM_Port
    xlcfgRise
    xlcfgTop
    xlcfgFastChThreshold
    xlcfgPUR_Enable
    xlcfgRTD_ON_OFF
    xlcfgRTD_threshold
    xlcfgRTD_Fast_HWHM
    xlcfgAutoBaseline
    xlcfgBLR
    xlcfgMCA_Channels
    xlcfgSlowChThreshold
    xlcfgBuffer_Select
    xlcfgGate_Input_TTL
    xlcfgPreset
    xlcfgCoarse_Gain
    xlcfgFine_Gain
    xlcfgInput_Polarity
    xlcfgInputOffset
    xlcfgPoleZero
    xlcfgDet_Rst_Lockout
    xlcfgTEC
    xlcfgHV
    xlcfgPreamp_Power
    xlcfgAnalog_Out
    xlcfgOutputOffset
    xlcfgAux
    xlcfgAudio
End Enum

Public Function GetXLCfgEntryLabel(Index As Integer) As String
    Select Case Index
        Case xlcfgNone
            GetXLCfgEntryLabel = "XLCfgEntry"
        Case xlcfgFilename
            GetXLCfgEntryLabel = "Filename"
        Case xlcfgDescription
            GetXLCfgEntryLabel = "Description"
        Case xlcfgCurrent_COM_Port
            GetXLCfgEntryLabel = "Current_COM_Port"
        Case xlcfgRise
            GetXLCfgEntryLabel = "Rise"
        Case xlcfgTop
            GetXLCfgEntryLabel = "Top"
        Case xlcfgFastChThreshold
            GetXLCfgEntryLabel = "FastChThreshold"
        Case xlcfgPUR_Enable
            GetXLCfgEntryLabel = "PUR_Enable"
        Case xlcfgRTD_ON_OFF
            GetXLCfgEntryLabel = "RTD_ON_OFF"
        Case xlcfgRTD_threshold
            If (DppDevice = DPPDP5) Then
                GetXLCfgEntryLabel = "RTD Ratio"
            Else
                GetXLCfgEntryLabel = "RTD_threshold"
            End If
        Case xlcfgRTD_Fast_HWHM
            If (DppDevice = DPPDP5) Then
                GetXLCfgEntryLabel = "RTD Slow Thresh"
            Else
                GetXLCfgEntryLabel = "RTD_Fast_HWHM"
            End If
        Case xlcfgAutoBaseline
            GetXLCfgEntryLabel = "AutoBaseline"
        Case xlcfgBLR
            GetXLCfgEntryLabel = "BLR"
        Case xlcfgMCA_Channels
            GetXLCfgEntryLabel = "MCA_Channels"
        Case xlcfgSlowChThreshold
            GetXLCfgEntryLabel = "SlowChThreshold"
        Case xlcfgBuffer_Select
            GetXLCfgEntryLabel = "Buffer_Select"
        Case xlcfgGate_Input_TTL
            GetXLCfgEntryLabel = "Gate_Input_TTL"
        Case xlcfgPreset
            GetXLCfgEntryLabel = "Preset"
        Case xlcfgCoarse_Gain
            GetXLCfgEntryLabel = "Coarse_Gain"
        Case xlcfgFine_Gain
            GetXLCfgEntryLabel = "Fine_Gain"
        Case xlcfgInput_Polarity
            GetXLCfgEntryLabel = "Input_Polarity"
        Case xlcfgInputOffset
            GetXLCfgEntryLabel = "InputOffset"
        Case xlcfgPoleZero
            GetXLCfgEntryLabel = "PoleZero"
        Case xlcfgDet_Rst_Lockout
            GetXLCfgEntryLabel = "Det_Rst_Lockout"
        Case xlcfgTEC
            GetXLCfgEntryLabel = "TEC"
        Case xlcfgHV
            GetXLCfgEntryLabel = "HV"
        Case xlcfgPreamp_Power
            GetXLCfgEntryLabel = "Preamp_Power"
        Case xlcfgAnalog_Out
            GetXLCfgEntryLabel = "Analog_Out"
        Case xlcfgOutputOffset
            GetXLCfgEntryLabel = "OutputOffset"
        Case xlcfgAux
            GetXLCfgEntryLabel = "Aux"
        Case xlcfgAudio
            GetXLCfgEntryLabel = "Audio"
        Case Else
            GetXLCfgEntryLabel = "XLCfgEntry"
    End Select
End Function

Public Function GetXLCfgEntryValue(Index As Integer, strValue As String) As String
    Dim dblValue As Double
    Dim strNewValue As String
    Dim strPercent As String
    Select Case Index
        Case xlcfgNone
            GetXLCfgEntryValue = strValue
        Case xlcfgFilename
            GetXLCfgEntryValue = strValue
        Case xlcfgDescription
            GetXLCfgEntryValue = strValue
        Case xlcfgCurrent_COM_Port
            GetXLCfgEntryValue = strValue
        Case xlcfgRise
            GetXLCfgEntryValue = strValue
        Case xlcfgTop
            GetXLCfgEntryValue = strValue
        Case xlcfgFastChThreshold
            GetXLCfgEntryValue = strValue
        Case xlcfgPUR_Enable
            GetXLCfgEntryValue = "PUR" & strValue
        Case xlcfgRTD_ON_OFF
            GetXLCfgEntryValue = "RTD" & strValue
        Case xlcfgRTD_threshold
            If (DppDevice = DPPDP5) Then
                strPercent = GetXLPercentDoubleStr(strValue)
                dblValue = atof(strPercent)
                strNewValue = Format(dblValue, "0.0") & "%"
                GetXLCfgEntryValue = strNewValue
            Else
                strPercent = GetXLPercentDoubleStr(strValue)
                dblValue = atof(strPercent)
                strNewValue = Format(dblValue, "0.00") & "% FS"
                GetXLCfgEntryValue = strNewValue
            End If
        Case xlcfgRTD_Fast_HWHM
            If (DppDevice = DPPDP5) Then
                strPercent = GetXLPercentDoubleStr(strValue)
                dblValue = atof(strPercent)
                strNewValue = Format(dblValue, "0") & "% FS"
                GetXLCfgEntryValue = strNewValue
            Else
                GetXLCfgEntryValue = strValue
            End If
        Case xlcfgAutoBaseline
            GetXLCfgEntryValue = strValue
        Case xlcfgBLR
            GetXLCfgEntryValue = GetBLRStrFromXLStr(strValue)
        Case xlcfgMCA_Channels
            GetXLCfgEntryValue = strValue
        Case xlcfgSlowChThreshold
            strPercent = GetXLPercentDoubleStr(strValue)
            dblValue = atof(strPercent)
            strNewValue = Format(dblValue, "0.00") & "% FS"
            GetXLCfgEntryValue = strNewValue
        Case xlcfgBuffer_Select
            GetXLCfgEntryValue = strValue
        Case xlcfgGate_Input_TTL
            GetXLCfgEntryValue = strValue
        Case xlcfgPreset
            GetXLCfgEntryValue = strValue
        Case xlcfgCoarse_Gain
            dblValue = atof(strValue)
            strNewValue = Format(dblValue, "0.00") & "x"
            GetXLCfgEntryValue = strNewValue
        Case xlcfgFine_Gain
            dblValue = atof(strValue)
            strNewValue = Format(dblValue, "0.0000")
            GetXLCfgEntryValue = strNewValue
        Case xlcfgInput_Polarity
            GetXLCfgEntryValue = strValue
        Case xlcfgInputOffset
            GetXLCfgEntryValue = strValue
        Case xlcfgPoleZero
            If (InStr(1, strValue, "off", vbTextCompare) > 0) Then
                GetXLCfgEntryValue = "OFF"
            Else
                GetXLCfgEntryValue = strValue
            End If
        Case xlcfgDet_Rst_Lockout
            If (InStr(1, strValue, "off", vbTextCompare) > 0) Then
                GetXLCfgEntryValue = "OFF"
            Else
                GetXLCfgEntryValue = strValue
            End If
        Case xlcfgTEC
            dblValue = atof(strValue)
            strNewValue = Format(dblValue, "0.0") & "K"
            GetXLCfgEntryValue = strNewValue
        Case xlcfgHV
            dblValue = atof(strValue)
            strNewValue = Format(dblValue, "0.0") & "V"
            GetXLCfgEntryValue = strNewValue
        Case xlcfgPreamp_Power
            GetXLCfgEntryValue = strValue
        Case xlcfgAnalog_Out
            GetXLCfgEntryValue = strValue
        Case xlcfgOutputOffset
            GetXLCfgEntryValue = strValue
        Case xlcfgAux
            GetXLCfgEntryValue = strValue
        Case xlcfgAudio
            GetXLCfgEntryValue = strValue
        Case Else
    End Select
End Function

'opens worksheet1
Public Function OpenWorkSheet(strWorkbookName As String) As Boolean
    Dim strDate As String                               'date working copy
    Dim strWorkSheet As String                          'sheet month index
    Dim strRes As Variant                               'return value
    OpenWorkSheet = False
    
    Set xlAppCls1 = New xlAppCls                        'create new app instance
    xlAppCls1.xlWorkbookName = strWorkbookName          'set the workbook path
    xlAppCls1.ShowWorkbook     'open Workbook
    xlAppCls1.xlSheetName = "Sheet1"                'set the worksheet index
    strRes = xlAppCls1.ActvateWorkSheet("Sheet1")   'activate the worksheet
    If (strRes = "Sheet1") Then
        OpenWorkSheet = True
    Else
        OpenWorkSheet = False
    End If
End Function

Public Sub SaveWorkbook(strWorkbookName As String)
    xlAppCls1.SaveAsExcelWorkbook (App.path & "\temp1.xls")
    xlAppCls1.QuitXLApp
    Set xlAppCls1 = Nothing
End Sub

Public Sub QuitWorkbook()
    xlAppCls1.QuitXLApp
    Set xlAppCls1 = Nothing
End Sub

Public Function GetExcelPath() As Boolean
    Dim strExcelPath As String
    Dim xlVersion As String
    Dim xlFound As Boolean
    Dim PathLen As Long
    
    'Search for excel
    xlFound = False
    GetExcelPath = False
    xlVersion = "No Excel Found"
    
    'Search For Old Excel App
    strExcelPath = GetOfficeAppPath("Excel.Application")
    If (Len(Trim(strExcelPath)) > 0) Then
        xlVersion = "Pre-Excel 2000"
        xlFound = True
    End If
   
    'Search For Excel 2003 App
    If ((Len(Trim(strExcelPath)) = 0) Or (Not xlFound)) Then   'haven't found yet, try Excel 2003
        strExcelPath = GetOfficeAppPath("Excel.Application.11")
        If (Len(Trim(strExcelPath)) > 0) Then
            xlVersion = "Excel 2003"
            xlFound = True
        End If
    End If
    
    'Search For Excel 2002 App
    If ((Len(Trim(strExcelPath)) = 0) Or (Not xlFound)) Then   'haven't found yet, try Excel 2002
        strExcelPath = GetOfficeAppPath("Excel.Application.10")
        If (Len(Trim(strExcelPath)) > 0) Then
            xlVersion = "Excel 2002"
            xlFound = True
        End If
    End If
    
    'Search For Excel 2000 App
    If ((Len(Trim(strExcelPath)) = 0) Or (Not xlFound)) Then   'haven't found yet, try Excel 2000
        strExcelPath = GetOfficeAppPath("Excel.Application.9")
        If (Len(Trim(strExcelPath)) > 0) Then
            xlVersion = "Excel 2000"
            xlFound = True
        End If
    End If
    
    'display search results
    If ((Len(Trim(strExcelPath)) > 0) And xlFound) Then
        If (InStr(1, strExcelPath, "excel.exe", vbTextCompare) > 0) Then
            'MsgBox strExcelPath & vbNewLine & xlVersion
            'xlFound = True
        Else
            xlFound = False
        End If
    End If
    GetExcelPath = xlFound
End Function

Private Function GetOfficeAppPath(ByVal ProgID As String) As String
    Dim lKey As Long
    Dim lRet As Long
    Dim sClassID As String
    Dim sAns As String
    Dim lngBuffer As Long
    Dim lPos As Long
    
    'GetClassID
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & ProgID & "\CLSID", 0&, KEY_ALL_ACCESS, lKey)
    If lRet = 0 Then
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
        sClassID = Space(lngBuffer)
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sClassID, lngBuffer)
        
        'drop null-terminator
        sClassID = Left(sClassID, lngBuffer - 1)
        RegCloseKey lKey
    End If
    
    'Get AppPath
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\CLSID\" & sClassID & "\LocalServer32", 0&, KEY_ALL_ACCESS, lKey)
    
    If lRet = 0 Then
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
        sAns = Space(lngBuffer)
        lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sAns, lngBuffer)
        sAns = Left(sAns, lngBuffer - 1)
        RegCloseKey lKey
    End If
    
    'Sometimes the registry will return a switch
    'beginning with "/" e.g., "/automation"
    
    lPos = InStr(sAns, "/")
    If lPos > 0 Then
        sAns = Trim(Left(sAns, lPos - 1))
    End If
    
    GetOfficeAppPath = sAns
End Function