VERSION 5.00 Begin VB.Form frmJustagewerte BorderStyle = 3 'Fester Dialog Caption = "Justage Werte" ClientHeight = 6825 ClientLeft = 45 ClientTop = 330 ClientWidth = 10065 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6825 ScaleWidth = 10065 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows-Standard Begin VB.Frame Frame3 Caption = "Justagewerte" Height = 2895 Left = 120 TabIndex = 34 Top = 3720 Width = 6495 Begin VB.TextBox txtSollQ_Offset2 Height = 285 Left = 2520 TabIndex = 46 Text = "Text1" Top = 1560 Width = 975 End Begin VB.TextBox txtIstQ_Offset2 Height = 285 Left = 2520 TabIndex = 45 Text = "Text1" Top = 1200 Width = 975 End Begin VB.TextBox txtSollQ_Offset1 Height = 285 Left = 1440 TabIndex = 44 Text = "Text1" Top = 1560 Width = 975 End Begin VB.TextBox txtIstQ_Offset1 Height = 285 Left = 1440 TabIndex = 41 Text = "Text1" Top = 1200 Width = 975 End Begin VB.TextBox txtSoll_K_KGeber2 Height = 285 Left = 2520 TabIndex = 40 Text = "Text1" Top = 720 Width = 975 End Begin VB.TextBox txtIst_K_Geber2 Height = 285 Left = 2520 TabIndex = 39 Text = "Text1" Top = 360 Width = 975 End Begin VB.TextBox txtSoll_K_Geber1 Height = 285 Left = 1440 TabIndex = 38 Text = "Text1" Top = 720 Width = 975 End Begin VB.TextBox txtIst_K_Geber1 Height = 285 Left = 1440 TabIndex = 35 Text = "Text1" Top = 360 Width = 975 End Begin VB.Label Label13 Caption = "Soll_Q_Offset1+2" Height = 255 Left = 120 TabIndex = 43 Top = 1560 Width = 1335 End Begin VB.Label Label12 Caption = "Ist_Q_Offset1+2" Height = 255 Left = 120 TabIndex = 42 Top = 1200 Width = 1335 End Begin VB.Label Label11 Caption = "Soll_K_Geber1+2" Height = 255 Left = 120 TabIndex = 37 Top = 720 Width = 1335 End Begin VB.Label Label9 Caption = "Ist_K_Geber1+2" Height = 255 Left = 120 TabIndex = 36 Top = 360 Width = 1335 End End Begin VB.Frame Frame2 Height = 915 Left = 6720 TabIndex = 16 Top = 0 Width = 2985 Begin VB.CommandButton Command1 Caption = "Grafik" Enabled = 0 'False Height = 435 Left = 1680 TabIndex = 17 Top = 240 Width = 1155 End Begin VB.Label lblSerienNr BorderStyle = 1 'Fest Einfach Height = 255 Left = 180 TabIndex = 21 Top = 480 Width = 1395 End Begin VB.Label Label10 Caption = "SerienNr:" Height = 285 Left = 180 TabIndex = 20 Top = 240 Width = 1335 End End Begin VB.Frame Frame1 Caption = "Offset Parameter" Height = 3675 Left = 120 TabIndex = 0 Top = 0 Width = 6495 Begin VB.TextBox txtOffset2 Alignment = 2 'Zentriert Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3390 MaxLength = 6 TabIndex = 6 Top = 2220 Width = 855 End Begin VB.CommandButton cmdBerechnen Caption = "Berechnen" Default = -1 'True Enabled = 0 'False Height = 405 Left = 1890 TabIndex = 26 Top = 3060 Width = 1335 End Begin VB.CommandButton cmdCancel Caption = "Abbrechen" Height = 405 Left = 5010 TabIndex = 19 Top = 3060 Width = 1335 End Begin VB.CommandButton cmdOK Caption = "OK" Enabled = 0 'False Height = 405 Left = 3450 TabIndex = 18 Top = 3060 Width = 1335 End Begin VB.TextBox txtOffset1 Alignment = 2 'Zentriert Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 5370 MaxLength = 6 TabIndex = 8 Top = 2220 Width = 855 End Begin VB.TextBox txtOffsetBereich Alignment = 2 'Zentriert Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 4380 MaxLength = 6 TabIndex = 7 Top = 2220 Width = 855 End Begin VB.Label lblFehler2AusVorpruef BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3390 TabIndex = 32 Top = 1500 Width = 855 End Begin VB.Label lblQ2 Alignment = 2 'Zentriert Caption = "m³/h" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3270 TabIndex = 29 Top = 420 Width = 945 End Begin VB.Label lblOffset2 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3390 TabIndex = 25 Top = 1860 Width = 855 End Begin VB.Label lblFehler2 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3390 TabIndex = 13 Top = 780 Width = 855 End Begin VB.Label lblFehlerErw2 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3390 TabIndex = 10 Top = 1140 Width = 855 End Begin VB.Label Label4 Alignment = 2 'Zentriert Caption = "max" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 3360 TabIndex = 4 Top = 150 Width = 765 End Begin VB.Label lblFehler1AusVorpruef BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 5370 TabIndex = 30 Top = 1500 Width = 855 End Begin VB.Label lblBereichAusVorpruef BorderStyle = 1 'Fest Einfach Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 4380 TabIndex = 31 Top = 1500 Width = 855 End Begin VB.Label lblQBereich Alignment = 2 'Zentriert Caption = "m³/h" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 4260 TabIndex = 28 Top = 420 Width = 945 End Begin VB.Label lblQ1 Alignment = 2 'Zentriert Caption = "m³/h" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 5340 TabIndex = 27 Top = 420 Width = 945 End Begin VB.Label lblOffsetBereich BorderStyle = 1 'Fest Einfach Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 4380 TabIndex = 24 Top = 1860 Width = 855 End Begin VB.Label lblOffset1 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 5370 TabIndex = 23 Top = 1860 Width = 855 End Begin VB.Label Label7 Alignment = 1 'Rechts Caption = "alte Wunschabweichung [%]" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 120 TabIndex = 22 Top = 1890 Width = 3045 End Begin VB.Label lblFehler1 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 5370 TabIndex = 15 Top = 780 Width = 855 End Begin VB.Label lblFehlerBereich BorderStyle = 1 'Fest Einfach Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 4380 TabIndex = 14 Top = 780 Width = 855 End Begin VB.Label lblFehlerErw1 BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 5370 TabIndex = 12 Top = 1140 Width = 855 End Begin VB.Label lblFehlerErw1Bereich BorderStyle = 1 'Fest Einfach Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 4380 TabIndex = 11 Top = 1140 Width = 855 End Begin VB.Label Label6 Alignment = 1 'Rechts Caption = "neue Wunschabweichung [%]" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 210 TabIndex = 9 Top = 2280 Width = 2985 End Begin VB.Label Label5 Alignment = 1 'Rechts Caption = "Fehler nach neuer Justage [%]" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 90 TabIndex = 5 Top = 1170 Width = 3105 End Begin VB.Label Label3 Alignment = 2 'Zentriert Caption = "Bereich" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 4380 TabIndex = 3 Top = 150 Width = 765 End Begin VB.Label Label2 Alignment = 2 'Zentriert Caption = "min" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 5580 TabIndex = 2 Top = 150 Width = 465 End Begin VB.Label Label1 Alignment = 1 'Rechts Caption = "Fehler aus letzter Hauptprüfung [%]" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 60 TabIndex = 1 Top = 810 Width = 3135 End Begin VB.Label Label8 Alignment = 1 'Rechts Caption = "Fehler aus letzter Vorprüfung [%]" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 90 TabIndex = 33 Top = 1530 Width = 3105 End End End Attribute VB_Name = "frmJustagewerte" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private m_SerienNr As Long Private m_blnActivated As Boolean Public m_Pruefzaehler As CPruefzaehler Public m_Pruefgang As CPruefgang Public m_EinbauplatzNr As Integer Private comport As Integer Public m_JustageWerte As CJustagewerte Public m_Vorpruefpunkte As CVorpruefpunkte Dim udtJustageParameter As JustageParameter_Type Dim udtZusatzParameter As US_ZusatzParameter_Typ Private Type US_ZusatzParameter_Typ FP_Impulswertigkeit As Double '---Impulswertigkeit normale Ausgabe FP_Impulswertigkeit_Pruef As Double '---Impulswertigkeit normale Ausgabe PulseMode As Byte '---PulseMode (PolluFlow=1,PolluStat=2) FP_Flow_Min As Double '---Minimaler Durchfluß FP_Flow_Max As Double End Type Private Sub cmdBerechnen_Click() ' udtJustageParameter.Bereich_ns ' udtJustageParameter.Geberkonstante_Neu1_m ' udtJustageParameter.Geberkonstante_Neu2_m ' udtJustageParameter.Geberkonstante1_IST_m ' udtJustageParameter.Geberkonstante2_IST_m ' udtJustageParameter.IstFehler_qmin_50°C ' udtJustageParameter.Istfluss1_m3ph ' udtJustageParameter.Istfluss2_m3ph ' udtJustageParameter.Offset_Neu1_m3ph ' udtJustageParameter.Offset_Neu2_m3ph ' udtJustageParameter.Offset_Qmin ' udtJustageParameter.Offset_QBereich ' udtJustageParameter.Offset_Qp ' udtJustageParameter.Offset1_IST_m3ph ' udtJustageParameter.Offset2_IST_m3ph ' udtJustageParameter.OffsetGeber_ns ' udtJustageParameter.SollFehlerDifferenz_Qmin ' udtJustageParameter.Sollfluss1_m3ph ' udtJustageParameter.Sollfluss2_m3ph ' udtJustageParameter.SteilheitGeber_nsp°C ' udtJustageParameter.Temperatur1_°C ' udtJustageParameter.Temperatur2_°C ' udtJustageParameter.Unlinearitaet Call Berechnung End Sub Private Sub Berechnung() Dim IstFluss1Neu As Double Dim IstFluss2Neu As Double Dim IstFehler1 As Double Dim IstFehler2 As Double Dim IstFehlerBereich As Double Dim WunschFehler1 As Double Dim WunschFehler2 As Double Dim WunschFehlerBereich As Double 'Aktuelle Werte aus Datenbank zuweisen gudtUSParameter.Geberkonstante1_IST_m = m_JustageWerte.FP_K_Geber1 gudtUSParameter.Geberkonstante2_IST_m = m_JustageWerte.FP_K_Geber2 'Die neuen Werte mit 0 vorbesetzen gudtUSParameter.Geberkonstante_Neu1_m = 0 gudtUSParameter.Geberkonstante_Neu2_m = 0 'Aktuelle Werte aus Datenbank zuweisen gudtUSParameter.Offset1_IST_m3ph = m_JustageWerte.FP_QOffset1 gudtUSParameter.Offset2_IST_m3ph = m_JustageWerte.FP_QOffset2 'Die neuen Werte mit 0 vorbesetzen gudtUSParameter.Offset_Neu1_m3ph = 0 gudtUSParameter.Offset_Neu2_m3ph = 0 gudtUSParameter.Bereich_ns = m_JustageWerte.FP_Bereich gudtUSParameter.SteilheitGeber_nsp°C = m_JustageWerte.FP_ST_Geber gudtUSParameter.OffsetGeber_ns = m_JustageWerte.FP_O_Geber 'Diese Wert nicht laden, da sonst immer in den Teil der 'Bereichsberechnung gesprungen wird 'erst mal ohne Bereichsjustage gudtUSParameter.Unlinearitaet = 0 '' Parameter für Heiß-Kalt Spreizung 'gudtUSParameter.Offset_Qmin = m_JustageWerte.Offset_Qmin 'gudtUSParameter.Offset_Qp = m_JustageWerte.Offset_Qp 'Aktuelle Werte aus Datenbank zuweisen (Flüsse und Temperaturen aus letzter Justage) gudtUSParameter.Istfluss1_m3ph = m_JustageWerte.IstFluss1 gudtUSParameter.Istfluss2_m3ph = m_JustageWerte.IstFluss2 gudtUSParameter.Sollfluss1_m3ph = m_JustageWerte.SollFluss1 gudtUSParameter.Sollfluss2_m3ph = m_JustageWerte.SollFluss2 gudtUSParameter.Temperatur1_°C = m_JustageWerte.Temperatur1 gudtUSParameter.Temperatur2_°C = m_JustageWerte.Temperatur2 ShowUSParameter gudtUSParameter, udtZusatzParameter, "Vor der Berechnung der Istdurchflüsse", 0 If IsNumeric(txtOffset1.text) Then 'IstFehler1 = CDbl(lblFehler1.Caption) WunschFehler1 = CDbl(txtOffset1.text) 'Umrechnung des IstFlusses aus der Vorprüfung auf den der letzten Vorprüfung 'gudtUSParameter.Istfluss1_m3ph = m_JustageWerte.SollFluss1 + (m_JustageWerte.SollFluss1 / 100 * IstFehler1) 'Berechnung des neuen IstFluss unter Berücksichtigung des Wunschfehlers 'gudtUSParameter.Istfluss1_m3ph = gudtUSParameter.Sollfluss1_m3ph gudtUSParameter.Istfluss1_m3ph = gudtUSParameter.Istfluss1_m3ph - (gudtUSParameter.Istfluss1_m3ph / 100 * WunschFehler1) 'IstFluss1Neu = NeuerIstFluss(IstfehlerAusVorpruef, m_JustageWerte.IstFluss1, m_JustageWerte.SollFluss1, IstFehler1, WunschFehler1) Debug.Print "Alter Fluß 1 =" & m_JustageWerte.IstFluss1 lblFehler1AusVorpruef = m_JustageWerte.IstFluss1 Debug.Print "Wunschfehler 1 = " & WunschFehler1 Debug.Print "Neuer Fluß 1 =" & gudtUSParameter.Istfluss1_m3ph Debug.Print "" If IsNumeric(txtOffset2.text) Then IstFehler2 = CDbl(lblFehler2.caption) WunschFehler2 = CDbl(txtOffset2.text) 'IstFluss2Neu = NeuerIstFluss(IstfehlerAusVorpruef, m_JustageWerte.IstFluss2, m_JustageWerte.SollFluss2, IstFehler2, WunschFehler2) 'Umrechnung des IstFlusses aus der Vorprüfung auf den der letzten Vorprüfung 'gudtUSParameter.Istfluss2_m3ph = m_JustageWerte.SollFluss2 + (m_JustageWerte.SollFluss2 / 100 * IstFehler2) 'Berechnung des neuen IstFluss unter Berücksichtigung des Wunschfehlers 'gudtUSParameter.Istfluss2_m3ph = gudtUSParameter.Sollfluss2_m3ph gudtUSParameter.Istfluss2_m3ph = gudtUSParameter.Istfluss2_m3ph - (gudtUSParameter.Istfluss2_m3ph / 100 * WunschFehler2) Debug.Print "Alter Fluß 2 =" & m_JustageWerte.IstFluss2 Debug.Print "Wunschfehler 2 = " & WunschFehler2 Debug.Print "Neuer Fluß 2 =" & gudtUSParameter.Istfluss2_m3ph Debug.Print "" Else MsgBox ("Bitte geben Sie die Wunschabweichung in Qmax an") cmdOK.Enabled = False Exit Sub End If Else MsgBox ("Bitte geben Sie die Wunschabweichung in Qmin an") cmdOK.Enabled = False Exit Sub End If If IsNumeric(txtOffsetBereich.text) Then IstFehlerBereich = CDbl(lblFehlerBereich.caption) WunschFehlerBereich = CDbl(txtOffsetBereich.text) End If ShowUSParameter gudtUSParameter, udtZusatzParameter, "Vor der JustageBerechnung", 0 modUS2000_Algorithmen.Justage_Execute ShowUSParameter gudtUSParameter, udtZusatzParameter, "Nach der Justage Execute", 0 'lblFehlerErw1.Caption = Format((100 * (gudtUSParameter.Istfluss1_m3ph - gudtUSParameter.Sollfluss1_m3ph) / gudtUSParameter.Sollfluss1_m3ph + IstFehler1) * (-1), "0.00") lblFehlerErw1.caption = gudtUSParameter.Istfluss1_m3ph 'lblFehlerErw2.Caption = Format((100 * (gudtUSParameter.Istfluss2_m3ph - gudtUSParameter.Sollfluss2_m3ph) / gudtUSParameter.Sollfluss2_m3ph + IstFehler2) * (-1), "0.00") lblFehlerErw2.caption = gudtUSParameter.Istfluss2_m3ph cmdOK.Enabled = True ShowUSParameter gudtUSParameter, udtZusatzParameter, "Nach der Berechnung", 0 'Getätigtet Wunschabweichungen in DB zurückschreiben m_JustageWerte.Offset_Qp = txtOffset1.text m_JustageWerte.Offset_Qmin = txtOffset2.text If txtOffsetBereich.text <> Null Then m_JustageWerte.Offset_Bereich = CDbl(txtOffsetBereich.text) End If m_JustageWerte.save End Sub Private Sub cmdCancel_Click() Unload Me End Sub Private Sub cmdOk_Click() If MsgBox("Möchten Sie wirklich die Werte in den Zähler schreiben ?", vbOKCancel, "Sie haben OK geklickt") = vbOK Then modIECCOM.SetOffsetAndGeberAndBereich comport, gudtUSParameter Unload Me Else MsgBox ("Es wurden KEINE Werte in den Zähler geschrieben") End If End Sub Private Sub Form_Activate() If m_blnActivated = False Then m_blnActivated = True Call FormInit End If End Sub Private Sub FormInit() Dim Vorpruefpunkt As CVorpruefpunkt m_SerienNr = m_Pruefzaehler.getSerienNr lblSerienNr.caption = FormatSerienNr(m_SerienNr) Set m_JustageWerte = New CJustagewerte 'Laden der Justagewerte aus der Datenbank m_JustageWerte.SerienNr = m_SerienNr m_JustageWerte.load If m_JustageWerte.SollFluss2 = 0 Or m_JustageWerte.SollFluss1 = 0 Then MsgBox "SollFluss = 0 !" Exit Sub End If Debug.Print m_JustageWerte.SollFluss1 - m_JustageWerte.IstFluss1 / m_JustageWerte.SollFluss1 Debug.Print m_JustageWerte.SollFluss2 - m_JustageWerte.IstFluss2 / m_JustageWerte.SollFluss2 Debug.Print m_JustageWerte.Unlinearitaet Debug.Print "Fehler aus letzter Vorprüfung Qmin: " & (100 - (m_JustageWerte.IstFluss1 / m_JustageWerte.SollFluss1 * 100)) * (-1) Debug.Print "Fehler aus letzter Vorprüfung Qn: " & (100 - (m_JustageWerte.IstFluss2 / m_JustageWerte.SollFluss2 * 100)) * (-1) lblFehler1AusVorpruef = Format((100 - (m_JustageWerte.IstFluss1 / m_JustageWerte.SollFluss1 * 100)) * (-1), "0.000") lblFehler2AusVorpruef = Format((100 - (m_JustageWerte.IstFluss2 / m_JustageWerte.SollFluss2 * 100)) * (-1), "0.000") Call CheckFehlerForOffsetjustage(m_SerienNr, m_Vorpruefpunkte, False) 'min lblOffset2.caption = m_JustageWerte.Offset_Qmin 'Bereich lblOffsetBereich.caption = m_JustageWerte.Offset_Bereich 'max lblOffset1.caption = m_JustageWerte.Offset_Qp lblFehlerBereich.caption = Format(m_JustageWerte.Unlinearitaet * 100, "0.00") comport = Val(g_App.Settings.getUSComPort(m_EinbauplatzNr)) Call WerteAktuell End Sub Public Function CheckFehlerForOffsetjustage(ByVal lngSerienNr As Long, Vorpruefpunkte As CVorpruefpunkte, blnUsePruefstation As Boolean) As Boolean ' Justagedaten + Prüfpunkte einer Hauptprüfung an dieser aktuellen Prüfstation in Qmin, Qmax oder QBereich Dim strSQL As String Dim rs As CRecordset Dim intHPPCount As Integer Dim intVPPCount As Integer Dim blnQminVorhanden As Boolean Dim blnQmaxVorhanden As Boolean Dim dtmDatum As Date Set rs = New CRecordset strSQL = "SELECT * from USJustagewerte where SerienNr = " & lngSerienNr rs.openRS strSQL If Not rs.EOF Then dtmDatum = rs.getDateValue("DatumVorpruefung") dtmDatum = DateAdd("n", -1, dtmDatum) Else Exit Function End If strSQL = "SELECT Pruefgang.*, * FROM Prueffehler INNER JOIN Pruefgang ON Prueffehler.PruefgangNr = Pruefgang.PruefgangNr Where Prueffehler.SerienNr = " & lngSerienNr & " and Pruefgang.Datum >= CONVERT(smalldatetime, '" & Format(dtmDatum, "yyyy-mm-dd hh:mm:ss") & "', 120)" If blnUsePruefstation Then strSQL = strSQL & " and Pruefgang.PruefstationNr = " & g_App.PruefstationNr End If strSQL = strSQL & " ORDER BY Prueffehler.PruefDatum DESC" Debug.Print strSQL rs.openRS strSQL If Not rs.EOF Then For intHPPCount = 1 To 10 If rs.getDoubleValue("PP" & intHPPCount & "_Soll") <> 0 Then Debug.Print "teste HP =" & rs.getDoubleValue("PP" & intHPPCount & "_Soll") For intVPPCount = 3 To 1 Step -1 Debug.Print intVPPCount & "; VP: " & Vorpruefpunkte.getPruefpunkt(intVPPCount).getQ & " =?= " & CSng(rs.getDoubleValue("PP" & intHPPCount & "_Soll")) If CSng(Vorpruefpunkte.getPruefpunkt(intVPPCount).getQ) = CSng(rs.getDoubleValue("PP" & intHPPCount & "_Soll")) Then Select Case intVPPCount Case 1 ' Qmax lblQ2.caption = Format(Vorpruefpunkte.getPruefpunkt(1).getQ, "0.00") & " m³/h" lblFehler2.caption = Format(rs.getDoubleValue("PP" & intHPPCount & "_Fehler"), "0.0000") txtOffset2.Visible = True txtOffset2.Enabled = True blnQmaxVorhanden = True Case 2 ' QBereich 'lblQBereich.Caption = Format(Vorpruefpunkte.getPruefpunkt(2).getQ, "0.00") & " m³/h" 'lblFehlerBereich.Caption = Format(rs.getDoubleValue("PP" & intHPPCount & "_Fehler"), "0.00") txtOffsetBereich.Visible = True txtOffsetBereich.Enabled = True Case 3 ' Q min lblQ1.caption = Format(Vorpruefpunkte.getPruefpunkt(3).getQ, "0.00") & " m³/h" lblFehler1.caption = Format(rs.getDoubleValue("PP" & intHPPCount & "_Fehler"), "0.0000") txtOffset1.Visible = True txtOffset1.Enabled = True blnQminVorhanden = True End Select End If Next End If Next Else End If End Function Private Sub Form_Load() txtOffset1.Visible = False txtOffsetBereich.Visible = False txtOffset2.Visible = False End Sub Function NeuerIstFluss(IstfehlerAusVorpruef As Double, _ IstFlussAusVorpruef As Double, _ SollFlussAusVorpruef As Double, _ IstFehlerAusHP As Double, _ Wunschfehler As Double) As Double NeuerIstFluss = IstFlussAusVorpruef + SollFlussAusVorpruef * (1 - (100 + Wunschfehler + IstfehlerAusVorpruef + IstFehlerAusHP) / 100) 'NeuerIstFluss = IstFluss * (1 - Wunschfehler / 100) End Function Function WerteAktuell() 'txtIst_K_Geber1.Text = udtUSJustageParameter.Geberkonstante1_IST_m 'txtIst_K_Geber2.Text = udtUSJustageParameter.Geberkonstante2_IST_m 'txtSoll_K_Geber1 = udtUSJustageParameter.Geberkonstante_Neu1_m 'txtSoll_K_Geber2 = udtUSJustageParameter.Geberkonstante_Neu2_m 'txtIstQ_Offset1 = udtUSJustageParameter.Offset1_IST_m3ph 'txtIstQ_Offset2 = udtUSJustageParameter.Offset2_IST_m3ph 'txtSollQ_Offset1 = udtUSJustageParameter.Offset_Neu1_m3ph 'txtSollQ_Offset2 = udtUSJustageParameter.Offset_Neu2_m3ph End Function Private Sub ShowUSParameter(udtUSJustageParameter As JustageParameter_Type, udtUSZusatzParameter As US_ZusatzParameter_Typ, sUeberschrift As String, EinbauplatzNr As Integer) Debug.Print "-----------------------------------------------------" Debug.Print sUeberschrift Debug.Print "Einbauplatz: " & EinbauplatzNr Debug.Print "Bereich_ns: " & udtUSJustageParameter.Bereich_ns Debug.Print "Geberkonstante_Neu1_m: " & udtUSJustageParameter.Geberkonstante_Neu1_m Debug.Print "Geberkonstante_Neu2_m: " & udtUSJustageParameter.Geberkonstante_Neu2_m Debug.Print " " Debug.Print "Geberkonstante1_IST_m: " & udtUSJustageParameter.Geberkonstante1_IST_m Debug.Print "Geberkonstante2_IST_m: " & udtUSJustageParameter.Geberkonstante2_IST_m Debug.Print "SteilheitGeber:" & udtUSJustageParameter.SteilheitGeber_nsp°C Debug.Print "Istfluss1_m3ph: " & udtUSJustageParameter.Istfluss1_m3ph Debug.Print " " Debug.Print "Istfluss2_m3ph: " & udtUSJustageParameter.Istfluss2_m3ph Debug.Print "Offset_Neu1_m3ph: " & udtUSJustageParameter.Offset_Neu1_m3ph Debug.Print "Offset_Neu2_m3ph: " & udtUSJustageParameter.Offset_Neu2_m3ph Debug.Print "Offset1_IST_m3ph: " & udtUSJustageParameter.Offset1_IST_m3ph Debug.Print "Offset2_IST_m3ph: " & udtUSJustageParameter.Offset2_IST_m3ph Debug.Print "OffsetGeber_ns: " & udtUSJustageParameter.OffsetGeber_ns Debug.Print " " Debug.Print "Sollfluss1_m3ph: " & udtUSJustageParameter.Sollfluss1_m3ph Debug.Print "Sollfluss2_m3ph: " & udtUSJustageParameter.Sollfluss2_m3ph Debug.Print "Temperatur1_°C: " & udtUSJustageParameter.Temperatur1_°C Debug.Print "Temperatur2_°C: " & udtUSJustageParameter.Temperatur2_°C Debug.Print "Unlinearitaet: " & udtUSJustageParameter.Unlinearitaet Debug.Print " " Debug.Print "FP_Impulswertigkeit: " & udtUSZusatzParameter.FP_Impulswertigkeit Debug.Print "FP_Impulswertigkeit_Pruef: " & udtUSZusatzParameter.FP_Impulswertigkeit_Pruef Debug.Print "PulseMode: " & udtUSZusatzParameter.PulseMode Debug.Print "FP_Flow_Min: " & udtUSZusatzParameter.FP_Flow_Min Debug.Print "FP_Flow_Max: " & udtUSZusatzParameter.FP_Flow_Max Debug.Print "-----------------------------------------------------" End Sub