Attribute VB_Name = "Module1"

Public Const PI = 3.141593
Private OnBits(0 To 31) As Long




Public Sub Init_7766(ByVal Cardnum As Integer)

    Dim count As Integer
    
        ' See spec for control register options etc
        ' for example: MCR0 and MCR1 == 0xA001  == 1010 000 000 0001 == MCR1 B7........MCR0 B0
        ' Init all 8 channels the same way for free running count mode acquisition:
        For count = 0 To 7
            'RelOutPort(CardNum, (uint)(Offset + 0 + (count * 8)), 0xA001);  // (no index)
            'RelOutPort(CardNum, (uint)(Offset + 0 + (count * 8)), 0x2821);  // (reset CNTR at index)
            RelOutPort Cardnum, Offset + 0 + (count * 8), &H2831  'default 0x2831 init PCI board mode see spec
            RelOutPortB Cardnum, Offset + 7 + (count * 8), &H1     ' swap inA and inB reverse direction value: (optional) (CPLD)
            RelOutPortB Cardnum, Offset + 6 + (count * 8), &H9     ' reset all flags and counters
        Next count
    
End Sub

Public Sub Reset_7766(ByVal chan As Integer)

        ' Reset the counters for one channel:
        RelOutPortB Cardnum, Offset + 6 + (chan * 8), &H9    ' reset all flags and counters

End Sub


Public Function Read_7766_ol(chan As Integer) As Long
        ' The Channel data starts at base address offset 0x02 See the LS7766 spec

        Dim result As Long
        
        RelOutPortB Cardnum, Offset + 6 + (chan * 8), &H4  ' load ODR from CNTR

        ' Read up to 8 channels 32 bits per channel:
        result = RelInPortL(Cardnum, Offset + &H2 + (chan * 8))

        Read_7766_ol = result

End Function


Public Function SetQuadCountMode_7766(chan, Index As Integer)

            ' See spec for options
            ' MCR0 B1B0  ==  00 v 01 v 10 v 11
            ' Use exiting MCR0 value  and reinit with new count mode bits:

            ' Set for one channel by index 0-3: NoQuad, x1, x2 , x4  were using 1,2,3 no 00
            ' Note: ctrReg is our global default set at startup and used in init func as well
            Dim mask, B1B0, ModeCtrlReg, shiftkit As Integer
            
            ModeCtrlReg = &H2831    ' default
            mask = ModeCtrlReg
            B1B0 = Index

            ' 00 is Non quadrature mode which is  A and B data are count and direction
            ' So this mode wont be appropriate for some encoders

            ' MCR0 and MCR1
            shiftkit = LShiftLong(&HFFFF, 2)
            mask = ModeCtrlReg And shiftkit  ' clear 2 right bits
            ModeCtrlReg = mask Or B1B0           ' set new value

            RelOutPort Cardnum, 0 + (chan * 8), ModeCtrlReg    ' rewrite control register

            RelOutPortB Cardnum, 7 + (chan * 8), &H1        ' swap inA and inB reverse direction value: (optional) (CPLD)
            RelOutPortB Cardnum, 6 + (chan * 8), &H9   ' reset all flags and counters

End Function


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