'File:      mBit.bas
'Name:      位运算模块
'Author:    zyl910
'Version:   V2.0
'Updata:    2006-4-29
'E-Mail:    zyl910@sina.com
'
'特点：在使用BitPosMask、BitMapMask、BitsMask前必须初始化
'需要初始化

'[2006-4-29]V2.0
'1.加了许多常数
'2.全面修改算法
'3.取消原来的属性设计，使用函数
'4.增加位扫描函数
'5.增加端序处理函数

Option Explicit

'#################################################
'## Const 常数 ###################################
'#################################################

'## 全局编译常数 #################################
'请在工程属性对话框设置“条件编译参数”

'IsRelease: 是否是发布版（编译成本机代码，启动所有高级优化）

'## 私有编译常数 #################################

'是否是大端方式。默认为False - 小端方式
#Const IsBigEndianSystem = False

'## 全局常数 #####################################

'== Bit4 =========================================
Public Const Bit4BitCount As Long = 4
Public Const Bit4AllMask As Byte = &HF
Public Const Bit4SMask   As Byte = &H8
Public Const Bit4NSMask As Byte = Bit4AllMask And Not Bit4SMask

'== BYTE =========================================
Public Const ByteBitCount As Long = 8
Public Const ByteAllMask As Byte = &HFF
Public Const ByteSMask   As Byte = &H80
Public Const ByteNSMask As Byte = ByteAllMask And Not ByteSMask

'== WORD =========================================
Public Const WordBitCount As Long = 16
Public Const WordAllMask As Integer = &HFFFF
Public Const WordSMask   As Integer = &H8000
Public Const WordNSMask As Integer = WordAllMask And Not WordSMask

'== DWORD ========================================
Public Const DWordBitCount As Long = 32
Public Const DWordAllMask As Long = &HFFFFFFFF
Public Const DWordSMask   As Long = &H80000000
Public Const DWordNSMask As Long = DWordAllMask And Not DWordSMask

'== Bit4 to BYTE =================================
Public Const byLoBit4Mask As Byte = Bit4AllMask
Public Const byHiBit4Mask As Byte = ByteAllMask And Not byLoBit4Mask

Public Const byHiBit4LS As Long = 4
Public Const byHiBit4LSN As Byte = (byHiBit4Mask And (byHiBit4Mask - 1)) Xor byHiBit4Mask

'== BYTE to WORD =================================
Public Const wLoByteMask As Integer = ByteAllMask
Public Const wHiByteMask As Integer = WordAllMask And Not wLoByteMask

Public Const wHiByteLS As Long = 8
Public Const wHiByteLSN As Integer = (wHiByteMask And (wHiByteMask - 1)) Xor wHiByteMask

'== WORD to DWORD ================================
Public Const dwLoWordMask As Long = &HFFFF&
Public Const dwHiWordMask As Long = DWordAllMask And Not dwLoWordMask

Public Const dwHiWordLS As Long = 16
Public Const dwHiWordLSN As Long = (dwHiWordMask And (dwHiWordMask - 1)) Xor dwHiWordMask

Public Const dwWordSMask As Long = WordSMask And dwLoWordMask

'== BYTE to DWORD ================================
Public Const dwByte0Mask       As Long = &HFF&
Public Const dwByte1Mask     As Long = &HFF00&
Public Const dwByte2Mask   As Long = &HFF0000
Public Const dwByte3Mask As Long = &HFF000000

'8位数据的左移位数
Public Const dwByte0LS As Long = ByteBitCount * 0
Public Const dwByte1LS As Long = ByteBitCount * 1
Public Const dwByte2LS As Long = ByteBitCount * 2
Public Const dwByte3LS As Long = ByteBitCount * 3

'VB没有移位运算符，只有用除法来模拟
Public Const dwByte0LSN As Long = (dwByte0Mask And (dwByte0Mask - 1)) Xor dwByte0Mask
Public Const dwByte1LSN As Long = (dwByte1Mask And (dwByte1Mask - 1)) Xor dwByte1Mask
Public Const dwByte2LSN As Long = (dwByte2Mask And (dwByte2Mask - 1)) Xor dwByte2Mask
Public Const dwByte3LSN As Long = (dwByte3Mask And (dwByte3Mask - 1)) Xor dwByte3Mask

'## 私有常数 #####################################

