laatzen/Pruef2000/source/frmRegulierungInQt.frm
2021-10-01 11:11:04 +02:00

855 lines
29 KiB
Plaintext
Raw Blame History

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<50>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<64>cke aktiv: Tatsenmakros werden ausgef<65>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<6C> 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<65>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<75>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<50>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<7A>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<65>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<70>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<70>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<74>lt den Solldurchfluss in m<>/h
'ByVal ImpulswertigkeitPZ_LWL As Long enth<74>lt die Impulswertigkeit des LWL Eingangs
'ByVal Pruefzeit As Long enth<74>lt die SollPr<50>fzeit in Sekunden
'Ausgabe:
'ByRef AnzahlPeriodenPZNeu As Long enth<74>lt die neu errechnete Impulsanzahl des Pr<50>fz<66>hlers
'ByRef FaktorPruefzeit As Double enth<74>lt den Korrekturwert f<>r die Impulsanzahl des RZ bzw. der Pr<50>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