VERSION 5.00 Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" Begin VB.Form frmRegulierungInQt Caption = "Pruef2000 Regulierung in Qt" ClientHeight = 11010 ClientLeft = 165 ClientTop = 555 ClientWidth = 15240 LinkTopic = "Form1" ScaleHeight = 11010 ScaleWidth = 15240 StartUpPosition = 3 'Windows-Standard WindowState = 2 'Maximiert Begin VB.Frame frMain BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 11055 Left = 0 TabIndex = 0 Top = 0 Width = 15195 Begin VB.Frame Frame2 Caption = "Test / Debug" Height = 2325 Left = 4590 TabIndex = 9 Top = 3720 Width = 2385 Begin VB.CommandButton cmdNeustart Caption = "Neustart Regulierung" Height = 465 Left = 180 TabIndex = 13 ToolTipText = "Startet die komplette Regulierung neu" Top = 540 Width = 1815 End Begin VB.CommandButton Command2 Caption = "Display Reset " Height = 465 Left = 180 TabIndex = 12 ToolTipText = "initialisiert alle Displays" Top = 1110 Width = 1815 End Begin VB.CommandButton cmdStartAlle Caption = "Starte alle Messungen neu" Height = 465 Left = 180 TabIndex = 11 Top = 1680 Width = 1815 End Begin VB.CheckBox chkTimer Caption = "Status aktualisieren" Height = 345 Left = 150 TabIndex = 10 Top = 210 Value = 1 'Aktiviert Width = 1845 End End Begin VB.Frame Frame1 Caption = "Vorgaben" Height = 2325 Left = 180 TabIndex = 6 Top = 3720 Width = 4365 Begin VB.TextBox txtPruefzeit Alignment = 1 'Rechts BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 450 Left = 1710 TabIndex = 8 Text = "160" Top = 480 Width = 675 End Begin VB.Label Label2 Caption = "Prüfzeit [s]:" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 300 TabIndex = 7 Top = 510 Width = 1455 End End Begin VB.Timer Timer1 Left = 2910 Top = 180 End Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 Height = 3045 Left = 150 TabIndex = 4 Top = 600 Width = 14865 _ExtentX = 26220 _ExtentY = 5371 _Version = 393216 Rows = 11 Cols = 8 End Begin VB.TextBox txtStatus Height = 4755 Left = 180 MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 3 Top = 6120 Width = 8775 End Begin VB.CommandButton cmdQuit Caption = "Schliessen" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 825 Left = 12930 TabIndex = 1 Top = 9900 Width = 1815 End Begin VB.Label lblAutosize BorderStyle = 1 'Fest Einfach Caption = "lblAutosize" Height = 285 Left = 1290 TabIndex = 5 Top = 240 Visible = 0 'False Width = 885 End Begin VB.Label Label1 Caption = "LWL Regulierung in Qt" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 5190 TabIndex = 2 Top = 210 Width = 3315 End End End Attribute VB_Name = "frmRegulierungInQt" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private m_bMessungLaeuft(11) As Boolean ' von aufrufender Form zu setzende Member Public m_Regulierdaten As New CRegulierdaten Public m_colUniquePP As CPruefpunktCol Public m_colEinbauplatz As Collection Public m_Referenzzaehler As CRefzaehler Public m_ImpulswertigkeitPZ As Long Public m_DurchflussSoll As Double Private m_bActivated As Boolean Public m_ersterPruefzaehlerNr As Integer Private WithEvents m_Display As CEAKIT Attribute m_Display.VB_VarHelpID = -1 Private m_FMBus As CFMBus Private m_SPS As CSPS Public m_bUseLWL As Boolean Private m_Pruefzeit As Long Private m_bisInTimer As Boolean Private m_bisInTaste As Boolean Private m_AnzahlPeriodenRZ As Long Private m_AnzahlPeriodenPZ As Long Private Sub chkTimer_Click() If chkTimer.value = vbChecked Then Timer1.Enabled = True Else Timer1.Enabled = False End If End Sub Private Sub cmdNeustart_Click() StartRegulierung End Sub Private Sub cmdQuit_Click() If Not m_Display Is Nothing Then m_Display.Adressierung 255 m_Display.EaKitOutput Chr(27) & "YA" & Chr(1) m_Display.ClrScreen m_Display.Licht 0 End If Timer1.Enabled = False Unload Me End Sub Private Sub StartButtonDarstellen(strText As String) 'Touchfelder reset 'm_Display.EaKitOutput Chr(27) & "TR" m_Display.DefineButton 41, 50, 3, strText 'Touchtaste automatsiches Invertieren m_Display.EaKitOutput Chr(27) & "TI" & Chr(1) 'Touchtaste ein Signalton m_Display.EaKitOutput Chr(27) & "TS" & Chr(1) ' Touchtasten Abfrage aktiv m_Display.EaKitOutput Chr(27) & "TA" & Chr(2) End Sub Private Sub InitalleDisplays() InitDisplay ' Tastendrücke aktiv: Tatsenmakros werden ausgeführt, aber werden nicht gesendet m_Display.EaKitOutput Chr(27) & "TA" & Chr(2) m_Display.DefineButton 41, 50, 3, "Start" End Sub Private Sub cmdStartAlle_Click() Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then m_bMessungLaeuft(Einbauplatz.getNr) = True Else m_bMessungLaeuft(Einbauplatz.getNr) = False End If Next StartMessungAnFM85 (0) End Sub Private Sub Command2_Click() InitalleDisplays End Sub Private Sub Form_Activate() If m_bActivated = False Then ' start Me.Visible = True DoEvents Call StartRegulierung m_bActivated = True End If End Sub Private Sub Form_Load() Call setupStdDlg(Me) Set m_Display = g_App.GetDisplay Set m_FMBus = g_App.getFMBus Set m_SPS = g_App.getSPS m_Pruefzeit = 160 MSFlexGrid1.FormatString = "Einbauplatz|Seriennr|ImpulsePZ|verbl. PZ|ImpulseRZ|verbl. RZ|Zeit|Fehler|>>|>>|>>|>>|>>|>>" PrintStatus "Form geladen" m_bActivated = False End Sub Private Sub StartRegulierung() cmdQuit.Enabled = False ' Die gesamte Regulierung wird hier gestartet Timer1.Enabled = False Dim i As Integer For i = 1 To 10 m_bMessungLaeuft(i) = False Next InitDisplay txtPruefzeit = m_Pruefzeit 'alle FM85 ansprechen und Messung starten If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter m_bUseLWL Sleep 100, True PrintStatus "Der FM85 Eingang wurde auf LWL geschaltet." PrintStatus "Warten bis Solldurchfluß erreicht..." Do While Not m_SPS.SolldurchflussErreicht Sleep 500, True If g_Abbruch = True Then Screen.MousePointer = vbNormal cmdQuit.Enabled = True Exit Sub End If Loop PrintStatus "Solldurchfluss für Regulierung erreicht bei Q=" & Format(m_SPS.getQIst, "0.000") End If ' ohne SPS StartMessungFuerAlle cmdQuit.Enabled = True AutoSpaltenBreite MSFlexGrid1, lblAutosize End Sub Private Sub InitDisplay() If m_Display Is Nothing Then Exit Sub PrintStatus "alle Displays initialisieren..." m_Display.Adressierung 255 m_Display.CallMakro 0 m_Display.EaKitOutput Chr(27) & "YA" & Chr(0) m_Display.Licht 1 m_Display.ClrScreen ' Font 3 kein Zoom m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(1) & Chr(1) ' Text-Modus replace Hintergrund löschen, Schwarze Pixel setzen m_Display.EaKitOutput Chr(27) & "L" & Chr(4) & Chr(1) m_Display.EaKitOutput Chr(27) & "TA" & Chr(2) Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler PrintStatus "Displays " & Einbauplatz.getNr & " initialiseren..." m_Display.Adressierung Einbauplatz.getNr ' Einbauplatz anzeigen m_Display.CenterText "Platz " & Einbauplatz.getNr, 80, 0 If Not Pruefzaehler Is Nothing Then ' SerienNr anzeigen If Einbauplatz.getPruefzaehler.m_strKundeneigeneSerienNr <> "" Then m_Display.PlaceText "Knd-SerNr " & Einbauplatz.getPruefzaehler.m_strKundeneigeneSerienNr, 10, 10 Else m_Display.PlaceText "SerienNr " & Einbauplatz.getPruefzaehler.getSerienNr, 10, 10 End If End If Next PrintStatus "alle Displays sind initialisiert" ' damit Touchmakros wieder in jedem Display ausgeführt werden m_Display.Adressierung 255 End Sub Private Sub StartMessungFuerAlle() Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler PrintStatus "alle FM85 initialisieren..." For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If Not m_Display Is Nothing Then m_Display.Adressierung 255 End If StartMessungAnFM85 (Einbauplatz.getNr) If Not m_Display Is Nothing Then m_Display.Adressierung Einbauplatz.getNr StartButtonDarstellen "1.Lauf" End If End If Next PrintStatus "1.Lauf" PrintStatus "Timer gestartet" Timer1.Interval = 300 Timer1.Enabled = True If Not m_Display Is Nothing Then m_Display.Adressierung 255 End If End Sub Private Sub m_Display_TasteGedrueckt(ByVal bytadresse As Byte, ByVal strTaste As String) If m_bisInTaste Then PrintStatus "vorheriger Tastendruck wird gerade behandlet. Taste " & bytadresse & " wird ignoriert!" Exit Sub Else PrintStatus "Taste " & strTaste & " an Platz " & bytadresse End If m_bisInTaste = True Dim blnTimer As Boolean blnTimer = Timer1.Enabled Timer1.Enabled = False DoEvents If strTaste = "3" Then ' TastenMakro3 Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz Set Einbauplatz = m_colEinbauplatz.Item(bytadresse) Set Pruefzaehler = Einbauplatz.getPruefzaehler If Pruefzaehler Is Nothing Then PrintStatus "Tastendruck von Display " & bytadresse & " wird ignoriert" Else m_Display.Adressierung CInt(bytadresse) m_Display.beep 2 m_Display.DefineButton 41, 50, 3, "init" 'm_Display.Adressierung 255 StartMessungAnFM85 (CInt(bytadresse)) m_Display.Adressierung CInt(bytadresse) m_Display.beep 2 m_Display.DefineButton 41, 50, 3, "laeuft" End If End If Timer1.Enabled = blnTimer m_bisInTaste = False m_Display.Adressierung 255 End Sub Private Sub StartMessungAnFM85(intEinbauplatzNr As Integer) Dim fm85p As CFM85P Dim ImpulswertigkeitRZ As Double PrintStatus "StartMessung an FM85P-" & intEinbauplatzNr m_bMessungLaeuft(intEinbauplatzNr) = True If intEinbauplatzNr = 0 Then m_FMBus.send "**0@" m_FMBus.receive 500 m_FMBus.send "R" Sleep 1000, True m_FMBus.send "**0@" m_FMBus.receive 500 Else Set fm85p = m_FMBus.getFM85P(intEinbauplatzNr) fm85p.sendAttention fm85p.send "R" Sleep 1000, True fm85p.sendAttention End If ' keine Doppelimpulssperre sendonly "G" PrintStatus "Sende 'keine Doppelimpulssperre' an FM85: 'G'" ' Doppelimpuls-Zeit PrintStatus "Sende Doppelimpuls-Zeit an FM85: '0000S'" sendonly "0000S" ' Multiplikator PrintStatus "Sende Multiplikator an FM85: '1s'" sendonly "1s" ' Dämpfung sendonly "3T" ' ' K Wert PrintStatus "Sende K-Wert an FM-85: '1000K+1'" sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K ' ---------------------------------------------------------------------------------- ' Periodenzahl errechnen Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz If intEinbauplatzNr = 0 Then intEinbauplatzNr = m_ersterPruefzaehlerNr Set Einbauplatz = m_colEinbauplatz.Item(intEinbauplatzNr) Set Pruefzaehler = Einbauplatz.getPruefzaehler Dim Korrekturwert As Double ErrechneImpulsanzahlFuerFM85 m_DurchflussSoll, m_ImpulswertigkeitPZ, m_Pruefzeit, m_AnzahlPeriodenPZ, Korrekturwert, Pruefzaehler.GetAnzahlPaletten PrintStatus "Anzahl Perioden PZ: " & m_AnzahlPeriodenPZ ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ m_AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ PrintStatus "unkorrigierte AnzahlPeriodenRZ = (" & m_Pruefzeit & "/ 3600) * " & m_DurchflussSoll & " * " & ImpulswertigkeitRZ & " = " & m_AnzahlPeriodenRZ m_AnzahlPeriodenRZ = m_AnzahlPeriodenRZ * Korrekturwert PrintStatus "Korrigierte AnzahlPeriodenRZ: = (" & m_Pruefzeit & "/ 3600) * " & m_DurchflussSoll & " * " & ImpulswertigkeitRZ & " * " & Korrekturwert & m_AnzahlPeriodenRZ & " = " & m_AnzahlPeriodenRZ PrintStatus "AnzahlPeriodenRZ=" & m_AnzahlPeriodenRZ & " an FM85: '" & Hex(m_AnzahlPeriodenRZ) & "M'" sendonly Hex(m_AnzahlPeriodenRZ) & "M" MSFlexGrid1.TextMatrix(intEinbauplatzNr, 4) = m_AnzahlPeriodenRZ PrintStatus "AnzahlPeriodenPZ=" & m_AnzahlPeriodenPZ & " an FM85: '" & Hex(m_AnzahlPeriodenPZ) & "H'" sendonly Hex(m_AnzahlPeriodenPZ) & "H" MSFlexGrid1.TextMatrix(intEinbauplatzNr, 2) = m_AnzahlPeriodenPZ Set Einbauplatz = m_colEinbauplatz.Item(intEinbauplatzNr) ' Zeit zurücksetzen Einbauplatz.m_lngPruefzeit = GetTickCount \ 1000 MSFlexGrid1.TextMatrix(intEinbauplatzNr, 6) = m_Pruefzeit m_bMessungLaeuft(intEinbauplatzNr) = True PrintStatus "Messung gestartet für FM85-" & intEinbauplatzNr & vbCrLf End Sub Private Function GetKWert(ImpulswertigkeitPZ As Long, ImpulswertigkeitRZ As Long, letzterFehlerRZ As Double) As Double ' K Wert bestimmen GetKWert = ImpulswertigkeitRZ / ImpulswertigkeitPZ DebugMsg "PZ-Impulse/qm = " & ImpulswertigkeitPZ DebugMsg "RZ-Impulse/qm = " & ImpulswertigkeitRZ DebugMsg "interpolierter Fehler RZ: " & letzterFehlerRZ & " % " DebugMsg "unkorrigierter K Wert: " & GetKWert GetKWert = ImpulswertigkeitRZ * (1 + letzterFehlerRZ / 100) / ImpulswertigkeitPZ DebugMsg "korrigierter K Wert: " & GetKWert End Function Private Sub sendonly(text) m_FMBus.send (text) m_FMBus.receive (500) End Sub Private Sub Timer1_Timer() If Not m_bisInTimer Then m_bisInTimer = True Call StatusUpdate m_bisInTimer = False Else PrintStatus "war schon in Timer" End If End Sub Private Sub StatusUpdate() ' verbleibende Impulse anzeigen Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz Dim FM85 As CFM85P Dim ImpulsePZ As Long Dim ImpulseRZ As Long Dim PeriodendauerPZ As Long Dim PeriodendauerRZ As Long Dim Fehler As Double Dim FehlerRefZ As Double Dim Spalte As Integer For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If m_bMessungLaeuft(Einbauplatz.getNr) = True Then Set FM85 = m_FMBus.getFM85P(Einbauplatz.getNr) FM85.sendAttention MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = 0 MSFlexGrid1.text = Einbauplatz.getNr MSFlexGrid1.col = 1 MSFlexGrid1.text = Einbauplatz.getPruefzaehler.getSerienNr Fehler = 0 ImpulsePZ = GetHexZahlFromFM85(Einbauplatz.getNr, "I") MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = 3 MSFlexGrid1.text = ImpulsePZ Sleep 100, True ImpulseRZ = GetHexZahlFromFM85(Einbauplatz.getNr, "J") MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = 5 MSFlexGrid1.text = ImpulseRZ Sleep 100, True If ImpulsePZ = 0 And ImpulseRZ = 0 Then ' Prüfung ist fertig, also Ergebnis anzeigen PeriodendauerPZ = GetHexZahlFromFM85(Einbauplatz.getNr, "X") PrintStatus "Pruefzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerPZ Sleep 100, True PeriodendauerRZ = GetHexZahlFromFM85(Einbauplatz.getNr, "Y") PrintStatus "Referenzzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerRZ Sleep 100, True If PeriodendauerPZ > 0 And PeriodendauerRZ > 0 Then FehlerRefZ = m_Referenzzaehler.letzterFehler(m_DurchflussSoll) If g_objExternePruefformel Is Nothing Then PrintStatus "Interne Pruefformel" ' die PeriodendauerRZ ist fehlerbehaftet muss korrigiert werden Fehler = (100 * PeriodendauerRZ / PeriodendauerPZ) - 100 PrintStatus "FehlerPZ (unkorrigiert) = 100 * ((PeriodendauerRZ / PeriodendauerPZ) - 1) = " & Format(Fehler, "0.00") & " %" 'PrintStatus "indicated volume = " & Format((Einbauplatz.m_AnzahlPeriodenPZ / ImpulswertigkeitPZ) / (PeriodendauerPZ / PeriodendauerRZ) * 1000, "0.000") & " Liter" ' Korrektur des Fehlers mit dem Fehler des Referenzzählers Fehler = Fehler + FehlerRefZ PrintStatus "meter error = Fehler PZ (korrigiert) = FehlerPZ (unkorrigiert) + FehlerRefZ = " & Format(Fehler - FehlerRefZ, "0.00") & "% + " & Format(FehlerRefZ, "0.00") & " % = " & Format(Fehler, "0.00") & " %" Else ' Fehlerberechnung in Externer DLL, neu RH 30.5.2017 Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(1 / PeriodendauerPZ, 1 / PeriodendauerRZ, FehlerRefZ) PrintStatus g_objExternePruefformel.GetLogText End If ' Historie For Spalte = MSFlexGrid1.Cols - 1 To 8 Step -1 MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Spalte) = MSFlexGrid1.TextMatrix(MSFlexGrid1.row, Spalte - 1) Next MSFlexGrid1.col = 7 MSFlexGrid1.text = Format(Fehler, "0.00") If Not m_Display Is Nothing Then m_Display.Adressierung Einbauplatz.getNr ' Font 3, 4*x 4*y Zoom m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(5) & Chr(5) m_Display.PlaceText Format(Fehler, "0.00") & " ", 30, 30 End If Else If Not m_Display Is Nothing Then ' eine Periodendauer ist null , also konnte kein fehler berechnet werden m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(5) & Chr(5) m_Display.PlaceText "?.?? ", 30, 30 End If DebugMsg GetHexZahlFromFM85(Einbauplatz.getNr, "J") End If If Not m_Display Is Nothing Then m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(1) & Chr(1) m_Display.DefineButton 41, 50, 3, "Start" m_Display.PlaceText " ", 60, 100 End If m_bMessungLaeuft(Einbauplatz.getNr) = False MSFlexGrid1.TextMatrix(Einbauplatz.getNr, 6) = "" AutoSpaltenBreite MSFlexGrid1, lblAutosize Else UpdateZeit Einbauplatz End If Else End If ' damit Touchmakros wieder in jedem Display ausgeführt werden If Not m_Display Is Nothing Then m_Display.Adressierung 255 End If End If DoEvents Next AutoSpaltenBreite MSFlexGrid1, lblAutosize End Sub Private Sub UpdateZeit(Einbauplatz As CEinbauplatz) Dim lngZeit As Long lngZeit = m_Pruefzeit - (GetTickCount() \ 1000 - Einbauplatz.m_lngPruefzeit) MSFlexGrid1.TextMatrix(Einbauplatz.getNr, 6) = CStr(lngZeit) If Not m_Display Is Nothing Then m_Display.Adressierung Einbauplatz.getNr m_Display.EaKitOutput Chr(27) & "F" & Chr(3) & Chr(1) & Chr(1) m_Display.PlaceText CStr(lngZeit) & " s ", 60, 100 End If End Sub Private Function GetHexZahlFromFM85(EinbauplatzNr As Integer, strSende As String) As Long Dim strAntwortAdressierung As String Dim strAntwort As String Dim Versuche As Long On Error GoTo Errorhandler Versuche = 0 startagain1: If g_Abbruch = True Then Exit Function If EinbauplatzNr > 0 Then ' FM85P mit entspr. Adresse ansprechen m_FMBus.send "**" & EinbauplatzNr & "@" strAntwortAdressierung = m_FMBus.receive(700) If InStr(1, strAntwortAdressierung, EinbauplatzNr) = 0 Then PrintStatus "FM85P-" & EinbauplatzNr & " antwortete bei Adressierung '" & strAntwortAdressierung & "'" If Versuche < 10 Then Versuche = Versuche + 1 GoTo startagain1 End If LogIntoDB "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'", "FM85 Hauptprüfung" End If End If Versuche = 0 startagain2: m_FMBus.send strSende strAntwort = m_FMBus.receive(700) If g_Abbruch = True Then Exit Function If IsNumeric("&H" & strAntwort) Then GetHexZahlFromFM85 = CLng("&H" & strAntwort) 'DebugMsg "Anwort vom FM85: " & strAntwort & " = " & GetHexZahlFromFM85 Else PrintStatus "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'" If InStr(1, strAntwort, "MESSERGEBNIS LIEGT NICHT VOR") > 0 Then GetHexZahlFromFM85 = -1 Exit Function End If If Versuche < 10 Then Versuche = Versuche + 1 GoTo startagain2 End If LogIntoDB "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'", "FM85 Hauptprüfung" GetHexZahlFromFM85 = -1 End If Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in GetHexZahlFromFM85:" & Err.Description, "Prg Fehler!" GetHexZahlFromFM85 = -1 End Function Private Sub PrintStatus(sText As String) txtStatus.text = txtStatus.text & sText & vbCrLf txtStatus.SelStart = Len(txtStatus.text) DebugMsg sText End Sub Private Function ErrechneImpulsanzahlFuerFM85(ByVal DurchflussSoll As Double, ByVal ImpulswertigkeitPZ As Long, ByVal Pruefzeit As Long, ByRef AnzahlPeriodenPZNeu As Long, ByRef Korrekturwert As Double, AnzahlPaletten) ' Eingabe: 'ByVal DurchflussSoll As Double as double enthält den Solldurchfluss in m³/h 'ByVal ImpulswertigkeitPZ_LWL As Long enthält die Impulswertigkeit des LWL Eingangs 'ByVal Pruefzeit As Long enthält die SollPrüfzeit in Sekunden 'Ausgabe: 'ByRef AnzahlPeriodenPZNeu As Long enthält die neu errechnete Impulsanzahl des Prüfzählers 'ByRef FaktorPruefzeit As Double enthält den Korrekturwert für die Impulsanzahl des RZ bzw. der Prüfzeit Dim AnzahlPeriodenPZ As Double ' Muss double sein, weil Stellen hinter dem Komma wichtig sind AnzahlPeriodenPZ = (Pruefzeit / 3600) * DurchflussSoll * ImpulswertigkeitPZ PrintStatus "unkorrigierter AnzahlPeriodenPZ: " & Pruefzeit & "s /(3600 s/h)* " & Round(DurchflussSoll, 4) & " m³/h * " & ImpulswertigkeitPZ & " Impulse/m³ = " & AnzahlPeriodenPZ & " Impulse" If AnzahlPaletten > 0 And g_blnganzeFluegelumrundung = True And m_bUseLWL = True Then AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / AnzahlPaletten + 0.999) * AnzahlPaletten PrintStatus "auf nächste AnzahlPaletten = " & AnzahlPaletten & " aufgerundet: " & AnzahlPeriodenPZNeu & " Impulse" ElseIf m_bUseLWL = False Then AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 10 + 0.999) * 10 PrintStatus "auf nächste 10 aufgerundet: " & AnzahlPeriodenPZNeu & " Impulse" Else AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ + 0.9999) PrintStatus "aufgerundet: " & AnzahlPeriodenPZNeu & " Impulse" End If Korrekturwert = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ PrintStatus "Korrekturwert = " & AnzahlPeriodenPZNeu & " / " & AnzahlPeriodenPZ & " = " & Korrekturwert End Function Private Sub txtPruefzeit_Change() If Val(txtPruefzeit.text) > 0 Then m_Pruefzeit = Val(txtPruefzeit.text) End If End Sub