Initial commit 3
This commit is contained in:
Rowlander
@@ -0,0 +1,680 @@
|
||||
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
|
||||
Reference in New Issue
Block a user