'#################################################
'#################################################
'#################################################

Private m_Inited As Boolean

Public BitPosMask(0 To 31) As Long '位位置掩码（从最右侧位（字节最低位）向左，小端方式）
Attribute BitPosMask.VB_VarDescription = "位位置掩码（最低位开始）"
Public BitMapMask(0 To 31) As Long '位图掩码（从最左侧位（字节最高位）向右连续）
Attribute BitMapMask.VB_VarDescription = "位图位掩码（最左边(最高位)开始）"
Public BitsMask(0 To 32) As Long '位屏蔽掩码
Attribute BitsMask.VB_VarDescription = "使用n位"

Public Property Get Inited() As Boolean
Attribute Inited.VB_Description = "初始化"
    Inited = m_Inited
End Property

Public Sub Init()
Attribute Init.VB_Description = "初始化"
    Dim I As Long
    Dim dwTemp As Long
   
    If m_Inited Then Exit Sub
    m_Inited = True
   
    dwTemp = 1
    For I = 0 To 30
        BitPosMask(I) = dwTemp
        If I < 30 Then
            dwTemp = dwTemp * 2
        End If
    Next I
    BitPosMask(31) = &H80000000
   
    For I = 0 To 7
        BitMapMask(I) = BitPosMask(7 - I)
    Next I
    For I = 8 To &HF
        BitMapMask(I) = BitPosMask(&H17 - I)
    Next I
    For I = &H10 To &H17
        BitMapMask(I) = BitPosMask(&H27 - I)
    Next I
    For I = &H18 To &H1F
        BitMapMask(I) = BitPosMask(&H37 - I)
    Next I
   
    For I = 0 To 30
        BitsMask(I) = BitPosMask(I) - 1
    Next I
    BitsMask(31) = &H7FFFFFFF
    BitsMask(32) = &HFFFFFFFF
   
End Sub

'## Bit4 #########################################

Public Function LoBit4(ByVal v As Byte) As Byte
Attribute LoBit4.VB_Description = "字节：低4位"
    LoBit4 = v And byLoBit4Mask
End Function

Public Function HiBit4(ByVal v As Byte) As Byte
    HiBit4 = (v And byHiBit4Mask) / byHiBit4LSN
End Function

Public Function MakeByte(ByVal vHi As Byte, ByVal vLo As Byte) As Byte
    MakeByte = ((vHi And byLoBit4Mask) * byHiBit4LSN) Or (vLo And byLoBit4Mask)
End Function

Public Function SetLoBit4(ByVal v As Byte, ByVal RHS As Byte) As Byte
    SetLoBit4 = (v And byHiBit4Mask) Or (RHS And byLoBit4Mask)
End Function

Public Function SetHiBit4(ByVal v As Byte, ByVal RHS As Byte) As Byte
Attribute SetHiBit4.VB_Description = "字节：高4位"
    SetHiBit4 = (v And byLoBit4Mask) Or ((RHS And byLoBit4Mask) * byHiBit4LSN)
End Function

'## Byte #########################################

Public Function LoByte(ByVal v As Integer) As Byte
Attribute LoByte.VB_Description = "字：低字节"
    LoByte = v And wLoByteMask
End Function

Public Function HiByte(ByVal v As Integer) As Byte
Attribute HiByte.VB_Description = "字：高字节"
    HiByte = ((v And wHiByteMask) / wHiByteLSN) And wLoByteMask
End Function

Public Function MakeWord(ByVal vHi As Byte, ByVal vLo As Byte) As Integer
    MakeWord = ((vHi And ByteNSMask) * wHiByteLSN Or (((vHi And ByteSMask) <> 0) And WordSMask)) _
            Or vLo
End Function

Public Function SetLoByte(ByVal v As Integer, ByVal RHS As Byte) As Integer
    SetLoByte = (v And wHiByteMask) Or RHS
End Function

Public Function SetHiByte(ByVal v As Integer, ByVal RHS As Byte) As Integer
    SetHiByte = (v And wLoByteMask) Or ((RHS And ByteNSMask) * wHiByteLSN) Or (((RHS And ByteSMask) <> 0) And WordSMask)
End Function

'## UWord ########################################

Public Function uLoWord(ByVal v As Long) As Long
Attribute uLoWord.VB_Description = "(无符号)双字：高字"
    uLoWord = v And dwLoWordMask
