Attribute VB_Name = "modSupport"
Option Explicit

Public Declare Sub DebugBreak Lib "kernel32" ()
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'=== System MessageBox ===========================================================
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Const MB_ICONASTERISK = &H40&
Public Const MB_ICONEXCLAMATION = &H30&
Public Const MB_ICONHAND = &H10&
Public Const MB_ICONINFORMATION = MB_ICONASTERISK
Public Const MB_ICONMASK = &HF0&
Public Const MB_ICONQUESTION = &H20&
Public Const MB_ICONSTOP = MB_ICONHAND
Public Const MB_MISCMASK = &HC000&
Public Const MB_MODEMASK = &H3000&
Public Const MB_NOFOCUS = &H8000&
Public Const MB_OK = &H0&
Public Const MB_OKCANCEL = &H1&
Public Const MB_PRECOMPOSED = &H1         '  use precomposed chars
Public Const MB_RETRYCANCEL = &H5&
Public Const MB_SETFOREGROUND = &H10000
Public Const MB_SYSTEMMODAL = &H1000&
Public Const MB_TASKMODAL = &H2000&
Public Const MB_TYPEMASK = &HF&
Public Const MB_USEGLYPHCHARS = &H4         '  use glyph chars, not ctrl chars
Public Const MB_YESNO = &H4&
Public Const MB_YESNOCANCEL = &H3&
'=================================================================================

Private SetBits(0 To 31) As Long

Public Function ShiftLeft(ByVal value As Long, ByVal Shift As Integer) As Long
    If (Shift = 31) Then    'shifting 31 causes vb overflow error
        If ((value And &H1) = 0) Then
            ShiftLeft = 0
        Else
            ShiftLeft = &H80000000
        End If
    ElseIf (Shift > 31) Then    'shifting 31 causes vb overflow error
        ShiftLeft = 0
    Else
        SaveSetBits
        If (value And (2 ^ (31 - Shift))) Then GoTo OverFlow
        ShiftLeft = ((value And SetBits(31 - Shift)) * (2 ^ Shift))
    End If
    Exit Function
OverFlow:
    ShiftLeft = ((value And SetBits(31 - (Shift + 1))) * (2 ^ (Shift))) Or &H80000000
End Function

Public Function ShiftRight(ByVal value As Long, ByVal Shift As Integer) As Long
    Dim hi As Long
    If (Shift = 31) Then    'shifting 31 causes vb overflow error
        ShiftRight = IntBool(Not ((value And &H80000000) = 0))
    ElseIf (Shift > 31) Then    'shifting 31 causes vb overflow error
        ShiftRight = 0
    Else
        SaveSetBits
        If (value And &H80000000) Then hi = &H40000000
        ShiftRight = (value And &H7FFFFFFE) \ (2 ^ Shift)
        ShiftRight = (ShiftRight Or (hi \ (2 ^ (Shift - 1))))
    End If
End Function

Private Sub SaveSetBits()
    Dim i As Integer
    Dim value As Long
  
    For i = 0 To 30
        value = value + (2 ^ i)
        SetBits(i) = value
    Next i
    SetBits(i) = value + &H80000000
End Sub

Public Function IntBool(vbBool As Boolean) As Integer
    If (vbBool) Then
        IntBool = 1
    Else
        IntBool = 0
    End If
End Function

'' spin values 0-16
'' to get blr setting BLR=((spin+15) << 2)
'int CDppBLR::SpinToBLR(int SpinVal)
Public Function SpinToBLR(SpinVal As Integer) As Byte
    If ((SpinVal <= 0) Or (SpinVal > 16)) Then
        SpinToBLR = 63
    Else
        SpinToBLR = ShiftLeft((SpinVal + 15), 2)
    End If
End Function

Public Function BLRToSpin(BLRVal As Byte) As Integer
    If ((BLRVal <= 63) Or (BLRVal > 124)) Then
        BLRToSpin = 0
    Else
        BLRToSpin = (ShiftRight(BLRVal, 2) - 15)
    End If
End Function

