108 lines
4.7 KiB
QBasic
108 lines
4.7 KiB
QBasic
Attribute VB_Name = "modPruefformel"
|
|
Option Explicit
|
|
|
|
|
|
Global g_objExternePruefformel As ExternePruefformeln.CPruefformeln
|
|
|
|
Public Function Instanziere_ExternePruefformel_Objekt(ByRef strError As String) As Boolean
|
|
Dim strGrund As String
|
|
Dim lngErrNum As Long
|
|
Dim strErrDesc As String
|
|
Dim strBenoetigteVersion As String
|
|
|
|
On Error GoTo Errorhandler
|
|
Set g_objExternePruefformel = Nothing
|
|
|
|
If g_objExternePruefformel Is Nothing Then
|
|
Set g_objExternePruefformel = New ExternePruefformeln.CPruefformeln
|
|
|
|
|
|
Instanziere_ExternePruefformel_Objekt = True
|
|
|
|
' Überprüfungen
|
|
strBenoetigteVersion = GetGlobaleEinstellung("Pruefstation_Pruefformeln_DLL", "Benoetigte_Version")
|
|
If strBenoetigteVersion = "" Then
|
|
strErrDesc = "Benoetigte Version [GetGlobaleEinstellung Pruefstation_Pruefformeln_DLL / Benoetigte_Version] der externen DLL ist unbekannt! "
|
|
LogIntoDB strErrDesc, "MEN"
|
|
MsgBox strErrDesc, vbCritical, "Globale Einstellung fehlt"
|
|
End
|
|
End If
|
|
|
|
If g_objExternePruefformel.GetVersion <> strBenoetigteVersion Then
|
|
strError = "Externe Prüfformel DLL:" & vbCrLf & "Benöigte Version " & strBenoetigteVersion & " <> " & g_objExternePruefformel.GetVersion & " !"
|
|
Instanziere_ExternePruefformel_Objekt = False
|
|
Exit Function
|
|
' falsche Version
|
|
Else
|
|
' alles OK
|
|
End If
|
|
|
|
Exit Function
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
lngErrNum = Err.Number
|
|
strErrDesc = Err.Description
|
|
|
|
Select Case lngErrNum
|
|
Case 429
|
|
strGrund = "Mögliche Ursache: ActiveX-Komponente 'ExternePruefformeln' ist nicht registriert. "
|
|
Case -2147024894
|
|
strGrund = "Mögliche Ursache: Die Assembly (ExternePruefformeln.CPruefformeln) ist zwar registriert aber die DLL-Datei (ExternePruefformeln.dll) konnte nicht am registrierten Ort gefunden werden. "
|
|
Case -2147220999
|
|
|
|
Case 430
|
|
|
|
Case Else
|
|
|
|
End Select
|
|
|
|
strError = "Fehler " & lngErrNum & ": " & strErrDesc & vbCrLf & strGrund
|
|
|
|
DebugMsg "ExternePruefformeln Objekt konnte nicht erzeugt werden. Fehler " & lngErrNum & ": " & strErrDesc & IIf(strGrund <> "", vbCrLf & strGrund, "")
|
|
LogIntoDB "ExternePruefformeln: Fehler " & lngErrNum & ": " & strErrDesc, "MEN"
|
|
|
|
' Fehler 430: Klasse unterstützt keine Automatisierung oder unterstützt erwartete Schnittstelle nicht
|
|
' Fehler 429: Objekterstellung durch ActiveX-Komponente nicht möglich
|
|
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
'Public Function Errechne_Dichte_Von_Wasser_in_kg_pro_m3(Temperatur As Double) As Double
|
|
' If g_objExternePruefformel Is Nothing Then
|
|
' Errechne_Dichte_Von_Wasser_in_kg_pro_m3 = ModMain.DichteVonWasser(Temperatur)
|
|
' DebugMsg "Interne Berechnung: " & Errechne_Dichte_Von_Wasser_in_kg_pro_m3 & "( T = " & Temperatur & ") = " & Errechne_Dichte_Von_Wasser_in_kg_pro_m3
|
|
' Else
|
|
' Errechne_Dichte_Von_Wasser_in_kg_pro_m3 = g_objExternePruefformel.Dichte_Von_Wasser_in_kg_pro_m3(Temperatur)
|
|
' DebugMsg g_objExternePruefformel.GetLogText
|
|
' End If
|
|
'End Function
|
|
|
|
Public Function Errechne_Volumen_Von_Wasser_in_m3(Gewicht As Double, Temperatur As Double) As Double
|
|
If g_objExternePruefformel Is Nothing Then
|
|
LogIntoDB "Fataler Fehler in Errechne_Volumen_Von_Wasser_in_m3(): g_objExternePruefformel is nothing.", "MEN"
|
|
ErrorMsg "Fataler Fehler in Errechne_Volumen_Von_Wasser_in_m3(): g_objExternePruefformel is nothing. Bitte Programmierer benachrichtigen!"
|
|
End
|
|
'Errechne_Volumen_Von_Wasser_in_m3 = Gewicht / DichteVonWasser(Temperatur)
|
|
'DebugMsg "Interne Berechnung: Volumen(Gewicht=" & Gewicht & " kg, Temperatur=" & Temperatur & "°C) = " & Errechne_Volumen_Von_Wasser_in_m3 & " m³"
|
|
Else
|
|
Errechne_Volumen_Von_Wasser_in_m3 = g_objExternePruefformel.Volumen_Von_Wasser_in_m3(Gewicht, Temperatur)
|
|
DebugMsg g_objExternePruefformel.GetLogText
|
|
End If
|
|
End Function
|
|
|
|
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
|
|
Public Function Errechne_Relative_Messabweichung_in_Prozent(Messwert As Double, ReferenzWert As Double, ReferenzFehlerInProzent As Double) As Double
|
|
' Ergebnis = 100 * (Messwert - Referenzwert) / Referenzwert + ReferenzfehlerInProzent;
|
|
If g_objExternePruefformel Is Nothing Then
|
|
LogIntoDB "Fataler Fehler: g_objExternePruefformel is nothing", "MEN"
|
|
ErrorMsg "Fataler Fehler in Errechne_Relative_Messabweichung_in_Prozent(): g_objExternePruefformel is nothing. Bitte Programmierer benachrichtigen!"
|
|
End
|
|
Else
|
|
Errechne_Relative_Messabweichung_in_Prozent = g_objExternePruefformel.GetRelativeMessabweichungInProzent(Messwert, ReferenzWert, ReferenzFehlerInProzent)
|
|
End If
|
|
End Function
|
|
|