modbit.bas

用vb编写的工程控制程序

Attribute VB_Name = "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

''////////////////////////////////////////////////////////////////////////////////////////////////
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)

''位操作前初使化动作,主要是初使化，如果不进行初使化，将会出现不可预计错误

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

''///////////////////////////////////////////////////////////////////////////////////////////

'' 如果对性能没有太大要求，或没能理解上面的函数的作法，可以用以下几个函数。

'' 一般不建议使用



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