SHARE
TWEET

BitShift

a guest Jun 19th, 2019 57 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'Ôóíêöèÿ îñóùåñòâëÿåò ïîáèòîâûé ñäâèã öåëîãî ÷èñëà number â ñòîðîíó ñòàðøèõ ðàçðÿäîâ íà êîëè÷åñòâî,
  2. 'ðàâíîå bitCount (â ñëó÷àå îòðèöàòåëüíîãî bitCount - ñäâèã â ñòîðîíó ìëàäøèõ ðàçðÿäîâ).
  3. Public Function Shift(ByVal number As Variant, ByVal bitCount As Long) As Variant
  4.     Dim i As Long, size As Long, mask As Variant, mask_ As Variant, vtype As VbVarType
  5.     Dim tolow As Boolean, signed As Boolean, signchange As Boolean
  6.     vtype = VarType(number)
  7.     Select Case vtype
  8.         Case vbByte
  9.             size = 8
  10.             signed = False
  11.         Case vbInteger
  12.             size = 16
  13.             signed = True
  14.         Case vbLong
  15.             size = 32
  16.             signed = True
  17.         Case vbCurrency
  18.             size = 64
  19.             signed = True
  20.         Case Else
  21.             Err.Raise 5, "Shift", "Àðãóìåíò number äîëæåí áûòü öåëî÷èñëåííûì (òèïà Byte, Integer, Long èëè Currency)."
  22.     End Select
  23.     If bitCount = 0 Then
  24.         Shift = number
  25.         Exit Function
  26.     ElseIf bitCount < 0 Then
  27.         bitCount = -bitCount
  28.         tolow = True
  29.     End If
  30.     If bitCount < size Then
  31.         Select Case True
  32.             Case Not tolow And Not signed
  33.                 mask = 1
  34.                 For i = 1 To size - 1
  35.                     mask = mask * 2
  36.                 Next i
  37.                 mask = mask - 1
  38.                 For i = 1 To bitCount
  39.                     number = (number And mask) * 2
  40.                 Next i
  41.             Case Not tolow And signed
  42.                 If vtype = vbCurrency Then
  43.                     mask_ = 0.0001@
  44.                     mask = -mask_
  45.                 Else
  46.                     mask = -1
  47.                     mask_ = 1
  48.                 End If
  49.                 For i = 1 To size - 2
  50.                     mask = mask * 2
  51.                     mask_ = mask_ * 2
  52.                 Next i
  53.                 mask = mask * 2
  54.                 For i = 1 To bitCount
  55.                     number = number And Not mask 'Îáíóëÿåì çíàêîâûé ðàçðÿä.
  56.                    If (number And mask_) = mask_ Then 'Åñëè åñòü áèò ïåðåä çíàêîâûì ðàçðÿäîì...
  57.                        number = number And Not mask_ '...òî óáèðàåì åãî.
  58.                        signchange = True
  59.                     End If
  60.                     number = number * 2 'Îñóùåñòâëÿåì ñäâèã â ñòîðîíó ñòàðøèõ ðàçðÿäîâ.
  61.                    If signchange Then  'Åñëè áûë óáðàí áèò ïåðåä çíàêîâûì ðàçðÿäîì...
  62.                        number = number Or mask   '...òî âñòàâëÿåì åãî â çíàêîâûé ðàçðÿä.
  63.                        signchange = False
  64.                     End If
  65.                 Next i
  66.             Case tolow And Not signed
  67.                 For i = 1 To bitCount
  68.                     number = number \ 2
  69.                 Next i
  70.             Case tolow And signed
  71.                 If vtype = vbCurrency Then
  72.                     mask_ = CCur(1) / CCur(10000)
  73.                     mask = -mask_
  74.                 Else
  75.                     mask = -1
  76.                     mask_ = 1
  77.                 End If
  78.                 For i = 1 To size - 2
  79.                     mask = mask * 2
  80.                     mask_ = mask_ * 2
  81.                 Next i
  82.                 mask = mask * 2
  83.                 For i = 1 To bitCount
  84.                     If (number And mask) = mask Then 'Åñëè åñòü áèò â çíàêîâîì ðàçðÿäå...
  85.                        number = number And Not mask '...òî îáíóëÿåì çíàêîâûé ðàçðÿä.
  86.                        signchange = True
  87.                     End If
  88.                     number = number \ 2 'Îñóùåñòâëÿåì ñäâèã â ñòîðîíó ìëàäøèõ ðàçðÿäîâ.
  89.                    If signchange Then  'Åñëè áûë óáðàí áèò èç çíàêîâîãî ðàçðÿäà...
  90.                        number = number Or mask_  '...òî âñòàâëÿåì åãî â áèò ïåðåä çíàêîâûì ðàçðÿäîì.
  91.                        signchange = False
  92.                     End If
  93.                 Next i
  94.         End Select
  95.         Shift = number
  96.     Else
  97.         Select Case vtype
  98.             Case vbByte
  99.                 Shift = CByte(0)
  100.             Case vbInteger
  101.                 Shift = 0
  102.             Case vbLong
  103.                 Shift = 0&
  104.             Case vbCurrency
  105.                 Shift = 0@
  106.         End Select
  107.     End If
  108. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top