Attribute VB_Name = "Module1"
'\ SPDA Remote Control program by T Roscoe
'\ twr04Apr02
'\ for B&B Electronics Mfg. Co. 232SPDA
'\
'\ twr26Apr02
' Option Explicit
Public ADinAry(24, 2) As Integer '\ A/D inputs
Public DinAry(8, 2) As Integer '\ digital inputs
Public DAOutAry(4, 5) As Integer '\ for D/A outputs
Public PortAry(17) As Integer '\ for com ports
Public CurPort, AnyPort, ioDisplay As Integer '\ new26Apr02
Public CmdChars, TempSettings As String
Public Red, Green, Yellow, Black, DigVal As Integer
Public Doutvar, Temport, Dvar, Avar, SamCnt As Integer
Public Dstat As Byte ' digital status var
Public Cmdno, Chcnt, ADCh, DACh, TymeStat, XStat As Integer
'\ Command number, channel counter, AD channel
'\ DA channel, sample var, extended sample
Public Wk$
' Public TimeOut As Integer ' not used here

Public Sub Setinit()

Red = &HFF&
Black = &H0&
Yellow = &HFFFF&
Green = &HFF00&
Form1.MSComm1.InputLen = 1
CheckPorts
' \ what ports are available?
DinAry(0, 2) = 1 ' for ease
DinAry(1, 2) = 2
DinAry(2, 2) = 4
DinAry(3, 2) = 8
DinAry(4, 2) = 16
DinAry(5, 2) = 32
DinAry(6, 2) = 64
DinAry(7, 2) = 128

TymeStat = 0 '\ sample off
ADCh = 0 '\ Startup Top A/D channel number to request
Chcnt = -1 '\ A/D Channel counter -1 when read done

Form1.MSComm1.InputLen = 2 '\ 2 chars at a time
Form1.MSComm1.CommPort = 2 '\ start on com2
Form1.MSComm1.RTSEnable = True '\ Set RTS Hi
Form1.MSComm1.DTREnable = True '\ Set DTR Hi
Form1.MSComm1.SThreshold = 1 '\ send threshold
Form1.MSComm1.RThreshold = 1 '\ receive

Form1.MSComm1.Settings = "9600,N,8,1"
TempSettings = Form1.MSComm1.Settings 'saves original
TemSet = Form1.MSComm1.Settings
TemSet = Left$(TemSet, 4)
If TemSet = "2400" Then
SerialMenu.Option1.Value = True
Else
If TemSet = "4800" Then
SerialMenu.Option2.Value = True
Else
If TemSet = "9600" Then
SerialMenu.Option3.Value = True
End If
End If
End If
Form1.MSComm1.Handshaking = comNone
Form1.MSComm1.InputMode = comInputModeBinary
' read values from 0 to 255 in & skip none

If PortAry(2) Then ' \ select my default if available
  CurPort = 2
Else
  If PortAry(1) Then
   CurPort = 1
  Else
   For x = 1 To 16
     Pval = 17 - x
    If PortAry(Pval) > 0 Then
      CurPort = Pval ' highest value sticks
      ' scan for highest port available
    End If
   Next
  End If
End If
InitConf = 0
End Sub
Public Sub CheckPorts()
' \what ports can be selected?
For x = 1 To 16
  PortAry(x) = True
  On Error Resume Next
  Form1.MSComm1.CommPort = x
  Form1.MSComm1.PortOpen = True
  Form1.MSComm1.PortOpen = False
 If Err Then
    PortAry(x) = False
 End If
 On Error GoTo 0
 Next
 For x = 1 To 16
   If PortAry(x) = True Then
     AnyPort = x
     '\ what if no com ports available?
   Else
     SerialMenu.ComSel(x).Enabled = False
   End If
 Next
End Sub

Public Sub DSRLite()
 '\ loopback indicator - DTR set high
If Form1.MSComm1.DSRHolding Then
    Form1.Lite3.BackColor = Green
    Else
    Form1.Lite3.BackColor = Black
End If
End Sub

Public Sub CTSLite()
  '\ loopback - RTS set high
If Form1.MSComm1.CTSHolding Then
    Form1.Lite1.BackColor = Green
    Else
    Form1.Lite1.BackColor = Black
End If
End Sub

Public Sub SendCmd()
 ' \ no success or failure
 ' \ should skip cmd if not done
Form1.MSComm1.Output = CmdChars
If ioDisplay Then DispForm.Label1.Caption = CmdChars
End Sub

Public Sub GetChars()
Dim MSB, LSB As Byte
Dim RcvAry() As Byte
 ' define as byte
Form1.MSComm1.InputLen = Form1.MSComm1.RThreshold
    ' \ read the number of bytes set by request
   
'  RcvAry = Form1.MSComm1.Input
If Cmdno = 1 Then
     RcvAry = Form1.MSComm1.Input
     Dstat = RcvAry(0)
     DigitBits
     Cmdno = 0
     If TymeStat > 0 Then Chcnt = -1
     '\ used as done flag and counter
