1、'逻辑左移
Public Function SHL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
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, 5 '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
Next
Case Else
SHL = False
Exit Function
End Select
SHL = Num
End Function
2、'逻辑右移
Public Function SHR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
a = VarType(Num)
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, 5 '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 Else
SHR = False
Exit Function
End Select
SHR = Num
End Function
3、'算术左移
Public Function SAL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
SAL = SHL(Num, iCL)
End Function
4、'算术右移
Public Function SAR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
a = VarType(Num)
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, 5 '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
SAR = False
Exit Function
End Select
SAR = Num
End Function
5、'循环左移
Public Function ROL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
Dim i As Byte
Dim bMask As Byte, iMask As Integer, lMask As Long
a = VarType(Num)
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, 5 '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 = Num
End Function
6、'循环右移
Public Function ROR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1)
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, 5 '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
Case Else
ROR = False
Exit Function
End Select
ROR = Num
End Function
7、'带进位循环左移
Public Function RCL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0)
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, 5 '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
8、'带进位循环右移
Public Function RCR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0)
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 = 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, 5 '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
RCR = Num
End Function
