'File:????? mBit.bas
'Name:????? 位運(yùn)算模塊
'Author:??? zyl910
'Version:?? V2.0
'Updata:??? 2006-4-29
'E-Mail:??? zyl910@sina.com
'
'特點(diǎn)：在使用BitPosMask、BitMapMask、BitsMask前必須初始化
'需要初始化

'[2006-4-29]V2.0
'1.加了許多常數(shù)
'2.全面修改算法
'3.取消原來的屬性設(shè)計(jì)，使用函數(shù)
'4.增加位掃描函數(shù)
'5.增加端序處理函數(shù)

Option Explicit

'#################################################
'## Const 常數(shù) ###################################
'#################################################

'## 全局編譯常數(shù) #################################
'請?jiān)诠こ虒傩詫υ捒蛟O(shè)置“條件編譯參數(shù)”

'IsRelease: 是否是發(fā)布版（編譯成本機(jī)代碼，啟動(dòng)所有高級(jí)優(yōu)化）

?

'## 私有編譯常數(shù) #################################

'是否是大端方式。默認(rèn)為False - 小端方式
#Const IsBigEndianSystem = False

'## 全局常數(shù) #####################################

'== 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位數(shù)據(jù)的左移位數(shù)
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沒有移位運(yùn)算符，只有用除法來模擬
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

'## 私有常數(shù) #####################################

?

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

Private m_Inited As Boolean

Public BitPosMask(0 To 31) As Long '位位置掩碼（從最右側(cè)位（字節(jié)最低位）向左，小端方式）
Attribute BitPosMask.VB_VarDescription = "位位置掩碼（最低位開始）"
Public BitMapMask(0 To 31) As Long '位圖掩碼（從最左側(cè)位（字節(jié)最高位）向右連續(xù)）
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 = "字節(jié)：低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 = "字節(jié)：高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 = "字：低字節(jié)"
??? LoByte = v And wLoByteMask
End Function

Public Function HiByte(ByVal v As Integer) As Byte
Attribute HiByte.VB_Description = "字：高字節(jié)"
??? 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 = "(無符號(hào))雙字：高字"
??? uLoWord = v And dwLoWordMask
End Function

Public Function uHiWord(ByVal v As Long) As Long
Attribute uHiWord.VB_Description = "(無符號(hào))雙字：高字"
??? 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 #####################################

' 取得某個(gè) DWORD 有多少個(gè)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位的個(gè)數(shù)
'@Return:?? 右邊的0位的個(gè)數(shù)
'@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默認(rèn)為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位的個(gè)數(shù)
'@Return:?? 左邊的0位的個(gè)數(shù)
'@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;
'}
'但是我沒有采用這個(gè)算法，直接從最高位開始檢查
??? Dim iShift As Long
???
??? If dwMask = 0 Then
??????? iShift = -1
??? Else
??????? 'iShift = 0 'VB默認(rèn)為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

' 取得掩碼中中間的位的數(shù)目
'注意該函數(shù)是使用 MaskToRShift、MaskToLShift 計(jì)算的，不考慮中間的0位，與 GetNumberOfBits 計(jì)算結(jié)果不同，可用來判斷掩碼是否正確
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中的字節(jié)
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中的字節(jié)
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

'轉(zhuǎn)換Word的端序?yàn)樾《?br />Public Function ConvLEByWord(ByVal v As Integer) As Integer
??? #If IsBigEndianSystem Then
??????? ConvLEByWord = SwapByteByWord(v)
??? #Else
??????? ConvLEByWord = v
??? #End If
End Function

'轉(zhuǎn)換Word的端序?yàn)榇蠖?br />Public Function ConvBEByWord(ByVal v As Integer) As Integer
??? #If IsBigEndianSystem Then
??????? ConvBEByWord = v
??? #Else
??????? ConvBEByWord = SwapByteByWord(v)
??? #End If
End Function

'轉(zhuǎn)換DWord的端序?yàn)樾《?br />Public Function ConvLEByDWord(ByVal v As Long) As Long
??? #If IsBigEndianSystem Then
??????? ConvLEByDWord = SwapByteByDWord(v)
??? #Else
??????? ConvLEByDWord = v
??? #End If
End Function

'轉(zhuǎn)換DWord的端序?yàn)榇蠖?br />Public Function ConvBEByDWord(ByVal v As Long) As Long
??? #If IsBigEndianSystem Then
??????? ConvBEByDWord = v
??? #Else
??????? ConvBEByDWord = SwapByteByDWord(v)
??? #End If
End Function

'轉(zhuǎn)換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

'轉(zhuǎn)換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 = "二進(jìn)制顯示"
??? 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 #####################################

'檢查數(shù)字占多少位
Public Function ChkNumBits(ByVal Value As Long) As Long
Attribute ChkNumBits.VB_Description = "檢查數(shù)字占多少位"
??? 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

'檢查數(shù)字占多少位，并根據(jù)正負(fù)翻轉(zhuǎn)位（JPEG系數(shù)的規(guī)定）
Public Function ChkNumBitsAuto(ByRef Value As Long) As Long
Attribute ChkNumBitsAuto.VB_Description = "檢查數(shù)字占多少位，并根據(jù)正負(fù)翻轉(zhuǎn)位（JPEG系數(shù)的規(guī)定）"
??? 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

轉(zhuǎn)載于:https://www.cnblogs.com/zyl910/archive/2006/05/24/2186655.html

總結(jié)

以上是生活随笔為你收集整理的位运算模块mBit.bas的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。