'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