Attribute VB_Name = "TA"
Option Explicit

'---------------------------------
'deklarace Kernel LPT driveru
Public Declare Function Inp Lib "inpout32.dll" _
    Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Public Declare Sub Out Lib "inpout32.dll" _
    Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)
'konec deklarace driveru
'---------------------------------


'----------------------------------------------------------
'navoleni sprvne masky podle vybraneho portu
'----------------------------------------------------------

Public Sub port()

    '-----------------------------
    'podle toho ktery vstup na LPT
    'je navolen pro spousteni
    'AirChecku podle toho se spocita
    'komparacni maska
    
    Select Case Frm1.CboTAVstup.ListIndex
        Case 0
            TAMaska = 64
        Case 1
            TAMaska = 128
        Case 2
            TAMaska = 32
        Case 3
            TAMaska = 16
        Case 4
            TAMaska = 8
    End Select
    
    DoEvents

End Sub


'----------------------------------------------------------
'nacteni vstupu a odpovidajici reakce na vstupni hodnoty
'----------------------------------------------------------

Public Sub NactiVstup()
    
    Dim TAin As Integer

    TAVstup = Inp(888 + 1)
    
    TAin = TAVstup And TAMaska
    
    If (TAVstupIndex = 1) Then
        If (TAin = 0) Then
            TAin = 1
        Else:
            TAin = 0
        End If
    End If
    
    DoEvents
    
    '-----------------------------
    'zalezi na tom jaka uroven je na vstupu
    'a na tom jakou urovni se ma spustit vysilani(H nebo L)

    '-----------------------------
    'pro pozitivni orientaci
    If (TAOrientace = 1) Then
        If (TAin > 0) Then
            If (TAStav = False) Then
                TAStav = True
                TAvysilani "zap"
            End If
        Else:
            If (TAStav = True) Then
                TAStav = False
                TAvysilani "vyp"
            End If
        End If
    End If
    
    '-----------------------------
    'pro negativni orientaci
    If (TAOrientace = 0) Then
        If (TAin = 0) Then
            If (TAStav = False) Then
                TAStav = True
                TAvysilani "zap"
            End If
        Else:
            If (TAStav = True) Then
                TAStav = False
                TAvysilani "vyp"
            End If
        End If
    End If
    
    DoEvents

End Sub


'----------------------------------------------------------
'sledovani jednotlivych pinu
'----------------------------------------------------------

Public Sub TASledujPorty()

    If ((TAVstup And 64) > 0) Then
        Frm1.LblPromoTAPin(0).BackColor = &HFF00&
    Else:
        Frm1.LblPromoTAPin(0).BackColor = &H8000000F
    End If
    
    If Not ((TAVstup And 128) > 0) Then
        Frm1.LblPromoTAPin(1).BackColor = &HFF00&
    Else:
        Frm1.LblPromoTAPin(1).BackColor = &H8000000F
    End If
    
    If ((TAVstup And 32) > 0) Then
        Frm1.LblPromoTAPin(2).BackColor = &HFF00&
    Else:
        Frm1.LblPromoTAPin(2).BackColor = &H8000000F
    End If
    
    If ((TAVstup And 16) > 0) Then
        Frm1.LblPromoTAPin(3).BackColor = &HFF00&
    Else:
        Frm1.LblPromoTAPin(3).BackColor = &H8000000F
    End If
    
    If ((TAVstup And 8) > 0) Then
        Frm1.LblPromoTAPin(4).BackColor = &HFF00&
    Else:
        Frm1.LblPromoTAPin(4).BackColor = &H8000000F
    End If

End Sub


'----------------------------------------------------------
'vysilani TA signalu
'----------------------------------------------------------

Public Sub TAvysilani(podm As String)

Dim i As Integer

On Error GoTo chyba

    If Frm1.MSComm1.PortOpen = True Then
    
        If (podm = "zap") Then
            '--------------------
            'posli retezec
            '--------------------
            Frm1.MSComm1.Output = TAZap + vbCrLf
            
            If (Dir(CestaSoubory & "/TAError.rds") <> "") Then
                Kill (CestaSoubory & "/TAError.rds")
            End If
            If (Dir(CestaSoubory & "/TAOff.rds") <> "") Then
                Kill (CestaSoubory & "/TAOff.rds")
            End If
            
            Open CestaSoubory & "/TA.rds" For Append As #30
            Close #30
            
            Open CestaSoubory & "/RDS-Logy/TA/" & GenerujNazevSouboru(Date) & "_TA.rds" For Append As #31
                Print #31, Date & " " & Time & "  TA ON"
            Close #31
            
            For i = 0 To 1
                Frm1.LblStTA(i).Caption = "Sledovani TA aktivni - Stav zapnuto"
                Frm1.LblStTA(i).BackColor = &H5BE866
            Next i
            
            DoEvents
        Else:
            '--------------------
            'posli retezec
            '--------------------
            Frm1.MSComm1.Output = TAVyp + vbCrLf
            
            If (Dir(CestaSoubory & "/TA.rds") <> "") Then
                Kill (CestaSoubory & "/TA.rds")
            End If
            If (Dir(CestaSoubory & "/TAError.rds") <> "") Then
                Kill (CestaSoubory & "/TAError.rds")
            End If
            If (Dir(CestaSoubory & "/TAOff.rds") <> "") Then
                Kill (CestaSoubory & "/TAOff.rds")
            End If
            
            Open CestaSoubory & "/RDS-Logy/TA/" & GenerujNazevSouboru(Date) & "_TA.rds" For Append As #31
                Print #31, Date & " " & Time & "  TA OFF"
            Close #31
            
            For i = 0 To 1
                Frm1.LblStTA(i).Caption = "Sledovani TA aktivni - Stav vypnuto"
                Frm1.LblStTA(i).BackColor = &H6DF2F5
            Next i
            
            DoEvents
        End If
        
    End If
    
Exit Sub

chyba:

    For i = 0 To 1
        Frm1.LblStTA(i).Caption = "TA ERROR"
        Frm1.LblStTA(i).BackColor = &H2248FF
    Next i
    
    If (Dir(CestaSoubory & "/TA.rds") <> "") Then
        Kill (CestaSoubory & "/TA.rds")
    End If
    If (Dir(CestaSoubory & "/TAOff.rds") <> "") Then
        Kill (CestaSoubory & "/TAOff.rds")
    End If
    
    Open CestaSoubory & "/TAError.rds" For Output As #30
    Close #30
    
    ZapisSystemLog "TA ERROR", "Chyba pri TA vysilani"
    OdesliEmail "RDSManager Error", 1, "Chyba pri TA vysilani!!"
    
End Sub
