VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CWaage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' Private Member
' --------------
' Comm Objekt, sollte vorher im g_App initialisiert sein
Private WithEvents m_comm As MSComm
Attribute m_comm.VB_VarHelpID = -1

' Angewählte Waaeg merken
Private m_Angewaehlt As Integer

' Letzter Fehlercode der seriellen Schnittstelle
Private m_nError As Integer
' Software Inputbuffer der seriellen Kommunikation
Private m_sInputBuffer As String
Private m_sStatus As String

Public m_strFehler As String

Public sLastAnswer As String
Public SoftTaraGewicht As Double

' Ruhe Parameter
Private m_RuheWdh As Integer
Private m_RuheGrenzwert As Double

Private m_ObererGrenzwert As Double ' wichtig für Grenzwert setzen

Public m_Waagenart As Integer
Private m_Nr As Integer


Public Function BefehlAnWaage(sBefehl As String, sBedeutung As String) As Boolean
    Dim sAntwort As String
    Call COMPufferleeren
    
    send (sBefehl)
    sAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
    
    Select Case sAntwort
        Case "w0"
            BefehlAnWaage = True
        Case "w5"
            BefehlAnWaage = True
        Case Else
            DebugMsg sBedeutung & " ist 1. mal fehlgeschlagen: '" & sAntwort & "'"
            Sleep 1000
            send (sBefehl)
            sAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            
            If sAntwort = "w0" Or sAntwort = "w5" Then
                BefehlAnWaage = True
                Exit Function
            Else
                DebugMsg sBedeutung & " ist 2. mal fehlgeschlagen: '" & sAntwort & "'"
                Exit Function
            End If
        End Select
        
Exit Function
BefehlAnWaageFehler:
    ErrorMsg ("Waagenstörung! Funktion " & sBedeutung & " fehlgeschlagen. Abbruch empfohlen.")
    BefehlAnWaage = False
End Function

Public Function TaraReset() As Boolean
    Dim strAntwort As String
    
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
            TaraReset = BefehlAnWaage("q#", "TaraReset")
        Case WAAGENART_METTLER
            send ("T ")
            strAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            If Left(strAntwort, 2) = "TB" Then
                TaraReset = True
            Else
                TaraReset = False
            End If
        Case WAAGENART_METTLER_2
            send ("TAC")
            strAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            If Left(strAntwort, 5) = "TAC A" Then
                TaraReset = True
            Else
                TaraReset = False
            End If
        End Select
End Function


' Setzt Grenzwert 1 für Nettovergleich
Public Function SetNettoGrenzwert1(Grenzwert As Double, Optional sFormat = "0.0") As Boolean
    Dim sBefehl As String
    Dim strAntwort As String
    SetNettoGrenzwert1 = False
    
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
            sBefehl = Chr$(39) & Chr$(49) & Format(Format(Grenzwert, sFormat), "@@@@@@@@") & "kg"
            SetNettoGrenzwert1 = BefehlAnWaage(sBefehl, "SetNettoGrenzwert1")
        Case WAAGENART_METTLER
            sBefehl = "AW020 "
            send (sBefehl)
            strAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            ' Grenzwert, uToleranz, oToleranz, Startwert
            sBefehl = "AW020 " & FormatMETTLERGrenzwert(Grenzwert, "kg") & Chr(9) & FormatMETTLERGrenzwert(0.1, "kg") & Chr(9) & FormatMETTLERGrenzwert(0.1, "kg") & Chr(9) & FormatMETTLERGrenzwert(0, "kg")
            send (sBefehl)
            strAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            If strAntwort = "AB" Then
                SetNettoGrenzwert1 = True
            End If
        Case WAAGENART_METTLER_2
            ' oberer Grenzwert, unterer Grenzwert  TODO
                        
            Select Case g_App.PruefstationNr
                Case 2007, 2005
                    sBefehl = "PMW ABS " & FormatMETTLERGrenzwert(Grenzwert, "") & " 250 kg"
                Case Else
                     If m_ObererGrenzwert > 0 Then
                        sBefehl = "PMW ABS " & Replace(Format(Grenzwert, "0.00"), ",", ".") & " " & Replace(Format(m_ObererGrenzwert, "0.00"), ",", ".") & " kg"
                     Else
                        sBefehl = "PMW ABS " & FormatMETTLERGrenzwert(Grenzwert, "") & " 150 kg"
                    End If
            End Select
            
            send (sBefehl)
            strAntwort = receive(WAAGE_DEFAULT_TIMEOUT)
            If strAntwort = "PMW A" Then
                SetNettoGrenzwert1 = True
            End If
        Case WAAGENART_FUELLSTAND
            ' nicht vorgsehen
            SetNettoGrenzwert1 = True
    End Select