'this function puts spaces in strings to align description Text (Right)
'NOTE: needs fixed width font to display correctly
'^^^^^^^^^^^^Description :
Public Function TR(strStr As String, bufsize As Integer) As String
    Dim posStart As Long
    Dim posEnd As Long
    Dim strText As String
    Dim strBuffer As String
    Dim lenStr As Long
    Dim strDescr As String
    Dim remNL As Boolean        'flag, if text has vb nl as first chars don't remove (ie =false)
    Dim lenAdj As Long       'adjust the string search for increase in size due to alignment
    Dim strPre As String
    Dim strMid As String
    Dim strEnd As String
    Dim loopCntr As Integer
    
    On Error GoTo trErr
    TR = strStr
    'If (InStr(1, strText, vbNewLine) = 1) Then
    If (InStr(1, strStr, vbNewLine) = 1) Then
        remNL = False
    Else
        strText = vbNewLine & strStr                    'append NL to string
        remNL = True                                    'will need to remove nl
    End If
    posStart = 1
    posEnd = 1
    lenStr = 0
    lenAdj = 0
    loopCntr = 0
    Do
        posStart = posStart + lenAdj
        posEnd = posEnd + lenAdj
        posStart = InStr(posEnd, strText, vbNewLine) + 2    'posStart at NL (2 chars)
        posEnd = InStr(posStart, strText, ":") + 1          'posEnd at ":"  (1 char)
        If (posEnd < 2) Then Exit Do
        lenStr = (posEnd - posStart) + 1
        lenAdj = bufsize - lenStr
        'strBuffer = Space(lenAdj)                           'create spaces buffer
        'strBuffer = String(lenAdj, "#")                           'create spaces buffer
        strBuffer = String(lenAdj, " ")                           'create spaces buffer
        strDescr = Mid(strText, posStart, lenStr)           'get string to be aligned
        
        strPre = Mid(strText, 1, posStart - 1)
        strMid = strBuffer & strDescr
        strEnd = Mid(strText, posEnd + 1)
        
        'insert string with buffer of spaces
        strText = strPre & strMid & strEnd
        If (loopCntr > 100) Then Exit Function  'exit if in infinite loop (won't do 100 lines)
    Loop While ((posEnd > 1) And (posEnd < Len(strText)))          'Loop Until ":" Not found
    
    
    If remNL Then strText = Mid(strText, 3) 'remove leading nl
    'MsgBox strText
    TR = strText
    Exit Function
trErr:
    'MsgBox Err.Description
    'exit without returning aligned string
End Function

Public Function GetDecNumber(strTextIn As String) As String
    Dim i As Integer
    Dim strText As String
    Dim tmpStr As String
    Dim ch As String
    Dim DPFound As Boolean
    Dim SignFound As Boolean
    Dim DigitFound As Boolean
    
    DPFound = False
    SignFound = False
    DigitFound = False
    tmpStr = strTextIn
    strText = ""
    For i = 1 To Len(tmpStr)    '48 to 57
        ch = Mid(tmpStr, i, 1)
        If ((Asc(ch) > 47) And (Asc(ch) < 58)) Then     'append digit
            DigitFound = True
            strText = strText & ch
        ElseIf ((Asc(ch) = 45) And (Not SignFound)) Then 'minus sign
            SignFound = True
            If (DigitFound) Then strText = strText & ch  'don't append after digits
        ElseIf ((Asc(ch) = 46) And (Not DPFound)) Then 'decimal point
            DPFound = True
            strText = strText & ch
        End If
    Next
    GetDecNumber = strText
End Function

Public Function GetXLPercentDoubleStr(strPercent As String) As String
    Dim strDouble As String
    Dim lPos As Long
    Dim dblPercent As Double
    
    If (Len(Trim(strPercent)) = 0) Then
        GetXLPercentDoubleStr = ""
        Exit Function
    End If
    strDouble = strPercent  'make working copy, don't change original
    'is FS text in string, if so string was not converted to percent double
    lPos = InStr(1, strDouble, "FS", vbTextCompare)
    If (lPos > 1) Then strDouble = Trim(Left(strDouble, lPos - 1))
    'is % sign in string, if so string was not converted to percent double
    lPos = InStr(1, strDouble, "%", vbTextCompare)
    If (lPos > 1) Then
        strDouble = Trim(Left(strDouble, lPos - 1))
    Else    'else is a percent double absolute value
        dblPercent = atof(strDouble) * 100#
        strDouble = CStr(dblPercent)
    End If
    GetXLPercentDoubleStr = strDouble
End Function

Public Function atof(strNumber As String) As Double
    Dim strDouble As String
    
    strDouble = GetDecNumber(strNumber)
    If (IsNumeric(strDouble)) Then
        atof = CDbl(strDouble)
    Else
        atof = 0#
    End If
End Function

Public Function GetBLRStrFromXLStr(strBLRIn As String) As String
    Dim strBLR As String
    Dim BLR0 As Long
    Dim BLR1 As Long
    Dim sepPos As Long
    
    If (InStr(1, strBLRIn, "off", vbTextCompare)) Then
        GetBLRStrFromXLStr = "BLR:OFF"
    Else
        strBLR = Trim(strBLRIn)
        sepPos = InStr(1, strBLR, " ")
        If (sepPos > 0) Then
            BLR0 = Val(Mid(strBLR, sepPos + 1))
            BLR1 = Val(Left(strBLR, sepPos - 1))
            GetBLRStrFromXLStr = "BLR:ON DN:" & CStr(BLR1) & " UP:" & CStr(BLR0)
        End If
    End If
End Function