Snippet Library

Option Explicit
'modBits.bas
'-------------------------------------------------------------
' Summary of contained methods:
'-------------------------------------------------------------
'   HiWord()
'   LoWord()
'   Word()
'   HexToNumber()
'   HexEx()
'   ProcPtr()
'   Random()

'-------------------------------------------------------------
' API Function Declarations
'-------------------------------------------------------------
Private Declare Sub CopyMemory Lib "kernel32" _
	Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
	ByVal ByteLen As Long)

Public Function Random(ByVal Lowerbound As Long, ByVal Upperbound As Long) As Long
    '-------------------------------------------------------------
    ' Returns a random number between Lowerbound and Upperbound.
    '-------------------------------------------------------------
    
    Random = Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)
End Function


Public Function ProcPtr(ByVal pAddressOfProc As Long) As Long
    '-------------------------------------------------------------
    ' Returns the pointer for a function. pAddressOfProc should
    ' be passed as AddressOf [proceedure name].
    '
    ' Example usage:
    '
    '   pProc = ProcPtr(AddressOf HexEx)
    '-------------------------------------------------------------
    
    ProcPtr = pAddressOfProc
End Function


Public Function HexEx(ByVal iDec As Long, _
    Optional iLen As Integer = 8, _
    Optional bCNotation As Boolean) As String
    '-------------------------------------------------------------
    ' An enhanced version of VB's Hex() method that lets you
    ' specify how may preceeding zero's to keep in the output
    ' notation. Optionally, you can specify to use C notation for
    ' hex.
    '-------------------------------------------------------------

    Dim sHex As String
    sHex = Right$(String(iLen, "0") & Hex(iDec), iLen)
    
    If bCNotation Then
        HexEx = "0x" & sHex
    Else
        HexEx = "&H" & sHex
    End If
End Function


Public Function HexToNumber(ByVal sHexValue As String) As Long
    '-------------------------------------------------------------
    ' Converts the string representation of a hexidecimal number
    ' into a long value. It does account for the C notation (0x..)
    ' as well as VB's (&H..).
    '-------------------------------------------------------------
    Dim iVal As Long
    Dim i As Integer
    Dim iLen As Integer
    
    Const cHexChars = "0123456789ABCDEF"
    
    sHexValue = UCase$(sHexValue)
    
    If InStr(sHexValue, "H") > 0 Then
        sHexValue = Mid$(sHexValue, InStr(sHexValue, "H") + 1)
    Else
        If InStr(sHexValue, "X") > 0 Then
            sHexValue = Mid$(sHexValue, InStr(sHexValue, "X") + 1)
        End If
    End If
    
    iLen = Len(sHexValue)
    For i = iLen To 1 Step -1
        iVal = iVal + ((16 ^ (iLen - i)) * (InStr(cHexChars, Mid$(sHexValue, i, 1)) - 1))
    Next i
    
    If Hex(iVal) <> sHexValue Then
        Err.Raise 5   'illegal function call
    Else
        HexToNumber = iVal
    End If
End Function



Public Function Word(ByVal LoWord As Integer, _
    ByVal HiWord As Integer) As Long
    '-------------------------------------------------------------
    ' Packs two integers into a long.
    '-------------------------------------------------------------
    '   API declarations:
    '-------------------------------------------------------------
    '   Private Declare Sub CopyMemory Lib "kernel32" _
    '       Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
    '       ByVal ByteLen As Long)
    '-------------------------------------------------------------
    Dim dw As Long
    
    CopyMemory dw, LoWord, 2&
    CopyMemory ByVal VarPtr(dw) + 2, HiWord, 2&
    
    Word = dw
End Function



Public Function HiWord(ByVal dw As Long) As Integer
    '-------------------------------------------------------------
    ' Extracts the HIWORD from a long.
    '-------------------------------------------------------------
    '   API declarations:
    '-------------------------------------------------------------
    '   Private Declare Sub CopyMemory Lib "kernel32" _
    '       Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
    '       ByVal ByteLen As Long)
    '-------------------------------------------------------------
    
    CopyMemory HiWord, ByVal VarPtr(dw) + 2, 2&
End Function



Public Function LoWord(ByVal dw As Long) As Integer
    '-------------------------------------------------------------
    ' Extracts the LOWORD from a long.
    '-------------------------------------------------------------
    '   API declarations:
    '-------------------------------------------------------------
    '   Private Declare Sub CopyMemory Lib "kernel32" _
    '       Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
    '       ByVal ByteLen As Long)
    '-------------------------------------------------------------
    CopyMemory LoWord, dw, 2&
End Function
;