Attribute VB_Name = "modDP5Status"
Option Explicit

'Amptek DPP Device Types
Public Const DPPNONE = &H0
Public Const DPPDP4 = &H1
Public Const DPPPX4 = &H2
Public Const DPPDP4EMUL = &H3
Public Const DPPDP5 = &H4 '

Public Function ReceiveArray(strInBuffer As String) As Variant
    Dim StrLen As Long
    Dim idxData As Long
    Dim ByteArr() As Byte
    
    On Error GoTo ReceiveArrayError
    
    StrLen = Len(strInBuffer)
    ReDim ByteArr(StrLen - 1)
    For idxData = 0 To StrLen - 1
        ByteArr(idxData) = CByte(Asc(Mid(strInBuffer, idxData + 1, 1)))
    Next idxData
    ReceiveArray = ByteArr
    
    Exit Function
ReceiveArrayError:
    MsgBox Err.Description, vbCritical, "Receive Array Error"
End Function

Public Function ProcessStatus(StatusBuf As Variant) As String
    Dim strStatus As String
    Dim strDppType As String
    Dim FPGA As Byte            ' FPGA version
    Dim Firmware As Byte        ' embedded code version
    'Dim SerialNumber As Long     'unit serial number
    Dim SerialNumber As Double     'unit serial number
    Dim BootStatus As Byte
    Dim DeviceType As Integer
    Dim StatDevInd As Byte          'device indicator from status block (0=dp4(emul dpp5),1=px4(emul dpp5))
    'Dim bb_BootFlags As Integer     'DP5 boot flags block
    Dim bb_BootFlags As Long     'DP5 boot flags block
    
    On Error GoTo ProcessStatusError
    
    FPGA = StatusBuf(8)
    Firmware = StatusBuf(13)
    SerialNumber = CLng(StatusBuf(14)) + CLng(StatusBuf(15)) * 256 + CLng(StatusBuf(16)) * 65536 + CLng(StatusBuf(17)) * (2 ^ 24)
    BootStatus = StatusBuf(23) ' boot flags
    StatDevInd = ((BootStatus And 128) / 128)          ' d7 device indicator from status  (0=dp4,1=px4)
    DeviceType = GetDppDeviceType(Firmware, StatDevInd)                    ' DPP5 20071017 get the dpp device type from status'
    bb_BootFlags = (StatusBuf(&H35) * 256) + StatusBuf(&H34)           '0x34-35 Boot flags (MSB currently unused)
    strDppType = DPPTypeString(DeviceType)
    strStatus = "Device Type: " & strDppType & vbNewLine
    strStatus = strStatus & "Serial Number: " & CStr(Format(SerialNumber, "0000")) & vbNewLine
    strStatus = strStatus & "Firmware: " & Right(CStr((Firmware And 240) / 16), 1) & "." & FormatNumber(Firmware And 15, 0) & vbNewLine
    strStatus = strStatus & "FPGA: " & Right(CStr((FPGA And 112) / 16), 1) & "." & FormatNumber(FPGA And 15, 0) & vbNewLine
    ProcessStatus = strStatus
    
    Exit Function
ProcessStatusError:
    MsgBox Err.Description, vbCritical, "Process Status Error"
End Function

Public Function GetDppDeviceType(Firmware As Byte, StatDevInd As Byte) As Integer
    Dim isDPP5 As Long      'indicates DPP5 type device
    
    On Error GoTo GetDppDeviceTypeError
    
    isDPP5 = Abs(Firmware >= &H50)
    GetDppDeviceType = ((isDPP5 * 2) + (StatDevInd * 1)) + 1
    
    Exit Function
GetDppDeviceTypeError:
    MsgBox Err.Description, vbCritical, "Get Dpp Device Type Error"
End Function

Public Function DPPTypeString(DPPDeviceVal As Integer) As String
    Select Case (DPPDeviceVal)
        Case DPPDP4
            DPPTypeString = "DP4"
        Case DPPPX4
            DPPTypeString = "PX4"
        Case DPPDP4EMUL
            'DPPTypeString = "DP4 EMUL"
            DPPTypeString = "DP5"
        Case DPPDP5
            DPPTypeString = "DP5"
        Case Else
            DPPTypeString = "DPP"   'default
    End Select
End Function

Public Function FormatNumber(ByVal dwNum As Currency, Optional NumPlacesAfterDec As Long) As Currency
    Dim sTemp As String
    Dim sNew As String
    Dim lDec As Long
    
    On Error GoTo FormatNumberError
    
    sTemp = dwNum
    lDec = InStr(1, sTemp, ".", vbTextCompare)
    If lDec = 0 Then
        FormatNumber = dwNum
    Else
        sNew = Left(sTemp, lDec + NumPlacesAfterDec)
        FormatNumber = Val(sNew)
    End If
    
    Exit Function
FormatNumberError:
    MsgBox Err.Description, vbCritical, "Format Number Error"
End Function