'===========================================================
' VBA における 32 ビット整数の高速ビットシフト関数群
' 論理左シフト（LogicalShiftLeft）、論理右シフト（LogicalShiftRight）、
' 算術右シフト（ArithmeticShiftRight）を高速かつ安全に実装。
' coded by isaku@pb4.so-net.ne.jp 2026
'===========================================================

Option Explicit

'-----------------------------------------------------------
' 高速論理左シフト：32ビット整数のビット列を shiftCount 分だけ左にシフトします。
' shiftCount の有効範囲は [1〜30] です。
'-----------------------------------------------------------
Public Function FastLogicalShiftLeft&(ByVal value&, ByVal shiftCount As Byte)
    Dim highBitMask&
    highBitMask = 2& ^ (31 - shiftCount)
    FastLogicalShiftLeft = (value And (highBitMask - 1)) * (2& ^ shiftCount)
    If (value And highBitMask) = highBitMask Then FastLogicalShiftLeft = FastLogicalShiftLeft Or &H80000000
End Function

'-----------------------------------------------------------
' 高速論理右シフト：32ビット整数のビット列を shiftCount 分だけ右にシフトします。
' shiftCount の有効範囲は [1〜30]。符号付き整数に対応。
'-----------------------------------------------------------
Public Function FastLogicalShiftRight&(ByVal value&, ByVal shiftCount As Byte)
    If value >= 0 Then
        FastLogicalShiftRight = value \ (2& ^ shiftCount)
    Else
        FastLogicalShiftRight = ((value And &H7FFFFFFF) \ (2& ^ shiftCount)) Or (2& ^ (31 - shiftCount))
    End If
End Function

'-----------------------------------------------------------
' 高速算術右シフト：符号ビットを保持したまま右にシフトします。
' shiftCount の有効範囲は [1〜30]。
'-----------------------------------------------------------
Public Function FastArithmeticShiftRight&(ByVal value&, ByVal shiftCount As Byte)
    FastArithmeticShiftRight = value \ (2& ^ shiftCount)
    If value < 0 And value Mod (2& ^ shiftCount) <> 0 Then FastArithmeticShiftRight = FastArithmeticShiftRight - 1
End Function

'-----------------------------------------------------------
' 論理左シフト：入力値の検証と境界条件の処理を含む安全な左シフト。
'-----------------------------------------------------------
Public Function LogicalShiftLeft&(ByVal value&, ByVal shiftCount As Byte)
    Dim highBitMask&
    shiftCount = shiftCount And 31 ' 0〜31 に制限
    
    Select Case shiftCount
        Case 0
            LogicalShiftLeft = value
        Case Is > 31
            LogicalShiftLeft = 0
        Case 31
            LogicalShiftLeft = IIf((value And 1) = 1, &H80000000, 0)
        Case Else
            highBitMask = 2& ^ (31 - shiftCount)
            LogicalShiftLeft = (value And (highBitMask - 1)) * (2& ^ shiftCount)
            If (value And highBitMask) = highBitMask Then LogicalShiftLeft = LogicalShiftLeft Or &H80000000
    End Select
End Function

'-----------------------------------------------------------
' 論理右シフト：入力値の検証と境界条件の処理を含む安全な右シフト。
'-----------------------------------------------------------
Public Function LogicalShiftRight&(ByVal value&, ByVal shiftCount As Byte)
    shiftCount = shiftCount And 31 ' 0〜31 に制限
    
    Select Case shiftCount
        Case 0
            LogicalShiftRight = value
        Case 31
            LogicalShiftRight = IIf(value < 0, 1, 0)
        Case Is > 31
            LogicalShiftRight = 0
        Case Else
            If value >= 0 Then
                LogicalShiftRight = value \ (2& ^ shiftCount)
            Else
                LogicalShiftRight = ((value And &H7FFFFFFF) \ (2& ^ shiftCount)) Or (2& ^ (31 - shiftCount))
            End If
    End Select
End Function

'-----------------------------------------------------------
' 算術右シフト：入力値の検証と境界条件の処理を含む安全な右シフト。
' 負の値に対して符号ビットを保持します。
'-----------------------------------------------------------
Public Function ArithmeticShiftRight&(ByVal value&, ByVal shiftCount As Byte)
    shiftCount = shiftCount And 31 ' 0〜31 に制限
    
    Select Case shiftCount
        Case 0
            ArithmeticShiftRight = value
        Case Is >= 31
            ArithmeticShiftRight = IIf(value < 0, -1, 0)
        Case Else
            ArithmeticShiftRight = value \ (2& ^ shiftCount)
            If value < 0 And value Mod (2& ^ shiftCount) <> 0 Then ArithmeticShiftRight = ArithmeticShiftRight - 1
    End Select
End Function