End Function

Public Function Anwahl(iAnwahl As Integer) As Boolean
    Dim Count As Integer
    
    If iAnwahl = 0 Then
        ' nur die Prüfstationen 2000/2001 und 2015/2016 benötigen die Waagen-Anwahl
        ' alle anderen brauchen diesen Befehl nicht
        Anwahl = True
        Exit Function
    End If
    
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
        Do
            Anwahl = BefehlAnWaage("qV" & Right(Str(iAnwahl), 1), "Anwahl")
            If Anwahl = False Then
                Sleep 1000
            End If
            Count = Count + 1
        Loop Until Anwahl = True Or Count > 3
     Case WAAGENART_METTLER, WAAGENART_METTLER_2
        ' nicht implementert
         Debug.Print "Anwahl für Mettler nicht implementert"
        Anwahl = True
     End Select
End Function

'Public Function AufNullStellenOderTara()
'    If g_App.Settings.GetWaageTaraStattNullstellen(m_Nr) = True Then
'        Me.SoftTaraReset
'        Me.Tara
'    Else
'        Me.Nullstellen
'    End If
'End Function

' Hier läd die Klasse seine Einstellungen selbst aus der ini
Public Sub Initialize(iNr As Integer)
    On Error GoTo Errorhandler
    m_Nr = iNr
    ' Port Schließen
    If m_comm.PortOpen = True Then
        m_comm.PortOpen = False
        Debug.Print "Waage COMPort " & m_comm.CommPort & " geschlossen"
    End If
   
    ' Port wechseln
    If g_App.Settings.GetWaageCOMPort(iNr) <> 0 Then
        m_comm.CommPort = g_App.Settings.GetWaageCOMPort(iNr)
    End If
    
    ' RS232 Parameter ändern
    If g_App.Settings.GetWaageCOMSettings(iNr) <> "" Then
        m_comm.Settings = g_App.Settings.GetWaageCOMSettings(iNr)
    End If
    
    If g_App.Settings.GetWaageObererGrenzwert(iNr) <> "" Then
        m_ObererGrenzwert = g_App.Settings.GetWaageObererGrenzwert(iNr)
    Else
        m_ObererGrenzwert = 0
    End If
    
    
    ' Waagen Art ändern
    If g_App.Settings.GetWaageArt(iNr) <> "" Then
        Select Case g_App.Settings.GetWaageArt(iNr)
            Case "METTLER"
                m_Waagenart = WAAGENART_METTLER
            Case "BIZERBA"
                m_Waagenart = WAAGENART_BIZERBA
            Case "METTLER_2"
                m_Waagenart = WAAGENART_METTLER_2
            Case "FUELLSTAND"
                m_Waagenart = WAAGENART_FUELLSTAND
            Case Else
                MsgBox "Unbekannte Waagenart in ini: " & m_Waagenart
            End Select
    End If
    
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
        Debug.Print "Waage an COM-" & m_comm.CommPort & " geöffnet"
    End If
    

    Exit Sub
Errorhandler:
    ErrorMsg "Waage konnte nicht an COM" & g_App.Settings.GetWaageCOMPort(iNr) & " initialisiert werden: Fehler " & Err.Number & vbCrLf & Err.Description
    Exit Sub
    Resume
End Sub

Public Function Nullstellen() As Boolean
    Dim strTmp As String
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
            Nullstellen = BefehlAnWaage("q!", "Nullstellen")
        Case WAAGENART_METTLER
            send ("Z")
            strTmp = receive(WAAGE_DEFAULT_TIMEOUT)
            
            Select Case Left(strTmp, 2)
                Case "ZB", "TA"
                    Nullstellen = True
                Case Else
                    Nullstellen = False
            End Select
        Case WAAGENART_METTLER_2
            send ("ZI")
            strTmp = receive(WAAGE_DEFAULT_TIMEOUT)
            
            Select Case Left(strTmp, 4)
                Case "ZI D", "ZI S"
                    Nullstellen = True
                Case Else
                    Nullstellen = False
            End Select
        Case Else
    End Select

    If Nullstellen = False Then
        DebugMsg "Nullstellen fehlgeschlagen"
    End If
End Function


