721 lines
21 KiB
OpenEdge ABL
721 lines
21 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 = "CRefzaehler"
|
|
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
|
|
|
|
'lokale Variable(n) zum Zuweisen der Eigenschaft(en)
|
|
Private mvarSerienNr As Long 'lokale Kopie
|
|
Private mvarPruefstationNr As Long 'lokale Kopie
|
|
Private mvarEinbauplatzNr As Integer 'lokale Kopie
|
|
Private mvarZaehlerNr As Long 'lokale Kopie
|
|
Private mvarBaujahr As Date 'lokale Kopie
|
|
Private mvarEinbaudatum As Date 'lokale Kopie
|
|
Private mvarZaehlerTyp As String 'lokale Kopie
|
|
Private mvarNennweite As Long 'lokale Kopie
|
|
Private mvarImpulseQM As Long 'lokale Kopie
|
|
|
|
Private mvarMIDGruppe As String 'lokale Kopie
|
|
Private mvarODurchfluss As Double 'lokale Kopie
|
|
Private mvarUDurchfluss As Double 'lokale Kopie
|
|
|
|
Private mvarDatumLetzterFehler As Date 'lokale Kopie
|
|
Private mvarTempLetzterFehler As Double 'lokale Kopie
|
|
|
|
Private mvarColPruefpunkte As Collection 'lokale Kopie
|
|
|
|
|
|
Public Property Get colPruefpunkte() As Collection
|
|
Set colPruefpunkte = mvarColPruefpunkte
|
|
End Property
|
|
|
|
|
|
Public Property Let ImpulseQM(ByVal vData As Long)
|
|
mvarImpulseQM = vData
|
|
End Property
|
|
|
|
Public Property Get ImpulseQM() As Long
|
|
ImpulseQM = mvarImpulseQM
|
|
End Property
|
|
|
|
Public Property Let Nennweite(ByVal vData As Long)
|
|
mvarNennweite = vData
|
|
End Property
|
|
|
|
Public Property Get Nennweite() As Long
|
|
Nennweite = mvarNennweite
|
|
End Property
|
|
|
|
Public Property Let ZaehlerTyp(ByVal vData As String)
|
|
mvarZaehlerTyp = vData
|
|
End Property
|
|
|
|
Public Property Get ZaehlerTyp() As String
|
|
ZaehlerTyp = mvarZaehlerTyp
|
|
End Property
|
|
|
|
Public Property Let Einbaudatum(ByVal vData As Date)
|
|
mvarEinbaudatum = vData
|
|
End Property
|
|
|
|
Public Property Get Einbaudatum() As Date
|
|
Einbaudatum = mvarEinbaudatum
|
|
End Property
|
|
|
|
Public Property Let Baujahr(ByVal vData As Date)
|
|
mvarBaujahr = vData
|
|
End Property
|
|
|
|
Public Property Get Baujahr() As Date
|
|
Baujahr = mvarBaujahr
|
|
End Property
|
|
|
|
Public Property Let ZaehlerNr(ByVal vData As Long)
|
|
mvarZaehlerNr = vData
|
|
End Property
|
|
|
|
Public Property Get ZaehlerNr() As Long
|
|
ZaehlerNr = mvarZaehlerNr
|
|
End Property
|
|
|
|
Public Property Let EinbauplatzNr(ByVal vData As Integer)
|
|
mvarEinbauplatzNr = vData
|
|
End Property
|
|
|
|
Public Property Get EinbauplatzNr() As Integer
|
|
EinbauplatzNr = mvarEinbauplatzNr
|
|
End Property
|
|
|
|
Public Property Let PruefstationNr(ByVal vData As Long)
|
|
mvarPruefstationNr = vData
|
|
End Property
|
|
|
|
Public Property Get PruefstationNr() As Long
|
|
PruefstationNr = mvarPruefstationNr
|
|
End Property
|
|
|
|
Public Property Let SerienNr(ByVal vData As Long)
|
|
mvarSerienNr = vData
|
|
End Property
|
|
|
|
Public Property Get SerienNr() As Long
|
|
SerienNr = mvarSerienNr
|
|
End Property
|
|
|
|
Public Property Let ODurchfluss(ByVal vData As Double)
|
|
mvarODurchfluss = vData
|
|
End Property
|
|
|
|
Public Property Get ODurchfluss() As Double
|
|
ODurchfluss = mvarODurchfluss
|
|
End Property
|
|
|
|
Public Property Let UDurchfluss(ByVal vData As Double)
|
|
mvarUDurchfluss = vData
|
|
End Property
|
|
|
|
Public Property Get UDurchfluss() As Double
|
|
UDurchfluss = mvarUDurchfluss
|
|
End Property
|
|
|
|
Public Property Let MidGruppe(ByVal vData As String)
|
|
mvarMIDGruppe = vData
|
|
End Property
|
|
|
|
Public Property Get MidGruppe() As String
|
|
MidGruppe = mvarMIDGruppe
|
|
End Property
|
|
|
|
Public Function loadForDurchfluss(Durchfluss As Double, MidGruppe As Integer) As Boolean
|
|
Dim PruefstationNr As Integer
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim sMIDGruppe As String
|
|
|
|
sMIDGruppe = "A"
|
|
If MidGruppe = 2 Then
|
|
sMIDGruppe = "B"
|
|
End If
|
|
|
|
'On Error GoTo loadForDurchflussErr
|
|
|
|
PruefstationNr = g_App.PruefstationNr
|
|
|
|
|
|
' Todo: Gruppe durch INI Datei voreingestellt: MIDGruppe='A';"
|
|
|
|
sSQL = "SELECT * FROM Referenzzaehler "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "ODurchfluss > " & ValueToSQLString(Durchfluss) & " and UDurchfluss <= " & ValueToSQLString(Durchfluss)
|
|
sSQL = sSQL & " AND PruefstationNr = " & PruefstationNr & " and MIDGruppe='" & sMIDGruppe & "';"
|
|
Debug.Print sSQL
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then Exit Function
|
|
|
|
If rs.EOF() Then Exit Function
|
|
|
|
mvarSerienNr = rs.getLongValue("SerienNr")
|
|
mvarPruefstationNr = rs.getLongValue("PruefstationNr")
|
|
mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
|
|
mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
|
|
mvarBaujahr = rs.getDateValue("Baujahr")
|
|
mvarEinbaudatum = rs.getDateValue("Einbaudatum")
|
|
mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
|
|
mvarNennweite = rs.getLongValue("Nennweite")
|
|
mvarImpulseQM = rs.getLongValue("ImpulseQM")
|
|
mvarMIDGruppe = rs.getStringValue("MIDGruppe")
|
|
mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
|
|
mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
|
|
|
|
Set rs = Nothing
|
|
|
|
loadForDurchfluss = True
|
|
Exit Function
|
|
|
|
loadForDurchflussErr:
|
|
Call showError("loadForDurchfluss")
|
|
Exit Function
|
|
End Function
|
|
|
|
|
|
Public Function loadForSerienNr(lSerienNr As Long) As Boolean
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo loadErr
|
|
|
|
sSQL = "SELECT * FROM Referenzzaehler "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "SerienNr = " & lSerienNr
|
|
sSQL = sSQL & ";"
|
|
|
|
Set rs = New CRecordset
|
|
If Not rs.openRS(sSQL) Then Exit Function
|
|
|
|
If rs.EOF() Then Exit Function
|
|
|
|
mvarSerienNr = rs.getLongValue("SerienNr")
|
|
mvarPruefstationNr = rs.getLongValue("PruefstationNr")
|
|
mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
|
|
mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
|
|
mvarBaujahr = rs.getDateValue("Baujahr")
|
|
mvarEinbaudatum = rs.getDateValue("Einbaudatum")
|
|
mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
|
|
mvarNennweite = rs.getLongValue("Nennweite")
|
|
mvarImpulseQM = rs.getLongValue("ImpulseQM")
|
|
mvarMIDGruppe = rs.getStringValue("MIDGruppe")
|
|
mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
|
|
mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
|
|
|
|
Set rs = Nothing
|
|
|
|
loadForSerienNr = True
|
|
Exit Function
|
|
|
|
loadErr:
|
|
Call showError("loadForSerienNr")
|
|
Exit Function
|
|
End Function
|
|
|
|
Public Function IstOkFuerDurchfluss(Q As Double) As Boolean
|
|
If mvarODurchfluss >= Q And mvarUDurchfluss < Q Then
|
|
IstOkFuerDurchfluss = True
|
|
Else
|
|
IstOkFuerDurchfluss = False
|
|
End If
|
|
End Function
|
|
|
|
Public Function LoadForRefzaehlerpruefung(EinbauplatzNr As Integer)
|
|
On Error GoTo LoadForRefzaehlerpruefungError
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim PruefstationNr As Integer
|
|
|
|
Set rs = New CRecordset
|
|
|
|
PruefstationNr = g_App.PruefstationNr
|
|
|
|
sSQL = "SELECT * from Referenzzaehler where PruefstationNr=" & PruefstationNr & " and EinbauplatzNr=" & EinbauplatzNr & ";"
|
|
If Not rs.openRS(sSQL) Then GoTo LoadForRefzaehlerpruefungError
|
|
If rs.RecordCount = 1 Then
|
|
mvarSerienNr = rs.getLongValue("SerienNr")
|
|
mvarPruefstationNr = rs.getLongValue("PruefstationNr")
|
|
mvarEinbauplatzNr = rs.getIntValue("EinbauplatzNr")
|
|
mvarZaehlerNr = rs.getLongValue("ZaehlerNr")
|
|
mvarBaujahr = rs.getDateValue("Baujahr")
|
|
mvarEinbaudatum = rs.getDateValue("Einbaudatum")
|
|
mvarZaehlerTyp = rs.getStringValue("ZaehlerTyp")
|
|
mvarNennweite = rs.getLongValue("Nennweite")
|
|
mvarImpulseQM = rs.getLongValue("ImpulseQM")
|
|
mvarMIDGruppe = rs.getStringValue("MIDGruppe")
|
|
mvarODurchfluss = rs.getDoubleValue("ODurchfluss")
|
|
mvarUDurchfluss = rs.getDoubleValue("UDurchfluss")
|
|
|
|
If Not LoadPruefpunkte() Then
|
|
GoTo LoadForRefzaehlerpruefungError
|
|
End If
|
|
|
|
LoadForRefzaehlerpruefung = 0
|
|
Else
|
|
LoadForRefzaehlerpruefung = -1
|
|
End If
|
|
Exit Function
|
|
LoadForRefzaehlerpruefungError:
|
|
LoadForRefzaehlerpruefung = False
|
|
ErrorMsg "Konnte RefZ.-Daten für Einbauplatz " & EinbauplatzNr & " nicht laden: " & Err.Description
|
|
End Function
|
|
|
|
Public Function LoadPruefpunkte()
|
|
On Error GoTo LoadPruefpunkteError
|
|
Dim Pruefpunkt As CRefZaehlerPruefpunkt
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
sSQL = "SELECT * from ReferenzzaehlerPruefpunkt where SerienNr=" & mvarSerienNr & " "
|
|
|
|
If g_blnVersuch Then
|
|
' Versuch
|
|
sSQL = sSQL & " and Ausfuehren_Versuch=1 order by Durchfluss DESC;"
|
|
Else
|
|
' Produktion
|
|
sSQL = sSQL & " and Ausfuehren=1 order by Durchfluss DESC;"
|
|
End If
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print sSQL
|
|
|
|
rs.openRS (sSQL)
|
|
Do While Not rs.EOF
|
|
Set Pruefpunkt = New CRefZaehlerPruefpunkt
|
|
Pruefpunkt.load SerienNr, rs.getIntValue("ID")
|
|
mvarColPruefpunkte.Add Pruefpunkt
|
|
Set Pruefpunkt = Nothing
|
|
rs.MoveNext
|
|
Loop
|
|
LoadPruefpunkte = True
|
|
Exit Function
|
|
LoadPruefpunkteError:
|
|
ErrorMsg "Konnte Prüfpunkte für RefZ " & mvarSerienNr & " nicht laden: " & Err.Description
|
|
End Function
|
|
|
|
Private Sub Class_Initialize()
|
|
Set mvarColPruefpunkte = New Collection
|
|
End Sub
|
|
|
|
Public Function letzterFehlerString(Durchfluss As Double, Optional Temperatur As Double = 0) As String
|
|
On Error GoTo letzterFehlerError
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim Msg As String
|
|
|
|
Dim Index As Integer
|
|
Dim feldprefix As String
|
|
Dim PP_Durchfluss As Double
|
|
Dim PP_Fehler As Double
|
|
|
|
|
|
mvarDatumLetzterFehler = 0
|
|
Set rs = New CRecordset
|
|
|
|
If Temperatur = 0 Then
|
|
sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
|
|
DebugMsg "Letzten Fehler des RefZ. " & mvarSerienNr & " ermitteln für Q =" & Format(Durchfluss, "0.000")
|
|
Else
|
|
DebugMsg "Letzten Fehler des RefZ. " & mvarSerienNr & " ermitteln für Q =" & Format(Durchfluss, "0.000") & " und Temperatur=" & Format(Temperatur, "0.0") & " °C"
|
|
sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr
|
|
If Temperatur < 40 Then
|
|
' Kaltwasser
|
|
sSQL = sSQL & " and PP1_WasserTemp <= 40"
|
|
ElseIf Temperatur < 70 Then
|
|
' Warmwasser
|
|
sSQL = sSQL & " and PP1_WasserTemp > 40 and PP1_WasserTemp <= 70 "
|
|
Else
|
|
' Heisswasser
|
|
sSQL = sSQL & " and PP1_WasserTemp > 70 "
|
|
End If
|
|
|
|
sSQL = sSQL & " order by Datum DESC;"
|
|
End If
|
|
Debug.Print sSQL
|
|
|
|
rs.openRS (sSQL)
|
|
|
|
' Betrachte den nächsten Recordset vom neusten bis zum ältesten
|
|
naechstesDatum:
|
|
|
|
If Not rs.EOF Then
|
|
mvarDatumLetzterFehler = rs.getDateValue("Datum")
|
|
mvarTempLetzterFehler = rs.getDoubleValue("PP1_WasserTemp")
|
|
'DebugMsg "Betrachtung der RZFehler vom Datum: " & Format(mvarDatumLetzterFehler, "dd.mm.yyyy hh:mm") & ", T=" & Format(mvarTempLetzterFehler, "0.0")
|
|
|
|
' Schleife vom höchsten zum niedrigsten geprüften Durchfluss
|
|
' des Referenzzaehlers bei der lezten Referenzzaehlerprüfung
|
|
For Index = 1 To 10
|
|
Debug.Print "Index: " & Index
|
|
feldprefix = "PP" & CStr(Index)
|
|
|
|
PP_Durchfluss = Round(rs.getDoubleValue(feldprefix & "_Soll_Q"), 4)
|
|
' Fehler in %
|
|
PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
|
|
|
|
Debug.Print "PP_Durchfluss: " & PP_Durchfluss
|
|
Debug.Print "PP_Fehler: " & PP_Fehler
|
|
|
|
If Durchfluss = PP_Durchfluss Then
|
|
letzterFehlerString = CStr(PP_Fehler)
|
|
Exit Function
|
|
End If
|
|
' Es darf nicht interpoliert werden
|
|
|
|
If PP_Durchfluss < Durchfluss Then
|
|
Exit For
|
|
End If
|
|
|
|
If PP_Durchfluss <= 0 Then
|
|
Exit For
|
|
End If
|
|
Next
|
|
Debug.Print "Es gibt keinen letzten Fehler für Durchfluss " & PP_Durchfluss
|
|
rs.MoveNext
|
|
GoTo naechstesDatum
|
|
Else
|
|
mvarDatumLetzterFehler = 0
|
|
LogIntoDB "EOF ! Es konnt kein letzter Fehler in der DB gefunden werden.", "FM85 RZ Prüf"
|
|
End If
|
|
|
|
letzterFehlerError:
|
|
If Msg = "" Then Msg = Err.Description
|
|
If Err.Description <> "" Then
|
|
LogIntoDB "Fehler " & Err.Number & " in letzterFehlerString(): " & Err.Description, "FM85 RZ Prüf"
|
|
End If
|
|
letzterFehlerString = ""
|
|
mvarDatumLetzterFehler = 0
|
|
End Function
|
|
|
|
'
|
|
'Public Function InterpolierterFehler(Durchfluss As Double) As Double
|
|
'Dim sSQL As String
|
|
'Dim rs As CRecordset
|
|
'Dim PP_Nr As Integer
|
|
'Dim feldprefix As String
|
|
'Dim PP_Durchfluss As Double
|
|
'Dim PP_Fehler As Double
|
|
'Dim untererDurchfluss As Double
|
|
'Dim untererFehler As Double
|
|
'Dim obererDurchfluss As Double
|
|
'Dim obererFehler As Double
|
|
'Dim Phase As Integer
|
|
'
|
|
' Phase = 1
|
|
' Set rs = New CRecordset
|
|
' sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
|
|
' rs.openRS (sSQL)
|
|
'
|
|
' obererDurchfluss = 0
|
|
' Do While Not rs.EOF
|
|
' PP_Nr = 1
|
|
' Do While PP_Nr < 11
|
|
' feldprefix = "PP" & CStr(PP_Nr)
|
|
' Durchfluss absteigend
|
|
' PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
|
|
' Fehler in %
|
|
' PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
|
|
' If PP_Durchfluss = 0 Then
|
|
' Feld leer
|
|
' Debug.Print "PP=0"
|
|
' Exit Do
|
|
' If PP_Durchfluss < Durchfluss Then
|
|
' PP_Durchfluss unterschreitet Durchfluss
|
|
' Suche in dieser Zeile abbrechen
|
|
' Exit Do
|
|
' Else
|
|
' obererDurchfluss = PP_Durchfluss
|
|
' obererFehler = PP_Fehler
|
|
' PP_Nr = PP_Nr + 1
|
|
' End If
|
|
' Loop
|
|
'
|
|
' nächste Zeile
|
|
' rs.MoveNext
|
|
' Loop
|
|
'
|
|
' Debug.Print "leider alles durchsucht"
|
|
' Exit Function
|
|
'Erfolg:
|
|
'
|
|
'
|
|
'
|
|
'TestePP:
|
|
' If PP_Nr > 10 Then
|
|
' diesen PP gibt es nicht
|
|
' rs.MoveNext
|
|
' If rs.EOF Then
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' PP_Nr = 1
|
|
' GoTo TestePP
|
|
' End If
|
|
'
|
|
' If PP_Durchfluss = 0 Then
|
|
' keine weiteren PP in dieser Zeile
|
|
' Debug.Print ("keine weiteren PP in dieser Zeile")
|
|
' rs.MoveNext
|
|
' If rs.EOF Then
|
|
' PP_Nr = PP_Nr + 1
|
|
' GoTo TestePP
|
|
' End If
|
|
' End If
|
|
' Debug.Print "================================"
|
|
' Debug.Print "Durchfluss:" & Durchfluss
|
|
' Debug.Print "PP_Nr: " & PP_Nr
|
|
' Debug.Print "PP_Durchfluss: " & PP_Durchfluss
|
|
' Debug.Print "PP_Fehler: " & PP_Fehler
|
|
'
|
|
' If PP_Durchfluss = Durchfluss Then
|
|
' OK. Wir haben ihn
|
|
' InterpolierterFehler = PP_Fehler
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' If PP_Durchfluss > Durchfluss Then
|
|
' obererDurchfluss = PP_Durchfluss
|
|
' obererFehler = PP_Fehler
|
|
' Testen, ob es noch einen kleineren gibt
|
|
' PP_Nr = PP_Nr + 1
|
|
' GoTo TestePP
|
|
' End If
|
|
'
|
|
' Nein, der nächste PP war bereits kleiner als der Durchfluss
|
|
' Debug.Print "PP ist kleiner als D"
|
|
'
|
|
' Phase 1: Finde den neusten kleinsten PP, der gerade noch größer ist als Durchfluss
|
|
' Phase 2: Finde den neusten größten PP, der gerade noch kleiner ist als Durchfluss
|
|
'
|
|
' PP_Nr = 1
|
|
' feldprefix = "PP" & CStr(PP_Nr)
|
|
' ' Durchfluss absteigend
|
|
'
|
|
' PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
|
|
' ' Fehler in %
|
|
' PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
|
|
'
|
|
' If PP_Durchfluss > Durchfluss Then
|
|
' ' größeren Durchfluss gefunden,
|
|
' ' überprüfen, ob es noch einen kleinerern gibt, der größer ist
|
|
' PP_Nr = PP_Nr + 1
|
|
' GoTo UeberpruefeDurch
|
|
' End If
|
|
'
|
|
'
|
|
'
|
|
' 'PP_Durchfluss als oberer Wert zum Interpolieren verwenden
|
|
' obererDurchfluss = PP_Durchfluss
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'ErsterPP:
|
|
'
|
|
' If PP_Durchfluss = Durchfluss Then
|
|
' InterpolierterFehler = PP_Fehler
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
' If Durchfluss > PP_Durchfluss Then
|
|
' ' Durchfluss des ersten PP ist schon kleiner als der Durchfluss
|
|
' ' (größer als interpolierbarer Bereich)
|
|
' ' also nächster RZ-Prüfgang
|
|
' rs.MoveNext
|
|
' If rs.EOF Then
|
|
' ' Es gibt keine weiteren Prüfgänge mehr
|
|
' GoTo InterpolierterFehlerError
|
|
' End If
|
|
' GoTo ErsterPP
|
|
' End If
|
|
'
|
|
' ' PP_Durchfluss > Durchfluss , also unteren Durchfluss merken
|
|
' untererDurchfluss = PP_Durchfluss
|
|
' untererFehler = PP_Fehler
|
|
'
|
|
'' nächsten PP in der Zeile betrachten:
|
|
'naechsterPP:
|
|
' PP_Nr = PP_Nr + 1
|
|
' feldprefix = "PP" & CStr(PP_Nr)
|
|
'
|
|
' PP_Durchfluss = rs.getDoubleValue(feldprefix & "_Soll_Q")
|
|
' ' Fehler in %
|
|
' PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
|
|
' Debug.Print "PP_Durchfluss: " & PP_Durchfluss
|
|
' Debug.Print "PP_Fehler: " & PP_Fehler
|
|
'
|
|
' If PP_Durchfluss < Durchfluss Then
|
|
' GoTo naechsterPP
|
|
' End If
|
|
'''''''''''''''
|
|
' ' unteren Durchfluss merken
|
|
' untererDurchfluss = PP_Durchfluss
|
|
' untererFehler = PP_Fehler
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'
|
|
'
|
|
' Exit Function
|
|
'
|
|
'InterpolierterFehlerError:
|
|
' MsgBox ("Der Fehler des Referenzzählers bei Q=" & Durchfluss & " konnte nicht bestimmt werden")
|
|
' InterpolierterFehler = 0
|
|
'End Function
|
|
|
|
|
|
' Ermittelt und interpoliert den Fehler eines Referenzzählers
|
|
' bei einem gegebenen Durchfluss unter Verwendung der Prüfergebnisse der
|
|
' letzten Referenzzählerprüfung
|
|
Public Function letzterFehler(Durchfluss As Double, Optional Temperatur As Double = 0) As Double
|
|
On Error GoTo letzterFehlerError
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim Msg As String
|
|
|
|
Dim Index As Integer
|
|
Dim feldprefix As String
|
|
Dim PP_Durchfluss As Double
|
|
Dim PP_Fehler As Double
|
|
|
|
Dim obererDurchfluss As Double
|
|
Dim obererFehler As Double
|
|
|
|
Set rs = New CRecordset
|
|
mvarDatumLetzterFehler = 0
|
|
|
|
If Temperatur = 0 Then
|
|
sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
|
|
'DebugMsg "Letzten Fehler des RefZ. ermitteln für Q =" & Durchfluss
|
|
Else
|
|
'DebugMsg "Letzten Fehler des RefZ. ermitteln für Q =" & Durchfluss & " und Temperatur=" & Temperatur & " °C"
|
|
sSQL = "SELECT * from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr
|
|
If Temperatur <= 40 Then
|
|
' Kaltwasser
|
|
sSQL = sSQL & " and PP1_WasserTemp <= 40"
|
|
ElseIf Temperatur < 70 Then
|
|
' Warmwasser
|
|
sSQL = sSQL & " and PP1_WasserTemp > 40 and PP1_WasserTemp <= 70 "
|
|
Else
|
|
' Heisswasser
|
|
sSQL = sSQL & " and PP1_WasserTemp > 70 "
|
|
End If
|
|
|
|
sSQL = sSQL & " order by Datum DESC;"
|
|
End If
|
|
|
|
|
|
rs.openRS (sSQL)
|
|
' Betrachte den nächsten Recordset vom neusten bis zum ältesten
|
|
naechstesDatum:
|
|
obererFehler = 0
|
|
obererDurchfluss = 0
|
|
If Not rs.EOF Then
|
|
mvarDatumLetzterFehler = rs.getDateValue("Datum")
|
|
Debug.Print "letztes RZ-Prüfdatum:" & Format(mvarDatumLetzterFehler, "dd.mm.yyyy hh:mm") & " für RZ-" & mvarMIDGruppe
|
|
|
|
' Schleife vom höchsten zum niedrigsten geprüften Durchfluss
|
|
' des Referenzzaehlers bei der lezten Referenzzaehlerprüfung
|
|
For Index = 1 To 10
|
|
'Debug.Print "Index: " & Index
|
|
feldprefix = "PP" & CStr(Index)
|
|
|
|
PP_Durchfluss = Round(rs.getDoubleValue(feldprefix & "_Soll_Q"), 4)
|
|
'Debug.Print "Q= " & PP_Durchfluss
|
|
' Fehler in %
|
|
PP_Fehler = rs.getDoubleValue(feldprefix & "_Fehler")
|
|
|
|
If Durchfluss = PP_Durchfluss Then
|
|
letzterFehler = PP_Fehler
|
|
Exit Function
|
|
End If
|
|
|
|
' Nur wenn folgende Bedingung erfüllt wird, darf interpoliert werden
|
|
If obererDurchfluss > Durchfluss And Durchfluss > PP_Durchfluss And PP_Durchfluss > 0 Then
|
|
letzterFehler = obererFehler - ((obererDurchfluss - Durchfluss) * _
|
|
(obererFehler - PP_Fehler) / (obererDurchfluss - PP_Durchfluss))
|
|
|
|
Debug.Print "letzter Fehler durch Interpolation: " & obererDurchfluss _
|
|
& " u. " & Durchfluss & " u." & PP_Durchfluss & " entspricht " & obererFehler _
|
|
& " u. " & letzterFehler & " u. " & PP_Fehler
|
|
Exit Function
|
|
End If
|
|
|
|
If PP_Durchfluss < Durchfluss Then
|
|
Exit For
|
|
End If
|
|
|
|
If PP_Durchfluss <= 0 Then
|
|
Exit For
|
|
End If
|
|
|
|
' merke Werte des letzen Schleifendurchgangs
|
|
' für nächsten Schleifendurchgang
|
|
obererFehler = PP_Fehler
|
|
obererDurchfluss = PP_Durchfluss
|
|
Next
|
|
Debug.Print "PP mit Q=" & Durchfluss & " liegt ausserhalb des interpolierbaren Bereiches. Nächst ältere RefZPrüfung wird herangezogen"
|
|
rs.MoveNext
|
|
GoTo naechstesDatum
|
|
Else
|
|
mvarDatumLetzterFehler = 0
|
|
Debug.Print "EOF !"
|
|
Msg = "Es konnte kein Fehler des Referenzzählers aus der DB ermittelt werden. Bitte geben Sie den letzen Fehler des Referenzzählers beim Durchfluß " & Durchfluss & " ein."
|
|
End If
|
|
letzterFehlerError:
|
|
If Msg = "" Then Msg = Err.Description
|
|
'letzterFehler = CDbl(InputBox(Msg, "", 0))
|
|
letzterFehler = -99
|
|
mvarDatumLetzterFehler = 0
|
|
End Function
|
|
|
|
Public Function DatumDesFehlers() As Date
|
|
DatumDesFehlers = mvarDatumLetzterFehler
|
|
End Function
|
|
|
|
Public Function TempDesFehlers() As Double
|
|
TempDesFehlers = mvarTempLetzterFehler
|
|
End Function
|
|
|
|
' Ermittelt das Datum der letzten Prüfung
|
|
Public Function letztePruefung() As Date
|
|
On Error GoTo letztePruefungError
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
Set rs = New CRecordset
|
|
|
|
sSQL = "SELECT Datum from ReferenzzaehlerFehler where SerienNr=" & mvarSerienNr & " order by Datum DESC;"
|
|
rs.openRS (sSQL)
|
|
' Betrachte nur den ersten Recordset mit dem neusten Datum
|
|
If Not rs.EOF Then
|
|
letztePruefung = rs.getDateValue("Datum")
|
|
Else
|
|
MsgBox ("Referenzzaehler.letztePruefung: kein Datensatz vorhanden")
|
|
End If
|
|
Exit Function
|
|
letztePruefungError:
|
|
|
|
End Function
|
|
|