VB中位操作运算函数【移位指令】
发信⼈: hermit (阿修罗～相拥我爱), 信区: VisualBasic
标题:  VB中位操作运算函数【移位指令】
发信站: BBS ⽔⽊清华站 (Sat Jun  1 12:40:23 2002)
'Module: BitPlus.Bas
'Code By Hermit @ SMTH , Jun. 1st,2000
'Email: mailtocw@sohu
'May these functions will help you, and
'Please keep this header if you use my code,thanks!
'提供在VB下进⾏位运算的函数
'SHL 逻辑左移  SHR  逻辑右移
'SAL 算术左移  SAR  算术右移
'ROL 循环左移  ROR  循环右移
'RCL 带进位循环左移  RCR  带进位循环右移
'Bin 将给定的数据转化成2进制字符串
'使⽤⽅法
'SHL SHR SAL SAR ROL ROR 基本类似，以SHL为例说明
'可以移位的变量类型，字节(Byte)，整数(Integer)，长整数(Long)
'返回值 True 移位成功， False 移位失败，当对⾮上述类型进⾏移位是会返回False
'Num 传引⽤变量，要移位的数据，程序会改写Num的值为运算后结果
'iCL 传值变量，要移位的次数，缺省值移位1次
'例 Dim A As Integer
'  A = &H10
'如 SHL A    则移位后 A = &H20
'如 SHL A,2  则移位后 A = &H40
'如 SHL A,4  则移位后 A = &H00
'RCR与RCL类似，以RCL为例说明
'这⾥需要多给定⼀个参数，即第⼀次移位时的进位值iCF
'Bin举例
'A = &H1
'如 A 为字节，则 Bin(A) 返回值为 "00000001"
'如 A 为整数，则 Bin(A) 返回值为 "0000000000000001"
'如 A 为长整数，则 Bin(A) 返回值为 "00000000000000000000000000000001"
'如果传⼊参数⾮上述类型时，返回值为 ""
'更详细的信息，请参考相关汇编书籍
'逻辑左移
Public Function SHL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
iMask = 0
If (Num And &H4000) <> 0 Then iMask = &H8000
Num = (Num And &H3FFF) * 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
lMask = 0
If (Num And &H40000000) <> 0 Then lMask = &H80000000
Num = (Num And &H3FFFFFFF) * 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
bMask = 0
If (Num And &H40) <> 0 Then bMask = &H80
Num = (Num And &H3F) * 2 Or bMask
End Function
'逻辑右移
Public Function SHR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
iMask = 0
If (Num And &H8000) <> 0 Then iMask = &H4000
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
lMask = 0
If (Num And &H80000000) <> 0 Then lMask = &H40000000
Num = (Num And &H7FFFFFFF) \ 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
bMask = 0
If (Num And &H80) <> 0 Then bMask = &H40
Num = (Num And &H7F) \ 2 Or bMask
Next
Case Else
SHR = False
Exit Function
End Select
SHR = True
End Function
'算术左移
Public Function SAL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
SAL = SHL(Num, iCL)
End Function
'算术右移
Public Function SAR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
iMask = 0
If (Num And &H8000) <> 0 Then iMask = &HC000
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
If (Num And &H80000000) <> 0 Then lMask = &HC0000000
Num = (Num And &H7FFFFFFF) \ 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
If (Num And &H80) <> 0 Then bMask = &HC0
Num = (Num And &H7F) \ 2 Or bMask
Next
Case Else
Public Function ROL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
iMask = 0
If (Num And &H4000) <> 0 Then iMask = &H8000
If (Num And &H8000) <> 0 Then iMask = iMask Or &H1
Num = (Num And &H3FFF) * 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
lMask = 0
If (Num And &H40000000) <> 0 Then lMask = &H80000000
If (Num And &H80000000) <> 0 Then lMask = lMask Or &H1
Num = (Num And &H3FFFFFFF) * 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
bMask = 0
If (Num And &H40) <> 0 Then bMask = &H80
If (Num And &H80) <> 0 Then bMask = bMask Or &H1
Num = (Num And &H3F) * 2 Or bMask
Next
Case Else
ROL = False
Exit Function
End Select
ROL = True
End Function
'循环右移
Public Function ROR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
iMask = 0
If (Num And &H8000) <> 0 Then iMask = &H4000
If (Num And &H1) <> 0 Then iMask = iMask Or &H8000
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
lMask = 0
If (Num And &H80000000) <> 0 Then lMask = &H40000000
If (Num And &H1) <> 0 Then lMask = lMask Or &H80000000
Num = (Num And &H7FFFFFFF) \ 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
bMask = 0
If (Num And &H80) <> 0 Then bMask = &H40
If (Num And &H1) <> 0 Then bMask = bMask Or &H80
Num = (Num And &H7F) \ 2 Or bMask
Next
'带进位循环左移
Public Function RCL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1, Op tional ByVal iCf As Byte = 0) As Boolean
Dim i As Byte, CF As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
CF = iCf
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
If CF = 0 Then
iMask = 0
Else
iMask = 1
End If
If (Num And &H4000) <> 0 Then iMask = iMask Or &H8000
If (Num And &H8000) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H3FFF) * 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
If CF = 0 Then
lMask = 0
Else
lMask = 1
End If
If (Num And &H40000000) <> 0 Then lMask = lMask Or &H80000000
If (Num And &H80000000) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H3FFFFFFF) * 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
If CF = 0 Then
bMask = 0
Else
bMask = 1
End If
If (Num And &H40) <> 0 Then bMask = bMask Or &H80
If (Num And &H80) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H3F) * 2 Or bMask
Next
Case Else
RCL = False
Exit Function
End Select
RCL = True
End Function
'带进位循环右移
Select Case VarType(Num)
Case 2 '16 bits
For i = 1 To iCL
If CF = 1 Then
iMask = &H8000
Else
iMask = 0
End If
If (Num And &H8000) <> 0 Then iMask = iMask Or &H4000
If (Num And &H1) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '32 bits
For i = 1 To iCL
If CF = 1 Then
lMask = &H80000000
Else
lMask = 0
End If
If (Num And &H80000000) <> 0 Then lMask = lMask Or &H40000000 If (Num And &H1) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H7FFFFFFF) \ 2 Or lMask
Next
Case 17 '8 bits
For i = 1 To iCL
If CF = 1 Then
bMask = &H80
Else
bMask = 0
End If
If (Num And &H80) <> 0 Then bMask = bMask Or &H40
If (Num And &H1) <> 0 Then
CF = 1
Else
CF = 0
End If
Num = (Num And &H7F) \ 2 Or bMask
Next
Case Else
RCR = False
Exit Function
End Select
hermitRCR = True
End Function
'将数值转化为⼆进制字符串
Public Function Bin(ByVal Num As Variant) As String
Dim tmpStr As String
Dim iMask As Long
Dim iCf As Byte, iMax As Byte
Select Case VarType(Num)
Case 2: iMax = 15 'Integer 16 bits
Case 3: iMax = 31 'Long 32 bits

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。