End If
If Cmdno = 10 Then
 ' get returned bytes 2 at a time until pairs gone
 Do Until Form1.MSComm1.InBufferCount < 2
  If Form1.MSComm1.InBufferCount = 0 Then Exit Do
    RcvAry = Form1.MSComm1.Input
   ' needs a timer exit in case data
    MSB = RcvAry(0)
    MSB = MSB And 15
    Avar = MSB * 256
    LSB = RcvAry(1)
    Avar = Avar Or LSB
    ADinAry(Chcnt, 1) = Avar
    ' Wk$ = Str(ADinAry(Chcnt, 1))
    ' Stop
    Chcnt = Chcnt - 1 ' decrease count of Channel bytes to be read
 If Chcnt < 0 Then
   ' got all byte pairs from request
   ADtoVDC
   Cmdno = 0
   ' Stop
   If TymeStat > 0 And XStat > 0 Then XStat = 1
   ' if sampling with digital set back
  Exit Do
  End If
 Loop
   If ioDisplay Then
      Wk$ = Str(Chcnt)
      DispForm.Label2.Caption = Wk$
   End If
 End If
End Sub

Public Sub DigitBits()
 b = Dstat
     ' 32 16 8
 For x = 3 To 5 ' only bit3-5 used
   Dinbit = b And DinAry(x, 2)
   Dinbit = Dinbit \ DinAry(x, 2)
         ' integer divide
   DinAry(x, 0) = Dinbit ' save in array
 If Dinbit = 1 Then
   Form1.DLite(x).BackColor = Green
   Form1.DinTxt(x).Text = "1"
 Else
  Form1.DLite(x).BackColor = Black
  Form1.DinTxt(x).Text = "0"
 End If
 Next
End Sub

Public Sub ADReq()
 ' A/D request
Form1.MSComm1.RThreshold = 2
CmdChars = "!0RA" + Chr$(ADCh)
SendCmd
Chcnt = ADCh ' Set channel count Channels 0-6
Cmdno = 10
' DispForm.Label1.Caption = CmdChars
End Sub

Public Sub ADtoVDC()
' store voltage in array - display values
Dim Vvar As Integer
' display values
For x = 0 To ADCh
  Avar = ADinAry(x, 1)
  Form1.ADValTxt(x).Text = Str(Avar)
  ' show A/D number value
  Vvar = Avar * 1.2209
  Vvar = Int(Vvar + 0.5)
  ADinAry(x, 2) = Vvar
  Form1.VolValTxt(x).Text = Str(Vvar)
  '\ show calculated voltage value in mV
Next

End Sub

Public Sub DigReq()
 ' digital request
CmdChars = "!0RD"
SendCmd
Cmdno = 1
Chcnt = 0
Form1.MSComm1.RThreshold = 1
If TymeStat > 0 And XStat > 0 Then XStat = 2
' \ stat above used during sampling
' \ when digital read is set back to =1
End Sub

Public Sub Num4check()
 ' \ leaves with DigVal and Wk$
 ' \ string numbers in/values out
If Len(Wk$) = 0 Then Wk$ = "0000"
DigVal = Str$(Wk$)
If DigVal > 4300 Then DigVal = 4300

If DigVal < 10 Then
 Wk$ = "000" + Chr$(DigVal + 48)
ElseIf DigVal < 100 Then
 Wk$ = Str$(DigVal)
 Wk$ = "00" + Right$(Wk$, 2) ' remove + sign
ElseIf DigVal < 1000 Then
 Wk$ = Str$(DigVal)
 Wk$ = "0" + Right$(Wk$, 3) ' remove + sign
Else
 Wk$ = Str$(DigVal)
 Wk$ = Right$(Wk$, 4) ' remove + sign
 'If Len(Wk$) > 2 Then Stop
End If

End Sub

Public Sub Volts2DAval()
  Channel = DACh
  Vout = DigVal ' in mV
 '\ suggest connecting D/A output channels to
 '\ up to 4 input channes so you can check output
 '\ levels when program started - how i checked
If Vout > 3750 Then
    Multibit = 1
    stepsize = 29.42
    ' \ at the crossover point one step is low
    ' \ the next is high - cal as needed
   If Vout > 4300 Then Vout = 4300
Else
    Multibit = 0
    stepsize = 14.71
    If Vout < 0 Then Vout = 0
End If
    DAvalue = Vout / stepsize
    DAvalue = DAvalue + 0.5
    ' \ round up/down
    DAvalue = Int(DAvalue)
    ' save in array cause there is no readback
    DAOutAry(Channel, 0) = Multibit
    DAOutAry(Channel, 1) = DAvalue
    DAOutAry(Channel, 2) = Vout
' \ turn value into low and highbytes
Lowchar = DAvalue And 7  ' masks off high bits to zeros
Lowchar = Lowchar * 16 ' leftshifts low bits
 ' \\ lowchar now = 112 dec

Highchar = DAvalue \ 8  ' use integer divide to right shift high bits 3 places right.
' \\\ highchar now = 31 dec
Chanvar = Channel And 3
Chanvar = Chanvar * 64  ' leftshifts bits 1 & 0 into high bits - handles channel 0 to 3
Highchar = Highchar Or Chanvar ' sets channel bits to high bits.

Multivar = Multibit * 32 ' left shift multiplier bit
Highchar = Highchar Or Multivar

' make the output string
CmdChars = "!0SV" + Chr$(Highchar) + Chr$(Lowchar)
SendCmd

End Sub