' Warte bis Waage in Ruhe
Public Function WarteAufRuhe()
    FrmWaagenRuhe.m_sFormat = "0.00"
    FrmWaagenRuhe.Show vbModal
End Function

' @return Bruttogewicht der ausgewählten Waage in kg
' -1 wenn das Gewicht nicht ermittelt werden kann
Public Function GetGewicht() As Double

    Dim strTmp As String
    Dim versuchzaehler As Integer
    GetGewicht = -9999
    
    On Error Resume Next
    
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
    End If
    
nochmal:
    versuchzaehler = versuchzaehler + 1
    If versuchzaehler > 20 Then
        GetGewicht = -9999
        Exit Function
    ElseIf versuchzaehler > 1 Then
        ' Wiederholung
        DebugMsg "Gewicht konnte das " & versuchzaehler & ". mal nicht gelesen werden!"
    End If
    
    Call COMPufferleeren
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
    
            If send("q%") Then
                strTmp = receive(WAAGE_DEFAULT_TIMEOUT)
                
                If Len(strTmp) = 13 Then
                    m_sStatus = Mid$(strTmp, 2, 1)
                    If Right$(strTmp, 2) = "kg" Then
                    'GetGewicht = CDbl(Mid(strTmp, 3, 8))
                        
                        strTmp = Right(strTmp, 11)
                        If InStr(1, strTmp, "?") Then
                            DebugMsg "ungültiges Gewicht von der Waage: '" & strTmp & "'"
                            GoTo nochmal
                        End If
                        
                        strTmp = Replace(strTmp, ",", ".")
                        GetGewicht = Val(strTmp)
                        
                    Else
                        m_nError = WAAGE_ERR_UNKNOWNANSWER
                        DebugMsg "Gewicht konnte nicht ermittelt werden (unknown Answer): " & vbCrLf & Err.Description & vbCrLf & "Antwort: " & strTmp
                        DebugMsg m_strFehler
                    End If
                Else
                    m_nError = WAAGE_ERR_UNKNOWNANSWER
                    DebugMsg "Gewicht konnte nicht ermittelt werden (unknown Answer): " & vbCrLf & Err.Description
                    DebugMsg m_strFehler
                End If
            Else
                m_nError = WAAGE_ERR_COM
                DebugMsg "Gewicht konnte nicht ermittelt werden (COM Error): " & vbCrLf & Err.Description
                DebugMsg m_strFehler
            End If
            GetGewicht = GetGewicht - SoftTaraGewicht
    Case WAAGENART_METTLER, WAAGENART_METTLER_2
        send ("SXI")
        strTmp = receive(WAAGE_DEFAULT_TIMEOUT)
        
        If Left(strTmp, 4) = "SX D" Or Left(strTmp, 4) = "SX S" Or Left(strTmp, 5) = "SX  G" Or Left(strTmp, 5) = "SXD G" Then
            'SX D G      0.081 kg   N      0.081 kg   T      0.000 kg '
            'SX S G     -0.022 kg   N     -0.022 kg   T      0.000 kg '
            'SX  G        1.0 kg   N        1.0 kg   T        0.0 kg '  ==> 2020  3.2.2015
            'SXD G      467.6 kg   N      467.6 kg   T        0.0 kg '  ==> 2020  3.2.2015
            
            strTmp = Mid(strTmp, 24, 12)
            ' todo: testen ab ab Position 25 auf der 2020
            strTmp = Replace(strTmp, "N", "")
            
            GetGewicht = Val(strTmp)
            GetGewicht = GetGewicht - SoftTaraGewicht
        Else
Unknown_Answer:
            m_nError = WAAGE_ERR_UNKNOWNANSWER
            Select Case strTmp
                Case "SI"
                    DebugMsg "Waage: ungültiger Wert"
                Case "SI-", "SX -"
                    DebugMsg "Waage im Unterlastbereich"
                Case "SI+", "SX +"
                    DebugMsg "Waage im Überlastbereich"
                Case Else
                    DebugMsg "Waage: unbekannte Antwort '" & strTmp & "', info: '" & m_strFehler & "'"
            End Select
            If g_Abbruch = True Then Exit Function
            GoTo nochmal
        End If
    Case Else
    End Select
End Function

