More Faster , More VB User
——VB位操作
为什么VB中不加入位操作的语法元素，我想主要是比尔的电脑比大多数人的电脑要快上几百倍。他可能觉得已经够了。
—— Llib.Setag
这篇文章是用来解决VB中位操作方面的问题，我想。其实这篇文章我来写有点太显摆，因为其中很多代码不是我的原创，虽然其中很多技术虽然早已用过很多回，但是用到位操作上，特别是利用数组来进行高低位取字（字节）是我没有想到的，这是CSDN qiqi5521的功劳，感谢他的代码。
代码中主要用到了三种技术：
数组技术、指针技术、内嵌汇编技术
这三种技术实际上并不是我们所凭空想出来了，基本上是来源于《Hardcore VB》和《Advanced Visual Basic》两书所提出来的方法。虽然这三种技术在一般的VB教课书上是不会提起的，但是由于它具有一定的实用性，在很多地方，特别是要求速度的地方可以加快代码不少的运行速度。关于具体的技术，我不太想在这篇文章中谈，如果有兴趣可以参考我的Blog: http://blog.csdn.net/BlueDog，里面有一个《VB深度下潜》系列，虽然没有写完，但这些技术会陆续提到。
代码、代码、还是代码，对于程序员而言，代码是最好的教课书。代码是我们的生存之道。然而在代码之前，还有几句要说的，在本模块中包括了几个版本的代码，显得有些乱，分别是一般速度、较高速度和最高速版。另外在代码中有两个函数是一定要记得使用，分别是
BitOperatorInit和BitOperatorEnd，这两个函数是分别在位操作前后使用。本模块引用了 WinAPI ANSI Typlib。
来了，代码来了。
建立一个modBit的模块，将以下代码拷入。
Option Explicit
' 版本更新记录
'
' 2004-12-23 增加利用内存共享开发新的函数HiByteFastest ......
' 本版本新增函数利用CSDN上 qiqi5521的代码进行了改进
'
Private Type BIT_WORD
LoByte As Byte
HiByte As Byte
End Type
Private Type BIT_DWORD
LoWord As Integer
HiWord As Integer
End Type
Private Type BIT_DWORD_BYTE
LoByte As Byte
SeByte As Byte
ThByte As Byte
HiByte As Byte
End Type
Private BitPower(31) As Long '0-31
Private BitRight32Code(23) As Byte
Private SHR32Addr As Long '汇编函数地址
Private BitLeft32Code(23) As Byte
Private SHL32Addr As Long '汇编函数地址
Private Type SafeArray1d '1维数组的 SafeArray 定义
cDims As Integer '维数
fFeatures As Integer '标志
cbElements As Long '单个元素的字节数
clocks As Long '锁定计数
pvData As Long '指向数组元素的指针
cElements As Long '维定义，该维的元素个数
Lbound As Long '该维的下界
End Type
Const FADF_AUTO = &H1
Const FADF_FIXEDSIZE = &H10
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
Private m_SA1DLong As SafeArray1d
Private m_SA1DInt As SafeArray1d
Private m_lSharedLong As Long '要被共享的长整形
Private m_aiIntsInLong() As Integer '要共享长整形地址空间的整形数组
Private m_lSharedInt As Integer
Private m_aiBytesInInt() As Byte
'////////////////////////////////////////////////////////////////////////////////////////////////
'位操作前初使化动作,主要是初使化，如果不进行初使化，将会出现不可预计错误
Public Sub BitOperatorInit()
Dim i As Long
Dim AsmCodeByte
For i = 0 To 30
BitPower(i) = 2 ^ i
Next
BitPower(31) = &H80000000
AsmCodeByte = Array( _
&H55, &H8B, &HEC, &H83, &HEC, &H44, &H53, &H56, _
&H57, &H8B, &H45, &H8, &H8B, &H4D, &HC, &HD3, _
&HE8, &H5F, &H5E, &H5B, &H8B, &HE5, &H5D, &HC3)
For i = 0 To 23
BitRight32Code(i) = AsmCodeByte(i)
Next
SHR32Addr = VarPtr(BitRight32Code(0))
AsmCodeByte = Array( _
&H55, &H8B, &HEC, &H83, &HEC, &H44, &H53, &H56, _
&H57, &H8B, &H45, &H8, &H8B, &H4D, &HC, &HD3, _
&HE0, &H5F, &H5E, &H5B, &H8B, &HE5, &H5D, &HC3)
For i = 0 To 23
BitLeft32Code(i) = AsmCodeByte(i)
Next
SHL32Addr = VarPtr(BitLeft32Code(0))
With m_SA1DLong
.cDims = 1
.fFeatures = 17
.cbElements = 2
.clocks = 0
.pvData = VarPtr(m_lSharedLong) '使数组的数据指针指向长整形变量m_lSharedLong
.cElements = 2
.Lbound = 0
End With
'使数组变量（其实就是个指针）指向我们自己创建的 SafeArray1d 结构
CopyMemory ByVal VarPtrArray(m_aiIntsInLong), VarPtr(m_SA1DLong), 4
With m_SA1DInt
.cDims = 1
.fFeatures = 17
.cbElements = 1
.clocks = 0
.pvData = VarPtr(m_lSharedInt) '使数组的数据指针指向长整形变量m_lSharedLong
.cElements = 2
.Lbound = 0
End With
CopyMemory ByVal VarPtrArray(m_aiBytesInInt), VarPtr(m_SA1DInt), 4
End Sub
' 在位操作运算完成后一个要调用此函数
'释放资源，程序结束前一定要调用
Public Sub BitOperatorEnd()
'把数组变量（其实就是个指针）指向 0,既 C 语言中的 NULL
CopyMemory ByVal VarPtrArray(m_aiIntsInLong), 0&, 4
CopyMemory ByVal VarPtrArray(m_aiBytesInInt), 0&, 4
End Sub
'///////////////////////////////////////////////////////////////////////////
'取高位整型最快的版本
Public Function HiWordFastest(ByRef Num As Long) As Integer
m_lSharedLong = Num
HiWordFastest = m_aiIntsInLong(1)
End Function
'取低位整型最快的版本
Public Function LoWordFastest(ByRef Num As Long) As Integer
m_lSharedLong = Num
LoWordFastest = m_aiIntsInLong(0)
End Function
'取高位Byte最快的版本
Public Function HiByteFastest(ByRef Num As Integer) As Integer
m_lSharedInt = Num
HiByteFastest = m_aiBytesInInt(1)
End Function
'取低位整型最快的版本
Public Function LoByteFastest(ByRef Num As Integer) As Integer
m_lSharedInt = Num
LoByteFastest = m_aiBytesInInt(0)
End Function
'///////////////////////////////////////////////////////////////////////////
'位测试 ,测试位为1 返回真
Public Function BitTest32(Number As Long, Bit As Long) As Boolean
If Number And BitPower(Bit) Then
BitTest32 = True
Else
BitTest32 = False
End If
End Function
'将某位设置为1并返回值
Public Function BitSet32(Number As Long, Bit As Long) As Long
BitSet32 = BitPower(Bit) Or Number
End Function
'无符号扩展,最好作为内嵌到函数内部，减少调用开支。 注意，它与Clng有本质的区别
Public Function WORD2DWORD(Num As Integer) As Long
WORD2DWORD = Num And &HFFFF&
End Function
'逻辑右移32位函数
Public Function SHR32(ByRef Num As Long, BitNum As Long) As Long
SHR32 = CallWindowProc(ByVal SHR32Addr, Num, BitNum, 0, 0)
End Function
'逻辑左移32位函数
Public Function SHL32(ByRef Num As Long, BitNum As Long) As Long
SHL32 = CallWindowProc(ByVal SHL32Addr, Num, BitNum, 0, 0)
End Function
'没有采用汇编码，如果需要也可以采用，但16位的汇编码较32位的差很多，此函数速度约比SHR32慢一倍左右还可以
Public Function SHR16(ByRef Num As Integer, BitNum As Long) As Integer
Dim mdw As BIT_DWORD
Dim rl As Long
mdw.LoWord = Num
CopyMemory rl, mdw, 4
rl = CallWindowProc(ByVal SHR32Addr, rl, BitNum, 0, 0)
CopyMemory SHR16, rl, 2
End Function
Public Function SHL16(ByRef Num As Integer, BitNum As Long) As Integer
Dim mdw As BIT_DWORD
Dim rl As Long
mdw.LoWord = Num
CopyMemory rl, mdw, 4
rl = CallWindowProc(ByVal SHL32Addr, rl, BitNum, 0, 0)
CopyMemory SHL16, rl, 2
End Function
'///////////////////////////////////////////////////////////////////////////////////////////
' 如果对性能没有太大要求，或没能理解上面的函数的作法，可以用以下几个函数。
' 一般不建议使用
Public Function HiByte(ByRef Num As Integer) As Byte
Dim mw As BIT_WORD
CopyMemory mw, Num, 2
HiByte = mw.HiByte
End Function
Public Function LoByte(ByRef Num As Integer) As Byte
CopyMemory LoByte, Num, 1 '可以省掉一次取值，
End Function
Public Function HiWord(ByRef Num As Long) As Integer
Dim mdw As BIT_DWORD
CopyMemory mdw, Num, 4
HiWord = mdw.HiWord
End Function
Public Function LoWord(ByRef Num As Long) As Integer
CopyMemory LoWord, Num, 2
End Function
'比LoWord更快一点的版本(但如果内置于一个大函数内，可能用loword更好，因为代码更清晰）
Public Function LoWordFaster(ByRef Num As Long) As Integer
If (Num And &H8000&) Then ' dw And &H00008000 来进行确定低位是不是负数
LoWordFaster = Num Or &HFFFF0000
Else
LoWordFaster = Num And &HFFFF& 'dw And &H0000FFFF
End If
End Function
