Attribute VB_Name = "modVariables"
Option Explicit
'****************************************************************
'* This module can be used freely for any non-commercial use and
'* is presented here for educational purposes only.
'* Contact Computer Services Contracting at CoSeCo@CoSeCo.com
'* for permission to use this module or it's function for commercial
'* use.
'*
'****************************************************************
Private Const MODULE_NAME = "modUser"
'This module is base in part on information in Microsoft articles and some that I made myself
'HOWTO: Convert Between Signed and Unsigned Numbers
'Last reviewed: July 16, 1998
'Article ID: Q189323
'see http://support.microsoft.com/support/kb/articles/q189/3/23.asp
'and
'Tip 22: Converting DWords, Words, and Bytes
'Created: March 1, 1995
'see http://premium.microsoft.com/msdn/library/techart/msdn_msdn22.htm


Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
Private Const OFFSET_2 = 65536
Private Const MAXINT_2 = 32767


Function fncCDblTouLng(dValue As Double) As Long
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncCDblTouLng")
    'Convert Double to Unsigned Long
    If dValue < 0 Or dValue >= OFFSET_4 Then Err.Raise 6 ' Overflow
    If dValue <= MAXINT_4 Then
        fncCDblTouLng = dValue
    Else
        fncCDblTouLng = dValue - OFFSET_4
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncCuLngToDbl(ulValue As Long) As Double
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncCuLngToDbl")
    'Convert  Unsigned Long to Double
    If ulValue < 0 Then
        fncCuLngToDbl = ulValue + OFFSET_4
    Else
        fncCuLngToDbl = ulValue
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncCLngTouInt(lValue As Long) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncCLngTouInt")
    'Convert  Unsigned Integer to Long
    If lValue < 0 Or lValue >= OFFSET_2 Then Err.Raise 6 ' Overflow
    If lValue <= MAXINT_2 Then
        fncCLngTouInt = lValue
    Else
        fncCLngTouInt = lValue - OFFSET_2
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncCuIntToLng(uValue As Integer) As Long
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncCuIntToLng")
    'Convert  Long to Unsigned Integer
    If uValue < 0 Then
        fncCuIntToLng = uValue + OFFSET_2
    Else
        fncCuIntToLng = uValue
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function
Function fncHiByte(ByVal wValue As Integer) As Byte
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncHiByte")
    If wValue And &H8000 Then
        fncHiByte = &H80 Or ((wValue And &H7FFF) \ &HFF)
    Else
        fncHiByte = wValue \ 256
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncHiWord(dwValue As Long) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncHiWord")
    If dwValue And &H80000000 Then
        fncHiWord = (dwValue \ 65535) - 1
    Else
        fncHiWord = dwValue \ 65535
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncLoByte(wValue As Integer) As Byte
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncLoByte")
    fncLoByte = wValue And &HFF
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncLoWord(dwValue As Long) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncLoWord")
    If dwValue And &H8000& Then
        fncLoWord = &H8000 Or (dwValue And &H7FFF&)
    Else
        fncLoWord = dwValue And &HFFFF&
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncLShiftWord(ByVal wValue As Integer, ByVal n As Integer) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncLShiftWord")
    Dim dw As Long
    dw = wValue * (2 ^ n)
    If dw And &H8000& Then
        fncLShiftWord = CInt(dw And &H7FFF&) Or &H8000
    Else
        fncLShiftWord = dw And &HFFFF&
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncRShiftWord(ByVal w As Integer, ByVal n As Integer) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncRShiftWord")
    Dim dw As Long
    If n = 0 Then
        fncRShiftWord = w
    Else
        dw = w And &HFFFF&
        dw = dw \ (2 ^ n)
        fncRShiftWord = dw And &HFFFF&
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncMakeWord(ByVal bHi As Byte, ByVal bLo As Byte) As Integer
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncMakeWord")
    If bHi And &H80 Then
        fncMakeWord = (((bHi And &H7F) * 256) + bLo) Or &H8000
    Else
        fncMakeWord = (bHi * 256) + bLo
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function

Function fncMakeDWord(wHi As Integer, wLo As Integer) As Long
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncMakeDWord")
    If wHi And &H8000& Then
        fncMakeDWord = (((wHi And &H7FFF&) * 65536) Or (wLo And &HFFFF&)) Or &H80000000
    Else
        fncMakeDWord = (wHi * 65535) + wLo
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function


Public Function fncTrimNulls(s As String) As String
Dim lCallChain As Long
lCallChain = fncAddProcedure(ModuleName & "-fncTrimNulls")
    If InStr(s, Chr$(0)) > 0 Then
        fncTrimNulls = Left$(s, InStr(s, Chr$(0)) - 1)
    Else
        fncTrimNulls = s
    End If
subRemoveProcedureFromCallChain (lCallChain)
End Function
Public Property Get ModuleName() As String
    ModuleName = MODULE_NAME
End Property