laatzen/Pruef2000/source/Regulierdaten.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CRegulierdaten"
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"
'==============================================================================
'
' File   : Regulierdaten.cls
' Author : Andreas Schmidt, lindner & partner
' Date   : 14.04.1999
' Version: 0.01
'
'==============================================================================
'
' Verwaltung der Regulierungsdaten zu einer IdentNr.
' Siehe Tabelle "SollwerteRegulierung"
'
'==============================================================================
'
' History:
'
' Author : Andreas Schmidt, lindner & partner
' Date   : 14.04.1999
' Version: 0.01
'
' Erste Version
'
'==============================================================================

Option Explicit

' Private Member
' --------------
Private Const MAX_REGULIERUNG% = 3

Private m_lIdentNr As Long
Private m_sPruefklasseKZ As String
Private m_vSPSSollwertRegulierung As Variant
Private m_vSteigung(MAX_REGULIERUNG) As Variant
Private m_vDaempfung(MAX_REGULIERUNG) As Variant

' Alle Member neu initialisieren
'
Private Sub init()
    Dim i As Integer
    
    m_lIdentNr = 0
    m_sPruefklasseKZ = ""

    For i = 1 To MAX_REGULIERUNG
        m_vSteigung(i) = Empty
        m_vDaempfung(i) = Empty
    Next i
    m_vSPSSollwertRegulierung = Empty

End Sub

Public Sub setIdentNr(lIdentNr As Long)
    m_lIdentNr = lIdentNr
End Sub

' @return Ident-Nr., zu der die Sollwerte 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, etc.)
'
Public Function getPruefklasseKZ() As String
    getPruefklasseKZ = m_sPruefklasseKZ
End Function

Public Sub clearSPSSollwertRegulierung()
    m_vSPSSollwertRegulierung = Empty
End Sub

Public Sub setSPSSollwertRegulierung(dSPSSollwertRegulierung As Double)
    m_vSPSSollwertRegulierung = dSPSSollwertRegulierung
End Sub

Public Function getSPSSollwertRegulierung() As Variant
    getSPSSollwertRegulierung = m_vSPSSollwertRegulierung
End Function

Public Sub clearDaempfung(nIndex As Integer)
    m_vDaempfung(nIndex) = Empty
End Sub

Public Sub setDaempfung(nIndex As Integer, lDaempfung As Long)
   m_vDaempfung(nIndex) = lDaempfung
End Sub

Public Function getDaempfung(nIndex As Integer) As Variant
   getDaempfung = m_vDaempfung(nIndex)
End Function

Public Sub clearSteigung(nIndex As Integer)
    m_vSteigung(nIndex) = Empty
End Sub

Public Sub setSteigung(nIndex As Integer, lSteigung As Double)
   m_vSteigung(nIndex) = lSteigung
End Sub

Public Function getSteigung(nIndex As Integer) As Variant
   getSteigung = m_vSteigung(nIndex)
End Function



Public Function save()
    Dim sSQL As String
    Dim rs As CRecordset
    On Error GoTo saveErr
    
    Set rs = New CRecordset
    sSQL = "SELECT * FROM "
    sSQL = sSQL & "SollwertRegulierung "
    sSQL = sSQL & "WHERE "
    ' sSQL = sSQL & "PruefstationNr = " & g_App.PruefstationNr & " AND "
    sSQL = sSQL & "IdentNr = " & m_lIdentNr & " AND "
    sSQL = sSQL & "PruefklasseKZ = " & rs.stringToSQLString(m_sPruefklasseKZ, True)
    sSQL = sSQL & ";"
   
    rs.openRS (sSQL)
    If rs.EOF Then
        If m_lIdentNr <> 0 Then
            ErrorMsg "Konnte Sollwertregulierdaten nicht zurückspeichern, da in DB nicht vorhanden."
        End If
        Exit Function
    End If
    
    rs.setValue "SPS_Sollwert_Regulierung", m_vSPSSollwertRegulierung
    ' weitere Felder möglich falls sie geändert werden.
    
    rs.update
    DebugMsg "SollwertRegulierung zurückgespeichert: " & m_vSPSSollwertRegulierung
    Exit Function
saveErr:
    ErrorMsg "Konnte Sollwertregulierdaten nicht zurückspeichern: " & Err.Description
End Function

' Daten zur übergebenen Ident-Nr. und Prüfklasse aus der
' Datenbank laden
'
' @return true = Laden erfolgreich durchgeführt
'
Public Function Load(lIdentNr As Long, sPruefklasseKZ As String) As Boolean
    Dim sSQL As String
    Dim rs As CRecordset
    Dim i As Integer
    Dim sNummer As String
   
    On Error GoTo loadErr
    
    Call init
    
    ' Sollwerte
    ' ---------
    Set rs = New CRecordset
    sSQL = "SELECT * FROM "
    sSQL = sSQL & "SollwertRegulierung "
    sSQL = sSQL & "WHERE "
    ' sSQL = sSQL & "PruefstationNr = " & g_App.PruefstationNr & " AND "
    sSQL = sSQL & "IdentNr = " & lIdentNr & " AND "
    sSQL = sSQL & "PruefklasseKZ = " & rs.stringToSQLString(sPruefklasseKZ, True)
    sSQL = sSQL & ";"
   
    If Not rs.openRS(sSQL) Then Exit Function
    If rs.EOF Then Exit Function

    m_lIdentNr = rs.getLongValue("IdentNr")
    m_sPruefklasseKZ = rs.getStringValue("PruefklasseKZ")
    
    For i = 1 To MAX_REGULIERUNG
       sNummer = Trim(Val(i))
       If Not rs.isFieldNull("Steigung" & sNummer) Then m_vSteigung(i) = rs.getDoubleValue("Steigung" & sNummer)
       If Not rs.isFieldNull("Daempfung" & sNummer) Then m_vDaempfung(i) = rs.getIntValue("Daempfung" & sNummer)
    Next i
    
    If Not rs.isFieldNull("SPS_Sollwert_Regulierung") Then
        m_vSPSSollwertRegulierung = rs.getDoubleValue("SPS_Sollwert_Regulierung")
    End If
    
    Load = True
    Exit Function
    
loadErr:
    Call showError("load")
    Exit Function
    
End Function


'------------------------------------------------------------------------------
' 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("CRegulierdaten." + sMethod, sInfo)
End Sub