681 lines
20 KiB
OpenEdge ABL
681 lines
20 KiB
OpenEdge ABL
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
|