Public Function Tara() As Boolean
    Dim strTemp As String
    Call COMPufferleeren
    Select Case m_Waagenart
        Case WAAGENART_BIZERBA
            Tara = BefehlAnWaage("q" & Chr$(34), "Tara")
        Case WAAGENART_METTLER
            send ("T")
            strTemp = receive(WAAGE_DEFAULT_TIMEOUT)
            Select Case Left(strTemp, 2)
                Case "TB", "ZA"
                    Tara = True
                Case "T-", "Z-"
                    DebugMsg "TARA-Fehler, Tarabereich unterschritten!"
                Case "T+", "Z+"
                    DebugMsg "TARA-Fehler, Tarabereich überschritten!"
                Case Else
                    DebugMsg "TARA-Fehler, Waage antwortetet mit '" & strTemp & "'"
            End Select
        Case WAAGENART_METTLER_2
            send ("TI")
            strTemp = receive(WAAGE_DEFAULT_TIMEOUT)
            Select Case Left(strTemp, 4)
                Case "TI S", "TI D"
                    Tara = True
                Case Else
                    Tara = False
            End Select
        End Select
End Function

Public Function Reset() As Boolean
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
    End If

    Select Case m_Waagenart
        Case WAAGENART_BIZERBA

        Call COMPufferleeren
        If send("q ") Then
           'Eingefügt am 24.6.2002 (Dirk Pulwer)
           Sleep 10000
           
           If InStr(1, receive(WAAGE_DEFAULT_TIMEOUT), "w0") > 0 Then
              Reset = True
           Else
              DebugMsg m_strFehler
              DebugMsg "Reset wird wiederholt"
              COMPufferleeren
              Sleep 7000, True
              send ("q " & vbCrLf)
              
              'Eingefügt am 24.6.2002 (Dirk Pulwer)
              Sleep 10000
              
              If InStr(1, receive(WAAGE_DEFAULT_TIMEOUT), "w0") > 0 Then
                 Reset = True
              Else
                 DebugMsg m_strFehler
                 Reset = False
              End If
           End If
        End If
        'sleep 6000
    Case WAAGENART_METTLER
        DebugMsg "Reset bei Mettler nicht implementiert"
        Reset = True
    Case WAAGENART_METTLER_2

        Call COMPufferleeren
        send ("@")
        receive (WAAGE_DEFAULT_TIMEOUT)
        Reset = True
    End Select
End Function

Public Sub OpenMSComm()
On Error GoTo Errorhandler
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
    End If
Exit Sub
Errorhandler:
    ErrorMsg ("OpenMSComm COM Port der Waage konnte nicht geöffnet werden")
End Sub

Public Sub setMScomm(comm As MSComm)
Dim comport As Integer

   On Error Resume Next
   Set m_comm = comm
   
   comport = g_App.Settings.getCOMPort(DEVPORT_Waage)
   If comport <> 0 Then
       ' aus Inifile
        Debug.Print "Waage an COM " & comport & "!"
        m_comm.CommPort = comport
   End If
   
   m_comm.DTREnable = True    ' notwendig für FM85.P, für Waage ?
   m_comm.EOFEnable = False   ' evtl. noch zu klären
   m_comm.Settings = "9600,E,7,1" ' notwendig
   m_comm.InputLen = 0
   m_comm.RThreshold = 1 'Event bei jedem Empfang

End Sub

'
' Daten auf serielle Schnittstelle senden
' @return true wenn erfolgreich, false wenn Fehler
Public Function send(s As String) As Boolean
    On Error GoTo WaageSendErr
    
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
    End If

    m_strFehler = "An Waage gesendet: '" & s & "'"
    DebugMsg "An Waage gesendet: '" & s & "'"
    
    m_sInputBuffer = ""
    m_comm.Output = s & vbCrLf
    send = True
    Exit Function
WaageSendErr:
    send = False
    ' Fehler sichtbar machen, protokollieren...
    DebugMsg "Konnte '" & s & "' nicht an Waage senden."
    Exit Function
End Function

'
' Eingabe von serieller Schnittstelle
'
' @param nTimeoutMillis  Anzahl der max. zu wartenden Millisekunden
'
Public Function receive(nTimeoutMillis As Integer) As String
   DoEvents
   Dim msEnd As Long
   receive = ""
   On Error GoTo WaageReceiveErr
   msEnd = GetTickCount() + nTimeoutMillis
   Do
      ' TODO: Von Serieller lesen!
      DoEvents
      If Right(m_sInputBuffer, 2) = Chr(13) + Chr(10) Then
         ' ganze Zeile von Waage empfangen
         Exit Do
      End If
   Loop While GetTickCount() <= msEnd
   
   If GetTickCount() > msEnd Then
      ' Todo Fehlerbehandlung optimieren
      m_nError = WAAGE_ERR_NOANSWER
      DebugMsg "Keine Antwort von Waage "
      receive = ""
      Exit Function
   End If
   ' CR LF abschneiden
   receive = Mid(m_sInputBuffer, 1, Len(m_sInputBuffer) - 2)
   m_strFehler = m_strFehler & vbCrLf & "Von Waage empfangen: '" & receive & "'"
   sLastAnswer = m_sInputBuffer
   m_sInputBuffer = ""
   Exit Function
