بفرما تو vb 6 اینه
فقط کد باید در ماژول کپی شود.
Declarations:
Private OnBits(0 To 31) As Long
Public Function LShiftLong(ByVal Value As Long, _
ByVal Shift As Integer) As Long
MakeOnBits
If (Value And (2 ^ (31 - Shift))) Then GoTo OverFlow
LShiftLong = ((Value And OnBits(31 - Shift)) * (2 ^ Shift))
Exit Function
OverFlow:
LShiftLong = ((Value And OnBits(31 - (Shift + 1))) * _
(2 ^ (Shift))) Or &H80000000
End Function
Public Function RShiftLong(ByVal Value As Long, _
ByVal Shift As Integer) As Long
Dim hi As Long
MakeOnBits
If (Value And &H80000000) Then hi = &H40000000
RShiftLong = (Value And &H7FFFFFFE) \ (2 ^ Shift)
RShiftLong = (RShiftLong Or (hi \ (2 ^ (Shift - 1))))
End Function
Private Sub MakeOnBits()
Dim j As Integer, _
v As Long
For j = 0 To 30
v = v + (2 ^ j)
OnBits(j) = v
Next j
OnBits(j) = v + &H80000000
End Sub
به شکل دیگر و حالتی دیگر
Function rightShift(value,bits)
Dim res
res = 65535 AND value
If value>=0 Then
res = res \ (2^bits)
Else If value=-1 Then
res = rightShift(res + 32768, bits - 1)
Else
res = rightShift(value \ 2 + 32768, bits - 1)
End If
End If
rightShift = res AND 65535
End Function
پاسخ با نقل قول