470 lines
14 KiB
OpenEdge ABL
470 lines
14 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 = "CVorpruefpunkte"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
'==============================================================================
|
|
'
|
|
' File : Vorpruefpunkte.cls
|
|
' Author : Reinhard Henning, lindner & partner
|
|
' Date : 12.12.2001
|
|
'
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' Verwaltung einer Menge von Prüfpunkten wie in der Datenbanktabelle
|
|
' "USVorpruefpunkte" hinterlegt.
|
|
'
|
|
' Die eigentlichen Prüfpunkte werden hier in einem Objekt der Klasse
|
|
' CVorpruefpunktCol verwaltet.
|
|
'
|
|
' @see CVorpruefpunktCol
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Übernommen aus CPruefpunkte 12.12.2001
|
|
'
|
|
' Erste dokumentierte Version
|
|
'
|
|
'==============================================================================
|
|
|
|
' Private Member
|
|
' --------------
|
|
Private Const MAX_PP% = 10
|
|
|
|
Private m_lIdentNr As Long
|
|
Private m_sPruefklasseKZ As String
|
|
Private m_Regulierdaten As CRegulierdaten
|
|
Private m_colPP As CVorpruefpunktCol
|
|
Private m_sInfo As String
|
|
Private m_sFehlerstack As String
|
|
|
|
Private m_Geberkonstante1 As Double
|
|
Private m_Offset1 As Double
|
|
Private m_Geberkonstante2 As Double
|
|
Private m_Offset2 As Double
|
|
Private m_Bereich As Double
|
|
Private m_SteilheitGeber As Double
|
|
Private m_OffsetGeber As Double
|
|
Private m_Unlinearitaet As Double
|
|
|
|
Private m_Offset_Qmin As Double
|
|
Private m_Offset_QBereich As Double
|
|
Private m_Offset_Qp As Double
|
|
Private m_SollFehlerDifferenz_Qmin As Double
|
|
Private m_Fehler_QminHeiss As Double
|
|
|
|
Private m_FlowMin As Double
|
|
Private m_FlowMax As Double
|
|
|
|
Private m_bytPulsMode As Byte
|
|
Private m_dblImpulswertigkeit As Double
|
|
Private m_dblImpulswertigkeit_Pruef As Double
|
|
|
|
Private m_Qn As Double
|
|
|
|
Public Function getOffset_Qmin() As Double
|
|
getOffset_Qmin = m_Offset_Qmin
|
|
End Function
|
|
|
|
Public Function getOffset_QBereich() As Double
|
|
getOffset_QBereich = m_Offset_QBereich
|
|
End Function
|
|
|
|
Public Function getOffset_Qp() As Double
|
|
getOffset_Qp = m_Offset_Qp
|
|
End Function
|
|
|
|
Public Function getSollFehlerDifferenz_Qmin() As Double
|
|
getSollFehlerDifferenz_Qmin = m_SollFehlerDifferenz_Qmin
|
|
End Function
|
|
|
|
Public Function getImpulswertigkeit() As Double
|
|
getImpulswertigkeit = m_dblImpulswertigkeit
|
|
End Function
|
|
|
|
Public Function getImpulswertigkeit_Pruef() As Double
|
|
getImpulswertigkeit_Pruef = m_dblImpulswertigkeit_Pruef
|
|
End Function
|
|
|
|
Public Function getPulseMode() As Byte
|
|
getPulseMode = m_bytPulsMode
|
|
End Function
|
|
|
|
Public Function getQn() As Double
|
|
getQn = m_Qn
|
|
End Function
|
|
|
|
|
|
|
|
Public Function getFlowMin() As Double
|
|
getFlowMin = m_FlowMin
|
|
End Function
|
|
|
|
Public Function getFlowMax() As Double
|
|
getFlowMax = m_FlowMax
|
|
End Function
|
|
|
|
|
|
Public Function getGeberkonstante1() As Double
|
|
getGeberkonstante1 = m_Geberkonstante1
|
|
End Function
|
|
|
|
Public Function getOffset1() As Double
|
|
getOffset1 = m_Offset1
|
|
End Function
|
|
|
|
Public Function getGeberkonstante2() As Double
|
|
getGeberkonstante2 = m_Geberkonstante2
|
|
End Function
|
|
|
|
Public Function getOffset2() As Double
|
|
getOffset2 = m_Offset2
|
|
End Function
|
|
|
|
Public Function getBereich() As Double
|
|
getBereich = m_Bereich
|
|
End Function
|
|
|
|
Public Function getSteilheitGeber() As Double
|
|
getSteilheitGeber = m_SteilheitGeber
|
|
End Function
|
|
|
|
Public Function getOffsetGeber() As Double
|
|
getOffsetGeber = m_OffsetGeber
|
|
End Function
|
|
|
|
Public Function getUnlinearitaet() As Double
|
|
getUnlinearitaet = m_Unlinearitaet
|
|
End Function
|
|
|
|
' Alle Member neu initialisieren
|
|
'
|
|
Private Sub init()
|
|
m_lIdentNr = 0
|
|
m_sPruefklasseKZ = ""
|
|
m_sInfo = ""
|
|
m_sFehlerstack = ""
|
|
Set m_colPP = New CVorpruefpunktCol
|
|
Set m_Regulierdaten = New CRegulierdaten
|
|
m_Qn = 0
|
|
m_Fehler_QminHeiss = -9999
|
|
End Sub
|
|
|
|
|
|
' @return RegulierdatenObject
|
|
'
|
|
'Public Function getRegulierdaten() As CRegulierdaten
|
|
' Set getRegulierdaten = m_Regulierdaten
|
|
'End Function
|
|
|
|
|
|
' @return Anzahl der definierten Prüfpunkte (0 bis MAX_PP)
|
|
'
|
|
Public Function getPruefpunkteCount() As Integer
|
|
If Not m_colPP Is Nothing Then getPruefpunkteCount = m_colPP.Count()
|
|
End Function
|
|
|
|
|
|
' @return Collection von Objekten der Klasse CVorpruefpunkt
|
|
'
|
|
Public Function getPruefpunkte() As CVorpruefpunktCol
|
|
Set getPruefpunkte = m_colPP
|
|
End Function
|
|
|
|
' @param colPP Collection von Objekten der Klasse CVorpruefpunkt
|
|
'
|
|
Public Sub setPruefpunkte(colPP As CVorpruefpunktCol)
|
|
Set m_colPP = colPP
|
|
End Sub
|
|
|
|
' @param nIndex Index in die Collection der Prüfpunkte
|
|
'
|
|
' @return Objekt vom Typ CPuefpunkt an der Stelle nIndex aus
|
|
' der Collection der Prüfpunkte
|
|
'
|
|
Public Function getPruefpunkt(nIndex As Integer) As CVorpruefpunkt
|
|
Set getPruefpunkt = m_colPP.Item(nIndex)
|
|
End Function
|
|
|
|
' @return true = Es gibt einen Pruefpunkt mit dem gesuchten Durchfluss
|
|
'
|
|
Public Function hasQ(dQ As Double) As Boolean
|
|
If Not m_colPP Is Nothing Then hasQ = m_colPP.hasQ(dQ)
|
|
End Function
|
|
|
|
Public Sub setIdentNr(lIdentNr As Long)
|
|
m_lIdentNr = lIdentNr
|
|
End Sub
|
|
|
|
' @return Ident-Nr., zu der die Prüfpunkte gehören
|
|
'
|
|
Public Function getIdentNr() As Long
|
|
getIdentNr = m_lIdentNr
|
|
End Function
|
|
|
|
Public Sub setPruefklasseKZ(sPruefklasseKZ As String)
|
|
m_sPruefklasseKZ = sPruefklasseKZ
|
|
End Sub
|
|
|
|
' @return Prüfklasse-Kennzeichen (A, B, HM)
|
|
'
|
|
Public Function getPruefklasseKZ() As String
|
|
getPruefklasseKZ = m_sPruefklasseKZ
|
|
End Function
|
|
|
|
Public Sub setInfo(sInfo As String)
|
|
m_sInfo = sInfo
|
|
End Sub
|
|
|
|
Public Function getInfo() As String
|
|
getInfo = m_sInfo
|
|
End Function
|
|
|
|
Public Sub setOffsetQi(OffsetFehler As Double)
|
|
m_Offset_Qmin = OffsetFehler
|
|
End Sub
|
|
|
|
|
|
' Prüfpunkte zur übergebenen Ident-Nr. und PrüfklasseKZ aus der
|
|
' Datenbank laden
|
|
'
|
|
' @return true = Laden erfolgreich durchgeführt
|
|
'
|
|
Public Function load(lIdentNr As Long, sPruefklasseKZ As String) As Boolean
|
|
Dim Pruefpunkt As CVorpruefpunkt
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim i As Integer
|
|
Dim sNummer As String
|
|
Dim Pruefzeit As Long
|
|
Dim Ordnung As Integer
|
|
|
|
On Error GoTo loadErr
|
|
|
|
Call init
|
|
|
|
' Prüfpunkte
|
|
' ----------
|
|
Set rs = New CRecordset
|
|
sSQL = "SELECT * FROM "
|
|
sSQL = sSQL & "USVorpruefpunkte "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "IdentNr = " & lIdentNr & " AND "
|
|
sSQL = sSQL & "PruefklasseKZ = " & rs.stringToSQLString(sPruefklasseKZ, True)
|
|
sSQL = sSQL & ";"
|
|
|
|
Debug.Print sSQL
|
|
|
|
If Not rs.openRS(sSQL) Then
|
|
ErrorMsg "DB Fehler beim Laden der Vorpruefpunkte: " & Err.Description
|
|
'Exit Function
|
|
End If
|
|
|
|
If rs.EOF Then
|
|
ErrorMsg "Es konnten keine Vorpruefpunkte (IdentNr=" & lIdentNr & ", PruefklasseKZ=" & sPruefklasseKZ & ") geladen werden."
|
|
Exit Function
|
|
End If
|
|
|
|
m_lIdentNr = rs.getLongValue("IdentNr")
|
|
m_sPruefklasseKZ = rs.getStringValue("PruefklasseKZ")
|
|
m_sInfo = rs.getStringValue("Info")
|
|
m_sFehlerstack = rs.getStringValue("Fehlerstack")
|
|
|
|
' neu RH 15.01.2002 JustageParameter
|
|
m_OffsetGeber = rs.getDoubleValue("FP_O_Geber")
|
|
m_Geberkonstante1 = rs.getDoubleValue("FP_K_Geber1")
|
|
m_Geberkonstante2 = rs.getDoubleValue("FP_K_Geber2")
|
|
m_FlowMin = rs.getDoubleValue("FP_Flow_Min")
|
|
m_FlowMax = rs.getDoubleValue("FP_Flow_Max")
|
|
m_Offset1 = rs.getDoubleValue("FP_QOffset1")
|
|
m_Offset2 = rs.getDoubleValue("FP_QOffset2")
|
|
m_SteilheitGeber = rs.getDoubleValue("FP_ST_Geber")
|
|
m_Bereich = rs.getDoubleValue("FP_Bereich")
|
|
m_Unlinearitaet = rs.getDoubleValue("Unlinearitaet")
|
|
|
|
' neu RH 19.7.2002
|
|
m_dblImpulswertigkeit = rs.getDoubleValue("FP_ImpulsWertigkeit")
|
|
m_dblImpulswertigkeit_Pruef = rs.getDoubleValue("FP_ImpulsWertigkeit_Pruef")
|
|
m_bytPulsMode = rs.getByteValue("PulseMode")
|
|
|
|
' neu RH 24.1.2003
|
|
m_Qn = rs.getDoubleValue("Qn")
|
|
' neu RH 30.4.2003
|
|
m_Offset_Qmin = rs.getDoubleValue("Offset_Qmin")
|
|
m_Offset_QBereich = rs.getDoubleValue("Offset_QBereich")
|
|
m_Offset_Qp = rs.getDoubleValue("Offset_Qp")
|
|
m_SollFehlerDifferenz_Qmin = rs.getDoubleValue("Soll_Fehlerdifferenz_Qmin")
|
|
|
|
|
|
DebugMsg "Vorprüfpunkte aus DB für IdentNr=" & lIdentNr & " PruefklasseKZ=" & sPruefklasseKZ & ":"
|
|
For i = 1 To MAX_PP
|
|
sNummer = Trim(Val(i))
|
|
|
|
|
|
Pruefzeit = rs.getIntValue("t" & sNummer)
|
|
Ordnung = rs.getIntValue("n" & sNummer)
|
|
|
|
If Not rs.isFieldNull("Q" & i) Then
|
|
Set Pruefpunkt = New CVorpruefpunkt
|
|
Call Pruefpunkt.setMember( _
|
|
rs.getDoubleValue("Q" & sNummer), Ordnung, Pruefzeit)
|
|
|
|
If Pruefpunkt.getQ > 0 Then
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
DebugMsg i & ". Prüfpunkt mit Q=" & rs.getDoubleValue("Q" & sNummer)
|
|
DebugMsg " Prüfzeit aus DB: " & Pruefzeit
|
|
DebugMsg " n aus DB: " & Ordnung
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
' Sollwerte
|
|
' --------
|
|
'Call m_Regulierdaten.load(lIdentNr, sPruefklasseKZ)
|
|
|
|
' Prüfpunkte sortieren
|
|
Call sortQ
|
|
|
|
load = True
|
|
Exit Function
|
|
|
|
loadErr:
|
|
Call showError("load")
|
|
Exit Function
|
|
End Function
|
|
|
|
|
|
Public Function LadeHeissesQMin(ByVal lngSerienNr As Long, ByVal dblQminSoll As Double, ByRef dblFehler As Double) As Boolean
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
sSQL = "SELECT TOP 1 AuftragPositionSerienNr.SerienNr, "
|
|
sSQL = sSQL & " AuftragPositionSerienNr.Pruefgangnr, "
|
|
sSQL = sSQL & " Pruefgang.Vorlauftemperatur, "
|
|
sSQL = sSQL & " Pruefgang.PP1_Soll, Prueffehler.PP1_Fehler, "
|
|
sSQL = sSQL & " Pruefgang.PP2_Soll, Prueffehler.PP2_Fehler, "
|
|
sSQL = sSQL & " Pruefgang.PP3_Soll, Prueffehler.PP3_Fehler, "
|
|
sSQL = sSQL & " Pruefgang.PP4_Soll, Prueffehler.PP4_Fehler "
|
|
|
|
sSQL = sSQL & "FROM AuftragPositionSerienNr "
|
|
sSQL = sSQL & " INNER JOIN Pruefgang ON AuftragPositionSerienNr.Pruefgangnr = Pruefgang.PruefgangNr "
|
|
sSQL = sSQL & " INNER JOIN Prueffehler ON AuftragPositionSerienNr.SerienNr = Prueffehler.SerienNr "
|
|
sSQL = sSQL & " AND AuftragPositionSerienNr.Pruefgangnr = Prueffehler.PruefgangNr "
|
|
|
|
sSQL = sSQL & "WHERE AuftragPositionSerienNr.SerienNr = " & lngSerienNr & " "
|
|
sSQL = sSQL & " AND Pruefgang.Vorlauftemperatur > 30 "
|
|
sSQL = sSQL & " AND left(Pruefgang.PruefgangNr,4) = '2020'"
|
|
sSQL = sSQL & " AND Prueffehler.PP1_Fehler Is Not Null "
|
|
|
|
|
|
|
|
sSQL = sSQL & " AND ("
|
|
sSQL = sSQL & " Pruefgang.PP2_Soll = " & Replace(dblQminSoll, ",", ".")
|
|
sSQL = sSQL & " OR Pruefgang.PP3_Soll = " & Replace(dblQminSoll, ",", ".")
|
|
sSQL = sSQL & " OR Pruefgang.PP4_Soll = " & Replace(dblQminSoll, ",", ".")
|
|
sSQL = sSQL & " )"
|
|
sSQL = sSQL & " ORDER BY Pruefgang.Datum DESC"
|
|
|
|
' sSQL = sSQL & "WHERE (((AuftragPositionSerienNr.SerienNr)=" & lngSerienNr & ") "
|
|
' sSQL = sSQL & " AND ((Pruefgang.Vorlauftemperatur) > 30)"
|
|
' sSQL = sSQL & " AND (left(Pruefgang.PruefgangNr,4) = '2020')"
|
|
' sSQL = sSQL & " AND ((Prueffehler.PP1_Fehler) Is Not Null) "
|
|
' 'sSQL = sSQL & " AND ((Prueffehler.PP3_Fehler) Is Null)" RH 23.1.2006
|
|
' sSQL = sSQL & " AND (Pruefgang.PP1_Soll = " & Replace(dblQminSoll, ",", ".") & ") "
|
|
' sSQL = sSQL & " OR (((AuftragPositionSerienNr.SerienNr)=" & lngSerienNr & ") "
|
|
' sSQL = sSQL & " AND (Pruefgang.PP2_Soll = " & Replace(dblQminSoll, ",", ".") & ")))"
|
|
' sSQL = sSQL & " ORDER BY Pruefgang.Datum DESC"
|
|
|
|
Set rs = New CRecordset
|
|
If rs.openRS(sSQL) Then
|
|
|
|
If Not rs.EOF Then
|
|
|
|
|
|
If Round(rs.getDoubleValue("PP1_Soll"), 2) = dblQminSoll Then
|
|
dblFehler = rs.getDoubleValue("PP1_Fehler")
|
|
LadeHeissesQMin = True
|
|
Exit Function
|
|
End If
|
|
|
|
If Round(rs.getDoubleValue("PP2_Soll"), 2) = dblQminSoll Then
|
|
dblFehler = rs.getDoubleValue("PP2_Fehler")
|
|
LadeHeissesQMin = True
|
|
Exit Function
|
|
End If
|
|
|
|
If Round(rs.getDoubleValue("PP3_Soll"), 2) = dblQminSoll Then
|
|
dblFehler = rs.getDoubleValue("PP3_Fehler")
|
|
LadeHeissesQMin = True
|
|
Exit Function
|
|
End If
|
|
|
|
If Round(rs.getDoubleValue("PP4_Soll"), 2) = dblQminSoll Then
|
|
dblFehler = rs.getDoubleValue("PP4_Fehler")
|
|
LadeHeissesQMin = True
|
|
Exit Function
|
|
End If
|
|
|
|
|
|
ErrorMsg "Fehler in LadeHeissesQMin, weder Übereinstimmung bei PP1 und PP2 mit QminSoll=" & dblQminSoll
|
|
Exit Function
|
|
Else
|
|
LadeHeissesQMin = False
|
|
Exit Function
|
|
End If
|
|
Else
|
|
Err.Raise -1, "CVorpruefpunkte.LadeHeissesQMin()", "Fehler bei rs.open SQL=" & sSQL
|
|
' Fehler beim Laden
|
|
End If
|
|
|
|
Exit Function
|
|
Errorhandler:
|
|
ErrorMsg "Fehler " & Err.Number & " in " & Err.Source & vbCrLf & Err.Description
|
|
LadeHeissesQMin = False
|
|
End Function
|
|
|
|
|
|
|
|
' Prüfpunkte absteigend nach Durchfluss sortieren
|
|
'
|
|
Public Sub sortQ()
|
|
Call m_colPP.sortQ
|
|
End Sub
|
|
|
|
' Prüfpunkte aufsteigend nach dem useCount-Member sortieren
|
|
'
|
|
Public Sub sortUseCount()
|
|
Call m_colPP.sortUseCount
|
|
End Sub
|
|
|
|
'------------------------------------------------------------------------------
|
|
' Private Funktionalität
|
|
'------------------------------------------------------------------------------
|
|
|
|
' Helper für Fehlerausgaben
|
|
'
|
|
' @param sMethod Name des Aufrufers
|
|
' @param sInfo optionaler Hinweistext
|
|
'
|
|
Private Sub showError(sMethod As String, Optional sInfo As String)
|
|
Call modError.showError("CVorpruefpunkte." + sMethod, sInfo)
|
|
End Sub
|
|
|
|
|