WaageReceiveErr:
    receive = ""
    DebugMsg ("WaageRecieveErr: '" & Err.Description) & "'"
    Exit Function
End Function

' @return Daten aus Inputbuffer
'
Public Function getData() As String
   getData = m_sInputBuffer
End Function

Private Sub Class_Initialize()
    m_Angewaehlt = 0
    m_Waagenart = WAAGENART_BIZERBA
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    m_comm.PortOpen = False
End Sub

' Event-Handler für das MS-Comm Control
'
Private Sub m_comm_OnComm()
    Dim nEvent As Integer
   Dim sTmp As String
   nEvent = m_comm.CommEvent
   Select Case nEvent
      Case comEvReceive
         sTmp = m_comm.Input
         m_sInputBuffer = m_sInputBuffer & sTmp
         DebugMsg "Waage sendet: " & m_sInputBuffer
      Case Default
         m_nError = WAAGE_ERR_COM
         DebugMsg "Serial Event: " & nEvent & vbCrLf
   End Select
End Sub

' Liegt ein Fehler vor?
'
' @return   true  = Fehler liegt vor, Fehlerbeschreibung kann
'                   mit getErrorCode/getErrorDesc eingeholt
'                   werden
'           false = alles OK
'
Public Function hasError() As Boolean
    hasError = (m_nError <> 0)
End Function

' @return   Interner Code des letzten Fehlers
'           (siehe modFM85P.bas)
'
Public Function getErrorCode() As Integer
    getErrorCode = m_nError
End Function

' @return Erläuterung zu dem letzten Fehler
'
Public Function getErrorDesc() As String
    Select Case m_nError
        Case WAAGE_ERR_NOANSWER
            getErrorDesc = WAAGE_ERR_NOANSWER_D
        Case Default
            getErrorDesc = ""
    End Select
End Function

' Funktion kehrt erst Zurück, wenn Waage ein
' Gewicht mit gesetztem Ruhe-Bit zurück gibt
'
Public Function WarteBisRuhe()
DebugMsg "Warte bis Waage in Ruhe"
Do While True
    If GetGewicht() <> -1 Then
        If Asc(m_sStatus) And 1 = 1 Then
            Exit Do
        End If
    Else
        MsgBox ("Waagen fehler: gewicht = -1")
        Exit Do
    End If
Loop
End Function


Public Sub releaseMScomm()
DebugMsg "releaseMScomm"
On Error Resume Next

    If m_comm.PortOpen = True Then
        m_comm.PortOpen = False
    End If

   If Err Then
       DebugMsg "releaseMScomm Fehler: " & Err.Number & ": " & Err.Description
        ' MsgBox ("Fehler beim Schließen des Comm port für Waage: " & Err.Description)
   End If
End Sub

Public Sub SoftTara()
    SoftTaraGewicht = 0
    SoftTaraGewicht = GetGewicht
    DebugMsg "Softtara bei " & SoftTaraGewicht
End Sub

Public Sub SoftTaraReset()
    SoftTaraGewicht = 0
End Sub

Private Function COMPufferleeren()
Dim sTmp As String
    ' m_sInputBuffer = ""
    'Exit Function
    If m_comm.PortOpen = False Then
        m_comm.PortOpen = True
    End If

    
    On Error Resume Next
    sTmp = m_comm.Input
    If Err.Number > 0 Then
        DebugMsg "Fehler " & Err.Number & " in COMPufferleeren: " & Err.Description
        
    End If
    If sTmp <> "" Then
        DebugMsg "Waagen COM-Puffer war nicht leer: '" & sTmp & "'"
    End If

End Function


Private Function FormatMETTLERGrenzwert(eingabe As Double, unit As String) As String
    FormatMETTLERGrenzwert = Replace(Format(eingabe, "0.00"), ",", ".") & " " & Mid(Trim(unit) & "   ", 1, 3)
End Function