سوال: شیفت به راست

بفرما تو 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