End Function

Public Function uHiWord(ByVal v As Long) As Long
Attribute uHiWord.VB_Description = "(无符号)双字：高字"
    uHiWord = ((v And dwHiWordMask) / dwHiWordLSN) And dwLoWordMask
End Function

Public Function uMakeDWord(ByVal vHi As Long, ByVal vLo As Long) As Long
    uMakeDWord = ((vHi And WordNSMask) * dwHiWordLSN Or (((vHi And dwWordSMask) <> 0) And DWordSMask)) _
            Or (vLo And dwLoWordMask)
End Function

Public Function uSetLoWord(ByVal v As Long, ByVal RHS As Long) As Long
    uSetLoWord = (v And dwHiWordMask) Or (RHS And dwLoWordMask)
End Function

Public Function uSetHiWord(ByVal v As Long, ByVal RHS As Long) As Long
    uSetHiWord = (v And dwLoWordMask) Or ((RHS And WordNSMask) * dwHiWordLSN) Or (((RHS And dwWordSMask) <> 0) And DWordSMask)
End Function

'## Word ########################################

Public Function LoWord(ByVal v As Long) As Integer
Attribute LoWord.VB_Description = "双字：高字"
    LoWord = v Or (((v And dwWordSMask) <> 0) And WordSMask)
End Function

Public Function HiWord(ByVal v As Long) As Integer
Attribute HiWord.VB_Description = "双字：高字"
    HiWord = (v And dwHiWordMask) / dwHiWordLSN
End Function

Public Function MakeDWord(ByVal vHi As Integer, ByVal vLo As Integer) As Long
    MakeDWord = ((vHi And WordNSMask) * dwHiWordLSN Or (((vHi And WordSMask) <> 0) And DWordSMask)) _
            Or (vLo And dwLoWordMask)
End Function

Public Function SetLoWord(ByVal v As Long, ByVal RHS As Integer) As Long
    SetLoWord = (v And dwHiWordMask) Or (RHS And dwLoWordMask)
End Function

Public Function SetHiWord(ByVal v As Long, ByVal RHS As Integer) As Long
    SetHiWord = (v And dwLoWordMask) Or ((RHS And WordNSMask) * dwHiWordLSN) Or (((RHS And WordSMask) <> 0) And DWordSMask)
End Function

