Attribute VB_Name = "PPG"
Private is_init As Boolean
Private seriell As MSComm
Private is_cts As Boolean
Public poweron As Boolean
Dim shiftreg(96) As Byte


Function init(comm As MSComm, setStr As String) As String
'initializes MsComm parameter, finds free Commport autom.
'open free commport
'return portnumber when matches, else "Failure"
Dim i As Byte
If is_init Then Exit Function

On Error GoTo feh
 comm.Settings = setStr
noch:
 i = i + 1

comm.CommPort = i
init = Str(i)
comm.PortOpen = True

is_init = True
 
 Set seriell = comm      'object seriell gets comm
Exit Function
feh:
 init = "Failure"
  If i < 5 Then GoTo noch
End Function

Sub SET_DTR()
'sets DTR.
'MScomm must be opened before!
  
  If is_init = True Then
   seriell.DTREnable = True
  Else
   MsgBox ("MSComm must be iinitialize first!")
  End If
End Sub

Sub CLR_DTR()
'clears DTR.
'MScomm must be opened before!
  
  If is_init = True Then
   seriell.DTREnable = False
  Else
   MsgBox ("MSComm must be iinitialize first!")
  End If
End Sub

Sub SET_RTS()
'sets RTS.
'MScomm must be opened before!
  
  If is_init Then
   seriell.RTSEnable = True
  Else
   MsgBox ("MSComm must be iinitialize first!")
  End If
 End Sub
 
Sub CLR_RTS()
'clears DTR.
'MScomm must be opened before!
  
  If is_init = True Then
   seriell.RTSEnable = False
  Else
   MsgBox ("MSComm must be iinitialize first!")
  End If

End Sub

Property Get cts_hi() As Boolean
If is_init Then
  If seriell.CTSHolding Then
   cts_hi = True
   is_cts = True
  Else
   cts_hi = False
   is_cts = False
  End If
Else
  MsgBox ("MSComm must be iinitialize first!")
End If
End Property

Sub toggle_FF()
If is_init Then
   seriell.Output = Chr(0)
Else
  MsgBox ("MSComm must be iinitialize first!")
End If
End Sub

Sub SET_CTS()
Static count As Byte
 While Not PPG.cts_hi
      PPG.toggle_FF
      count = count + 1
      If count > 5 Then
         MsgBox ("CTS doesn't work! Check Power or CTS-Connection!")
         Exit Sub
      End If
    count = 0
 Wend
      count = 0
End Sub

Sub CLR_CTS()
Static count As Byte
  While PPG.cts_hi
      PPG.toggle_FF
      count = count + 1
      If count > 5 Then
         MsgBox ("CTS doesn't work! Check Power or CTS-Connection!")
         Exit Sub
      End If
 Wend
count = 0
End Sub
Function check_power() As Boolean
Static i As Integer
   If is_init Then
     Do
     seriell.Output = Chr(0)
     DoEvents
     i = i + 1
      If i > 10 Then
       MsgBox ("Check Power or CTS-Connection!")
       check_power = False
       poweron = False
      Exit Function
      End If
     Loop Until PPG.cts_hi
  check_power = True
  poweron = True
   Else
     MsgBox ("MSComm must be iinitialize first!")
   End If
End Function
Sub shift_hi()
'shifts a hi-bit into shiftregiser
 PPG.CLR_DTR
 PPG.SET_CTS
  PPG.SET_RTS
  PPG.CLR_RTS
 
End Sub
Sub shift_lo()
'shifts a lo-bit into shiftregiser
PPG.CLR_DTR
 PPG.CLR_CTS
  PPG.SET_RTS
  PPG.CLR_RTS
PPG.SET_CTS
End Sub
Sub circulate()
  'starts free-running-mode
  PPG.CLR_RTS
  PPG.SET_DTR
End Sub
Sub set_puls_on_pos(position As Byte)
Dim i As Integer

  shiftreg(position) = 1
       For i = 1 To 96
         If shiftreg(i) = 1 Then
            PPG.shift_hi
         Else
            PPG.shift_lo
         End If
       Next i
       
End Sub
Sub clr_puls_on_pos(position As Byte)
Dim i As Integer

  shiftreg(position) = 0
       For i = 1 To 96
         If shiftreg(i) = 1 Then
            PPG.shift_hi
         Else
            PPG.shift_lo
         End If
       Next i

End Sub

Sub update_arr(pos As Byte)
shiftreg(pos) = 1
End Sub
Function is_power_on(power As Form3) As Boolean
'checks power or connection to commport
  If is_init Then
     power.Visible = True
     power.SetFocus
     Form1.Enabled = False
     
     Do
       DoEvents
       
       If Form3.weiter = True Then
       Form3.weiter = False
       power.Visible = False
       Form1.Enabled = True
       Form1.SetFocus
       
       Exit Function
       
       End If
       
     
     PPG.CLR_DTR
     Loop Until seriell.CDHolding = True

   power.Visible = False
   Form1.Enabled = True
   Form1.SetFocus
   
      
  
  
  End If
  
End Function