855 lines
29 KiB
Plaintext
855 lines
29 KiB
Plaintext
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
|