'DWORD MAKELONG(
'  WORD wLow,  // low-order word of long value
'  WORD wHigh  // high-order word of long value
');
Public Function MAKELONG(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
Attribute MAKELONG.VB_Description = "制造Long"
    MAKELONG = MakeDWord(wHigh, wLow)
End Function

'## COLORREF #####################################

Public Function crR(ByVal v As Long) As Byte
Attribute crR.VB_Description = "颜色Red"
    crR = v And dwByte0Mask
End Function

Public Function crG(ByVal v As Long) As Byte
Attribute crG.VB_Description = "颜色Green"
    crG = (v And dwByte1Mask) / dwByte1LSN
End Function

Public Function crB(ByVal v As Long) As Byte
Attribute crB.VB_Description = "颜色Blue"
    crB = (v And dwByte2Mask) / dwByte2LSN
End Function

Public Function crA(ByVal v As Long) As Byte
Attribute crA.VB_Description = "颜色Alpha"
    crA = ((v And dwByte3Mask) / dwByte3LSN) And ByteAllMask
End Function

Public Function crMake(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte, ByVal A As Byte) As Long
    crMake = R Or G * dwByte1LSN Or B * dwByte2LSN Or ((A And ByteNSMask) * dwByte3LSN Or (((A And ByteSMask) <> 0) And DWordSMask))
End Function

Public Function crSetR(ByVal v As Long, ByVal RHS As Byte) As Long
    crSetR = (v And Not dwByte0Mask) Or RHS
End Function

Public Function crSetG(ByVal v As Long, ByVal RHS As Byte) As Long
    crSetG = (v And Not dwByte1Mask) Or (RHS * dwByte1LSN)
End Function

Public Function crSetB(ByVal v As Long, ByVal RHS As Byte) As Long
    crSetB = (v And Not dwByte2Mask) Or (RHS * dwByte2LSN)
End Function

Public Function crSetA(ByVal v As Long, ByVal RHS As Byte) As Long
    crSetA = (v And Not dwByte3Mask) Or ((RHS And ByteNSMask) * dwByte3LSN Or (((RHS And ByteSMask) <> 0) And DWordSMask))
End Function

'## Bit Scan #####################################

' 取得某个 DWORD 有多少个1位
Public Function GetNumberOfBits(ByVal dwMask As Long) As Long
'// DirectX 7.0 SDK : DDPIXELFORMAT
'WORD GetNumberOfBits( DWORD dwMask )
'{
'    WORD wBits = 0;
'    While (dwMask)
'    {
'        dwMask = dwMask & ( dwMask - 1 );
'        wBits++;
'    }
'    return wBits;
'}
    Dim iBits As Long
   
    #If IsRelease = False Then
        If dwMask < 0 Then
            dwMask = dwMask And &H7FFFFFFF
            iBits = 1
        End If
    #End If
   
    While dwMask
        dwMask = dwMask And (dwMask - 1)
        iBits = iBits + 1
    Wend
   
    GetNumberOfBits = iBits
End Function

' 取得掩码右边的0位的个数
'@Return:   右边的0位的个数
'@dwMask:   掩码。如果为0返回-1
Public Function MaskToRShift(ByVal dwMask As Long) As Long
'// Charles Petzold《Programming Windows》
'int MaskToRShift(DWORD dwMask)
'{
'    int iShift;
'    if (dwMask == 0)    return 0;
'    for (iShift = 0; !(dwMask & 1); iShift++)   dwMask >>= 1;
'    return  iShift;
'}
    Dim iShift As Long
   
    If dwMask = 0 Then
        iShift = -1
    Else
        'iShift = 0 'VB默认为0
        If dwMask < 0 Then
            dwMask = dwMask And &H7FFFFFFF
            iShift = 1
        End If
        While (dwMask And 1) = 0
            dwMask = dwMask / 2
            iShift = iShift + 1
        Wend
    End If
   
    MaskToRShift = iShift
End Function

' 取得掩码左边的0位的个数
'@Return:   左边的0位的个数
'@dwMask:   掩码。如果为0返回-1
Public Function MaskToLShift(ByVal dwMask As Long) As Long
'// Charles Petzold《Programming Windows》
'int MaskToLShift(DWORD dwMask)
'{
'   int iShift;
'   if (dwMask == 0)    return 0;
'   while (!(dwMask & 1))   dwMask >>= 1 ;
'   for (iShift = 0; dwMask & 1; iShift++)  dwMask >>= 1;
'   return  8 - iShift;
'}
'但是我没有采用这个算法，直接从最高位开始检查
    Dim iShift As Long
   
    If dwMask = 0 Then
        iShift = -1
    Else
        'iShift = 0 'VB默认为0
        If dwMask < 0 Then
            iShift = 0
        Else
            iShift = 1
            While (dwMask And &H40000000) = 0
                dwMask = (dwMask And &H3FFFFFFF) * 2
                iShift = iShift + 1
            Wend
        End If
    End If
   
    MaskToLShift = iShift
End Function

' 取得掩码中中间的位的数目
'注意该函数是使用 MaskToRShift、MaskToLShift 计算的，不考虑中间的0位，与 GetNumberOfBits 计算结果不同，可用来判断掩码是否正确
Public Function GetMaskMidBits(ByVal dwMask As Long) As Long
    Dim iRet As Long
   
    If dwMask = 0 Then
        iRet = 0
    Else
        iRet = 32 - (MaskToRShift(dwMask) + MaskToLShift(dwMask))
    End If
   
    GetMaskMidBits = iRet
End Function

'## Bit Endian ###################################

'交换Word中的字节
Public Function SwapByteByWord(ByVal v As Integer) As Integer
    SwapByteByWord = (((v And wHiByteMask) / wHiByteLSN) And wLoByteMask) _
            Or ((v And ByteNSMask) * wHiByteLSN) Or (((v And ByteSMask) <> 0) And WordSMask)
End Function

'交换DWord中的字节
Public Function SwapByteByDWord(ByVal v As Long) As Long
    SwapByteByDWord = (((v And dwByte3Mask) / dwByte3LSN) And dwByte0Mask) _
            Or ((v And dwByte2Mask) / dwByte1LSN) _
            Or ((v And dwByte1Mask) * dwByte1LSN) _
            Or ((v And ByteNSMask) * dwByte3LSN) Or (((v And ByteSMask) <> 0) And DWordSMask)
End Function

'转换Word的端序为小端
Public Function ConvLEByWord(ByVal v As Integer) As Integer
    #If IsBigEndianSystem Then
        ConvLEByWord = SwapByteByWord(v)
    #Else
        ConvLEByWord = v
    #End If
End Function

'转换Word的端序为大端
Public Function ConvBEByWord(ByVal v As Integer) As Integer
    #If IsBigEndianSystem Then
        ConvBEByWord = v
    #Else
        ConvBEByWord = SwapByteByWord(v)
    #End If
End Function

'转换DWord的端序为小端
Public Function ConvLEByDWord(ByVal v As Long) As Long
    #If IsBigEndianSystem Then
        ConvLEByDWord = SwapByteByDWord(v)
    #Else
        ConvLEByDWord = v
    #End If
End Function

'转换DWord的端序为大端
Public Function ConvBEByDWord(ByVal v As Long) As Long
    #If IsBigEndianSystem Then
        ConvBEByDWord = v
    #Else
        ConvBEByDWord = SwapByteByDWord(v)
    #End If
End Function

'转换Word的端序
Public Function ConvEndianByWord(ByVal v As Integer, ByVal bIsBigEnd As Boolean) As Integer
    #If IsBigEndianSystem Then
        If bIsBigEnd Then
            ConvEndianByWord = v
        Else
            ConvEndianByWord = SwapByteByWord(v)
        End If
    #Else
        If bIsBigEnd Then
            ConvEndianByWord = SwapByteByWord(v)
        Else
            ConvEndianByWord = v
        End If
    #End If
End Function

'转换DWord的端序
Public Function ConvEndianByDWord(ByVal v As Long, ByVal bIsBigEnd As Boolean) As Long
    #If IsBigEndianSystem Then
        If bIsBigEnd Then
            ConvEndianByDWord = v
        Else
            ConvEndianByDWord = SwapByteByDWord(v)
        End If
    #Else
        If bIsBigEnd Then
            ConvEndianByDWord = SwapByteByDWord(v)
        Else
            ConvEndianByDWord = v
        End If
    #End If
End Function

'## ToString #####################################

Public Function Int2Bin(ByVal v As Long, Optional ByVal iLength As Long = -1) As String
Attribute Int2Bin.VB_Description = "二进制显示"
    Dim Sign As Boolean
    Dim TempStr As String
   
    'Check Sign
    Sign = v < 0
    v = v And &H7FFFFFFF
   
    ' Main
    Do
        TempStr = CStr(v And 1) & TempStr
        v = v / 2
    Loop Until 0 = v
   
    ' Sign
    If Sign Then
        TempStr = "1" & String$(32 - Len(TempStr) - 1, "0") & TempStr
    End If
   
    If iLength > Len(TempStr) Then TempStr = String$(iLength - Len(TempStr), "0") & TempStr
    'Debug.Print TempStr
   
    Int2Bin = TempStr
   
End Function

'## Num Bits #####################################

'检查数字占多少位
Public Function ChkNumBits(ByVal Value As Long) As Long
Attribute ChkNumBits.VB_Description = "检查数字占多少位"
    If Value = &H80000000 Then ChkNumBits = 32: Exit Function
    If Value < 0 Then Value = Abs(Value)
    Dim I As Long
    For I = 0 To 31
        If Value <= BitsMask(I) Then Exit For
    Next I
    ChkNumBits = I
End Function

'检查数字占多少位，并根据正负翻转位（JPEG系数的规定）
Public Function ChkNumBitsAuto(ByRef Value As Long) As Long
Attribute ChkNumBitsAuto.VB_Description = "检查数字占多少位，并根据正负翻转位（JPEG系数的规定）"
    If Value = &H80000000 Then ChkNumBitsAuto = 32: Exit Function
    Dim Sign As Long '为了速度，Long比Boolean快
    Dim I As Long
    Sign = Value And &H80000000
    If Sign Then Value = Abs(Value)
    For I = 0 To 31
        If Value <= BitsMask(I) Then Exit For
    Next I
    If Sign Then Value = Value Xor BitsMask(I)
    ChkNumBitsAuto = I
End Function