VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" Begin VB.Form frmHauptprf_ereg Caption = "Pruef2000" ClientHeight = 11115 ClientLeft = 165 ClientTop = 450 ClientWidth = 15240 LinkTopic = "Form1" ScaleHeight = 11115 ScaleWidth = 15240 StartUpPosition = 3 'Windows-Standard Begin VB.Frame frMain Height = 11055 Left = 0 TabIndex = 0 Top = 60 Width = 15195 Begin VB.CheckBox chkKeineVolumenvorgabe Caption = "keine Volumen Vorgabe LWL" Height = 285 Left = 12420 TabIndex = 119 Top = 8790 Width = 2535 End Begin VB.CommandButton cmdTest Caption = "Test" Height = 405 Left = 14340 TabIndex = 118 Top = 6060 Width = 585 End Begin VB.CheckBox chkNachpruefung Caption = "Nachprüfung" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 13080 TabIndex = 117 ToolTipText = "Bei einer Nachprüfung werden Überschreitung der Fehlergrenzen NICHT rot angezeigt." Top = 8340 Width = 1785 End Begin VB.TextBox txtBemerkung Height = 375 Left = 6450 MaxLength = 250 TabIndex = 110 ToolTipText = "Geben Sie hier einen Text ein. Dieser wird in Pruffehler.info gespeichert." Top = 210 Width = 1425 End Begin VB.CheckBox chkProtokolldruck Caption = "Prüf-Protokoll drucken" Height = 315 Left = 13110 TabIndex = 107 Top = 8040 Width = 1965 End Begin VB.Frame Frame6 Caption = "Info" Height = 795 Left = 180 TabIndex = 104 Top = 6270 Width = 3045 Begin VB.Label Label25 Caption = "Doppelimpulsperre:" Height = 285 Left = 210 TabIndex = 106 Top = 300 Width = 1365 End Begin VB.Label lblDoppelimpulssperre BackColor = &H8000000B& BorderStyle = 1 'Fest Einfach Height = 315 Left = 1710 TabIndex = 105 Top = 270 Width = 1035 End End Begin VB.CommandButton cmdVorzeitigBeenden Caption = "Prüfpunkt vorzeitig beenden" Enabled = 0 'False Height = 615 Left = 13320 TabIndex = 101 Top = 10320 Width = 1665 End Begin VB.Frame Frame3 Caption = "Breiten" Height = 1755 Left = 13140 TabIndex = 97 Top = 5940 Width = 1005 Begin VB.CheckBox chkAutobreite Caption = "auto" Height = 225 Left = 210 TabIndex = 109 Top = 1350 Width = 645 End Begin VB.CommandButton cmdFlexgridReset Caption = "Reset" Height = 285 Left = 180 TabIndex = 100 Top = 930 Width = 615 End Begin VB.CommandButton cmdFlexgridRead Caption = "load" Height = 285 Left = 180 TabIndex = 99 Top = 600 Width = 615 End Begin VB.CommandButton cmdFlexgridWrite Caption = "save" Height = 285 Left = 180 TabIndex = 98 Top = 270 Width = 615 End End Begin VB.Frame frameKontinuierlich Caption = "Kontinuierliche Prüfung" Height = 1095 Left = 7380 TabIndex = 82 Top = 9180 Width = 6855 Begin VB.TextBox txtPruefzeitMax Alignment = 1 'Rechts Height = 255 Left = 1800 TabIndex = 95 Text = "120" Top = 780 Width = 615 End Begin VB.ComboBox cmbKontSprung Height = 315 ItemData = "frmHauptprf_ereg.frx":0000 Left = 3780 List = "frmHauptprf_ereg.frx":0010 TabIndex = 88 ToolTipText = "Hier kann auch direkt ein Wert 10-90% eingegeben werden" Top = 720 Width = 1425 End Begin VB.TextBox txtFlowMin Alignment = 1 'Rechts Height = 315 Left = 2850 TabIndex = 87 Top = 330 Width = 915 End Begin VB.TextBox txtFlowMax Alignment = 1 'Rechts Height = 315 Left = 1050 TabIndex = 86 Top = 330 Width = 915 End Begin VB.CommandButton cmdStartKontinuierlich Caption = "START" Height = 315 Left = 5640 TabIndex = 85 Top = 720 Width = 1095 End Begin VB.TextBox txtPruefzeitMin Alignment = 1 'Rechts Height = 255 Left = 960 TabIndex = 84 Text = "60" Top = 780 Width = 495 End Begin VB.TextBox txtKontCount Alignment = 1 'Rechts Height = 315 Left = 6240 TabIndex = 83 Text = "10" Top = 210 Width = 465 End Begin VB.Label Label23 Caption = "bis" Height = 195 Left = 1560 TabIndex = 96 Top = 780 Width = 255 End Begin VB.Label Label15 Caption = "bis Qmin=" Height = 195 Index = 0 Left = 2070 TabIndex = 94 Top = 360 Width = 855 End Begin VB.Label Label14 Caption = "von Qmax=" Height = 195 Left = 150 TabIndex = 93 Top = 360 Width = 945 End Begin VB.Label Label17 Caption = "Prüfzeit[s]:" Height = 255 Left = 120 TabIndex = 92 Top = 780 Width = 795 End Begin VB.Label Label19 Caption = "verbleibene Anzahl" Height = 195 Left = 4800 TabIndex = 91 Top = 330 Width = 1425 End Begin VB.Label Label21 Caption = "%" Height = 255 Left = 5280 TabIndex = 90 Top = 780 Width = 315 End Begin VB.Label Label22 Caption = "Schrittweite" Height = 285 Left = 2760 TabIndex = 89 Top = 780 Width = 855 End End Begin VB.CommandButton cmdCancel Caption = "Zurück" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 11340 TabIndex = 62 Top = 10320 Width = 1935 End Begin VB.CommandButton cmdSPSInfo Caption = "Schaubild" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 9150 TabIndex = 61 Top = 10320 Width = 1935 End Begin VB.Frame Frame1 Caption = "Fortschritt" Height = 3735 Left = 180 TabIndex = 46 Top = 7230 Width = 3735 Begin MSComctlLib.ProgressBar ProgressBar1 Height = 225 Left = 150 TabIndex = 54 Top = 3000 Width = 3375 _ExtentX = 5953 _ExtentY = 397 _Version = 393216 Appearance = 1 End Begin VB.CommandButton cmdDauerEnde Caption = "Abbruch" Enabled = 0 'False BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 585 Left = 2550 TabIndex = 53 Top = 990 Width = 975 End Begin VB.Label Label16 Alignment = 1 'Rechts Caption = "Prüfgang Nr.:" Height = 225 Left = 270 TabIndex = 60 Top = 3360 Width = 1035 End Begin VB.Label lblPruefgangNr BackColor = &H00FFFFFF& BorderStyle = 1 'Fest Einfach Height = 315 Left = 1410 TabIndex = 59 Top = 3300 Width = 1065 End Begin VB.Label Label10 Caption = "Sekunden" Height = 285 Left = 2580 TabIndex = 58 Top = 540 Width = 855 End Begin VB.Label Label9 Caption = "Minuten" Height = 285 Left = 2550 TabIndex = 57 Top = 2460 Width = 825 End Begin VB.Label Label8 Alignment = 1 'Rechts Caption = "Ges. Zeit" Height = 285 Left = 240 TabIndex = 56 Top = 2460 Width = 825 End Begin VB.Label lblGesZeit Alignment = 1 'Rechts BackColor = &H00FFFFFF& BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1170 TabIndex = 55 Top = 2400 Width = 1275 End Begin VB.Label Label15 Alignment = 1 'Rechts Caption = "Zeit (PP):" Height = 285 Index = 1 Left = 240 TabIndex = 52 Top = 570 Width = 825 End Begin VB.Label Label11 Alignment = 1 'Rechts Caption = "Dauerprüfung:" Height = 285 Left = 90 TabIndex = 51 Top = 1140 Width = 1035 End Begin VB.Label lblDauer Alignment = 1 'Rechts BackColor = &H00FFFFFF& BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1170 TabIndex = 50 Top = 1110 Width = 1275 End Begin VB.Label lblZeit Alignment = 1 'Rechts BackColor = &H00FFFFFF& BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1170 TabIndex = 49 Top = 480 Width = 1305 End Begin VB.Label Label6 Alignment = 1 'Rechts Caption = "Langprüfung:" Height = 255 Left = 120 TabIndex = 48 Top = 1770 Width = 975 End Begin VB.Label lblLang Alignment = 1 'Rechts BackColor = &H00FFFFFF& BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1170 TabIndex = 47 Top = 1740 Width = 1275 End End Begin VB.Frame Frame2 Caption = "Meßwertabweichung in %" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 5145 Left = 3390 TabIndex = 44 Top = 600 Width = 11475 Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 Height = 4905 Left = 210 TabIndex = 45 Top = 210 Width = 11205 _ExtentX = 19764 _ExtentY = 8652 _Version = 393216 Rows = 12 Cols = 1 AllowBigSelection= 0 'False ScrollBars = 1 AllowUserResizing= 1 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Arial" Size = 14.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End End Begin VB.ListBox lstPruefpunkte Height = 2400 Left = 11760 TabIndex = 42 Top = 6030 Width = 1215 End Begin VB.Frame frameVerblImpulse Caption = "verbleibene Impulse / Impulse" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 5565 Left = 180 TabIndex = 23 Top = 600 Width = 3045 Begin VB.Label lblImpulseRZ BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1800 TabIndex = 102 Top = 4500 Width = 1035 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 6 Left = 540 TabIndex = 81 Top = 2550 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 5 Left = 540 TabIndex = 80 Top = 2190 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Index = 4 Left = 540 TabIndex = 79 Top = 1830 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 3 Left = 540 TabIndex = 78 Top = 1470 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 2 Left = 540 TabIndex = 77 Top = 1080 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 540 TabIndex = 76 Tag = "#1" Top = 720 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Index = 10 Left = 540 TabIndex = 75 Top = 4110 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 7 Left = 540 TabIndex = 74 Top = 2940 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 8 Left = 540 TabIndex = 73 Top = 3330 Width = 1095 End Begin VB.Label lblVerbleib BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 9 Left = 540 TabIndex = 72 Top = 3720 Width = 1095 End Begin VB.Label Label1 Caption = "7" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 3 Left = 240 TabIndex = 71 Top = 3030 Width = 315 End Begin VB.Label Label1 Caption = "8" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 2 Left = 240 TabIndex = 70 Top = 3390 Width = 315 End Begin VB.Label Label1 Caption = "9" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 240 TabIndex = 69 Top = 3720 Width = 315 End Begin VB.Label Label1 Caption = "10" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 180 TabIndex = 68 Top = 4110 Width = 315 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 9 Left = 1770 TabIndex = 67 Top = 3720 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 8 Left = 1770 TabIndex = 66 Top = 3330 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 7 Left = 1770 TabIndex = 65 Top = 2940 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Index = 10 Left = 1770 TabIndex = 64 Top = 4110 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 6 Left = 1770 TabIndex = 41 Top = 2580 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 5 Left = 1770 TabIndex = 40 Top = 2190 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 4 Left = 1770 TabIndex = 39 Top = 1830 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 3 Left = 1770 TabIndex = 38 Top = 1470 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 2 Left = 1770 TabIndex = 37 Top = 1080 Width = 1095 End Begin VB.Label lblPZImpulse BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 1770 TabIndex = 36 Top = 720 Width = 1095 End Begin VB.Label Label1 Caption = "6" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 6 Left = 240 TabIndex = 35 Top = 2640 Width = 315 End Begin VB.Label Label1 Caption = "5" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 7 Left = 240 TabIndex = 34 Top = 2220 Width = 315 End Begin VB.Label Label1 Caption = "4" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 8 Left = 240 TabIndex = 33 Top = 1860 Width = 315 End Begin VB.Label Label1 Caption = "3" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 9 Left = 240 TabIndex = 32 Top = 1530 Width = 315 End Begin VB.Label Label1 Caption = "2" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 10 Left = 240 TabIndex = 31 Top = 1140 Width = 315 End Begin VB.Label Label1 Caption = "1" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 11 Left = 240 TabIndex = 30 Top = 750 Width = 315 End Begin VB.Label Label1 Caption = "RZ" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 12 Left = 120 TabIndex = 29 Top = 4500 Width = 315 End Begin VB.Label lblVerbleibRZ BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 540 TabIndex = 28 Top = 4500 Width = 1095 End Begin VB.Label lblVerbleibRZA BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 1830 TabIndex = 27 Top = 5100 Width = 1035 End Begin VB.Label lblVerbleibRZB BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 360 TabIndex = 26 Top = 5100 Width = 1095 End Begin VB.Label Label1 Caption = "A" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 13 Left = 1560 TabIndex = 25 Top = 5130 Width = 255 End Begin VB.Label Label1 Caption = "B" BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 14 Left = 120 TabIndex = 24 Top = 5130 Width = 375 End End Begin VB.Frame Frame4 Caption = "Soll-Durchfluss" Height = 735 Left = 7380 TabIndex = 16 Top = 5760 Width = 4275 Begin VB.CommandButton cmdQSollMinus Caption = "QSoll -" Enabled = 0 'False Height = 375 Left = 1170 TabIndex = 18 Top = 240 Width = 915 End Begin VB.CommandButton cmdQSollPlus Caption = "QSoll +" Enabled = 0 'False Height = 375 Left = 180 TabIndex = 17 Top = 240 Width = 915 End Begin VB.Label lblQSoll BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2160 TabIndex = 19 Top = 270 Width = 915 End End Begin VB.Frame Frame5 Height = 2745 Left = 7380 TabIndex = 3 Top = 6420 Width = 4275 Begin VB.Label Label29 Alignment = 1 'Rechts Caption = "Vorlauf Temperatur:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 330 TabIndex = 116 Top = 2340 Width = 2025 End Begin VB.Label Label28 Caption = "°C" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3600 TabIndex = 115 Top = 2340 Width = 465 End Begin VB.Label lblVorlauftemperatur BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 114 Top = 2310 Width = 1095 End Begin VB.Label Label24 Alignment = 1 'Rechts Caption = "Wasserdruck:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 690 TabIndex = 113 Top = 1980 Width = 1635 End Begin VB.Label Label26 Caption = "bar" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3600 TabIndex = 112 Top = 1980 Width = 465 End Begin VB.Label lblWasserdruck BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 111 Top = 1950 Width = 1095 End Begin VB.Label lblGrenzwert BackColor = &H80000004& BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 22 Top = 510 Width = 1095 End Begin VB.Label Label13 Caption = "kg" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 3630 TabIndex = 21 Top = 510 Width = 375 End Begin VB.Label Label12 Alignment = 1 'Rechts Caption = "Waagengrenzwert:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 90 TabIndex = 20 Top = 510 Width = 2205 End Begin VB.Label Label7 Caption = "l" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 3630 TabIndex = 15 Top = 1260 Width = 405 End Begin VB.Label lblFehlerRZ BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 14 Top = 1590 Width = 1095 End Begin VB.Label lblLabelFehlerRZ Alignment = 1 'Rechts Caption = "Fehler RZ:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 810 TabIndex = 13 Top = 1620 Width = 1515 End Begin VB.Label Label5 Caption = "%" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3660 TabIndex = 12 Top = 1620 Width = 255 End Begin VB.Label Label4 Caption = "kg" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3660 TabIndex = 11 Top = 900 Width = 375 End Begin VB.Label Label2 Alignment = 1 'Rechts Caption = "Soll Volumen:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 690 TabIndex = 10 Top = 1230 Width = 1635 End Begin VB.Label lblSollV BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 9 Top = 1230 Width = 1095 End Begin VB.Label lblQIst BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 8 Top = 150 Width = 1095 End Begin VB.Label Label3 Alignment = 1 'Rechts Caption = "Durchfluß:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 750 TabIndex = 7 Top = 180 Width = 1545 End Begin VB.Label lblGewicht BorderStyle = 1 'Fest Einfach BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 2460 TabIndex = 6 Top = 870 Width = 1095 End Begin VB.Label lblGewichtLabel Alignment = 1 'Rechts Caption = "Gewicht:" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 1140 TabIndex = 5 Top = 900 Width = 1155 End Begin VB.Label Label20 Caption = "m³/h" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 3630 TabIndex = 4 Top = 150 Width = 585 End End Begin VB.CommandButton cmdStop Caption = "STOP" Enabled = 0 'False BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 7470 TabIndex = 2 Top = 10320 Width = 1335 End Begin VB.TextBox txtStatus Height = 5085 Left = 3990 MultiLine = -1 'True ScrollBars = 2 'Vertikal TabIndex = 1 Top = 5880 Width = 3285 End Begin VB.Label lblAutosize AutoSize = -1 'True BorderStyle = 1 'Fest Einfach Caption = "Autosize" Height = 255 Left = 4650 TabIndex = 108 Top = 240 Visible = 0 'False Width = 660 End Begin VB.Label lblMsg BackColor = &H8000000B& BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 825 Left = 150 TabIndex = 103 Top = 10140 Width = 6975 End Begin VB.Line Line1 Index = 10 X1 = 3120 X2 = 3450 Y1 = 5040 Y2 = 5040 End Begin VB.Line Line1 Index = 9 X1 = 3120 X2 = 3450 Y1 = 4680 Y2 = 4680 End Begin VB.Line Line1 Index = 8 X1 = 3120 X2 = 3450 Y1 = 4320 Y2 = 4320 End Begin VB.Line Line1 Index = 7 X1 = 3090 X2 = 3420 Y1 = 3930 Y2 = 3930 End Begin VB.Line Line1 Index = 6 X1 = 3120 X2 = 3450 Y1 = 3540 Y2 = 3540 End Begin VB.Line Line1 Index = 5 X1 = 3120 X2 = 3450 Y1 = 3180 Y2 = 3180 End Begin VB.Line Line1 Index = 4 X1 = 3120 X2 = 3450 Y1 = 2790 Y2 = 2790 End Begin VB.Line Line1 Index = 3 X1 = 3180 X2 = 3510 Y1 = 2430 Y2 = 2430 End Begin VB.Line Line1 Index = 2 X1 = 3180 X2 = 3510 Y1 = 2070 Y2 = 2070 End Begin VB.Line Line1 Index = 1 X1 = 3120 X2 = 3450 Y1 = 1680 Y2 = 1680 End Begin VB.Line Line1 Index = 0 X1 = 3120 X2 = 3450 Y1 = 1320 Y2 = 1320 End Begin VB.Label lblTitle Alignment = 2 'Zentriert Caption = "Hauptprüfung eRegister" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 3420 TabIndex = 63 Top = 240 Width = 10695 End Begin VB.Label Label18 Caption = "Prüfpunkte:" Height = 195 Left = 11760 TabIndex = 43 Top = 5820 Width = 1155 End End End Attribute VB_Name = "frmHauptprf_ereg" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ' von aufrufender Form zu setzende Member ' --------------------------------------- ' Für Regulierung und Prüfzaehler Prüfung Public m_colUniquePP As CPruefpunktCol Public m_colEinbauplatz As Collection Public m_ParentForm As Form ' Für Regulierung Public m_Regulierdaten As CRegulierdaten Public m_RegulierPruefpunkt As CPruefpunkt Public m_bAutomatik As Boolean ' Public m_bKeineRegulierung As Boolean ' Für Prüfzaehlerprüfung Public m_ImpulswertigkeitPZ As Long Public m_ImpulswertigkeitLwl As Long Private m_AnwahlLetzterBehaelter As Long Public m_bDauerpruefung As Boolean Public m_bRegulierungDurchfuehren As Boolean Public m_bRegulierungInQtDurchfehhren As Boolean Public m_DauerpruefungAnzahl As Integer Public m_PruefungsArtWaage As Boolean Public m_bPruefgangLang As Boolean Public m_Regelart As String ' FU, Servo Public m_NurMesseinsaetze As Boolean Public m_Pruefgang As CPruefgang Public m_RegulierungVerwenden As Boolean Public m_blnRueckwaertspruefung As Boolean Public m_bKontinuierlich As Boolean Public m_bEichpruefvorgabenIgnorieren As Boolean Public m_bLichtwellenleiter As Boolean Public m_bytDoppelimpulssperrzahl As Byte Public m_blnKundeneigeneSerienNrAnzeigen As Boolean Public m_blnVersuch_Prf_Automatisch_Beenden As Boolean Public m_bln_Alle_PP_mit_eRegister As Boolean ' Private Member ' -------------- Private m_PPDauerpruefung As Double Private dummy As Variant Private mblnDurchflussAbweichung As Boolean Private m_nRet As Integer Private m_SPS As CSPS Private m_FMBus As CFMBus Private m_ColPumpen As Collection Private m_Pruefpunkt As CPruefpunkt Private FormActivated As Boolean Private m_ZaehlerPP As Integer Private m_DurchflussSoll As Double Private m_letzter_Durchfluss As Double Private m_DurchflussSollManuell As Double Private m_Pumpe As CPumpe Private m_Referenzzaehler As CRefzaehler Private m_ReferenzzaehlerA As CRefzaehler Private m_ReferenzzaehlerB As CRefzaehler Private m_AnzahlPeriodenRZ As Long Private m_PruefpunktFertig As Boolean Private m_DauerStop As Boolean Private m_laeuft As Boolean 'Status Prüfung läuft Private m_Startzeit As Long Private m_Pruefzeit As Long Private m_DauerpruefungZaehler As Integer Private m_GesZeitZaehler As Long Private PP_Ist_Zeit As Long Private AuftragpositionSerienNr As CAuftragPositionSerienNr Private m_VolumenSoll As Double Private FehlerInPruefgangLang(3, 10) As Double Private ZaehlerPruefgangLang As Integer Private PruefgangLangPruefpunktWiederholen As Boolean Private m_ersterPruefzaehler As CPruefzaehler Private m_ersterPruefzaehlerNr As Integer Private m_ArrayBehaelter(4) As CBehaelter Private m_Behaelter As CBehaelter Private m_BehaelterNr As Integer Private m_Waage As CWaage Private m_DruckMsg As String Private m_bVoreinstellwertSetzen As Boolean Private m_Tpruef As Long Private m_Tstart As Long Private m_arStrBreite(10) As String Private m_VorgabeLiterLWL As Double Private m_bln_LWL_PP As Boolean 'Private m_blnRegulierungWurdeDurchgefuehrt As Boolean Const COLOUR_Lightred = &HC0C0FF '-------------------------------------------------------------------- ' @return Code, mit dem endDialog aufgerufen wurde ' Public Function getExitCode() As Integer getExitCode = m_nRet End Function ' Dialog beenden ' ' @param nRet Returncode des Dialogs ' Private Sub endDialog(nRet As Integer) m_nRet = nRet Unload Me End Sub Private Sub chkAutobreite_Click() If chkAutobreite.value = vbChecked Then AutoSpaltenBreite MSFlexGrid1, lblAutosize, 1 End If End Sub Private Sub chkNachpruefung_Click() If chkNachpruefung.value = vbChecked Then Call g_App.Settings.saveStringValue("Vorbelegung", "Nachpruefung", "1") Else Call g_App.Settings.saveStringValue("Vorbelegung", "Nachpruefung", "0") End If End Sub Private Sub chkProtokolldruck_Click() If chkProtokolldruck.value = vbChecked Then g_blnPruefprotokoll = True Else g_blnPruefprotokoll = False End If End Sub Private Sub cmdCancel_Click() PrintStatus "Prüfung soll beendet werden." If m_laeuft Then MsgBox ("Sie müssen die Prüfung zuerst stoppen") PrintStatus "Sie müssen die Prüfung zuerst stoppen!" Else endDialog (IDCANCEL) End If End Sub Private Sub cmdDauerEnde_Click() PrintStatus "Dauerprüfung wird nach diesem Prüfgang beendet" cmdDauerEnde.caption = "Dauer-P endet !" cmdDauerEnde.Enabled = False m_DauerStop = True End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' FlexGrid Breite ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub FlexGridReadBreite() On Error GoTo Errorhandler Dim i As Integer Dim strBreite As String strBreite = g_App.Settings.GetBreiteTabelle(g_App.Mitarbeiter.getNr) If strBreite = "" Then strBreite = g_App.Settings.GetBreiteTabelle("Default") If strBreite = "" Then strBreite = "1755|1005|1005|1005|1005|1005|1005|1005|1005|1005|1005" Call g_App.Settings.SetBreiteTabelle(strBreite, "Default") End If End If For i = 0 To 10 m_arStrBreite(i) = Split(strBreite, "|")(i) If i < MSFlexGrid1.Cols Then MSFlexGrid1.ColWidth(i) = m_arStrBreite(i) End If Next Exit Sub Errorhandler: strBreite = "1755|1005|1005|1005|1005|1005|1005|1005|1005|1005|1005" Call g_App.Settings.SetBreiteTabelle(strBreite, g_App.Mitarbeiter.getNr) End Sub Private Sub cmdFlexgridRead_Click() FlexGridReadBreite End Sub Private Sub cmdFlexgridReset_Click() Dim i As Integer Dim strBreite As String On Error GoTo Errorhandler strBreite = g_App.Settings.GetBreiteTabelle("Default") If strBreite = "" Then strBreite = "1755|1005|1005|1005|1005|1005|1005|1005|1005|1005|1005" End If For i = 0 To 10 m_arStrBreite(i) = Split(strBreite, "|")(i) If i < MSFlexGrid1.Cols Then MSFlexGrid1.ColWidth(i) = m_arStrBreite(i) End If Next Exit Sub Errorhandler: strBreite = "1755|1005|1005|1005|1005|1005|1005|1005|1005|1005|1005" Call g_App.Settings.SetBreiteTabelle(strBreite, "Default") End Sub Private Sub cmdFlexgridWrite_Click() Dim strBreite As String Dim i As Integer For i = 0 To MSFlexGrid1.Cols - 1 m_arStrBreite(i) = CStr(MSFlexGrid1.ColWidth(i)) Next strBreite = "" For i = 0 To 10 If strBreite <> "" Then strBreite = strBreite & "|" End If strBreite = strBreite + m_arStrBreite(i) Next Call g_App.Settings.SetBreiteTabelle(strBreite, g_App.Mitarbeiter.getNr) End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' Ende FlexGrid Breite ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Private Sub cmdOK_Click() ' If m_laeuft Then ' ErrorMsg ("Sie müssen die Prüfung zuerst stoppen") ' Else ' endDialog (IDOK) ' End If 'End Sub Private Sub cmdQSollMinus_Click() m_DurchflussSollManuell = CDbl(Format(m_DurchflussSollManuell * 0.99, "0.000")) If Not g_ohneSPS Then m_SPS.SetQSoll m_DurchflussSollManuell End If PrintStatus "Nächster Durchfluss: " & m_DurchflussSollManuell lblQsoll.caption = m_DurchflussSollManuell End Sub Private Sub cmdQSollPlus_Click() m_DurchflussSollManuell = CDbl(Format(m_DurchflussSollManuell * 1.01, "0.000")) If Not g_ohneSPS Then m_SPS.SetQSoll m_DurchflussSollManuell End If PrintStatus "Nächster Durchfluss: " & m_DurchflussSollManuell lblQsoll.caption = m_DurchflussSollManuell End Sub Private Sub cmdSPSInfo_Click() Call g_App.getSPS().ActivateProTool End Sub Private Sub Abbruch(Optional strGrund As String = "") Dim dlg As frmAbbruch Set dlg = New frmAbbruch cmdVorzeitigBeenden.Enabled = False ' Abbruch-Button deaktivieren cmdStop.Enabled = False ' Flags setzen g_Abbruch = True m_laeuft = False If Not g_ohneSPS Then ' SPS zurücksetzen m_SPS.setBetrieb 0 m_SPS.AbwahlPumpe 1 m_SPS.AbwahlPumpe 2 m_SPS.AbwahlPumpe 3 m_SPS.AbwahlPumpe 5 m_SPS.SetNurMesseinsaetze False m_SPS.SetServoStellung 50 End If Call ResetPruefung lblQIst.caption = "" If g_blnVersuch = False Then dlg.m_strGrund = strGrund dlg.Show vbModal m_Pruefgang.Bemerkung = "Prüfungsabbruch: " & dlg.m_strGrund End If m_Pruefgang.save PrintStatus "Prüfungsabbruch: " & dlg.m_strGrund endDialog IDCANCEL End Sub Private Sub cmdStartKontinuierlich_Click() Dim i As Integer Dim Ende As Integer Dim tMax As Long Dim tMin As Long Dim Qmax As Double Dim Qmin As Double g_Abbruch = False cmdStop.Enabled = True If IsNumeric(txtPruefzeitMin.text) Then tMin = CLng(txtPruefzeitMin.text) txtPruefzeitMin.BackColor = RGB(255, 255, 255) Else MsgBox "die minimale Prüfzeit muß ein ganzzahliger Wert sein" txtPruefzeitMin.BackColor = RGB(255, 128, 128) txtPruefzeitMin.SetFocus Exit Sub End If If IsNumeric(txtPruefzeitMax.text) Then tMax = CLng(txtPruefzeitMax.text) If tMax < tMin Then MsgBox "die maximale Prüfzeit muß größer als die Minimale Prüfzeit sein!" txtPruefzeitMax.BackColor = RGB(255, 128, 128) txtPruefzeitMax.SetFocus Exit Sub End If txtPruefzeitMax.BackColor = RGB(255, 255, 255) Else MsgBox "die maximale Prüfzeit muß ein ganzzahliger Wert sein" txtPruefzeitMax.BackColor = RGB(255, 128, 128) txtPruefzeitMax.SetFocus Exit Sub End If If IsNumeric(txtFlowMin.text) Then Qmin = CDbl(txtFlowMin.text) If Qmin <= 0 Then MsgBox "der minimale Durchfluß muß größer 0 sein!" txtFlowMax.SetFocus Exit Sub End If Else MsgBox "der minimale Durchfluß muß ein Wert im Format '" & CDbl(11 / 10) & "' sein!" txtFlowMin.SetFocus Exit Sub End If If IsNumeric(txtFlowMax.text) Then Qmax = CDbl(txtFlowMax.text) If Qmax = 0 Or Qmax <= Qmin Then MsgBox "der maximale Durchfluß muß größer 0 und kleiner Qmin sein!" txtFlowMax.SetFocus Exit Sub End If Else MsgBox "der maximale Durchfluß muß ein Wert im Format '" & CDbl(11 / 10) & "' sein!" txtFlowMax.SetFocus Exit Sub End If m_Pruefgang.save lblTitle.caption = "kontinuierliche Prüfzähler Prüfung" cmdStartKontinuierlich.Enabled = False Ende = CInt(txtKontCount.text) For i = Ende To 1 Step -1 If g_Abbruch Then Exit Sub End If txtKontCount.text = i PrintStatus "kontinuierlicher Prüfgang " & Ende - i & "/" & Ende Call KontinuierlichePruefung Set m_Pruefgang = Nothing Set m_Pruefgang = New CPruefgang m_Pruefgang.save Next cmdStartKontinuierlich.Enabled = True End Sub Private Sub cmdStop_Click() cmdStop.Enabled = False Call Abbruch("") cmdStop.Enabled = True m_laeuft = False End Sub Private Sub ResetPruefung() cmdVorzeitigBeenden.Enabled = False cmdDauerEnde.caption = "Dauer-P beenden" cmdQSollPlus.Enabled = False cmdQSollMinus.Enabled = False cmdStartKontinuierlich.Enabled = True 'cmdOK.Enabled = True m_laeuft = False End Sub Private Sub cmdTest_Click() ' dient zum Testen der Funktion EichamtvorschriftUeberpruefen. Button ist unsichtbar. Dim Pruefpunkt As CPruefpunkt Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim i As Integer Dim j As Integer MSFlexGrid1.Rows = 11 MSFlexGrid1.Cols = 4 For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount Set Pruefpunkt = m_colUniquePP.Item(i) MSFlexGrid1.row = 0 MSFlexGrid1.col = i MSFlexGrid1.text = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ MSFlexGrid1.row = Einbauplatz.getNr Select Case i Case 1 Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Round((Rnd(1) * 3 * Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo - Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo), 1) Case 2 Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Round((Rnd(1) * 3 * Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo - Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo), 1) Case 3 Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Round((Rnd(1) * 3 * Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo - Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo), 1) End Select MSFlexGrid1.text = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler MSFlexGrid1.CellBackColor = vbWhite MSFlexGrid1.row = 10 MSFlexGrid1.text = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo & "/" & Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGu FehlerSpeichern Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler, Pruefzaehler, m_Pruefgang, Pruefpunkt, m_colUniquePP Next End If Next EichamtvorschriftUeberpruefen End Sub Private Sub cmdVorzeitigBeenden_Click() cmdVorzeitigBeenden.Enabled = False PrintStatus "Prüfung wird vorzeitig beendet" m_PruefpunktFertig = True End Sub Private Sub Form_Load() Dim nLeft As Integer Dim nTop As Integer FormActivated = False Me.Width = Screen.Width Me.Height = Screen.Height Call centerFormInScreen(Me) If gblnIsInIDE Then cmdTest.Visible = True End If If Not g_ohneSPS Then Set m_SPS = g_App.getSPS Else MsgBox "Es ist keine SPS verfügbar!" End If Set m_FMBus = g_App.getFMBus Set m_ColPumpen = g_App.Settings.getPumpen m_ZaehlerPP = 0 'cmdOK.Enabled = False cmdCancel.Enabled = True Dim Index As Integer For Index = 1 To 4 Set m_Behaelter = New CBehaelter If m_Behaelter.LoadFromIni(Index) Then Set m_ArrayBehaelter(Index) = m_Behaelter Else Set m_Behaelter = Nothing Exit For End If Next If m_PruefungsArtWaage = True Then Set m_Waage = g_App.getWaage m_Waage.SoftTaraReset End If ' todo: überflüssig? m_ArrayBehaelter(1).LoadFromIni (1) m_ArrayBehaelter(2).LoadFromIni (2) lblMsg.BackColor = &H8000000B txtBemerkung.Visible = False If g_App.Settings.GetOrSetIniWert("Vorbelegung", "Nachpruefung", "1") = "1" Then chkNachpruefung.value = vbChecked Else chkNachpruefung.value = vbUnchecked End If If g_blnVersuch Then chkAutobreite.value = vbUnchecked Else chkAutobreite.value = vbChecked End If End Sub 'Private Sub Form_Activate() ' If Not FormActivated Then ' FormActivated = True ' DoEvents ' Call Hauptpruefung ' End If 'End Sub Private Sub RegulierungInQt() Dim dlgRegulierung As frmRegulierungInQt Set dlgRegulierung = New frmRegulierungInQt Set dlgRegulierung.m_Regulierdaten = m_Regulierdaten Set dlgRegulierung.m_colUniquePP = m_colUniquePP Set dlgRegulierung.m_colEinbauplatz = m_colEinbauplatz Set dlgRegulierung.m_Referenzzaehler = m_Referenzzaehler dlgRegulierung.m_ersterPruefzaehlerNr = m_ersterPruefzaehlerNr dlgRegulierung.m_DurchflussSoll = m_DurchflussSoll dlgRegulierung.m_bUseLWL = m_bLichtwellenleiter ' Wichtig ! dlgRegulierung.m_ImpulswertigkeitPZ = m_ImpulswertigkeitLwl Debug.Print "RegulierPP: " & m_RegulierPruefpunkt.getQ dlgRegulierung.Show vbModal If m_nRet = IDCANCEL Then Call cmdStop_Click Exit Sub End If ' Jetzt in frmRegulierung: ' Sollwertvorgabedurch PC ' Entscheidung manuelles oder automatisches Regulieren ' Anzeige Sollwert, Daempfung am PC einstellbar anzeigen ' Sollwertweitergabe an SPS ' Voreinstellen der Fm85 ' Wert an FM85P übergeben ' WarteAufStartfreigabe (fehlte!) ' Pruefung und Pumpen Starten ' Regulieren: ' Abschaltbedingung ' Verhalten wenn sich ein Zaehler nicht regulieren läßt ' Manuelles SToppen der Pumpen muß möglich sein End Sub Private Sub Regulierung() Dim dlgRegulierung As frmRegulierung Set dlgRegulierung = New frmRegulierung Set dlgRegulierung.m_Regulierdaten = m_Regulierdaten Set dlgRegulierung.m_colUniquePP = m_colUniquePP Set dlgRegulierung.m_colEinbauplatz = m_colEinbauplatz Set dlgRegulierung.m_Referenzzaehler = m_Referenzzaehler dlgRegulierung.m_Durchfluss = m_DurchflussSoll If g_blnLWLfuerallePruefpunkte = True Then dlgRegulierung.m_ImpulswertigkeitPZ = m_ImpulswertigkeitLwl Else dlgRegulierung.m_ImpulswertigkeitPZ = m_ImpulswertigkeitPZ End If dlgRegulierung.m_bAutomatik = m_bAutomatik Debug.Print "RegulierPP: " & m_RegulierPruefpunkt.getQ dlgRegulierung.Show vbModal If m_nRet = IDCANCEL Then Call cmdStop_Click Exit Sub End If ' Jetzt in frmRegulierung: ' Sollwertvorgabedurch PC ' Entscheidung manuelles oder automatisches Regulieren ' Anzeige Sollwert, Daempfung am PC einstellbar anzeigen ' Sollwertweitergabe an SPS ' Voreinstellen der Fm85 ' Wert an FM85P übergeben ' WarteAufStartfreigabe (fehlte!) ' Pruefung und Pumpen Starten ' Regulieren: ' Abschaltbedingung ' Verhalten wenn sich ein Zaehler nicht regulieren läßt ' Manuelles SToppen der Pumpen muß möglich sein End Sub ' Hauptprüfung mit Referenzzaehler Public Sub Hauptpruefung() On Error GoTo Errorhandler Dim dummy As Variant Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim bFehlerermittelt As Boolean Dim Impulse As Long Dim AlleImpulseFertig As Boolean Dim PeriodendauerPZ As Long Dim PeriodendauerRZ As Long Dim PeriodendauerRefZ1 As Long Dim PeriodendauerRefZ2 As Long Dim ImpulswertigkeitPZ As Long Dim PPStartZeit As Date Dim k As Double Dim Fehler As Double Dim FehlerRefZ As Double Dim FehlerRefZA As Double Dim FehlerRefZB As Double Dim QIst As Double Dim PPNr As Integer Dim tmpPPNr As Integer Dim Temperatur As Double Dim PZCount As Integer Dim bImpulsTest As Boolean Dim bPPQIstSaved As Boolean Dim ImpulsTestZeit As Double Dim AnzahlZaehlerOhneImpulse As Integer Dim i As Integer Dim PPSollZeit As Integer Dim Gewicht As Double Dim BehaelterVolumen As Double Dim Waagengrenzwert As Double Dim GesZeit As Long Dim tmpPruefpunkt As CPruefpunkt Dim Voreinstellwert As Integer Dim strTemp As String Dim ImpulseTmp As Long Dim lngTemp As Long m_VorgabeLiterLWL = g_App.Settings.GetOrSetIniWert("Vorbelegung", "LWL_Volumen", "10") g_Abbruch = False cmdVorzeitigBeenden.Enabled = False If m_bKontinuierlich Then frameKontinuierlich.Visible = True Else frameKontinuierlich.Visible = False End If MSFlexGrid1.col = 0 MSFlexGrid1.row = 0 If (m_bRegulierungDurchfuehren Or m_bRegulierungInQtDurchfehhren) And Not m_RegulierPruefpunkt Is Nothing Then '------------------------------------------------------------------------ 'Prüfpunkt für Regulierung bestimmen Set m_Pruefpunkt = m_RegulierPruefpunkt m_DurchflussSoll = m_RegulierPruefpunkt.getQ lblQsoll.caption = m_DurchflussSoll DebugMsg "Regulierprüfpunkt Q= " & m_DurchflussSoll '------------------------------------------------------------------------ m_DurchflussSoll = m_RegulierPruefpunkt.getQ Else ' erster Durchfluss der normalen Prüfung m_DurchflussSoll = m_colUniquePP.Item(1).getQ DebugMsg "Q= " & m_DurchflussSoll End If If g_blnLWLfuerallePruefpunkte = True Then PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter True Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet." End If Else PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter False Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf Opto geschaltet." End If End If lblPruefgangNr.caption = m_Pruefgang.PruefgangNr ' neu RH 11.10.2010 m_blnVersuch_Prf_Automatisch_Beenden = False If g_blnVersuch And g_App.PruefstationNr = 2020 Then If MsgBox("Möchten Sie (nach der Prüfung) die Prüfung automatisch beenden (d.h. Strecke entleeren bei Messeinsätzen / sonst lösen) ?" & vbCrLf & "Klicken Sie auf 'Nein', wenn sie weder entleeren noch lösen wollen.", vbYesNo, " automatisch beenden ?") = vbYes Then m_blnVersuch_Prf_Automatisch_Beenden = True End If End If If Not g_ohneSPS Then ' Einstellung für Vergleichsprüfung-Modus in der SPS testen TestReferenzPrf: If m_SPS.IstRefZPrf Then dummy = MsgBox("Bitte SPS auf Hauptzähler Vergleichs-Prüfung stellen", vbOKCancel) If dummy = vbCancel Then endDialog (IDCANCEL) Exit Sub End If GoTo TestReferenzPrf End If If g_App.PruefstationNr <> 2006 Then ' an der P 2006 wird einer der Behälter auch von einer anderen Prüfstation benutzt PrintStatus "Beide Behälter leeren bis Prüfmenge nicht mehr erreicht..." m_SPS.WassserAblassen 0 ' beide Behälter leeren bis Prüfmenge nicht mehr erreicht Sleep 2000 m_SPS.WassserAblassen 3 Sleep 2000 If m_SPS.GrenzwertWaageErreicht Then Sleep 5000 Do While m_SPS.GrenzwertWaageErreicht Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop End If m_SPS.WassserAblassen 0 End If Else MsgBox "SPS: Test auf Hauptzähler Vergleichs-Prüfung, Wasser ablassen" End If ' Formular und Flags zurücksetzen cmdStop.Enabled = True m_laeuft = True ' Pruefgang Daten setzen mit Eigenschaften des ersten Zählers For Each Einbauplatz In m_colEinbauplatz Einbauplatz.setAktiv True Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then Set m_ersterPruefzaehler = Pruefzaehler m_ersterPruefzaehlerNr = Einbauplatz.getNr m_Pruefgang.Typ = Pruefzaehler.getIdentNrObj.getTyp m_Pruefgang.Typzusatz = Pruefzaehler.getIdentNrObj.getTypzusatz m_Pruefgang.Nennweite = Pruefzaehler.getIdentNrObj.getNennweite m_Pruefgang.Nenntemperatur = Pruefzaehler.getIdentNrObj.GetTemperatur PrintStatus "Neue Hauptpruefung" PrintStatus "------------------" PrintStatus "Pruefgang Daten:" PrintStatus "Typ: " & m_Pruefgang.Typ PrintStatus "Nennweite: " & m_Pruefgang.Nennweite PrintStatus "Nenntemperatur: " & m_Pruefgang.Nenntemperatur PrintStatus "Waage statt Referenzzaehler: " & CStr(m_PruefungsArtWaage) Exit For End If Next Einbauplatz ' Flag für PruefgangLang im Pruefgang-Objekt für Tabelle Pruefgang setzen: m_Pruefgang.PruefgangLang = m_bPruefgangLang PrintStatus "Pruefgang Lang: " & CStr(m_bPruefgangLang) If Not g_ohneSPS Then ' Vorwahl nur Messeinsaetze am Beginn der Pruefung, gilt für alle Prüfpunkte m_SPS.SetNurMesseinsaetze m_NurMesseinsaetze PrintStatus "Nur Messeinsätze:" & CStr(m_NurMesseinsaetze) End If ' Pruefpunkte absteigend sortieren nach Durchfluessen m_colUniquePP.sortQ If (m_Pruefgang.Nennweite = 50 Or m_Pruefgang.Nennweite = 80) And (m_Pruefgang.Typ = "MS" Or m_Pruefgang.Typ = "MMS") Then Call MeistreamEntlueften End If ' für den Pruefzaehler herangezogener Referenzzaehler Set m_Referenzzaehler = New CRefzaehler ' für den Referenzzaehler-Vergleich herangezogene Referenzzaehler Set m_ReferenzzaehlerA = New CRefzaehler If g_App.Settings.getAnzahlMIDGruppen > 1 Then Set m_ReferenzzaehlerB = New CRefzaehler End If ' Referenzzaehler in Abbhängigkeit vom Durchfluß und INI Datei bestimmen m_ReferenzzaehlerA.loadForDurchfluss m_DurchflussSoll, 1 If Not g_ohneSPS Then Temperatur = m_SPS.GetEinlaufTemperatur Else Temperatur = InputBox("Einlauf-Temperatur an der SPS messen:", "SPS nicht vorhanden", 22) End If lblVorlauftemperatur.caption = Format(Temperatur, "0.0") FehlerRefZA = m_ReferenzzaehlerA.letzterFehler(m_DurchflussSoll, Temperatur) If g_App.Settings.getAnzahlMIDGruppen > 1 Then m_ReferenzzaehlerB.loadForDurchfluss m_DurchflussSoll, 2 FehlerRefZB = m_ReferenzzaehlerB.letzterFehler(m_DurchflussSoll, Temperatur) ' Aktiven Referenzzähler auswählen Select Case g_App.Settings.getMIDGruppe Case 1 Set m_Referenzzaehler = m_ReferenzzaehlerA PrintStatus "Aktive RefZ-Gruppe ist A" FehlerRefZ = FehlerRefZA lblLabelFehlerRZ.caption = "Fehler RZ-A:" Case 2 Set m_Referenzzaehler = m_ReferenzzaehlerB PrintStatus "Aktive RefZ-Gruppe ist B" FehlerRefZ = FehlerRefZB lblLabelFehlerRZ.caption = "Fehler RZ-B:" Case Else ErrorMsg ("MID-Gruppe in INI Datei ungültig: MidGr. A gewählt") Set m_Referenzzaehler = m_ReferenzzaehlerA FehlerRefZ = FehlerRefZA lblLabelFehlerRZ.caption = "Fehler RZ-A:" End Select Else Set m_Referenzzaehler = m_ReferenzzaehlerA PrintStatus "Aktive RefZ-Gruppe ist A" FehlerRefZ = FehlerRefZA lblLabelFehlerRZ.caption = "Fehler RZ-A:" End If PrintStatus "Gewähltere RZ-Strang: " & m_Referenzzaehler.Nennweite & " für Q=" & m_DurchflussSoll lblFehlerRZ.caption = Format(FehlerRefZ, "0.00") '-------------------------------------- If Not m_PruefungsArtWaage Then ' Vergleichsprüfung: ' Referenzzaehler Daten für 1. Pruefpunkt speichern m_Pruefgang.PP_RefZSerienNr(1) = m_Referenzzaehler.SerienNr ' Impulswertigkeit des RefZ für FM85P überprüfen If m_Referenzzaehler.ImpulseQM = 0 Then ErrorMsg "Es konnten keine Impulswertigkeit des Referenzzählers mit der SerienNr " & m_Referenzzaehler.SerienNr & " festgestellt werden" Neueingabe: m_Referenzzaehler.ImpulseQM = Val(InputBox("Bitte geben Sie die Impulswertigkeit des Referenzzählers " & m_Referenzzaehler.SerienNr & " an")) If m_Referenzzaehler.ImpulseQM = 0 Then ErrorMsg ("Impulswertigkeit des Referenzzählers kann nicht 0 sein!") GoTo Neueingabe End If End If Else End If ' not Prüfungsart Waage '-------------------------------------- If Not g_ohneSPS Then ' Einstellung für Automatik-Modus in der SPS testen TestAutomatik: If Not m_SPS.IstAutomatik Then dummy = MsgBox("Bitte SPS auf Automatik stellen", vbOKCancel) If dummy = vbCancel Then endDialog (IDCANCEL) Exit Sub End If GoTo TestAutomatik End If m_SPS.setBetrieb 8 ' Bits zurücksetzen Sleep 300 m_SPS.setBetrieb 0 ' kein Start, kein Stop, kein Programmende m_letzter_Durchfluss = 0 Debug.Print "SPS Parameter werden für " & m_DurchflussSoll & " m³/h gesetzt um Prüfbereitschafts-Signal zu bekommen." If Not g_ohneSPS Then initSPSfuerDurchlauf initSPSfuerPP Else MsgBox "wegen Prüfbereitschaft: bitte " & m_DurchflussSoll & " m³/h einstellen!" End If If Not m_SPS.IstStreckePruefbereit_Neu Then ' Betrieb Vorbereiten If MsgBox("Die SPS meldet 'Strecke ist nicht Prüfbereit'! Bitte Überprüfen!" & vbCrLf & "Soll die Anlage jetzt spannen und füllen? Falls die SPS 'prüfbereit' anzeigt, klicken Sie auf 'nein'", vbYesNo Or vbDefaultButton2) = vbYes Then m_SPS.setBetrieb 1 ' If m_NurMesseinsaetze = False Then ' SendMail "Pruefstation" & g_App.PruefstationNr, "juergen.dreyer@sensus.com;reinhard.henning@sensus.com", "Benachrichtigung von Pruefstation " & g_App.PruefstationNr, "Messeinsätze=falsch !" & vbCrLf & "Strecke nicht prüfbereit!" ' End If LogIntoDB "Pruefstation " & g_App.PruefstationNr & ": NICHT PRÜFBEREIT => Füllen, Messeinsätze=" & m_NurMesseinsaetze, "Meldung_von_" & g_App.PruefstationNr PrintStatus "Betrieb vorbereiten: Spannen und Füllen..." End If Do While Not m_SPS.IstStreckeGefuellt Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop ' nach dem Füllen: Betrieb auf 0 Sleep 500 m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 '------------------------------------------------------------------------ PrintStatus "Warte auf Pruefbereitschaft der SPS..." Do While Not m_SPS.IstStreckePruefbereit Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop End If PrintStatus "Strecke ist Prüfbereit !" Else MsgBox ("SPS: Test auf Automatik und Prüfbereitschaft") End If ' not ohne SPS '--------------------------------------------------------------- If m_bKontinuierlich Then '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Kontinuierliche Prüfung '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call KontinuierlichePruefungInit Exit Sub End If '--------------------------------------------------------------- ' vorraussichtliche Pruefzeit ausrechnen tmpPPNr = 0 GesZeit = 0 For Each tmpPruefpunkt In m_colUniquePP.getCollection tmpPPNr = tmpPPNr + 1 If m_bPruefgangLang And tmpPPNr = m_colUniquePP.Count Then GesZeit = GesZeit + tmpPruefpunkt.GetTime * 3 Else GesZeit = GesZeit + tmpPruefpunkt.GetTime End If Next GesZeit = GesZeit * m_DauerpruefungAnzahl / 60 m_GesZeitZaehler = 0 lblGesZeit.caption = Format(m_GesZeitZaehler, "#0.0") & "/" & Format(GesZeit, "#0.0") '--------------------------------------------------------------- 'm_blnRegulierungWurdeDurchgefuehrt = False If g_blneRegisterPruefung Then ' auskommentoert, da lt. Martin Fechtner eine Regulierung mit eRegister auch für grosse Nennweiten an der P2006 möglich ist ''''''''''''''''''''''''''' '' If Not m_RegulierPruefpunkt Is Nothing And (m_bRegulierungDurchfuehren = True) Then '' ' Neu RH 5.4.2017 An der Prüfstation 2006 wird ab NW 200 die Regulierung mit einem mechanischen Werk vorangestellt '' If g_App.PruefstationNr = 2006 And m_ersterPruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite >= 200 Then '' ' SPS für Regulierung initialisieren: '' If Not g_ohneSPS Then '' Call initSPSfuerPP '' Call initSPSfuerDurchlauf '' '' Sleep 500, True '' ' Prüfung starten '' m_SPS.setBetrieb 2 '' Sleep 1000, True '' Call WarteAufSolldurchflussErreicht(2000) '' Else '' MsgBox "Bitte Durchfluss " & m_DurchflussSoll & "m³/h einstellen!", vbOKOnly, "keine SPS" '' End If '' '' Call Regulierung '' m_blnRegulierungWurdeDurchgefuehrt = True '' '' PrintStatus "Betrieb gestoppt" '' '' If Not g_ohneSPS Then '' m_SPS.setBetrieb 0 '' Sleep 500, True '' Else '' MsgBox "Bitte Durchfluss an der SPS stoppen", vbOKOnly, "keine SPS" '' End If '' '' MsgBox "Setzen Sie nun die eRegister Werke auf und klicken anschliessend auf 'OK'!", vbOKOnly '' PrintStatus "Durchfluss " & m_DurchflussSoll & " starten zur eRegister Prüfungsinitialisierung" '' '' If Not g_ohneSPS Then '' Call initSPSfuerPP '' Call initSPSfuerDurchlauf '' '' ' Prüfung starten '' m_SPS.setBetrieb 2 '' Else '' MsgBox "Bitte Durchfluss " & m_DurchflussSoll & "m³/h einstellen!", vbOKOnly, "keine SPS" '' End If '' End If '' End If '' ''''''''''''''''''''''''''' '--------------------------------------------------------------- ' eRegister Prüfungsinitialisierung '--------------------------------------------------------------- ' SPS initialisieren mit höchstem/erstem Durchfluss m_DurchflussSoll = getHoechsterDurchfluss() DebugMsg "Q= " & m_DurchflussSoll Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) PrintStatus "Gewähltere RZ-Strang: " & m_Referenzzaehler.Nennweite & " für Q=" & m_DurchflussSoll If Not g_ohneSPS Then PrintStatus "Betrieb gestoppt" Call initSPSfuerPP Call initSPSfuerDurchlauf ' Prüfung starten PrintStatus "Durchfluss " & m_DurchflussSoll & " starten zur eRegister Prüfungsinitialisierung" m_SPS.setBetrieb 2 m_letzter_Durchfluss = m_DurchflussSoll Else MsgBox "Durchfluss " & m_DurchflussSoll & " starten zur eRegister Prüfungsinitialisierung" End If ' anzeigen ab hier Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz frmeRegisterPrf.m_dblSolldurchfluss = m_DurchflussSoll frmeRegisterPrf.Show vbModeless, Me frmeRegisterPrf.Visible = True If Not frmeRegisterPrf.PruefungInitialisierung_NeuerVako() Then 'Prüfung abbrechen Unload frmeRegisterPrf If Not g_ohneSPS Then PrintStatus "Betrieb gestoppt" m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 End If endDialog IDCANCEL Exit Sub Else frmeRegisterPrf.Visible = False WindowsAPI.BringWindowToTop Me.hwnd DoEvents End If End If 'If m_blnRegulierungWurdeDurchgefuehrt = True Then ' ' falls die Regulierung schon stattgefunden hat, die Regulierung hier überspringen ' GoTo RegulierungFertig 'End If '--------------------------------------------------------------- ' Regulierung '--------------------------------------------------------------- If Not m_RegulierPruefpunkt Is Nothing And (m_bRegulierungDurchfuehren = True) Then ' Es gibt einen Regulierprüfpunkt und eine der beiden Regulierungsarten soll durchgeführt werden m_DurchflussSoll = m_RegulierPruefpunkt.getQ DebugMsg "Regulierprüfpunkt Q= " & m_DurchflussSoll lblQsoll.caption = m_DurchflussSoll Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) If Not g_ohneSPS Then If m_DurchflussSoll <> m_letzter_Durchfluss Then ' nur wenn Soll-Durchfluss anders als letzter Durchlfluss ist, Betreieb stoppen und mit neuen Einstellungen neu starten PrintStatus "Betrieb gestoppt" m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 Sleep 2000, True ' SPS für Regulierung initialisieren: Call initSPSfuerPP Call initSPSfuerDurchlauf Sleep 500, True ' Prüfung starten m_SPS.setBetrieb 2 m_letzter_Durchfluss = m_DurchflussSoll Sleep 1000, True End If Call WarteAufSolldurchflussErreicht(2000) Else MsgBox ("Bitte Regulier-Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen") End If If m_bRegulierungDurchfuehren = True Then ' **************************** REGULIERUNG **************************** If g_blneRegisterPruefung Then ' eRegister Regulierung frmeRegisterPrf.Visible = True frmeRegisterPrf.m_dblSolldurchfluss = m_DurchflussSoll If frmeRegisterPrf.Regulierung_durchfuehren() = False Then Unload frmeRegisterPrf 'Call Abbruch("eRegister-Regulierung abgebrochen") If Not g_ohneSPS Then m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 Else MsgBox "SPS: Betrieb stoppen", "keine SPS angeschlossen" End If endDialog IDCANCEL Exit Sub End If frmeRegisterPrf.Visible = False WindowsAPI.BringWindowToTop Me.hwnd DoEvents Else Call Regulierung End If ' *********************************************************************** If g_Abbruch = True Then Call Abbruch("manueller Abbruch während der Regulierung, Grund: ") Exit Sub End If PrintStatus "Regulierung beendet" Else PrintStatus "Regulierung (eRegister LED-Protokoll / OptoImpulse) übersprungen" End If If m_RegulierPruefpunkt.getQ <> m_colUniquePP.Item(1).getQ Or m_RegulierungVerwenden Then ' Wenn Regulierung nicht im höchsten Durchfluss ' dann wird beim ersten Prüfpunkt ein anderer Durchfluß eingestellt, ' deshalb Wasser stoppen ' Wenn der eigestellter Fehler beim Regulieren als Fehlerwert der Prüfung verwendet wird, ' braucht dieser Prüfpunkt nicht mehr verwendet werden ' Was ist aber, wenn beide Bedingungen zutreffen ? PrintStatus "Wasser stoppen, da Regulierung NICHT im diesem höchsten Durchfluss oder der Regulierwert als Fehler verwendet wird" ' Betrieb stop If Not g_ohneSPS Then m_SPS.setBetrieb 8 Sleep 500 m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 lblQIst.caption = "" PrintStatus "Wasser gestoppt" Sleep 1000 End If Else PrintStatus "Durchlauf beibehalten, da Regulierung im höchsten Durchfluss." End If ElseIf m_bRegulierungInQtDurchfehhren And Not m_RegulierPruefpunkt Is Nothing Then m_DurchflussSoll = m_RegulierPruefpunkt.getQ DebugMsg "Regulierprüfpunkt Q= " & m_DurchflussSoll lblQsoll.caption = m_DurchflussSoll Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) PrintStatus "Gewähltere RZ-Strang: " & m_Referenzzaehler.Nennweite & " für Q=" & m_DurchflussSoll If Not g_ohneSPS Then m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 Sleep 2000, True ' SPS für Regulierung initialisieren: Call initSPSfuerPP Call initSPSfuerDurchlauf Sleep 500, True ' Prüfung starten m_SPS.setBetrieb 2 m_letzter_Durchfluss = m_DurchflussSoll Call WarteAufSolldurchflussErreicht(2000) Else MsgBox ("Bitte Regulier-Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen") End If Call RegulierungInQt ' *********************************************************************** If g_Abbruch = True Then Call Abbruch("manueller Abbruch während der Regulierung in Qt, Grund: ") Exit Sub End If PrintStatus "Regulierung in Qt beendet" ' Betrieb stop If Not g_ohneSPS Then m_SPS.setBetrieb 8 Sleep 500 m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 lblQIst.caption = "" PrintStatus "Wasser gestoppt" Sleep 1000 Else MsgBox "Bitte Wasser stoppen!" End If Else PrintStatus "Regulierung wurde übersprungen da kein Regulier-PP definiert oder Regulierung nicht ausgewählt ist." End If 'RegulierungFertig: If g_blnLWLfuerallePruefpunkte = True Then PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter True Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet.", , "Keine SPS angeschlossen" End If Else PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter False Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf Opto geschaltet.", , "Keine SPS angeschlossen" End If End If DoEvents '----------------------------------------------------------------------------- ' Regulierung beendet '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Schleifenbeginn Dauerprüfung '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call DoStichprobensteuerung(m_colEinbauplatz) m_DruckMsg = "" m_DauerStop = False If m_DauerpruefungAnzahl > 1 Then cmdDauerEnde.Enabled = True End If For m_DauerpruefungZaehler = 1 To m_DauerpruefungAnzahl If m_DauerpruefungZaehler > 1 Then ' LWL Relais ggF. zurücksetzen If m_bLichtwellenleiter = True Or g_blnLWLfuerallePruefpunkte = False Then If Not g_ohneSPS Then PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." m_SPS.SetLichtwellenleiter False Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf Opto geschaltet.", vbOKOnly, "Keine SPS angeschlossen" End If End If End If ' Pruefgang wird komplett, aber ohne Regulierung wiederholt PrintStatus "Dauerprf.: " & m_DauerpruefungZaehler & " / " & m_DauerpruefungAnzahl lblDauer.caption = m_DauerpruefungZaehler & " / " & m_DauerpruefungAnzahl PPNr = 0 ' Zaehler für Pruefpunkte , 1 = Qmax, If m_DauerpruefungZaehler > 1 Then m_Pruefgang.save ' Neuer Pruefgang-Eintrag in der Datenbank Set m_Pruefgang = Nothing Set m_Pruefgang = New CPruefgang m_Pruefgang.Typ = m_ersterPruefzaehler.getIdentNrObj.getTyp m_Pruefgang.Nennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite m_Pruefgang.Nenntemperatur = m_ersterPruefzaehler.getIdentNrObj.GetTemperatur PrintStatus "neuer Prüfgang (ohne Regulierung) gestartet" End If ' Pruefgang abspeichern Call MesseWetterdaten m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur m_Pruefgang.RelativeFeuchte = g_dblLuftFeuchte m_Pruefgang.LuftDruck = g_dblLuftDruck If m_Pruefgang.RelativeFeuchte > 0 Then PrintStatus "Relative Luft Feuchte: " & Format(m_Pruefgang.RelativeFeuchte, "0.0") End If If m_Pruefgang.Lufttemperatur > 0 Then PrintStatus "Lufttemperatur: " & Format(m_Pruefgang.Lufttemperatur, "0.0") End If If m_Pruefgang.LuftDruck > 0 Then PrintStatus "LuftDruck: " & m_Pruefgang.LuftDruck & " mbar" End If 'End If ' Prüfgang das erste mal speichern erzeugt Prüfgang Nr m_Pruefgang.save PrintStatus "Pruefgang Daten gesichert." lblPruefgangNr.caption = m_Pruefgang.PruefgangNr ' Listbox mit allen Durchflüssen füllen lstPruefpunkte.Clear For Each tmpPruefpunkt In m_colUniquePP.getCollection lstPruefpunkte.AddItem Format(tmpPruefpunkt.getQ, "0.00000") Next ' Anzahl der Pruefzähler zählen, wird in Pruefgang Tabelle eingetragen ' FlexGrid dimensionieren MSFlexGrid1.Clear MSFlexGrid1.RowHeight(0) = 445 PZCount = 0 MSFlexGrid1.ColWidth(0) = 1800 MSFlexGrid1.Cols = 1 + m_colUniquePP.Count MSFlexGrid1.row = 0 MSFlexGrid1.col = 0 MSFlexGrid1.text = "SNr.\[m³/h]" For Each Einbauplatz In m_colEinbauplatz Debug.Print "Einbauplatz " & Einbauplatz.getNr & " ist aktiv: " & Einbauplatz.getAktiv Einbauplatz.setAktiv True Set Pruefzaehler = Einbauplatz.getPruefzaehler MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = 0 If Not Pruefzaehler Is Nothing Then If Einbauplatz.m_ImpulseQM = 0 Then ' wenn Impulswertigkeit für diesen Zähler nicht gesetzt ist, ' dann Default Impulswertigkeit verwenden Einbauplatz.m_ImpulseQM = m_ImpulswertigkeitPZ End If If Einbauplatz.m_ImpulseLwl = 0 Then ' wenn Lwl Impulswertigkeit für diesen Zähler nicht gesetzt ist, ' dann Default Impulswertigkeit verwenden Einbauplatz.m_ImpulseLwl = m_ImpulswertigkeitLwl End If If Pruefzaehler.m_strKundeneigeneSerienNr <> "" And m_blnKundeneigeneSerienNrAnzeigen Then MSFlexGrid1.text = " " & Trim(Pruefzaehler.m_strKundeneigeneSerienNr) Else MSFlexGrid1.text = FormatSerienNr(Pruefzaehler.getSerienNr) End If PZCount = PZCount + 1 ' Änderung am 22.8.2002 Reinhard Henning: Pruefzaehler.getAuftragPositionSerienNr.setPruefgangNr m_Pruefgang.PruefgangNr Pruefzaehler.getAuftragPositionSerienNr.setEinbauplatzNr Einbauplatz.getNr Pruefzaehler.getAuftragPositionSerienNr.setPruefgangDatum m_Pruefgang.Datum ' erst mal zurücksetzen Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 22 ' Hochzählen des Wiederholungszählers (-1 = Original Datensatz, 0 = 1. Pruefung, 1 = 1.Wdh, 2 = 2.Wdh , usw. Pruefzaehler.getAuftragPositionSerienNr.setWiederholungen Pruefzaehler.getAuftragPositionSerienNr.getWiederholungen + 1 ' Bemerkungen brauchen nicht vererbt werden ??? Todo: klären ' Pruefzaehler.getAuftragPositionSerienNr.setBemerkung "" ' alle anderen Angaben in AuftragPositionSeriennr werden von der vorherigen Wiederholung vererbt Pruefzaehler.getAuftragPositionSerienNr.setAnlageDatum Now() Pruefzaehler.getAuftragPositionSerienNr.setAnlageMitarbeiterNr g_App.Mitarbeiter.getNr 'Angaben für Änderung löschen Pruefzaehler.getAuftragPositionSerienNr.setAenderungDatum Empty Pruefzaehler.getAuftragPositionSerienNr.setAenderungMitarbeiterNr Empty ' Metrologische Klasse unter der diese Prüfung durchgeführt wurde Pruefzaehler.getAuftragPositionSerienNr.setMetrolog Pruefzaehler.getPruefklasseKZ ' Rückwärtsprüfung im StatusFlag als Bit 1 (= 2^1 = 2) speichern Pruefzaehler.getAuftragPositionSerienNr.AlterStatusFlag StatusFlagBits.StatusFlagWert_Rueckwaerts_geprueft, m_blnRueckwaertspruefung ' AuftragPositionsobjekt als neuen Datensatz speichern PrintStatus "neuer Datensatz in AuftragPosSerNr mit Pruefgang=" & m_Pruefgang.PruefgangNr & ", SerNr=" & FormatSerienNr(Pruefzaehler.getSerienNr) & ", Wdh=" & Pruefzaehler.getAuftragPositionSerienNr.getWiederholungen & ", Rueckwärts=" & m_blnRueckwaertspruefung Pruefzaehler.getAuftragPositionSerienNr.SetEinbaulage Einbauplatz.m_strEinbaulage Pruefzaehler.getAuftragPositionSerienNr.save True End If Next Einbauplatz If Not g_blnVersuch Then MSFlexGrid1.Rows = 12 MSFlexGrid1.TextMatrix(11, 0) = "Fehlerrahmen" tmpPPNr = 0 MSFlexGrid1.row = MSFlexGrid1.Rows - 1 For Each m_Pruefpunkt In m_colUniquePP.getCollection 'Für alle Prüfpunkte der aktuellen Prüfung tmpPPNr = tmpPPNr + 1 MSFlexGrid1.col = tmpPPNr If m_Pruefpunkt.getFGo = -m_Pruefpunkt.getFGu Then MSFlexGrid1.text = MSFlexGrid1.text & " +/-" & Round(m_Pruefpunkt.getFGo, 2) Else MSFlexGrid1.text = MSFlexGrid1.text & " " & Round(m_Pruefpunkt.getFGo, 2) & "/" & Round(m_Pruefpunkt.getFGu, 2) End If Next End If For i = 1 To m_colUniquePP.Count MSFlexGrid1.row = 0 MSFlexGrid1.col = i MSFlexGrid1.text = FormatDurchfluss(m_colUniquePP.Item(i).getQ) MSFlexGrid1.CellAlignment = flexAlignGeneral Next 'Breite der Spalte bestimmen If chkAutobreite.value = vbChecked Then AutoSpaltenBreite MSFlexGrid1, lblAutosize, 1 Else Call FlexGridReadBreite End If m_Pruefgang.Anzahl = PZCount PrintStatus "Anzahl eingebaute Pruefzähler: " & CStr(PZCount) lblPruefgangNr.caption = m_Pruefgang.PruefgangNr ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Schleife für alle Pruefpunkte ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For Each m_Pruefpunkt In m_colUniquePP.getCollection ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' nächster Pruefpunkt ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For i = 1 To 10 lblVerbleib(i).caption = "" lblPZImpulse(i).caption = "" Next ' Alle Einbauplätze wieder aktivieren For Each Einbauplatz In m_colEinbauplatz lblPZImpulse(Einbauplatz.getNr).BackColor = &H8000000F lblVerbleib(Einbauplatz.getNr).BackColor = &H8000000F Einbauplatz.setAktiv True Einbauplatz.m_Versuche = 0 Next DoEvents If g_Abbruch Then Exit Sub End If PrintStatus "--------------------------------------" ' Für diesen PP wurde noch kein QIst gespeichert bPPQIstSaved = False ' Zähler für PP in PP Collection: PPNr = 1 bei Qmax PPNr = PPNr + 1 m_DurchflussSoll = m_Pruefpunkt.getQ PrintStatus "nächster Pruefpunkt (" & PPNr & " / " & m_colUniquePP.Count & "): " & m_DurchflussSoll ' Dauer dieses Pruefpunktes m_Pruefzeit = m_Pruefpunkt.GetTime PrintStatus "Soll-Pruefzeit für diesen PP: " & m_Pruefzeit & " sec" m_DurchflussSoll = m_Pruefpunkt.getQ g_dblWasserdruck = -1 lblQsoll.caption = m_DurchflussSoll ' Durchfluß ist nun änderbar cmdQSollPlus.Enabled = True cmdQSollMinus.Enabled = True m_DurchflussSollManuell = m_DurchflussSoll ' Balkenanzeige in der Liste der Durchflüsse aktualisieren For i = 0 To lstPruefpunkte.ListCount - 1 If FormatDurchfluss(lstPruefpunkte.List(i)) = FormatDurchfluss(m_DurchflussSoll) Then lstPruefpunkte.Selected(i) = True Else lstPruefpunkte.Selected(i) = False End If Next ' Referenzzähler wechseln ' ---------------------- ' für den Referenzzaehler-Vergleich herangezogene Referenzzaehler Set m_ReferenzzaehlerA = New CRefzaehler Set m_ReferenzzaehlerB = New CRefzaehler ' Referenzzaehler in Abbhängigkeit vom Durchfluß und INI Datei bestimmen m_ReferenzzaehlerA.loadForDurchfluss m_DurchflussSoll, 1 If Not g_ohneSPS Then Temperatur = m_SPS.GetEinlaufTemperatur() Else Temperatur = InputBox("Einlauf-Temperatur an der SPS messen:", "SPS nicht vorhanden", 22) End If lblVorlauftemperatur.caption = Format(Temperatur, "0.0") FehlerRefZA = m_ReferenzzaehlerA.letzterFehler(m_DurchflussSoll, Temperatur) If g_App.Settings.getAnzahlMIDGruppen > 1 Then m_ReferenzzaehlerB.loadForDurchfluss m_DurchflussSoll, 2 FehlerRefZB = m_ReferenzzaehlerB.letzterFehler(m_DurchflussSoll, Temperatur) PrintStatus "Letzter Fehler des Referenzzählers A(interpoliert): " & Format(FehlerRefZA, "0.00") & "%" PrintStatus "Letzter Fehler des Referenzzählers B(interpoliert): " & Format(FehlerRefZB, "0.00") & "%" ' Aktiven Referenzzähler auswählen Select Case g_App.Settings.getMIDGruppe Case 1 Set m_Referenzzaehler = m_ReferenzzaehlerA PrintStatus "Aktive RefZ-Gruppe ist A" FehlerRefZ = FehlerRefZA Case 2 Set m_Referenzzaehler = m_ReferenzzaehlerB PrintStatus "Aktive RefZ-Gruppe ist B" FehlerRefZ = FehlerRefZB Case Else ErrorMsg ("MID-Gruppe in INI Datei ungültig: MidGr. A gewählt") Set m_Referenzzaehler = m_ReferenzzaehlerA FehlerRefZ = FehlerRefZA End Select Else Set m_Referenzzaehler = m_ReferenzzaehlerA PrintStatus "einzige RefZ-Gruppe ist A" FehlerRefZ = FehlerRefZA End If '''''''''''''' 'neu RH 26.7.2006 strTemp = "Die letzte Prüfung des Referenzzählers (Nennweite " & m_Referenzzaehler.Nennweite & ") für diesen Prüfpunkt war am " & Format(m_Referenzzaehler.DatumDesFehlers, "dd.mm.yyyy") If (m_Referenzzaehler.DatumDesFehlers * 1) < (Now() - 7) * 1 Then strTemp = strTemp & " und liegt länger als 7 Tage zurück!" ExtraMessage strTemp Else ExtraMessage "" End If DebugMsg strTemp '''''''''''''' lblFehlerRZ.caption = Format(FehlerRefZ, "0.00") ' Referenzzaehler Daten für Pruefpunkt speichern m_Pruefgang.PP_RefZSerienNr(PPNr) = m_Referenzzaehler.SerienNr If m_RegulierPruefpunkt Is Nothing Then Set m_RegulierPruefpunkt = New CPruefpunkt If m_DurchflussSoll = 0 Then DebugMsg "Durchfluß ist 0, wird übersprungen" ElseIf m_DurchflussSoll = m_RegulierPruefpunkt.getQ And m_RegulierungVerwenden Then ' ###################################################################################### PrintStatus "Durchfluß ist Regulierdurchfluß und Regulierwert wird als Fehler verwendet => Fehler speichern" Fehler = m_Regulierdaten.getSPSSollwertRegulierung If Not g_ohneSPS Then ' Prüfgang Daten in DB synchronisieren QIst = m_SPS.getQIst Else ' QIst = m_DurchflussSoll End If m_Pruefgang.PP_Soll(PPNr) = m_DurchflussSoll m_Pruefgang.PP_Zeit(PPNr) = 0 m_Pruefgang.PP_Ist(PPNr) = m_DurchflussSoll If PPNr = 1 Then If Not g_ohneSPS Then Temperatur = m_SPS.GetEinlaufTemperatur lblVorlauftemperatur.caption = Format(Temperatur, "0.0") Else End If m_Pruefgang.Vorlauftemperatur = Temperatur PrintStatus "Temperatur: " & Format(Temperatur, "0.00") & " °C" End If For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If (Not Pruefzaehler Is Nothing) Then If (Not Pruefzaehler.getPruefpunkte Is Nothing) Then If (Pruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) = True) Then Call FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, m_Pruefpunkt, m_colUniquePP) MSFlexGrid1.col = PPNr MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.text = "Reg " & Format(Fehler, "0.00") ' Fehler speichern für Druck For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount If Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ = m_DurchflussSoll Then Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Fehler End If Next ' Bei Grenzwertüberschreitung Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr ' If GrenzwertUeberschritten(m_Pruefpunkt.getFGo, Fehler, m_Pruefpunkt.getFGu) Then ' AuftragPositionSerienNr.setStatusFertigung 25 ' AuftragPositionSerienNr.save ' PrintStatus "Grenzwert überschritten. " & m_Pruefpunkt.getFGu & " < " & Fehler & " < " & m_Pruefpunkt.getFGo & " ?" ' MSFlexGrid1.CellBackColor = &HC0C0FF ' End If ' Neu RH 14.05.2007: PrintStatus "Grenzwert überprüfen für " & Pruefzaehler.getSerienNr & " bei Q= " & m_DurchflussSoll & ": FGo=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & ", Fgu=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & ", F=" & Round(Fehler, 2) If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then AuftragpositionSerienNr.setStatusFertigung 25 AuftragpositionSerienNr.save PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !" If chkNachpruefung.value = vbUnchecked Then MSFlexGrid1.CellBackColor = &HC0C0FF End If End If PrintStatus " ermittelter Fehler = " & Format(Fehler, "0.00") & "%" End If ' Prüfzähler hat diesen Prüfpunkt End If ' Prüfpunkte vorhanden End If 'Pruefzaehler vorhanden Next Einbauplatz 'In m_colEinbauplatz m_Pruefgang.save ' ###################################################################################### Else PrintStatus "Dieser Prüfpunkt wird geprüft (Regulierwert-Fehler wird nicht für diesen Prüfpunkt verwendet)." ' Schleife PruefgangLang initialisieren ZaehlerPruefgangLang = 0 PruefgangLangPruefpunktWiederholen = False SchleifenanfangPruefgangLang: ' SchleifenanfangPruefgangLang: ' PPNr und Q bleibt ' ----------------------------- PrintStatus "Schleifenbeginn Prüfgang Lang, Zaehler=" & ZaehlerPruefgangLang lblLang.caption = ZaehlerPruefgangLang If Not m_PruefungsArtWaage Then PrintStatus "MIDs verwenden" ' Vergleichsprüfung gegen RefZ: erst Pumpen starten, dann messen mit FM85 ' SPS für diesen Prüfpunkt initialisieren: ' FM85 für Periodendauermessung für diesen Prüfpunkt initialisieren If m_letzter_Durchfluss <> m_DurchflussSoll Then ' Da neuer Pruefpunkt, Pruefpunkt neu initialisieren If Not g_ohneSPS Then ' u.a. Pumpen stoppen Call initSPSfuerPP ' Durchfluß statt Behälter Call initSPSfuerDurchlauf ' WarteAufStartfreigabe PrintStatus "checke Pruefbereitschaft der SPS " Do While Not m_SPS.IstStreckePruefbereit Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop ' Vergleichsprüfung gegen RefZ ' Pruefung starten PrintStatus "Prüfung starten" m_SPS.setBetrieb 0 Sleep 11500, True m_SPS.setBetrieb 2 m_letzter_Durchfluss = m_DurchflussSoll Call WarteAufSolldurchflussErreicht(2000) Else MsgBox ("Bitte Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen") End If ' ohne SPS Else If m_RegulierungVerwenden Then PrintStatus "erster Prüfpunkt = Regulierprüfpunkt: Pumpen laufen lassen!" Else If g_bln_Pruefung_nach_MID Then Call WarteAufSolldurchflussErreicht_bei_Prf_nach_MID(2000, PPNr, m_DurchflussSoll) Else WarteAufSolldurchflussErreicht 2000 End If End If End If If Not g_ohneSPS Then ' Durchflußanzeige RefIstWert korrigiert QIst = m_SPS.getQIst PrintStatus "Solldurchfluss erreicht bei Q=" & Format(QIst, "0.000") Else ' ohne SPS QIst = m_DurchflussSoll End If lblQIst.caption = Format(QIst, "0.000") If g_blneRegisterPruefung Then If m_Pruefpunkt.m_bln_eRegisterPruefung Then ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' dieser Pruefpunkt soll mit einer eRegisterMessung geprüft werden ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' frmeRegisterPrf.Visible = True frmeRegisterPrf.m_dblSolldurchfluss = m_DurchflussSoll frmeRegisterPrf.m_lSollPruefzeit_s = m_Pruefpunkt.GetTime frmeRegisterPrf.m_PPNr = PPNr Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz m_Pruefgang.PP_Ist(PPNr) = QIst m_Pruefgang.PP_Soll(PPNr) = m_DurchflussSoll m_Pruefgang.Bemerkung = "eRegister Prf" m_Pruefgang.save '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''' Eigentliche Messung '''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Not frmeRegisterPrf.eRegister_PP_Messung_durchfuehren(Not m_bln_Alle_PP_mit_eRegister) Then ' Bei Abbruch SPS Betrieb stoppen Unload frmeRegisterPrf If Not g_ohneSPS Then m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 End If endDialog IDCANCEL WindowsAPI.BringWindowToTop Me.hwnd Exit Sub Else ' Messung hat geklappt frmeRegisterPrf.Visible = False WindowsAPI.BringWindowToTop Me.hwnd DoEvents End If m_Pruefgang.PP_Ist_V(PPNr) = frmeRegisterPrf.m_dblRefzDurchfluss * frmeRegisterPrf.m_lSollPruefzeit_s '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' nach dem Qmax soll Wassertemperatur für Prüfgang ermittelt und gespeichert werden If PPNr = 1 Then If Not g_ohneSPS Then Temperatur = m_SPS.GetEinlaufTemperatur Else Temperatur = InputBox("Bitte Temperatur eingeben", "Keine SPS angeschlossen", "22") End If lblVorlauftemperatur.caption = Format(Temperatur, "0.0") m_Pruefgang.Vorlauftemperatur = Temperatur PrintStatus "Temperatur: " & Format(Temperatur, "0.00") & " °C" End If m_Pruefgang.save '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sleep 2000, True For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If Not Einbauplatz.eRegister Is Nothing Then MSFlexGrid1.col = PPNr MSFlexGrid1.row = Einbauplatz.getNr Fehler = Einbauplatz.eRegister.m_dblFehler MSFlexGrid1.text = Format(Fehler, "0.00") 'Round(Fehler, 2) Call FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, m_Pruefpunkt, m_colUniquePP) ' Fehler speichern für Druck For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount If Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ = m_DurchflussSoll Then Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Fehler End If Next Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr ' Bei Grenzwertüberschreitung PrintStatus "Grenzwert (eRegister) überprüfen für " & Pruefzaehler.getSerienNr & " bei Q= " & m_DurchflussSoll & ": FGo=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & ", Fgu=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & ", F=" & Round(Fehler, 2) If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then AuftragpositionSerienNr.setStatusFertigung 25 AuftragpositionSerienNr.save PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !" If chkNachpruefung.value = vbUnchecked Then MSFlexGrid1.CellBackColor = &HC0C0FF End If Else ' Fehler ist INNERHALB der Fehlergrenzen End If End If End If Next m_Pruefgang.PP_Info(PPNr, PP_INFO_LWL) = False ' Dieser Pruefpunkt wird vom eRegister gemessen, nicht LWL GoTo FehlerSpeichernFertig End If End If FM85FuerPeriodendauermessungInit: If g_Abbruch Then Exit Sub End If ' FM85 für Periodendauermessung für diesen Pruefpunkt initialisieren PrintStatus "FM85 für Periodendauermessung für diesen Pruefpunkt initialisieren" If m_ImpulswertigkeitPZ > 0 Then Call initFM85fuerPP Else Call initFM85fuerPPundImpulswertigkeit End If ' speichern in Prüfgang Tabelle, ob LWL verwendet wurde: m_Pruefgang.PP_Info(PPNr, PP_INFO_LWL) = m_bln_LWL_PP lblQIst.BackColor = &H8000000F ' RH 10.3.2004 lblZeit.caption = "" m_Startzeit = GetTickCount() Else PrintStatus "Waage verwenden" 'PruefungsArt ist Waage ' ZeitSoll, Durchfluß -> SollVolumen ' -> Behälter ' -> Waage ' Behälter leeren ' erst Messung mit FM85 , ' dann Pumpen starten ' Todo: Behälter Zuleitung füllen ' Messung gegen Waage/Behälter in der SPS vorbereiten ' --------------------------------------------------- ' Betrieb stoppen und Pumpen Abwählen ' Durchfluß vorgabe ' Pumpe auswählen und anwählen ' Regelart und Regel-Position setzen ' MID Strang setzen If g_Abbruch Then Exit Sub End If ' Pruefung mit Waage ' -------------------- ' geschätzes Volumen in Litern ' Behälterauswahl ' Waagenauswahl ' Behälter leeren ' Tara ' Waagengrenzwert setzen Call WaageVorbereitenFuerPP If g_Abbruch Then Exit Sub End If If Not g_ohneSPS Then Call initSPSfuerPP End If If g_Abbruch Then Exit Sub End If ' If Not g_ohneSPS Then ' Call initSPSfuerWaage ' End If ' Anzeige Füllmenge lblGewicht.caption = "" ' lblVolA.Caption = "" ' lblVolB.Caption = "" ' lblImpulseRZ1.Caption = "" ' lblImpulseRZ2.Caption = "" ' lblFehlerA.Caption = "" ' lblFehlerB.Caption = "" ' Sollvolumen für Waagengrenzwert: ' m_VolumenSoll = (m_Pruefzeit / 3600) * m_DurchflussSoll ' lblSollV.Caption = Format(m_VolumenSoll * 1000, "0") ' Waagengrenzwert in Litern entspricht kg ' Waagengrenzwert = m_VolumenSoll * 1000 - m_DurchflussSoll * m_Behaelter.m_nUeberlaufFaktor ' PrintStatus "setze Waagengrenzwert: " & Waagengrenzwert & " kg" ' lblGrenzwert.Caption = Format(Waagengrenzwert, "0") ' Grenzwert an Waage übergeben ' m_Waage.SetNettoGrenzwert1 Waagengrenzwert, m_Behaelter.m_Genauigkeit ' Warte auf Startfreigabe If Not g_ohneSPS Then PrintStatus "Warte auf Startfreigabe" Do While Not m_SPS.IstStreckePruefbereit Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop End If ' Impulszählung programmieren Call initFM85fuerPP_Waage If g_Abbruch Then Exit Sub End If lblZeit.caption = "" m_Startzeit = GetTickCount() If Not g_ohneSPS Then ' Prüfung starten m_SPS.setBetrieb 0 Sleep 500, True m_SPS.setBetrieb 2 m_letzter_Durchfluss = m_DurchflussSoll PrintStatus "Pumpe läuft, Regel-Ventil ist noch geschlossen" Do While Not ((m_Pumpe.GetStatus And 4) = 4) Sleep 500, True Loop PrintStatus "Durchfluß geregelt nach " & Int((GetTickCount() - m_Startzeit) / 1000) & " s" End If End If ' wieder beide Prüfungsarten (Waage und Vergleich) ' Anzeige diverser SPS Parameter: ' Betriebsanzeige Pumpen, ' Pumpendrehzahl, ' Leistungsanzeige FU, ' Pruefgang Daten aktualisieren m_Pruefgang.PP_Soll(PPNr) = m_DurchflussSoll ' Prüfgang Daten in DB synchronisieren m_Pruefgang.save AnzahlZaehlerOhneImpulse = 0 bImpulsTest = False ' Flag für Beendigung dieses Pruefpunktes zurücksetzen m_PruefpunktFertig = False 'cmdVorzeitigBeenden.Enabled = False cmdVorzeitigBeenden.Enabled = True ' neu RH 6.5.2010 ' Schleife: Einsprung solange Messung läuft PrintStatus "Messung des Prüfpunkts gestartet" PPStartZeit = Now() Do While Not m_PruefpunktFertig Messung: ' Initialisieren des Flags zur Beendung der Prüfung AlleImpulseFertig = True For Each Einbauplatz In m_colEinbauplatz If g_Abbruch = True Then Exit Sub DoEvents If g_Abbruch Then Exit Sub ' Zeit anzeigen PP_Ist_Zeit = Int((GetTickCount() - m_Startzeit) / 1000) lblZeit.caption = Str(PP_Ist_Zeit) & " / " & Str(m_Pruefzeit) lblGesZeit.caption = Format((m_GesZeitZaehler + PP_Ist_Zeit) / 60, "#0.0") & "/" & Format(GesZeit, "#0.0") If ((m_GesZeitZaehler + PP_Ist_Zeit) / 60) < GesZeit And GesZeit <> 0 Then ProgressBar1.value = 100 * (m_GesZeitZaehler + PP_Ist_Zeit) / (60 * GesZeit) Else ProgressBar1.value = 1 End If If Not g_ohneSPS Then lblQIst.caption = Format(m_SPS.getQIst, "0.000") Else lblQIst.caption = "?" End If Set Pruefzaehler = Einbauplatz.getPruefzaehler 'Geändert Andreas Pfeiffer am 17.05.2004 'Um einen Zähler, der innerhalb der doppelten Pulsabstandszeit 'keinen Impuls gesendet hat, weiter zu analysieren, wird in diese 'Bedingte Schleife gesprungen, da ein solcher Zähler als inaktiv 'geschalten wurde. If Einbauplatz.m_Versuche > 0 And Einbauplatz.getAktiv = True And (Not Pruefzaehler Is Nothing) Then ' Dieser Zähler hat mind. einmal in Folge keine Impulse geliefert ' FM85P mit entspr. Adresse ansprechen Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "U") ' m_FMBus.send "**" & Einbauplatz.getNr & "@" ' m_FMBus.receive (500) ' ' Pruefzaehlerimpulse auslesen ' m_FMBus.send "U" ' Impulse = Val("&H0000" & m_FMBus.receive(500)) PrintStatus "Anzahl Impulse von Einbauplatz " & Einbauplatz.getNr & ": " & Impulse & " im " & Einbauplatz.m_Versuche & ". Versuch" End If If (Not Pruefzaehler Is Nothing) And (Einbauplatz.getAktiv = True) Then ' Pruefzaehler ist eingebaut If Not Pruefzaehler.getPruefpunkte Is Nothing Then If (Pruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) = True) Then ' Prüfzähler hat diesen Prüfpunkt ' ' FM85P mit entspr. Adresse ansprechen ' m_FMBus.send "**" & Einbauplatz.getNr & "@" ' m_FMBus.receive (500) ' ' Pruefzaehlerimpulse auslesen ' m_FMBus.send "U" ' Impulse = Val("&H0000" & m_FMBus.receive(500)) ' Pruefzaehlerimpulse auslesen Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "U") ' Todo: Nur zeigen wenn Waage If m_PruefungsArtWaage Then lblPZImpulse(Einbauplatz.getNr).caption = Str(Impulse) End If If m_ImpulswertigkeitPZ > 0 Then ' Zeit in s in der der erste Impuls erwartet wird ImpulsTestZeit = (3600 / (m_DurchflussSoll * m_ImpulswertigkeitPZ)) * 2 'PrintStatus "Pulsabstand : " & Format(ImpulsTestZeit / 2, "0.0") & " s min." Else ImpulsTestZeit = (3600 / (m_DurchflussSoll * Einbauplatz.m_ImpulseQM)) * 2 'PrintStatus "Pulsabstand für Zähler " & Einbauplatz.getNr & " : " & Format(ImpulsTestZeit / 2, "0.0") & " s min." End If 'PrintStatus "Wartezeit auf 1. Impuls = " & Format(ImpulsTestZeit, "0.0") & " s" If PP_Ist_Zeit > ImpulsTestZeit And Not m_PruefungsArtWaage Then ' Jetzt müsste eigentlich mindestens ein Impuls gekommen sein If Impulse = 0 And bImpulsTest = False Then 'Hier ist kein Impuls gekommen lblPZImpulse(Einbauplatz.getNr).BackColor = &HC0C0FF lblVerbleib(Einbauplatz.getNr).BackColor = &HC0C0FF Einbauplatz.m_Versuche = Einbauplatz.m_Versuche + 1 PrintStatus "Keine Impulse nach " & Format(ImpulsTestZeit, "0.0") & "s von Einbauplatz " & Einbauplatz.getNr & " im " & Einbauplatz.m_Versuche & ". Versuch!" If Einbauplatz.m_Versuche < 3 Then ' Wir geben diesem Zähler noch eine Chance, ' zeigen dies im Impuls-Feld an lblPZImpulse(Einbauplatz.getNr).caption = "0 (" & Einbauplatz.m_Versuche & ".)" 'und wiederholen diesen Prüfpunkt mit der Initialisierung der FM85 GoTo FM85FuerPeriodendauermessungInit Else PrintStatus "Zähler " & Einbauplatz.getNr & " wird inaktiv!" ' Dieser Zähler hat zum 3. mal keine Impulse abgegeben ' und wird inaktiv geschaltet Einbauplatz.setAktiv False lblPZImpulse(Einbauplatz.getNr).BackColor = &HFF lblVerbleib(Einbauplatz.getNr).BackColor = &HFF AnzahlZaehlerOhneImpulse = AnzahlZaehlerOhneImpulse + 1 'Pruefzaehler.getPruefpunkte.getPruefpunkt.setFehler 99 ' m_DruckMsg = m_DruckMsg & "Der Prüfzähler auf Einbauplatz " & Einbauplatz.getNr & " lieferte keine Impulse " & vbCrLf & "und wurde deshalb nicht fertig geprüft." & vbCrLf ' Status Fertigung auf Ausfall setzen Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr AuftragpositionSerienNr.setStatusFertigung 23 AuftragpositionSerienNr.save End If Else 'Hier sind Impulse gekommen If Einbauplatz.m_Versuche > 0 Then ' und kann die Versuche zurücksetzen PrintStatus "Zähler " & Einbauplatz.getNr & " lieferte wieder Impulse. Die Anzahl der Versuche wird zurückgesetzt." ' RH 12.07.2007 lblPZImpulse(Einbauplatz.getNr).BackColor = &H8000000F lblVerbleib(Einbauplatz.getNr).BackColor = &H8000000F Einbauplatz.m_Versuche = 0 End If End If End If ' ToDo: 'Kein ABBRUCH wenn <50% aller Zähler keine Pulse liefern 'Änderung Andreas Pfeiffer 07.04.00 #0006 'Call Abbruch 'Exit Sub If Not m_PruefungsArtWaage Then ' Verbleibende Pruefzaehlerimpulse auslesen Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "I") ' m_FMBus.send "I" ' Impulse = Val("&H0000" & m_FMBus.receive(500)) lblVerbleib(Einbauplatz.getNr).caption = Str(Impulse) ' Solange für irgendeinen Prüfling die verbleibenden Impulse <> 0 sind, ' kann nicht mit dem nächsten Pruefpunkt fortgesetzt werden If Impulse <> 0 Then AlleImpulseFertig = False End If ' Verbleibende Referenzzählerimpulse auslesen Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "J") ' Solange für irgendeinen Prüfling die verbleibenden Impulse <> 0 sind, ' kann nicht mit dem nächsten Pruefpunkt fortgesetzt werden If Impulse <> 0 Then AlleImpulseFertig = False End If End If ' Wieder beide Arten End If ' dieser Prüfzähler hat diesen Durchfluß als Prüfpunkt End If ' dieser Prüfzähler hat ein Prüfpunkte-Objekt End If ' Schleifenende für jeden genutzten Einbauplatz: Next Einbauplatz dummy = MesseWasserdruck() If dummy >= 0 Then lblWasserdruck.caption = Round(dummy, 2) Else lblWasserdruck.caption = "" End If ' ist dieser Prüfpunkt fertig ? ' ----------------------------- If m_PruefungsArtWaage Then ' Behälter voll ? dann Stopphase If Not g_ohneSPS Then If m_SPS.GrenzwertWaageErreicht Then m_PruefpunktFertig = True End If Else If MsgBox("Wurde der Grenzwert erreicht?", vbYesNo) = vbYes Then m_PruefpunktFertig = True End If End If Set m_Waage = g_App.getWaage lblGewicht.caption = m_Waage.GetGewicht Else ' Verbleibende Referenzzaehlerimpulse auslesen ' Auf Adressierung wird verzichtet, da der zuletzt adressierte Zähler verwendet wird. ' Impulse = GetHexZahlFromFM85(-1, "J") ' '' m_FMBus.send "J" '' Impulse = Val("&H0000" & m_FMBus.receive(500)) ' 'lblVerbleibRZ.Caption = Str(Impulse) ' ' If Impulse <> 0 Then ' AlleImpulseFertig = False ' End If ' Verbleibende Referenzzaehlerimpulse in FM85 für RefZ-Vergleich auslesen Impulse = GetHexZahlFromFM85(g_FM85RefZAdresse, "J") ' m_FMBus.send "**" & g_FM85RefZAdresse & "@" ' m_FMBus.receive (500) ' m_FMBus.send "J" ' Impulse = Val("&H0000" & m_FMBus.receive(500)) lblVerbleibRZ.caption = Str(Impulse) If Impulse <> 0 Then AlleImpulseFertig = False Else cmdVorzeitigBeenden.Enabled = True End If If g_App.Settings.getAnzahlMIDGruppen > 1 Then ' m_FMBus.send "I" ' Impulse = Val("&H0000" & m_FMBus.receive(500)) 'lblVerbleibRZB.Caption = Str(Impulse) Impulse = GetHexZahlFromFM85(g_FM85RefZAdresse, "I") If Impulse <> 0 Then AlleImpulseFertig = False End If End If If AlleImpulseFertig = True Then m_PruefpunktFertig = True End If End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''' Durchfluss Überwachung''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Neu RH 18.2.2008 ' If g_ohneSPS = False Then ' If Not m_SPS.SolldurchflussErreicht Then ' ' Durchfluss weicht ab! ' If mblnDurchflussAbweichung = False Then ' ' das erste Mal für diesen Prüfpunkt ' mblnDurchflussAbweichung = True ' PrintStatus "Q (" & Format(m_SPS.getQIst(), "0.000") & "m³/h) weicht von Qsoll (" & lblQSoll.Caption & "m³/h) um " & Format((CDbl(lblQSoll.Caption) - m_SPS.getQIst()) / CDbl(lblQSoll.Caption), "0.0") & "% ab! Zeit: " & PP_Ist_Zeit ' End If ' End If ' End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Nach halber Zeit im Pruefpunkt If bPPQIstSaved = False And PP_Ist_Zeit >= m_Pruefzeit / 2 Then bPPQIstSaved = True ' Wasserdruck messen für Zulassungspruefdaten g_dblWasserdruck = Round(MesseWasserdruck(), 3) If g_dblWasserdruck <> -1 Then PrintStatus "Wasserdruck: " & g_dblWasserdruck End If 'wird Ist-Durchfluss gespeichert If Not g_ohneSPS Then QIst = m_SPS.getQIst Else QIst = m_DurchflussSoll End If 'PrintStatus "nach halber Zeit des PP in Pruefgang speichern : QIst=" & Format(QIst, "0.000") 'm_Pruefgang.PP_Ist(PPNr) = QIst 'm_Pruefgang.save ' Wenn Durchfluss abweicht um >= 5% dann Abbruch ' Max Durchflussabweichung 0,05 ' Geändert Pfeiffer 26.02.04 laufen lassen If (Abs(m_DurchflussSollManuell - QIst) / m_DurchflussSollManuell) > 0.05 Then PrintStatus "Abweichung Durchfluß vom SollDurchfluß > 5%" End If If m_bVoreinstellwertSetzen Then ' 2% höher regeln, um den Durchfluß schneller zu erreichen ' Todo: diese Formel von g_App.Settings.GetAnzahlFuerVoreinstellwert abhängig machen Voreinstellwert = m_SPS.GetStellwert + 2 ' PrintStatus "Stellwert: " & m_SPS.GetStellwert 'PrintStatus "Stellwert2:" & m_SPS.GetServoFUStellwert(m_Pumpe.GetRegelart,???? 'PrintStatus "Anzahl eingeb.Zähler:" & g_App.Settings.GetAnzahlFuerVoreinstellwert PrintStatus "+2% => Voreinstellwert " & Voreinstellwert & " speichern" SetVoreinstellwert m_DurchflussSoll, Voreinstellwert End If ' Wasserdruck aufnehmen g_dblWasserdruck = MesseWasserdruck() If g_dblWasserdruck <> -1 Then PrintStatus "Wasserdruck (initialSupplyPressure): " & Round(g_dblWasserdruck, 3) & " bar" End If End If DoEvents If g_Abbruch Then Exit Sub End If ' Neu RH 13.12.2004 If PP_Ist_Zeit > m_Pruefzeit * 2 Then ' doppelte Prüfzeit ist verstrichen For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If m_ImpulswertigkeitPZ > 0 Then ImpulswertigkeitPZ = m_ImpulswertigkeitPZ Else ImpulswertigkeitPZ = Einbauplatz.m_ImpulseQM End If If PP_Ist_Zeit > (3600 / (m_DurchflussSoll * ImpulswertigkeitPZ)) * 20 * 2 Then 'In dieser Zeit (doppelt veranschlagt) hätten auch mind. 20 Impulse gekommen sein müssen PrintStatus "Doppelte Prüfzeit für Zähler " & Einbauplatz.getNr & " ist verstrichen!" 'welche Zähler haben noch nicht alle Impulse gezählt ? ' Pruefzähler ist eingebaut If Einbauplatz.getAktiv = True Then ' und noch nicht deaktiviert Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "I") lblVerbleib(Einbauplatz.getNr).caption = Str(Impulse) If Impulse <> 0 Then ' Zähler als defekt markieren PrintStatus " Einbauplatz " & Einbauplatz.getNr & " wird inaktiv. Verbleibende Impulse=" & Impulse lblVerbleib(Einbauplatz.getNr).caption = Str(Impulse) lblVerbleib(Einbauplatz.getNr).BackColor = &HC0C0FF ' Einbauplatz.setAktiv False ' Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr AuftragpositionSerienNr.setStatusFertigung 23 AuftragpositionSerienNr.save ' Else PrintStatus " Einbauplatz " & Einbauplatz.getNr & " bleibt aktiv. Verbleibende Impulse=" & Impulse End If End If End If End If Next ' Dieser Prüfpunkt muss abgebrochen werden m_PruefpunktFertig = True End If ' Schleifenende Loop 'Breite der Spalte bestimmen If chkAutobreite.value = vbChecked Then AutoSpaltenBreite MSFlexGrid1, lblAutosize, 1 End If ' dieser Pruefpunkt ist fertig cmdVorzeitigBeenden.Enabled = False m_GesZeitZaehler = m_GesZeitZaehler + PP_Ist_Zeit Stopphase: lblWasserdruck.caption = "" m_Pruefgang.PP_Zeit(PPNr) = m_Pruefpunkt.GetTime m_Pruefgang.save ' Betrieb stop: es ist hier ungewiss, ob Pruefpunkt wiederholt wird wenn Prüefgang Lang If m_bPruefgangLang And PPNr = m_colUniquePP.Count And Not m_PruefungsArtWaage Then ' Betrieb wird später gestoppt Else If Not g_ohneSPS Then m_SPS.setBetrieb 8 Sleep 500 m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 lblQIst.caption = "" PrintStatus "Wasser gestoppt" Else MsgBox ("Bitte Wasser stoppen!") End If End If ' nach dem Qmax soll Wassertemperatur für Prüfgang ermittelt und gespeichert werden If PPNr = 1 Then If Not g_ohneSPS Then Temperatur = m_SPS.GetEinlaufTemperatur Else Temperatur = InputBox("Bitte Temperatur eingeben", "Keine SPS angeschlossen", "22") End If lblVorlauftemperatur.caption = Format(Temperatur, "0.0") m_Pruefgang.Vorlauftemperatur = Temperatur PrintStatus "Temperatur: " & Format(Temperatur, "0.00") & " °C" m_Pruefgang.save End If ' Nachlauf abwarten lngTemp = g_App.Settings.GetNachlaufzeit_s() If lngTemp > 0 Then PrintStatus "Nachlauf abwarten für " & lngTemp & " Sekunden..." For i = lngTemp To 0 Step -1 PrintStatusTemporaer "noch " & i & " Sekunden" Sleep 1000, True Next PrintStatus "" End If '---------------------------------------------------------------- ' Fehlerermittung '---------------------------------------------------------------- PrintStatus "Fehlerermittlung:" PrintStatus "-----------------" If m_PruefungsArtWaage Then PrintStatus "Beruhigungsphase..." Sleep 3000, True 'm_Waage.WarteAufRuhe m_Behaelter.WarteAufRuhe If g_Abbruch Then Call Abbruch("") Exit Sub End If Gewicht = m_Waage.GetGewicht lblGewicht.caption = Format(Gewicht, "0") PrintStatus "Gewicht: " & Format(Gewicht, "0.000") If g_App.Settings.GetBenutzeFuellstandStattWaage() Then m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Behaelter Else m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Waage End If ' Volumen in der Waage ermitteln BehaelterVolumen = Errechne_Volumen_Von_Wasser_in_m3(Gewicht, Temperatur) m_Pruefgang.PP_Ist_V(PPNr) = BehaelterVolumen * 1000 m_Pruefgang.PP_Waage(PPNr) = m_Behaelter.m_Nr PrintStatus "Volumen in der Waage: " & Format(BehaelterVolumen * 1000, "0.000") & " l" Else m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Referenzzaehler ' FM85P mit entspr. Adresse ansprechen ' erster belegter FM85 für Referenzzzaehler auswählen ''''''AP auskommentiert am 21.0.6.04 ''''m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", "FM85" 'geändert m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", "" 'm_ersterPruefzaehlerNr If g_Abbruch Then Exit Sub End If ' ' Periodendauer über n Perioden des Referenzzaehlers auslesen ' PeriodendauerRZ = GetHexZahlFromFM85(m_ersterPruefzaehlerNr, "Y") '' ' Periodendauer über n Perioden des Referenzzaehlers auslesen '' m_FMBus.send "Y" '' PeriodendauerRZ = Val("&H0000" & m_FMBus.receive(500)) '' PrintStatus "Referenzzaehler Periodendauer = " & PeriodendauerRZ End If For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If (Not Pruefzaehler Is Nothing) Then ' And (Einbauplatz.getAktiv = True) Then If (Not Pruefzaehler.getPruefpunkte Is Nothing) Then If (Pruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) = True) Then MSFlexGrid1.col = PPNr MSFlexGrid1.row = Einbauplatz.getNr Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "U") PrintStatus "Impulse von Prüfzähler " & Einbauplatz.getNr & "= " & Impulse If m_ImpulswertigkeitPZ > 0 Then ImpulswertigkeitPZ = m_ImpulswertigkeitPZ Else ImpulswertigkeitPZ = Einbauplatz.m_ImpulseQM End If If m_PruefungsArtWaage Then ' Prüfzählermpulse Anzeige aktualisieren lblPZImpulse(Einbauplatz.getNr).caption = Str(Impulse) ' Fehlerermittlung Fehler = (Impulse / ImpulswertigkeitPZ - BehaelterVolumen) * 100 / BehaelterVolumen PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " %" If g_blnZulassungspruefung Then Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, Impulse / ImpulswertigkeitPZ * 1000, 1000 * BehaelterVolumen, Fehler, Temperatur, PPStartZeit, True) End If Else ' Periodendauer über n Perioden auslesen PeriodendauerPZ = GetHexZahlFromFM85(Einbauplatz.getNr, "X") PrintStatus "** Pruefzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerPZ PeriodendauerRZ = GetHexZahlFromFM85(Einbauplatz.getNr, "Y") PrintStatus "** Referenzzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerRZ If Not PeriodendauerRZ = 0 Then PrintStatus "Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %" ' RH 9.5.2005 ' Speichern des IstDurchflusses, berechnet aus Referenzzähler Werten QIst = (m_AnzahlPeriodenRZ / m_Referenzzaehler.ImpulseQM) / (PeriodendauerRZ / 2994) * 3600 * (1 - FehlerRefZ / 100) PrintStatus "water temp = " & Format(Temperatur, "0.0") & " °C" 'PrintStatus "Prüfvolumen des RZ = " & Format((m_AnzahlPeriodenRZ / m_Referenzzaehler.ImpulseQM) * (1 - FehlerRefZ / 100), "0.000") & " m³" PrintStatus "actual flowrate = Qist = (AnzahlPeriodenRz / ImpulswertigkeitRZ) / (PeriodendauerRZ/2994) * 3600s/h * (1-Frz/100) = " & Format(Int(QIst * 100000 + 0.5) / 100000, "0.000") & " m³/h" PrintStatus "actual volume = (AnzahlPeriodenRZ / ImpulswertigkeitRz) * (1 - FehlerRefZ / 100) = " & Format(1000 * (m_AnzahlPeriodenRZ / m_Referenzzaehler.ImpulseQM) * (1 - FehlerRefZ / 100), "0.000") & " Liter" m_Pruefgang.PP_Ist(PPNr) = QIst m_Pruefgang.save ' Fehler-Formel hergeleitet aus ' Q = ( Impulswertigkeit * Impulse) / Periodendauer ' FPz = (QPz - QRz)/QRz ' Fehler in % (* 100) 'Änderung Andreas Pfeiffer 07.04.00 #0007 'Wenn keine Impulse eingegangen sind soll kein Fehler berechnet werden Fehlwert = 99% 'Fehler Division durch 0 vermeiden und Hinweis in Datenbank auf nicht Funktion If PeriodendauerPZ > 0 Then If g_objExternePruefformel Is Nothing Then PrintStatus "Interne Pruefformel" ' Anmerkung: Eigentlich ist die PeriodendauerRZ fehlerbehaftet und könnte hier korrigiert werden Fehler = (100 * PeriodendauerRZ / PeriodendauerPZ) - 100 PrintStatus " PeriodendauerRZ = " & PeriodendauerRZ PrintStatus " PeriodendauerPZ = " & PeriodendauerPZ PrintStatus " FehlerRefZ= " & FehlerRefZ PrintStatus "Impulswertigkeit Pruefzaehler = " & ImpulswertigkeitPZ PrintStatus "indicated volume = " & Format((Einbauplatz.m_AnzahlPeriodenPZ / ImpulswertigkeitPZ) / (PeriodendauerPZ / PeriodendauerRZ) * 1000, "0.000") & " Liter" PrintStatus "FehlerPZ (unkorrigiert) = 100 * ((PeriodendauerRZ / PeriodendauerPZ) - 1) = " & Format(Fehler, "0.00") & " %" ' Korrektur des Fehlers mit dem Fehler des Referenzzählers Fehler = Fehler + FehlerRefZ PrintStatus "meter error = Fehler PZ (korrigiert) = FehlerPZ (unkorrigiert) + FehlerRefZ = " & Format(Fehler - FehlerRefZ, "0.00") & "% + " & Format(FehlerRefZ, "0.00") & " % = " & Format(Fehler, "0.00") & " %" Else ' Fehlerberechnung in Externer DLL, neu RH 30.4.2017 Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(1 / PeriodendauerPZ, 1 / PeriodendauerRZ, FehlerRefZ) PrintStatus g_objExternePruefformel.GetLogText End If If g_blnZulassungspruefung Then Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, (Einbauplatz.m_AnzahlPeriodenPZ / ImpulswertigkeitPZ) / (PeriodendauerPZ / PeriodendauerRZ) * 1000, 1000 * (m_AnzahlPeriodenRZ / m_Referenzzaehler.ImpulseQM) * (1 - FehlerRefZ / 100), Fehler, Temperatur, PPStartZeit, False) End If Else Fehler = 99 'Merker für "Keine Impulse" End If Else ErrorMsg ("Die Periodendauer des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden (=0)") Fehler = 98 End If End If PrintStatus "ermittelter Fehler: " & Format(Fehler, "0.00") & " %" ' Fehler dieses Prüfpunktes für diesen Einbauplatz steht fest, ' es ist aber noch nicht berücksichtigt, ob Langmessung nötig ist bFehlerermittelt = False If m_bPruefgangLang And PPNr = m_colUniquePP.Count Then ' ------------------------------------------ ' Behandlung bei Pruefgang Lang, ' letzter Prüfpunkt mit kleinstem Durchfluss ' ------------------------------------------ ' Pruefgang-Lang und Pruefpunkt = Qmin. FehlerInPruefgangLang(ZaehlerPruefgangLang, Einbauplatz.getNr) = Fehler MSFlexGrid1.text = Format(Fehler, "0.00") & "/" & ZaehlerPruefgangLang + 1 Select Case ZaehlerPruefgangLang Case 0 PrintStatus "PruefgangLang: 1.Fehler: wurde zwischengespeichert" PruefgangLangPruefpunktWiederholen = True Case 1 PrintStatus "PruefgangLang: 2.Fehler: Vergleich mit 1.Fehler" ' Abweichung aus Ini Datei in % PrintStatus "Testen ob die gemessenen Fehler abweichen um weiniger als " & g_App.Settings.getPruefgangLangAbweichung() & " % ..." PrintStatus "Einbauplatz: " & Einbauplatz.getNr PrintStatus "Fehler Lang 1: " & FehlerInPruefgangLang(1, Einbauplatz.getNr) PrintStatus "Fehler Lang 0: " & FehlerInPruefgangLang(0, Einbauplatz.getNr) PrintStatus "Abweichung: " & FehlerInPruefgangLang(1, Einbauplatz.getNr) - FehlerInPruefgangLang(0, Einbauplatz.getNr) PrintStatus " Abs() ist größer als " & g_App.Settings.getPruefgangLangAbweichung() & " ?" If Abs(FehlerInPruefgangLang(1, Einbauplatz.getNr) - FehlerInPruefgangLang(0, Einbauplatz.getNr)) > g_App.Settings.getPruefgangLangAbweichung() Then PruefgangLangPruefpunktWiederholen = True PrintStatus " ja, also Prüfung wiederholen." Else PrintStatus " nein, also Mittelwert bestimmen." ' Wiederholen, wenn mind 1 mal Abweichung überschritten ' Mittelwert aus den letzen beiden Fehlern für diesen PP bestimmen Fehler = (FehlerInPruefgangLang(1, Einbauplatz.getNr) + FehlerInPruefgangLang(0, Einbauplatz.getNr)) / 2 ' Fehler steht fest bFehlerermittelt = True ' geändert RH 17.09.2007 ' PruefgangLangPruefpunktWiederholen = False End If Case 2 PrintStatus "PruefgangLang: 3.Fehler..." ' Bestimmen der dicht beieinander liegenden Punkte Fehler = MittelwertDerFehlerOhneAusreisser(FehlerInPruefgangLang(0, Einbauplatz.getNr), FehlerInPruefgangLang(1, Einbauplatz.getNr), FehlerInPruefgangLang(2, Einbauplatz.getNr)) ' Fehler steht fest bFehlerermittelt = True PruefgangLangPruefpunktWiederholen = False End Select Else ' ------------------------------------------ ' Behandlung sonst, wenn kein Pruefgang Lang ' ------------------------------------------ bFehlerermittelt = True End If ' nur Prüfgang lang ' ------------------------------- ' Behandlung aller Pruefungen ' ------------------------------- If bFehlerermittelt = True Then ' Fehler steht fest: ' speichern ' Todo: was ist wenn Fehler nicht ermittelt werden konnte ? Dann ist er hier 0 If g_Abbruch = True Then Exit Sub Call FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, m_Pruefpunkt, m_colUniquePP) MSFlexGrid1.text = Format(Fehler, "0.00") ' Fehler speichern für Druck For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount If Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ = m_DurchflussSoll Then Pruefzaehler.getPruefpunkte.getPruefpunkt(i).setFehler Fehler End If Next Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr ' Bei Grenzwertüberschreitung 'Alt: GrenzwertUeberschritten(m_Pruefpunkt.getFGo, Fehler, m_Pruefpunkt.getFGu) Then ' Neu RH 14.05.2007: PrintStatus "Grenzwert überprüfen für " & Pruefzaehler.getSerienNr & " bei Q= " & m_DurchflussSoll & ": FGo=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & ", Fgu=" & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & ", F=" & Round(Fehler, 2) If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then AuftragpositionSerienNr.setStatusFertigung 25 AuftragpositionSerienNr.save PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !" If chkNachpruefung.value = vbUnchecked Then MSFlexGrid1.CellBackColor = &HC0C0FF End If End If 'if mblnDurchflussAbweichung = true then 'MSFlexGrid1.CellBackColor = &HFFC0FF 'end if End If ' bFehlerermittelt End If ' Prüfzähler hat diesen Prüfpunkt End If ' Prüfpunkte vorhanden End If 'Pruefzaehler vorhanden Next Einbauplatz 'In m_colEinbauplatz FehlerSpeichernFertig: If m_bPruefgangLang And PPNr = m_colUniquePP.Count Then ZaehlerPruefgangLang = ZaehlerPruefgangLang + 1 lblLang.caption = (ZaehlerPruefgangLang + 1) & " ." DebugMsg "Zähler PGang Lang: " & ZaehlerPruefgangLang End If If Not m_PruefungsArtWaage Then If g_App.Settings.getAnzahlMIDGruppen > 1 Then ' Abweichung zwischen den Referenzzaehlern ermitteln PeriodendauerRefZ1 = GetHexZahlFromFM85(g_FM85RefZAdresse, "X") ' m_FMBus.send "**" & g_FM85RefZAdresse & "@" ' m_FMBus.receive (500) ' m_FMBus.send "X" ' PeriodendauerRefZ1 = Val("&H0000" & m_FMBus.receive(500)) PrintStatus "Referenzzaehler1 Periodendauer = " & PeriodendauerRefZ1 PeriodendauerRefZ2 = GetHexZahlFromFM85(g_FM85RefZAdresse, "Y") ' m_FMBus.send "Y" ' PeriodendauerRefZ2 = Val("&H0000" & m_FMBus.receive(500)) If PeriodendauerRefZ1 = 0 Or PeriodendauerRefZ2 = 0 Then ErrorMsg ("Periodendauer eines RefZ (FM85P-" & g_FM85RefZAdresse & ")liegt noch nicht vor.") Else PrintStatus "Referenzzaehler1 Periodendauer = " & PeriodendauerRefZ1 PrintStatus "Referenzzaehler2 Periodendauer = " & PeriodendauerRefZ2 PrintStatus "Fehler des RefZählers A: " & FehlerRefZA & " %" PrintStatus "Fehler des RefZählers B: " & FehlerRefZB & " %" ' Korrigierter Wert PeriodendauerRefZ1 = PeriodendauerRefZ1 * (1 - FehlerRefZA / 100) PeriodendauerRefZ2 = PeriodendauerRefZ2 * (1 - FehlerRefZB / 100) PrintStatus "Referenzzaehler1 Periodendauer (korrigiert)= " & PeriodendauerRefZ1 PrintStatus "Referenzzaehler2 Periodendauer (korrigiert)= " & PeriodendauerRefZ2 Fehler = 100 * (PeriodendauerRefZ1 - PeriodendauerRefZ2) / (PeriodendauerRefZ1) PrintStatus "Testen, ob Fehler zwischen den Referenzzählern: " & Fehler & "% größer als " & g_App.Settings.getMaxDiffRZ() & "%" ' Warnung, wenn Fehler zwischen den Referenzzählern > MaxDiff If Abs(Fehler) > g_App.Settings.getMaxDiffRZ() Then m_DruckMsg = m_DruckMsg & "Warnung: der Fehler zwischen Referenzzaehlern " & Format(Fehler, "0.000") & "% ist größer als " & g_App.Settings.getMaxDiffRZ() & " %" & vbCrLf End If ' Fehler > MaxDiff End If ' Periodendauer (nicht) liegt vor End If Else Call WaageZuruecksetzen End If ' Prüfungsart Vergleichsprüfung, not Waage PrintStatus "Schleifenende Pruefgang Lang: Zähler=" & ZaehlerPruefgangLang ' Schleifenende für Pruefgang Lang If PruefgangLangPruefpunktWiederholen Then PrintStatus "Wg. Pruefgang Lang: Pruefpunkt wiederholen..." GoTo SchleifenanfangPruefgangLang End If If Not g_ohneSPS Then m_SPS.setBetrieb 8 Sleep 500 m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 lblQIst.caption = "" Else MsgBox "Bitte Wasser stoppen" End If PrintStatus "Wasser gestoppt" lblWasserdruck.caption = "" lblFehlerRZ.caption = "" ' Alle Einbauplätze wieder aktivieren For Each Einbauplatz In m_colEinbauplatz lblPZImpulse(Einbauplatz.getNr).BackColor = &H8000000F lblVerbleib(Einbauplatz.getNr).BackColor = &H8000000F Einbauplatz.setAktiv True Next End If ' m_DurchflussSoll > 0 und RZ-Vergleichs-Prüfung erfolgt 'Breite der Spalte bestimmen If chkAutobreite.value = vbChecked Then AutoSpaltenBreite MSFlexGrid1, lblAutosize, 1 End If ' Schleifenende Pruefpukte: nächster Pruefpunkt Next m_Pruefpunkt Call EichamtvorschriftUeberpruefen ' Kompletter Pruefgang bendet ' ---------------------------- ' Für jeden geprüften Pruefzähler: '0=ohne Bearbeitung, '10=Vorfertigung OK, '20=Montage, '22=Prüfung abgebrochen, '25=Grenzwertüberschreitung Prüfstation, '30=Prüfstation geprüft, '40=dieser Zähler ausgeliefert, '45= Lagerauftrag an Lager geliefert, '50=Auftrag ausgeliefert ereg_Pruefungsabschluss: For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If g_blnZulassungspruefung Then g_dblWasserdruck = MesseWasserdruck() If g_dblWasserdruck <> -1 Then PrintStatus "Wasserdruck (initialSupplyPressure): " & Round(g_dblWasserdruck, 3) & " bar" End If Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, 0, 0, 0, 0, 0, Temperatur, Now()) End If Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr Select Case AuftragpositionSerienNr.getStatusFertigung Case 25 ' Grenzwertüberschreitung in einem Prüfpunkt ' bleibt Case 23 ' Ausfall in einem Prüfpunkt ' bleibt Case 22 ' Geprüft in allen Prüfpunkten ohne Ausfall und Grenzwertüberschreitung AuftragpositionSerienNr.setStatusFertigung 30 End Select AuftragpositionSerienNr.save End If Next Einbauplatz If g_blnPruefprotokoll Then PrintStatus "Prüfergebnisse werden gedruckt..." DoEvents Call PruefgangDruck(m_Pruefgang, Temperatur, m_colEinbauplatz, PZCount, m_DruckMsg) If chkProtokolldruck.value = vbChecked Then chkProtokolldruck.value = vbUnchecked Call chkProtokolldruck_Click End If End If ' Neu RH 28.3.2017 Verschiebe_Prueffehler_Befundpruefung_Eichung m_Pruefgang.PruefgangNr ' Todo: wann neuer Prüfgang für AuftragpositionSeriennummer ? PrintStatus "Schleifenende Dauerprüfung. " & m_DauerpruefungZaehler If m_DauerStop = True Then Exit For End If Next m_DauerpruefungZaehler ' Schleifenende Dauerprüfung PrintStatus "Prüfgangdaten werden gespeichert..." DoEvents ' Speichern der PruefgangDaten m_Pruefgang.save ' SPS Betrieb Programmende PrintStatus "Programmende..." DoEvents ' Stoppen If Not g_ohneSPS Then m_SPS.setBetrieb 0 Sleep 1000 End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' eRegister Prüfungsabschluss '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If g_blneRegisterPruefung Then If g_blnVersuch Then If MsgBox("Prüfung ist beendet. Möchten Sie den Prüfungsabschluss durchführen?", vbYesNo, "Fortfahren als Versuchsprüfer") = vbNo Then frmeRegisterPrf.Visible = True frmeRegisterPrf.LED_Aus_Sleep Unload frmeRegisterPrf Exit Sub Else End If Else MsgBox "Prüfung ist beendet. Fortfahren mit Prüfungsabschluss", vbOKOnly, "Fortfahren?" End If ' Prüfungsabschluss frmeRegisterPrf.Visible = True If frmeRegisterPrf.PruefungsAbschlussNeuerVako() = False Then Unload frmeRegisterPrf If Not g_ohneSPS Then m_SPS.setBetrieb 0 End If endDialog IDCANCEL Exit Sub Else ' From eRegisterPrf wird micht mehr benötigt Unload frmeRegisterPrf WindowsAPI.BringWindowToTop Me.hwnd Call Show_eRegister_Infos End If End If If Not g_ohneSPS Then ' Programmende einleiten If m_blnVersuch_Prf_Automatisch_Beenden = True Then ' Neu RH 11.10.2010 auf Wunsch von C.Nettemann ' Die Strecke soll nach der Prüfung automatisch entleert (Messeinsätze) bzw. beendet werden ' Betrieb = Beenden m_SPS.setBetrieb 4 Sleep 1000 Else ' gewohnter Pfad If MsgBox("Möchten Sie jetzt die Prüfung automatisch beenden (d.h. Strecke entleeren bei Messeinsätzen / sonst lösen) ?" & vbCrLf & "Klicken Sie auf 'Nein', wenn sie weder entleeren noch lösen wollen.", vbYesNo, " automatisch beenden ?") = vbNo Then GoTo Fertig ' nicht öffnen Else ' Betrieb = Beenden m_SPS.setBetrieb 4 Sleep 1000 End If End If If m_NurMesseinsaetze = False Then ' warten bis Lösen begonnen wurde PrintStatus "Warten bis Lösen beginnt..." Do While m_SPS.IstStreckeGespannt Sleep 1000, True If g_Abbruch = True Then Exit Sub End If Loop PrintStatus "Lösen..." End If Fertig: ' Jetzt kann Betrieb = 0 gesetzt werden m_SPS.setBetrieb 0 m_letzter_Durchfluss = 0 m_SPS.SetServoStellung 50 Sleep 1000 End If 'ohne SPS If m_PruefungsArtWaage = True Then If g_App.PruefstationNr = 2020 Then Call AlleBehaelterLeeren(Me, m_SPS, m_Waage) End If Call m_Waage.releaseMScomm End If Call ResetPruefung If g_bMeitwinMID_Sonderpruefung Then MsgBox "Die bei der automatischen Prüfung ermittelten Werte werden nicht gespeichert und müssen jetzt manuell auf das Datenblatt übertragen werden. Danach muss 'Hand- Prüfung' ausgewählt werden. Klicken Sie erst auf 'OK', nachdem sie die Ergebnisse notiert haben!" endDialog IDOK Exit Sub End If Call PruefungFertigmeldenDialog("Die Prüfung ist beendet.", m_colEinbauplatz) Call SchotteinstellungenAendern endDialog IDOK Exit Sub Errorhandler: Dim returnwert As Long Dim strErr As String Dim errnum As Long strErr = Err.Description errnum = Err.Number showError "Hauptprüfung", "Fehler " & errnum & " in Hauptprüfung: " & strErr returnwert = MsgBox("Möchten Sie den Befehl, der den Fehler verursacht hat, wiederholen, " & vbCrLf & "die Prüfung abbrechen oder den Fehler ignorieren?", vbAbortRetryIgnore, "Fehlerbehandlung Hauptprüfung") If returnwert = vbRetry Then Resume ElseIf returnwert = vbIgnore Then Resume Next Else Call Abbruch("Fehler " & errnum & " in Hauptprüfung: " & strErr) End If End Sub Private Sub initSPSfuerDurchlauf() ' Durchlauf auswählen m_SPS.setBehaelter 1 lblGewichtLabel.Enabled = False lblGewicht.Enabled = False End Sub Private Sub Show_eRegister_Infos() On Error GoTo Errorhandler Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim eRegister As CeRegister MSFlexGrid1.Cols = MSFlexGrid1.Cols + 1 MSFlexGrid1.col = MSFlexGrid1.Cols - 1 MSFlexGrid1.TextMatrix(0, MSFlexGrid1.col) = "eRegister Prüfungabschluss" For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then Set eRegister = Einbauplatz.eRegister MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = MSFlexGrid1.Cols - 1 If Not eRegister Is Nothing Then If eRegister.m_StateClosed Then If eRegister.m_lastDEBUG.Factory_State = 2 Then If eRegister.m_lastDEBUG.Wake_Up_Interval = 0 Then MSFlexGrid1.text = "OK" MSFlexGrid1.CellBackColor = RGB(128, 255, 128) ' hell grün Else MSFlexGrid1.text = "Nicht OK (WUP<>0)" MSFlexGrid1.CellBackColor = RGB(255, 128, 128) ' hell rot End If Else MSFlexGrid1.text = "Nicht OK (FactoryState<>2)" MSFlexGrid1.CellBackColor = RGB(255, 128, 128) ' hell rot End If Else MSFlexGrid1.text = "Nicht OK (nicht geschlossen)" MSFlexGrid1.CellBackColor = RGB(255, 128, 128) ' hell rot End If Else MSFlexGrid1.text = "Nicht OK (ausgenommen)" MSFlexGrid1.CellBackColor = RGB(255, 128, 128) ' hell rot End If End If Next AutoSpaltenBreite MSFlexGrid1, lblAutosize Exit Sub Errorhandler: MsgBox "Fehler " & Err.Number & " in Show_eRegister_Infos() " & Err.Description End Sub 'Private Function initSPSfuerPP() '' SPS für diesen Prüfpunkt initialisieren, unabhängig von Waage/Behälter oder Durchlauf '' ------------------------------------------------------------------------------------- '' Betrieb stoppen und Pumpen Abwählen '' Durchfluß vorgabe '' Pumpe auswählen und anwählen '' Regelart und Regel-Position setzen '' MID Strang setzen ' ' Dim i As Integer ' Dim Waagengrenzwert As Double ' ' ' Betrieb Start zurücksetzen ' m_SPS.setBetrieb 8 ' sleep 500 ' m_SPS.setBetrieb 0 ' ' ' Durchfluß vorgabe ' m_SPS.SetQSoll m_DurchflussSoll ' PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll ' ' ' Pumpenauswahl ' ' Hochbehälter Auswahl wenn Q < 1 m ^3 -> Pumpe.Nr = 4 ' ' siehe modPumpe ' m_SPS.AllePumpenAbwaehlen ' ' Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen) ' PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname ' m_Pumpe.Anwahl ' ' Select Case m_Pumpe.GetRegelart ' Case "Servo" ' ' Servo vorgeschrieben ' m_SPS.SetRegelart ("Servo") ' PrintStatus "Servo: Vorgabe 50%" ' ' todo: Formel für ServoPosition zur Feinregulierung des Durchflusses folgt ' m_SPS.SetServoStellung 50 ' Case "FU" ' ' Frequenzumrichter vorgeschrieben ' m_SPS.SetRegelart ("FU") ' ' todo: Formel für Frequenzvorgabe zur Feinregulierung des Durchflusses folgt ' m_SPS.SetServoStellung 50 ' Case Else ' ErrorMsg "Es ist keine Regelart für die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert." ' Call Abbruch ' Exit Function ' End Select ' ' ' Vorwahl Referenzzaehler ' m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr ' 'End Function Private Function initSPSfuerPP() On Error GoTo Errorhandler ' SPS für diesen Prüfpunkt initialisieren, unabhängig von Waage/Behälter oder Durchlauf ' ------------------------------------------------------------------------------------- ' Betrieb stoppen und Pumpen Abwählen ' Durchfluß vorgabe ' Pumpe auswählen und anwählen ' Regelart und Regel-Position setzen ' MID Strang setzen Dim Einbauplatz As CEinbauplatz Dim i As Integer Dim iStellwert As Integer Dim AnzahlPP As Integer ' Betrieb Start zurücksetzen m_SPS.setBetrieb 8 Sleep 500 m_SPS.setBetrieb 0 m_SPS.SetQSoll m_DurchflussSoll PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll ' Pumpenauswahl ' Hochbehälter Auswahl wenn Q < 1 m ^3 -> Pumpe.Nr = 4 ' siehe modPumpe m_SPS.AllePumpenAbwaehlen Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen) PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname m_Pumpe.Anwahl Select Case m_Pumpe.GetRegelart Case "Servo" ' Servo vorgeschrieben m_SPS.SetRegelart ("Servo") ' Formel für ServoPosition zur Feinregulierung des Durchflusses ' Wenn letzter PP 'AnzahlPP = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkteCount 'If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(AnzahlPP).getQ Then ' jetzt für alle Prüfpunkte iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen) 'Else ' iStellwert = CInt(lookupFUServoStellwert(m_DurchflussSoll, "Servo")) 'End If PrintStatus "Stellwert: " & iStellwert m_SPS.SetServoStellung iStellwert Case "FU" ' Frequenzumrichter vorgeschrieben m_SPS.SetRegelart ("FU") ' Formel für ServoPosition zur Feinregulierung des Durchflusses 'If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(1).getQ Then iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen) 'If iStellwert = 0 Then ' PrintStatus "GetUSVoreinstellwert= 0, deshalb Voreinstellwert aus RZPP" ' iStellwert = lookupFUServoStellwert(m_DurchflussSoll, "FU") 'End If ' iStellwert = iStellwert * (1 + (m_AnzahlPZ * (100 - m_ersterPruefzaehler.getIdentNrObj.GetNennweite) * 0.001)) If iStellwert > 100 Then iStellwert = 100 PrintStatus "Stellwert: " & iStellwert m_SPS.SetServoStellung iStellwert Case Else ErrorMsg "Es ist keine Regelart für die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert." Call Abbruch Exit Function End Select ' Vorwahl Referenzzaehler m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr m_SPS.SetQDiff 0 Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in InitSPSfuerPP(): " & Err.Description, "Softwarefehler" Resume Next End Function Private Function initSPSfuerWaage() Dim i As Integer Dim Waagengrenzwert As Double ' initialisierung der SPS und Waage für Pruefung mit Waage '--------------------------------------------------------- ' Behälterauswahl ' Waagenanwahl ' Waagengrenzwert auf oberen Wert ' Behälter leeren ' Waage tarieren ' letzter Fehler auf 0 ' geschätzes Volumen in Litern als Sollvolumen für Waagengrenzwert: m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6 PrintStatus "geschätztes Soll-Volumen in Litern: " & m_VolumenSoll lblSollV.caption = Format(m_VolumenSoll, "0") ' Behälterauswahl For i = 1 To 2 If m_ArrayBehaelter(i).IstOkFuerVolumen(m_VolumenSoll) Then Set m_Behaelter = m_ArrayBehaelter(i) m_BehaelterNr = i Exit For End If Next ' Waagenanwahl If Not m_Behaelter Is Nothing Then PrintStatus "-> Gewählte Waage: " & m_Behaelter.m_WaageAnwahl PrintStatus "-> Gewählte m_Behaelter: " & m_Behaelter.m_BehaelterAnwahl Set m_Waage = g_App.getWaage m_Waage.Initialize m_Behaelter.m_Nr m_Waage.Anwahl (m_Behaelter.m_WaageAnwahl) ' 2= klein, 4= groß m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl Else ErrorMsg ("Es konnte keine Waage und kein Behälter für Volumen " & m_VolumenSoll & " bestimmt werden") ' Prüfung abbrechen g_Abbruch = True Call Abbruch Exit Function End If m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert, m_Behaelter.m_Genauigkeit m_SPS.WassserAblassen 0 ' Vor jedem Prüfpunkt beide Behälter leeren bis Prüfmenge nicht mehr erreicht m_SPS.WassserAblassen 3 PrintStatus "Beide Behälter leeren bis Prüfmenge nicht mehr erreicht..." Sleep 5000 Do While m_SPS.GrenzwertWaageErreicht Sleep 1000, True If g_Abbruch = True Then Exit Function End If Loop PrintStatus "gewählten Behälter " & m_BehaelterNr & " leeren..." ' Vor jedem Prüfpunkt gewählten Behälter leeren ' --------------------------------------------- m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl Sleep 5000 ' auf Ruhe testen 'm_Waage.WarteAufRuhe m_Behaelter.WarteAufRuhe If g_Abbruch = True Then Call Abbruch Exit Function End If ' Waage ist nun in Ruhe, Ablassen kann beendet werden PrintStatus "Behälter ist nun leer.!" ' Wasser ablassen beenden m_SPS.WassserAblassen 0 'm_Waage.Reset ' RH 26.2.2002 Hier gbts Probleme : ' Waage auf Null stellen WaageAufNull1: PrintStatus "Waage auf Null stellen" m_Waage.TaraReset If m_Waage.Nullstellen = False Then ErrorMsg "Achtung: Nullstellung fehlgeschlagen!" & vbCrLf & " Bitte Fehler beheben und 'Ignorien' klicken oder abbrechen." GoTo WaageAufNull1 End If ' Waage tarieren PrintStatus "Waage Tarieren" m_Waage.Tara Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen) PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname m_Pumpe.Anwahl ' Waagengrenzwert bestimmen Waagengrenzwert = m_VolumenSoll - m_DurchflussSoll * m_Behaelter.m_nUeberlaufFaktor PrintStatus "Waagengrenzwert: " & Waagengrenzwert lblGrenzwert.caption = Format(Waagengrenzwert, "0") ' Grenzwert an Waage übergeben m_Waage.SetNettoGrenzwert1 Waagengrenzwert, m_Behaelter.m_Genauigkeit ' Der Durchfluß Wert soll unbereinigt angezeigt werden m_SPS.SetQDiff 0 lblGewichtLabel.Enabled = True lblGewicht.Enabled = True End Function Private Sub initFM85fuerPP_Waage() ' FM85 für Impulszählung für diesen Pruefpunkt initialisieren sendonly "**0@" sendonly "R" Sleep 1000, True ' ' Multiplikator ' sendonly "**0@" ' sendonly "1s" ' ' ' keine Doppelimpulssprerre ' sendonly "G" ' ' ' Dämpfung ' sendonly "3T" ' ' ' Doppelimpuls-Zeit ' sendonly "0000S" ' ' ' K Wert ' sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K ' ' PZ Impulse zählen sendonly "Q" ' RZ Impulse zählen sendonly "O" m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", "" If g_Abbruch Then Exit Sub End If m_FMBus.send "42 " dummy = Mid(m_FMBus.receive(500), 6, 2) If dummy <> "00" And dummy <> "03" Then If MsgBox("FM85 Fehlerbyte ist weder '00' noch '03' sondern '" & dummy & "'" & vbCrLf & Fehlerbyte42Meldung(dummy) & vbCrLf & "Möchten Sie weitermachen?", vbYesNo Or vbCritical) = vbYes Then Else ' Todo: Allgemeine Abbruchfunktion ' Prüfung abbrechen g_Abbruch = True Call Abbruch Exit Sub End If End If End Sub '------------------------------------------------------------------------- ' FM85 für diesen Prüfpunkt initialisieren: Private Sub initFM85fuerPP() Dim strAntwort As String Dim AnzahlPeriodenPZ As Double Dim AnzahlPeriodenRZ As Double Dim AnzahlPeriodenPZNeu As Long Dim AnzahlPeriodenRZA As Long Dim AnzahlPeriodenRZB As Long Dim ImpulswertigkeitRZ As Long Dim Korrekturwert As Double Dim Fehler As Double Dim fm85p As CFM85P Dim Einbauplatz As CEinbauplatz Dim Doppelimpulssperrzahl As Byte Dim Impulswertigkeit_PZ As Long Dim strDoppelimpulssperrzeit_ms As String Dim strMultiplikator As String Dim FaktorPruefzeit As Double Dim AnzahlPaletten As Integer FaktorPruefzeit = 1 PrintStatus "**********************************************" PrintStatus "Initialisierung der FM85 für Vergleichsprüfung" ' Dummy Werte sendonly "**0@" sendonly "R" Sleep 1000, True sendonly "**0@" Impulswertigkeit_PZ = m_ImpulswertigkeitPZ 'Doppelimpulssperrzahl = m_ersterPruefzaehler.getIdentNrObj.GetDoppelimpulssperrzahl PrintStatus "Doppelimpulssperrzahl= " & m_bytDoppelimpulssperrzahl Call GetDoppelimpulssperreAndMultiplikator(m_DurchflussSoll, Impulswertigkeit_PZ, m_bytDoppelimpulssperrzahl, strDoppelimpulssperrzeit_ms, strMultiplikator) If strDoppelimpulssperrzeit_ms = "0000" Then ' keine Doppelimpulssperre lblDoppelimpulssperre.caption = "keine" lblDoppelimpulssperre.BackColor = &H8000000F sendonly "G" PrintStatus "Sende 'keine Doppelimpulssperre' an FM85: 'G'" ' Doppelimpuls-Zeit PrintStatus "Sende Doppelimpuls-Zeit an FM85: '0000S'" sendonly "0000S" ' Multiplikator PrintStatus "Sende Multiplikator an FM85: '1s'" sendonly "1s" Else PrintStatus "Doppelimpulssperrzeit [ms]:" & strDoppelimpulssperrzeit_ms & " * " & strMultiplikator lblDoppelimpulssperre.caption = strDoppelimpulssperrzeit_ms & " ms * " & strMultiplikator lblDoppelimpulssperre.BackColor = vbYellow ' Doppelimpuls-Zeit PrintStatus "Sende Doppelimpuls-Zeit an FM85: '" & strDoppelimpulssperrzeit_ms & "S'" sendonly strDoppelimpulssperrzeit_ms & "S" ' Multiplikator PrintStatus "Sende Multiplikator an FM85: '" & strMultiplikator & "s'" sendonly strMultiplikator & "s" End If ' Dämpfung sendonly "3T" ' K Wert PrintStatus "Sende K-Wert an FM-85: '1000K+1'" sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = 1 ' ---------------------------------------------------------------------------------- ' Periodenzahl errechnen ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM PrintStatus "ImpulswertigkeitPZ: " & m_ImpulswertigkeitPZ PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ If m_Pruefzeit < 60 Then If m_bEichpruefvorgabenIgnorieren = True Then PrintStatus "Eichpruefvorgaben ignoriert: Pruefzeit < 60 sec!" Else PrintStatus "Prüfzeit dieses PP (" & m_Pruefzeit & "s) auf 60 s korrigiert." m_Pruefzeit = 60 End If End If Call ErrechneImpulsanzahlFuerFM85(m_DurchflussSoll, m_ImpulswertigkeitLwl, m_Pruefzeit, m_ImpulswertigkeitPZ, AnzahlPeriodenPZNeu, Korrekturwert, m_bln_LWL_PP) FaktorPruefzeit = Korrekturwert If Not g_ohneSPS Then If m_bln_LWL_PP Then m_SPS.SetLichtwellenleiter True Sleep 100, True PrintStatus "Der FM85 Eingang wurde auf LWL geschaltet." Else m_SPS.SetLichtwellenleiter False Sleep 100, True PrintStatus "Der FM85 Eingang wurde auf Opto geschaltet." End If Else MsgBox "ohne SPS: Der FM85 Eingang wird auf " & IIf(m_bln_LWL_PP, "LWL", "Opto") & " geschaltet." End If AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert PrintStatus "Korrigierte AnzahlPeriodenRZ= (" & m_Pruefzeit & "/ 3600 s/h) * " & m_DurchflussSoll & " * " & ImpulswertigkeitRZ & " * " & Korrekturwert & " = " & AnzahlPeriodenRZ '''''''''''''''' AnzahlPeriodenRZ(Prüfzeit) übersteigt die Fähigkeiten des FM85 Dim neue_Pruefzeit As Long If AnzahlPeriodenRZ > 65500 Then ' maximal mögliche Prüfzeit neue_Pruefzeit = 3600 * 65500 / (m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert) If g_blnVersuch Then PrintStatus "Die Prüfzeit wurde automatsich auf " & neue_Pruefzeit & " Sekunden verringert, damit der RZ nicht mehr als 65500 Impulse zählen muss." Else Dim strTemp As String EingabePruefzeit: ' wiederholte Eingabe der neuen Prüfzeit bis sinnvoller Wert strTemp = InputBox("Die Prüfzeit (" & m_Pruefzeit & " s) dieses Prüfpunktes ist zu lang." & vbCrLf & "Die entsprechende Anzahl der Impulse kann vom FM85 nicht mehr verarbeitet werden." & vbCrLf & "Bitte geben Sie die neue Prüfzeit in Sekunden " & vbCrLf & "(maximal " & neue_Pruefzeit & ") ein:", "Prüfzeit ist zu lang!", CStr(neue_Pruefzeit)) If Not IsNumeric(strTemp) Then GoTo EingabePruefzeit If (CLng(strTemp) < 0) Or (CLng(strTemp) >= neue_Pruefzeit) Then GoTo EingabePruefzeit neue_Pruefzeit = CLng(strTemp) PrintStatus "Die Prüfzeit wurde manuell auf " & strTemp & " Sekunden verringert, damit der RZ nicht mehr als 65500 Impulse zählen muss." End If ' Korrektur der Prüfzeit m_Pruefzeit = neue_Pruefzeit ' Korrektur der Referenzzähler-Perioden AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert End If AnzahlPeriodenPZ = AnzahlPeriodenPZNeu AnzahlPeriodenRZ = Int(AnzahlPeriodenRZ) m_AnzahlPeriodenRZ = AnzahlPeriodenRZ lblImpulseRZ.caption = AnzahlPeriodenRZ PrintStatus "AnzahlPeriodenRZ " & AnzahlPeriodenRZ & " an FM85: " & Hex(AnzahlPeriodenRZ) & "M" 'm_FMBus.send Hex(AnzahlPeriodenRZ) & "M" sendonly Hex(AnzahlPeriodenRZ) & "M" 'If m_FMBus.receive(500) <> "" Then ' PrintStatus "Warnung: Periodenzahl RZ " & AnzahlPeriodenRZ & " für FM85 ausserhalb des zulässigen Bereiches" 'End If PrintStatus "AnzahlPeriodenPZ " & AnzahlPeriodenPZ & " an FM85: " & Hex(AnzahlPeriodenPZ) & "H" For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If Einbauplatz.getPruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) Then lblPZImpulse(Einbauplatz.getNr).caption = AnzahlPeriodenPZ End If End If Next 'm_FMBus.send Hex(AnzahlPeriodenPZ) & "H" sendonly Hex(AnzahlPeriodenPZ) & "H" ' If m_FMBus.receive(500) <> "" Then ' PrintStatus "Warnung: Periodenzahl PZ " & AnzahlPeriodenPZ & " für FM85 ausserhalb des zulässigen Bereiches" ' End If Set fm85p = m_FMBus.getFM85P(m_ersterPruefzaehlerNr) fm85p.sendAttention fm85p.receive If g_Abbruch Then Exit Sub End If 'sendonly "42 " fm85p.send ("42 ") fm85p.receive strAntwort = Mid(fm85p.getLastAnswer, 6, 2) If strAntwort <> "00" Then PrintStatus Fehlerbyte42Meldung(strAntwort) If MsgBox("FM85 Fehlerbyte ist nicht '00' sondern '" & strAntwort & "':" & vbCrLf & Fehlerbyte42Meldung(strAntwort) & vbCrLf & "Möchten Sie weitermachen", vbYesNo, "FM85 Fehler") = vbYes Then Else ' Todo: Allgemeine Abbruchfunktion ' Prüfung abbrechen Call Abbruch Exit Sub End If End If If g_App.Settings.getAnzahlMIDGruppen > 1 Then ''''''''''''''''''''''''''''''''''''''''''''' ' FM85 Nr: 7 Referenzähler Vergleich: PrintStatus "Impulswertigkeit RefZ A: " & m_ReferenzzaehlerA.ImpulseQM PrintStatus "Impulswertigkeit RefZ B: " & m_ReferenzzaehlerB.ImpulseQM AnzahlPeriodenRZA = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerA.ImpulseQM) * Korrekturwert lblVerbleibRZA.caption = AnzahlPeriodenRZA AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM) * Korrekturwert lblVerbleibRZB.caption = AnzahlPeriodenRZB ' FM85 für Referenzzähler Vergleich Nr 7 setzen ' Adressieren Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) fm85p.sendAttention If g_Abbruch Then Exit Sub End If fm85p.send "R" fm85p.receive Sleep 1000, True ' Adressieren Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) fm85p.sendAttention 'fm85p.receive (500) ' Todo: Multiplikator fm85p.send "1s" ' keine Doppelimpulssprerre fm85p.send "G" ' Doppelimpuls-Zeit fm85p.send "0000S" ' Dämpfung fm85p.send "3T" ' Todo: K Wert für beide Referenzzähler sollte immer 1 sein fm85p.send Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K = 1 ' Referenzzähler A PrintStatus "Anzahl der Perioden RZA: " & AnzahlPeriodenRZA fm85p.send Hex(AnzahlPeriodenRZA) & "M" fm85p.receive If fm85p.getLastAnswer <> "" Then PrintStatus "Warnung: Periodenzahl RZA " & AnzahlPeriodenRZA & " für FM85 ausserhalb des zulässigen Bereiches" End If ' Referenzzähler B PrintStatus "Anzahl der Perioden RZB: " & AnzahlPeriodenRZB fm85p.send Hex(AnzahlPeriodenRZB) & "H" fm85p.receive If fm85p.getLastAnswer <> "" Then PrintStatus "Warnung: Periodenzahl RZB " & AnzahlPeriodenRZB & " für FM85 ausserhalb des zulässigen Bereiches" End If 'FEHLERBYTE ROUTINE AUSKOMMENTIERT APFEIFFER 21.06.2004 'fm85p.send "**" & g_FM85RefZAdresse & "@" 'm_FMBus.receive (500) fm85p.send ("42 ") fm85p.receive strAntwort = fm85p.getLastAnswer If Mid(strAntwort, 6, 2) <> "00" Then If MsgBox("FM85 Nr." & g_FM85RefZAdresse & ": Fehlerbyte ist nicht '00'" & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then Else Call Abbruch Exit Sub End If End If End If ' 2 RefZ m_Pruefzeit = m_Pruefzeit * FaktorPruefzeit PrintStatus "Neue Prüfzeit " & m_Pruefzeit & " s" End Sub ''------------------------------------------------------------------------- '' FM85 für diesen Prüfpunkt initialisieren: 'Private Sub initFM85fuerPP() ' Dim strAntwort As String ' ' Dim AnzahlPeriodenPZ As Double ' Dim AnzahlPeriodenRZ As Double ' ' Dim AnzahlPeriodenPZNeu As Long ' ' Dim AnzahlPeriodenRZA As Long ' Dim AnzahlPeriodenRZB As Long ' ' Dim ImpulswertigkeitRZ As Long ' ' Dim Korrekturwert As Double ' ' Dim Fehler As Double ' Dim fm85p As CFM85P ' ' Dim Einbauplatz As CEinbauplatz ' ' Dim Doppelimpulssperrzahl As Byte ' Dim Impulswertigkeit_PZ As Long ' ' Dim strDoppelimpulssperrzeit_ms As String ' Dim strMultiplikator As String ' ' Dim FaktorPruefzeit As Double ' Dim AnzahlPaletten As Integer ' ' FaktorPruefzeit = 1 ' ' PrintStatus "**********************************************" ' PrintStatus "Initialisierung der FM85 für Vergleichsprüfung" ' ' Dummy Werte ' sendonly "**0@" ' sendonly "R" ' ' Sleep 1000, True ' ' sendonly "**0@" ' ' Impulswertigkeit_PZ = m_ImpulswertigkeitPZ ' ' 'Doppelimpulssperrzahl = m_ersterPruefzaehler.getIdentNrObj.GetDoppelimpulssperrzahl ' PrintStatus "Doppelimpulssperrzahl= " & m_bytDoppelimpulssperrzahl ' Call GetDoppelimpulssperreAndMultiplikator(m_DurchflussSoll, Impulswertigkeit_PZ, m_bytDoppelimpulssperrzahl, strDoppelimpulssperrzeit_ms, strMultiplikator) ' If strDoppelimpulssperrzeit_ms = "0000" Then ' ' keine Doppelimpulssperre ' lblDoppelimpulssperre.Caption = "keine" ' lblDoppelimpulssperre.BackColor = &H8000000F ' ' sendonly "G" ' PrintStatus "Sende 'keine Doppelimpulssperre' an FM85: 'G'" ' ' Doppelimpuls-Zeit ' PrintStatus "Sende Doppelimpuls-Zeit an FM85: '0000S'" ' sendonly "0000S" ' ' Multiplikator ' PrintStatus "Sende Multiplikator an FM85: '1s'" ' sendonly "1s" ' Else ' PrintStatus "Doppelimpulssperrzeit [ms]:" & strDoppelimpulssperrzeit_ms & " * " & strMultiplikator ' lblDoppelimpulssperre.Caption = strDoppelimpulssperrzeit_ms & " ms * " & strMultiplikator ' lblDoppelimpulssperre.BackColor = vbYellow ' ' Doppelimpuls-Zeit ' PrintStatus "Sende Doppelimpuls-Zeit an FM85: '" & strDoppelimpulssperrzeit_ms & "S'" ' sendonly strDoppelimpulssperrzeit_ms & "S" ' ' Multiplikator ' PrintStatus "Sende Multiplikator an FM85: '" & strMultiplikator & "s'" ' sendonly strMultiplikator & "s" ' End If ' ' ' Dämpfung ' sendonly "3T" ' ' ' K Wert ' PrintStatus "Sende K-Wert an FM-85: '1000K+1'" ' sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K ' ' ' ---------------------------------------------------------------------------------- ' ' Periodenzahl errechnen ' ' ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM ' ' PrintStatus "ImpulswertigkeitPZ: " & m_ImpulswertigkeitPZ ' PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ ' ' If m_Pruefzeit < 60 Then ' If m_bEichpruefvorgabenIgnorieren = True Then ' PrintStatus "Eichpruefvorgaben ignoriert: Pruefzeit < 60 sec!" ' Else ' PrintStatus "Prüfzeit dieses PP (" & m_Pruefzeit & "s) auf 60 s korrigiert." ' m_Pruefzeit = 60 ' End If ' End If ' ' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitPZ ' PrintStatus "unkorrigierter AnzahlPeriodenPZ: " & AnzahlPeriodenPZ ' ' AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 10 + 0.999) * 10 ' PrintStatus "auf nächste 10 aufgerundete AnzahlPeriodenPZ: " & AnzahlPeriodenPZNeu ' ' ' If AnzahlPeriodenPZNeu <= 20 Then ' PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") für Opto ist kleiner oder gleich 20 !" ' If m_bLichtwellenleiter = True Then ' PrintStatus "Der FM85 Eingang wird auf LWL geschaltet." ' m_bln_LWL_PP = True ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Sleep 100, True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL geschaltet." ' End If ' ' PrintStatus "Messung mit Lichtwellenleiter: ImpulswertigkeitLWL=" & m_ImpulswertigkeitLwl ' ' ' Prüfe mit kleinerer Pruefmenge nach Vorgabe (P.Buch Regel) ' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitLwl ' PrintStatus " errechnete AnzahlPerioden für LWL: " & AnzahlPeriodenPZ ' ' Dim mindest_AnzahlPeriodenPZLWL As Long ' mindest_AnzahlPeriodenPZLWL = (m_VorgabeLiterLWL / 1000) * m_ImpulswertigkeitLwl ' ' PrintStatus " mind. Prüfmenge =" & m_VorgabeLiterLWL & " Liter" ' PrintStatus " mind. AnzahlPeriodenLWL=" & mindest_AnzahlPeriodenPZLWL ' ' 'neu RH, PB 19.11.2009 ' 'AnzahlPeriodenPZNeu = m_VorgabeLiterLWL / 1000 * m_ImpulswertigkeitLwl * (1000 / m_ImpulswertigkeitPZ) ' ' AnzahlPeriodenPZNeu = AnzahlPeriodenPZ ' PrintStatus " LWL Impulsanzahl: AnzahlPeriodenPZNeu =" & AnzahlPeriodenPZ ' ' If AnzahlPeriodenPZNeu < mindest_AnzahlPeriodenPZLWL Then ' PrintStatus "Anzahl der Perioden für Lwl wird auf mindest Anzahl (" & mindest_AnzahlPeriodenPZLWL & " Impulse) hoch gesetzt." ' AnzahlPeriodenPZNeu = mindest_AnzahlPeriodenPZLWL ' End If ' ' PrintStatus "Anzahl der Perioden für Lwl: " & AnzahlPeriodenPZNeu ' ' AnzahlPaletten = m_ersterPruefzaehler.GetAnzahlPaletten() ' PrintStatus "Anzahl der Paletten: " & AnzahlPaletten ' ' ganze Flügelradumdrehungen ' If g_blnganzeFluegelumrundung And AnzahlPaletten > 0 Then ' AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / AnzahlPaletten + 0.999) * AnzahlPaletten ' PrintStatus "auf ganze Anzahl der Paletten aufgerundet: " & AnzahlPeriodenPZNeu ' End If ' Else ' If g_blnLWLfuerallePruefpunkte = True Then ' m_bln_LWL_PP = True ' PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Sleep 100, True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' End If ' Else ' m_bln_LWL_PP = False ' PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter False ' Sleep 100, True ' Else ' MsgBox "Der FM85 Eingang wird auf Opto geschaltet." ' End If ' End If ' ' If m_bEichpruefvorgabenIgnorieren = True Then ' PrintStatus "Eichpruefvorgaben ignoriert: AnzahlPeriodenPZ < 20 !" ' Else ' PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") auf 20 Pulse korrigiert." ' AnzahlPeriodenPZNeu = 20 ' PrintStatus "PeriodenPZ muss >= 20 sein. Prüfzeit dieses PP auf " & Int(m_Pruefzeit * FaktorPruefzeit) & " s korrigiert." ' End If ' End If ' Else ' If g_blnLWLfuerallePruefpunkte = True Then ' m_bln_LWL_PP = True ' PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Sleep 100, True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' End If ' Else ' m_bln_LWL_PP = False ' PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter False ' Sleep 100, True ' Else ' MsgBox "Der FM85 Eingang wird auf Opto geschaltet." ' End If ' End If ' End If ' ' For Each Einbauplatz In m_colEinbauplatz ' If Not Einbauplatz.getPruefzaehler Is Nothing Then ' Einbauplatz.m_AnzahlPeriodenPZ = AnzahlPeriodenPZNeu ' Else ' Einbauplatz.m_AnzahlPeriodenPZ = 0 ' End If ' Next ' ' FaktorPruefzeit = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ ' ' PrintStatus "AnzahlPeriodenPZNeu: " & AnzahlPeriodenPZNeu ' Korrekturwert = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ ' PrintStatus "AnzahlPeriodenPZNeu / AnzahlPeriodenPZ = Korrekturwert= " & Korrekturwert ' ' AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert ' ' '''''''''''''''' AnzahlPeriodenRZ(Prüfzeit) übersteigt die Fähigkeiten des FM85 ' Dim neue_Pruefzeit As Long ' If AnzahlPeriodenRZ > 65500 Then ' ' maximal mögliche Prüfzeit ' neue_Pruefzeit = 3600 * 65500 / (m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert) ' Dim strTemp As String 'EingabePruefzeit: ' wiederholte Eingabe der neuen Prüfzeit bis sinnvoller Wert ' strTemp = InputBox("Die Prüfzeit (" & m_Pruefzeit & " s) dieses Prüfpunktes ist zu lang." & vbCrLf & "Die entsprechende Anzahl der Impulse kann vom FM85 nicht mehr verarbeitet werden." & vbCrLf & "Bitte geben Sie die neue Prüfzeit in Sekunden " & vbCrLf & "(maximal " & neue_Pruefzeit & ") ein:", "Prüfzeit ist zu lang!", CStr(neue_Pruefzeit)) ' If Not IsNumeric(strTemp) Then GoTo EingabePruefzeit ' If (CLng(strTemp) < 0) Or (CLng(strTemp) >= neue_Pruefzeit) Then GoTo EingabePruefzeit ' neue_Pruefzeit = CLng(strTemp) ' PrintStatus "Die Prüfzeit wurde manuell auf " & strTemp & " Sekunden verringert, damit der RZ nicht mehr als 65500 Impulse zählen muss." ' ' Korrektur der Prüfzeit ' m_Pruefzeit = neue_Pruefzeit ' ' Korrektur der Referenzzähler-Perioden ' AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert ' End If ' ' AnzahlPeriodenPZ = AnzahlPeriodenPZNeu ' AnzahlPeriodenRZ = Int(AnzahlPeriodenRZ) ' ' PrintStatus "Perioden RZ: " & AnzahlPeriodenRZ ' m_AnzahlPeriodenRZ = AnzahlPeriodenRZ ' ' lblImpulseRZ.Caption = AnzahlPeriodenRZ ' ' PrintStatus "AnzahlPeriodenRZ an FM85: " & Hex(AnzahlPeriodenRZ) & "M" ' ' 'm_FMBus.send Hex(AnzahlPeriodenRZ) & "M" ' sendonly Hex(AnzahlPeriodenRZ) & "M" ' ' 'If m_FMBus.receive(500) <> "" Then ' ' PrintStatus "Warnung: Periodenzahl RZ " & AnzahlPeriodenRZ & " für FM85 ausserhalb des zulässigen Bereiches" ' 'End If ' ' PrintStatus "Perioden PZ: " & AnzahlPeriodenPZ ' PrintStatus "AnzahlPeriodenPZ an FM85: " & Hex(AnzahlPeriodenPZ) & "H" ' ' For Each Einbauplatz In m_colEinbauplatz ' If Not Einbauplatz.getPruefzaehler Is Nothing Then ' If Einbauplatz.getPruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) Then ' lblPZImpulse(Einbauplatz.getNr).Caption = AnzahlPeriodenPZ ' End If ' End If ' Next ' ' ' 'm_FMBus.send Hex(AnzahlPeriodenPZ) & "H" ' sendonly Hex(AnzahlPeriodenPZ) & "H" ' '' If m_FMBus.receive(500) <> "" Then '' PrintStatus "Warnung: Periodenzahl PZ " & AnzahlPeriodenPZ & " für FM85 ausserhalb des zulässigen Bereiches" '' End If ' ' Set fm85p = m_FMBus.getFM85P(m_ersterPruefzaehlerNr) ' fm85p.sendAttention ' fm85p.receive ' ' If g_Abbruch Then ' Exit Sub ' End If ' ' 'sendonly "42 " ' fm85p.send ("42 ") ' fm85p.receive ' ' strAntwort = Mid(fm85p.getLastAnswer, 6, 2) ' ' If strAntwort <> "00" Then ' PrintStatus Fehlerbyte42Meldung(strAntwort) ' If MsgBox("FM85 Fehlerbyte ist nicht '00' sondern '" & strAntwort & "':" & vbCrLf & Fehlerbyte42Meldung(strAntwort) & vbCrLf & "Möchten Sie weitermachen", vbYesNo, "FM85 Fehler") = vbYes Then ' Else ' ' Todo: Allgemeine Abbruchfunktion ' ' Prüfung abbrechen ' Call Abbruch ' Exit Sub ' End If ' End If ' 'If g_App.Settings.getAnzahlMIDGruppen > 1 Then ' ''''''''''''''''''''''''''''''''''''''''''''' ' ' FM85 Nr: 7 Referenzähler Vergleich: ' ' PrintStatus "Impulswertigkeit RefZ A: " & m_ReferenzzaehlerA.ImpulseQM ' PrintStatus "Impulswertigkeit RefZ B: " & m_ReferenzzaehlerB.ImpulseQM ' ' AnzahlPeriodenRZA = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerA.ImpulseQM) * Korrekturwert ' lblVerbleibRZA.Caption = AnzahlPeriodenRZA ' ' AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM) * Korrekturwert ' lblVerbleibRZB.Caption = AnzahlPeriodenRZB ' ' ' FM85 für Referenzzähler Vergleich Nr 7 setzen ' ' Adressieren ' ' Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) ' fm85p.sendAttention ' ' If g_Abbruch Then ' Exit Sub ' End If ' ' fm85p.send "R" ' fm85p.receive ' ' Sleep 1000, True ' ' ' Adressieren ' Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) ' fm85p.sendAttention ' ' 'fm85p.receive (500) ' ' ' Todo: Multiplikator ' fm85p.send "1s" ' ' ' keine Doppelimpulssprerre ' fm85p.send "G" ' ' ' Doppelimpuls-Zeit ' fm85p.send "0000S" ' ' ' Dämpfung ' fm85p.send "3T" ' ' ' Todo: K Wert für beide Referenzzähler sollte immer 1 sein ' fm85p.send Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K = 1 ' ' ' Referenzzähler A ' PrintStatus "Anzahl der Perioden RZA: " & AnzahlPeriodenRZA ' fm85p.send Hex(AnzahlPeriodenRZA) & "M" ' ' fm85p.receive ' ' If fm85p.getLastAnswer <> "" Then ' PrintStatus "Warnung: Periodenzahl RZA " & AnzahlPeriodenRZA & " für FM85 ausserhalb des zulässigen Bereiches" ' End If ' ' ' Referenzzähler B ' PrintStatus "Anzahl der Perioden RZB: " & AnzahlPeriodenRZB ' fm85p.send Hex(AnzahlPeriodenRZB) & "H" ' fm85p.receive ' ' If fm85p.getLastAnswer <> "" Then ' PrintStatus "Warnung: Periodenzahl RZB " & AnzahlPeriodenRZB & " für FM85 ausserhalb des zulässigen Bereiches" ' End If ' ' ' 'FEHLERBYTE ROUTINE AUSKOMMENTIERT APFEIFFER 21.06.2004 ' ' 'fm85p.send "**" & g_FM85RefZAdresse & "@" ' 'm_FMBus.receive (500) ' ' fm85p.send ("42 ") ' fm85p.receive ' strAntwort = fm85p.getLastAnswer ' ' If Mid(strAntwort, 6, 2) <> "00" Then ' ' If MsgBox("FM85 Nr." & g_FM85RefZAdresse & ": Fehlerbyte ist nicht '00'" & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then ' Else ' Call Abbruch ' Exit Sub ' End If ' End If ' End If ' 2 RefZ ' ' m_Pruefzeit = m_Pruefzeit * FaktorPruefzeit ' PrintStatus "Neue Prüfzeit " & m_Pruefzeit & " s" 'End Sub ' Private Function ErrechneImpulsanzahlFuerFM85(ByVal DurchflussSoll As Double, ByVal ImpulswertigkeitPZ_LWL As Long, ByVal Pruefzeit As Long, ByVal ImpulswertigkeitPZ_Opto As Long, ByRef AnzahlPeriodenPZNeu As Long, ByRef Korrekturwert As Double, ByRef blnRelais_auf_LWL As Boolean) ' Eingabe: 'ByVal DurchflussSoll As Double as double enthält den Solldurchfluss in m³/h 'ByVal ImpulswertigkeitPZ_LWL As Long enthält die Impulswertigkeit des LWL Eingangs 'ByVal Pruefzeit As Long enthält die SollPrüfzeit in Sekunden 'ByVal ImpulswertigkeitPZ_Opto As Long enthält die Impulswertigkeit des Opto Eingangs 'Ausgabe: 'ByRef AnzahlPeriodenPZNeu As Long enthält die neu errechnete Impulsanzahl des Prüfzählers 'ByRef FaktorPruefzeit As Double enthält den Korrekturwert für die Impulsanzahl des RZ bzw. der Prüfzeit 'ByRef blnRelais_auf_LWL As Boolean wird True wenn Umschaltung auf LWL erfolgen muss Dim AnzahlPaletten As Integer Dim AnzahlPeriodenPZ As Double ' Muss double sein, weil Stellen hinter dem Komma wichtig sind Dim mindest_AnzahlPeriodenPZLWL As Long Dim Einbauplatz As CEinbauplatz ' zum Vergleich mit 20 Impulsen immer Opto-Impulswertigkeit verwenden AnzahlPeriodenPZ = (Pruefzeit / 3600) * DurchflussSoll * ImpulswertigkeitPZ_Opto PrintStatus "unkorrigierter AnzahlPeriodenPZ (Opto): " & Pruefzeit & "s /(3600 s/h)* " & Round(DurchflussSoll, 5) & " m³/h * " & ImpulswertigkeitPZ_Opto & " Impulse/m³ = " & AnzahlPeriodenPZ & " Impulse" AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 10 + 0.999) * 10 PrintStatus "auf nächste 10 aufgerundet: " & AnzahlPeriodenPZNeu & " Impulse" If AnzahlPeriodenPZNeu <= 20 Then PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") für Opto ist kleiner oder gleich 20 !" If m_bLichtwellenleiter Then ' Lichtwellenleiter wird verwendet ' UND die Anzahl der Perioden wären für einen Opto weniger als 20 Impulse: ' dann mit LWL prüfen ' Der FM85 Eingang wird auf LWL geschaltet blnRelais_auf_LWL = True PrintStatus "Messung mit Lichtwellenleiter: ImpulswertigkeitLWL=" & ImpulswertigkeitPZ_LWL ' Prüfe mit kleinerer Pruefmenge nach Vorgabe (P.Buch Regel) AnzahlPeriodenPZ = (Pruefzeit / 3600) * DurchflussSoll * ImpulswertigkeitPZ_LWL PrintStatus "AnzahlPerioden für LWL: " & AnzahlPeriodenPZ ' jetzt mit der Impulswertigekeit des LWL rechnen AnzahlPeriodenPZNeu = AnzahlPeriodenPZ If chkKeineVolumenvorgabe.value = vbUnchecked Then mindest_AnzahlPeriodenPZLWL = Int((m_VorgabeLiterLWL / 1000) * ImpulswertigkeitPZ_LWL + 0.99) PrintStatus " mind. Prüfmenge =" & m_VorgabeLiterLWL & " Liter entspricht mind. AnzahlPeriodenLWL=" & mindest_AnzahlPeriodenPZLWL If AnzahlPeriodenPZNeu < mindest_AnzahlPeriodenPZLWL Then PrintStatus "Anzahl der Perioden für Lwl wird auf mindest Anzahl (" & mindest_AnzahlPeriodenPZLWL & " Impulse entspricht " & m_VorgabeLiterLWL & " Liter) hoch gesetzt." AnzahlPeriodenPZNeu = mindest_AnzahlPeriodenPZLWL End If End If ' ganze Flügelradumdrehungen If g_blnganzeFluegelumrundung And AnzahlPaletten > 0 Then AnzahlPaletten = m_ersterPruefzaehler.GetAnzahlPaletten() AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / AnzahlPaletten + 0.999) * AnzahlPaletten PrintStatus "auf ganze Anzahl der Paletten (" & AnzahlPaletten & ") aufgerundet: " & AnzahlPeriodenPZNeu End If Else ' es sollen nur Optos verwendet werden ' die Anzahl der Perioden sind für einen Opto weniger als 20 Impulse: If g_blnLWLfuerallePruefpunkte = True Then ' LWL statt Opto für alle PP bei Encoder blnRelais_auf_LWL = True PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." Else blnRelais_auf_LWL = False PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." End If If m_bEichpruefvorgabenIgnorieren = True Then PrintStatus "Eichpruefvorgaben ignoriert: AnzahlPeriodenPZ darf kleiner gleich 20 sein!" Else ' mindestens 20 Impulse beim Opto als auch beim LWL PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") auf 20 Pulse korrigiert." ' es wird auf 20 Impulse aufgerundet AnzahlPeriodenPZNeu = 20 End If End If Else ' für einen Opto wären es mehr als 20 Impulse, also Opto verwenden ' es sei denn, Encoder ist ausgewählt PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") für Opto ist größer 20 !" If g_blnLWLfuerallePruefpunkte = True Then blnRelais_auf_LWL = True PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." AnzahlPeriodenPZ = (Pruefzeit / 3600) * DurchflussSoll * ImpulswertigkeitPZ_LWL PrintStatus "unkorrigierter AnzahlPeriodenPZ (LWL): " & Pruefzeit & "s /(3600 s/h)* " & Round(DurchflussSoll, 5) & " m³/h * " & ImpulswertigkeitPZ_LWL & " Impulse/m³ = " & AnzahlPeriodenPZ & " Impulse" ' ganze Flügelradumdrehungen bei LWL If g_blnganzeFluegelumrundung And AnzahlPaletten > 0 Then AnzahlPaletten = m_ersterPruefzaehler.GetAnzahlPaletten() AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / AnzahlPaletten + 0.999) * AnzahlPaletten PrintStatus "auf ganze Anzahl der Paletten (" & AnzahlPaletten & ") aufgerundet: " & AnzahlPeriodenPZNeu Else 'todo Hier erst AnzahlPeriodenPZNeu berechnen AnzahlPeriodenPZNeu = AnzahlPeriodenPZ End If Else blnRelais_auf_LWL = False PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." End If End If For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then Einbauplatz.m_AnzahlPeriodenPZ = AnzahlPeriodenPZNeu Else Einbauplatz.m_AnzahlPeriodenPZ = 0 End If Next Korrekturwert = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ PrintStatus "Korrekturwert = " & AnzahlPeriodenPZNeu & " / " & AnzahlPeriodenPZ & " = " & Korrekturwert End Function ''------------------------------------------------------------------------- '' FM85 für diesen Prüfpunkt initialisieren: 'Private Sub initFM85fuerPPundImpulswertigkeit() ' Dim strAntwort As String ' ' Dim AnzahlPeriodenPZ As Double ' Dim AnzahlPeriodenRZ As Double ' ' Dim AnzahlPeriodenPZNeu As Long ' ' Dim AnzahlPeriodenRZA As Long ' Dim AnzahlPeriodenRZB As Long ' ' Dim ImpulswertigkeitRZ As Long ' ' Dim Korrekturwert As Double ' ' Dim Fehler As Double ' Dim fm85p As CFM85P ' ' Dim Pruefzaehler As CPruefzaehler ' Dim Einbauplatz As CEinbauplatz ' ' Dim Doppelimpulssperrzahl As Byte ' Dim Impulswertigkeit_PZ As Long ' ' Dim strDoppelimpulssperrzeit_ms As String ' Dim strMultiplikator As String ' ' Dim FaktorPruefzeit As Double ' Dim AnzahlPaletten As Integer ' ' FaktorPruefzeit = 1 ' ' PrintStatus "**********************************************" ' PrintStatus "Initialisierung der FM85 für Vergleichsprüfung" ' ' Dummy Werte ' sendonly "**0@" ' sendonly "R" ' Sleep 1000, True ' ' For Each Einbauplatz In m_colEinbauplatz ' If Not Einbauplatz.getPruefzaehler Is Nothing Then ' If m_ImpulswertigkeitPZ > 0 Then ' Impulswertigkeit_PZ = m_ImpulswertigkeitPZ ' Else ' Impulswertigkeit_PZ = Einbauplatz.m_ImpulseQM ' End If ' ' sendonly "**" & Einbauplatz.getNr & "@" ' PrintStatus "Doppelimpulssperrzahl= " & m_bytDoppelimpulssperrzahl ' Call GetDoppelimpulssperreAndMultiplikator(m_DurchflussSoll, Impulswertigkeit_PZ, m_bytDoppelimpulssperrzahl, strDoppelimpulssperrzeit_ms, strMultiplikator) ' If strDoppelimpulssperrzeit_ms = "0000" Then ' ' keine Doppelimpulssperre ' lblDoppelimpulssperre.Caption = "keine" ' lblDoppelimpulssperre.BackColor = &H8000000F ' sendonly "G" ' PrintStatus "Sende 'keine Doppelimpulssperre' an FM85-" & Einbauplatz.getNr & ": 'G'" ' ' Doppelimpuls-Zeit ' PrintStatus "Sende Doppelimpuls-Zeit an FM85: '0000S'" ' sendonly "0000S" ' ' Multiplikator ' PrintStatus "Sende Multiplikator an FM85: '1s'" ' sendonly "1s" ' Else ' PrintStatus "FM85-" & Einbauplatz.getNr & ": Doppelimpulssperrzeit [ms]:" & strDoppelimpulssperrzeit_ms & " * " & strMultiplikator ' lblDoppelimpulssperre.Caption = strDoppelimpulssperrzeit_ms & " ms * " & strMultiplikator ' lblDoppelimpulssperre.BackColor = vbYellow ' ' Doppelimpuls-Zeit ' PrintStatus "Sende Doppelimpuls-Zeit an FM85: '" & strDoppelimpulssperrzeit_ms & "S'" ' sendonly strDoppelimpulssperrzeit_ms & "S" ' ' Multiplikator ' PrintStatus "Sende Multiplikator an FM85: '" & strMultiplikator & "s'" ' sendonly strMultiplikator & "s" ' End If ' End If ' Next ' ' 'für alle gleich: ' ' Dämpfung für ' sendonly "**0@" ' sendonly "3T" ' ' K Wert ' PrintStatus "Sende K-Wert an FM-85: '1000K+1'" ' sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K ' ' ' ---------------------------------------------------------------------------------- ' ' Periodenzahl errechnen ' PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ ' ' ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM ' If m_Pruefzeit < 60 Then ' If m_bEichpruefvorgabenIgnorieren = True Then ' PrintStatus "Eichpruefvorgaben ignoriert: Pruefzeit < 60 sec!" ' Else ' PrintStatus "Prüfzeit dieses PP (" & m_Pruefzeit & "s) auf 60 s korrigiert." ' m_Pruefzeit = 60 ' End If ' End If ' ' For Each Einbauplatz In m_colEinbauplatz ' If Not Einbauplatz.getPruefzaehler Is Nothing Then ' If m_ImpulswertigkeitPZ > 0 Then ' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitPZ ' PrintStatus "unkorrigierte AnzahlPeriodenPZ für alle Einbauplaetze (" & Einbauplatz.getNr & ") : " & AnzahlPeriodenPZ ' Else ' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * Einbauplatz.m_ImpulseQM ' PrintStatus "unkorrigierte AnzahlPeriodenPZ für Einbauplatz " & Einbauplatz.getNr & " : " & AnzahlPeriodenPZ ' End If ' ' 'geändert für MeiStream Versuche AP 25.01.2005 ' 'AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 12 + 0.999) * 12 ' 'wieder zurück geändert für normale Opto Kopf Abgriffe AP 01.03.2005 ' AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 10 + 0.999) * 10 ' PrintStatus "auf nächste 10 aufgerundete AnzahlPeriodenPZ: " & AnzahlPeriodenPZNeu ' ' ' FaktorPruefzeit = FaktorPruefzeit * AnzahlPeriodenPZNeu / AnzahlPeriodenPZ ' ' If AnzahlPeriodenPZNeu <= 20 Then ' PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") für Opto ist kleiner oder gleich 20!" ' If m_bLichtwellenleiter = True Then ' m_bln_LWL_PP = True ' PrintStatus "Der FM85 Eingang wird auf LWL geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL geschaltet." ' End If ' ' ' Prüfe mit 10 Litern ' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * Einbauplatz.m_ImpulseLwl ' PrintStatus "Messung mit Lichtwellenleiter: ImpulswertigkeitLWL=" & Einbauplatz.m_ImpulseLwl ' ' PrintStatus " Prüfmenge " & m_VorgabeLiterLWL & " Liter" ' ' 'AnzahlPeriodenPZNeu = m_VorgabeLiterLWL / 1000 * m_ImpulswertigkeitLwl ' ' ' 'neu RH, PB 19.11.2009 ' AnzahlPeriodenPZNeu = m_VorgabeLiterLWL / 1000 * m_ImpulswertigkeitLwl * (1000 / Einbauplatz.m_ImpulseQM) ' PrintStatus "Anzahl der Perioden für Lwl: " & AnzahlPeriodenPZNeu ' ' AnzahlPaletten = Einbauplatz.getPruefzaehler.GetAnzahlPaletten() ' PrintStatus "Anzahl der Paletten: " & AnzahlPaletten ' ' ganze Flügelradumdrehungen ' If g_blnganzeFluegelumrundung And AnzahlPaletten > 0 Then ' AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / AnzahlPaletten + 0.999) * AnzahlPaletten ' PrintStatus "auf ganze Anzahl der Paletten aufgerundet: " & AnzahlPeriodenPZNeu ' End If ' Else ' If g_blnLWLfuerallePruefpunkte = True Then ' m_bln_LWL_PP = True ' PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' End If ' Else ' m_bln_LWL_PP = False ' PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter False ' Else ' MsgBox "Der FM85 Eingang wird auf Opto geschaltet." ' End If ' End If ' ' If m_bEichpruefvorgabenIgnorieren = True Then ' PrintStatus "Eichpruefvorgaben ignoriert: AnzahlPeriodenPZ < 20 !" ' Else ' PrintStatus "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") auf 20 Pulse korrigiert." ' AnzahlPeriodenPZNeu = 20 ' PrintStatus "PeriodenPZ muss >= 20 sein. Prüfzeit dieses PP auf " & Int(m_Pruefzeit * FaktorPruefzeit) & " s korrigiert." ' End If ' End If ' Else ' If g_blnLWLfuerallePruefpunkte = True Then ' m_bln_LWL_PP = True ' PrintStatus "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter True ' Else ' MsgBox "Der FM85 Eingang wird auf LWL / Encoder geschaltet." ' End If ' Else ' m_bln_LWL_PP = False ' PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." ' If Not g_ohneSPS Then ' m_SPS.SetLichtwellenleiter False ' Else ' MsgBox "Der FM85 Eingang wird auf Opto geschaltet." ' End If ' End If ' End If ' ' FaktorPruefzeit = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ ' ' PrintStatus "AnzahlPeriodenPZNeu: " & AnzahlPeriodenPZNeu ' Einbauplatz.m_AnzahlPeriodenPZ = AnzahlPeriodenPZNeu ' ' Korrekturwert = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ ' PrintStatus "AnzahlPeriodenPZNeu / AnzahlPeriodenPZ = Korrekturwert= " & Korrekturwert ' ' AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert ' '''''''''''''''' AnzahlPeriodenRZ(Prüfzeit) übersteigt die Fähigkeiten des FM85 ' Dim neue_Pruefzeit As Long ' If AnzahlPeriodenRZ > 65500 Then ' ' maximal mögliche Prüfzeit ' neue_Pruefzeit = 3600 * 65500 / (m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert) ' Dim strTemp As String ' 'EingabePruefzeit: ' wiederholte Eingabe der neuen Prüfzeit bis sinnvoller Wert ' strTemp = InputBox("Die Prüfzeit (" & m_Pruefzeit & " s) dieses Prüfpunktes ist zu lang." & vbCrLf & "Die entsprechende Anzahl der Impulse kann vom FM85 nicht mehr verarbeitet werden." & vbCrLf & "Bitte geben Sie die neue Prüfzeit in Sekunden " & vbCrLf & "(maximal " & neue_Pruefzeit & ") ein:", "Prüfzeit ist zu lang!", CStr(neue_Pruefzeit)) ' If Not IsNumeric(strTemp) Then GoTo EingabePruefzeit ' If (CLng(strTemp) < 0) Or (CLng(strTemp) >= neue_Pruefzeit) Then GoTo EingabePruefzeit ' neue_Pruefzeit = CLng(strTemp) ' PrintStatus "Die Prüfzeit wurde manuell auf " & strTemp & " Sekunden verringert, damit der RZ nicht mehr als 65500 Impulse zählen muss." ' ' Korrektur der Prüfzeit ' m_Pruefzeit = neue_Pruefzeit ' ' Korrektur der Referenzzähler-Perioden ' AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert ' End If ' ' AnzahlPeriodenPZ = AnzahlPeriodenPZNeu ' AnzahlPeriodenRZ = Int(AnzahlPeriodenRZ) ' ' PrintStatus "Perioden RZ: " & AnzahlPeriodenRZ ' m_AnzahlPeriodenRZ = AnzahlPeriodenRZ ' ' lblImpulseRZ.Caption = AnzahlPeriodenRZ ' sendonly "**" & Einbauplatz.getNr & "@" ' ' PrintStatus "AnzahlPeriodenRZ an FM85-" & Einbauplatz.getNr & ": " & Hex(AnzahlPeriodenRZ) & "M" ' sendonly Hex(AnzahlPeriodenRZ) & "M" ' ' If Einbauplatz.getPruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) Then ' lblPZImpulse(Einbauplatz.getNr).Caption = AnzahlPeriodenPZ ' End If ' ' PrintStatus "Perioden PZ: " & AnzahlPeriodenPZ ' PrintStatus "AnzahlPeriodenPZ an FM85-" & Einbauplatz.getNr & ": " & Hex(AnzahlPeriodenPZ) & "H" ' sendonly Hex(AnzahlPeriodenPZ) & "H" ' ' ' fehlerbyte prüfen ' Set fm85p = m_FMBus.getFM85P(Einbauplatz.getNr) ' ' fm85p.send ("42 ") ' fm85p.receive ' strAntwort = Mid(fm85p.getLastAnswer, 6, 2) ' ' If strAntwort <> "00" Then ' PrintStatus Fehlerbyte42Meldung("FM85-" & Einbauplatz.getNr & ": " & strAntwort) ' If MsgBox("FM85 Fehlerbyte ist nicht '00' sondern '" & strAntwort & "':" & vbCrLf & Fehlerbyte42Meldung(strAntwort) & vbCrLf & "Möchten Sie weitermachen", vbYesNo, "FM85 Fehler") = vbYes Then ' ' ' Else ' ' Todo: Allgemeine Abbruchfunktion ' ' Prüfung abbrechen ' Call Abbruch ' Exit Sub ' End If ' End If ' Else ' 'Prüfzähler is nothing ' Einbauplatz.m_AnzahlPeriodenPZ = 0 ' End If 'Prüfzähler is not nothing ' If g_Abbruch Then ' Exit Sub ' End If ' Next ' 'If g_App.Settings.getAnzahlMIDGruppen > 1 Then ' ''''''''''''''''''''''''''''''''''''''''''''' ' ' FM85 Nr: 7 Referenzähler Vergleich: ' ' PrintStatus "Impulswertigkeit RefZ A: " & m_ReferenzzaehlerA.ImpulseQM ' PrintStatus "Impulswertigkeit RefZ B: " & m_ReferenzzaehlerB.ImpulseQM ' ' AnzahlPeriodenRZA = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerA.ImpulseQM) * Korrekturwert ' lblVerbleibRZA.Caption = AnzahlPeriodenRZA ' ' AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM) * Korrekturwert ' lblVerbleibRZB.Caption = AnzahlPeriodenRZB ' ' ' FM85 für Referenzzähler Vergleich Nr 7 setzen ' ' Adressieren ' ' Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) ' fm85p.sendAttention ' ' If g_Abbruch Then ' Exit Sub ' End If ' ' fm85p.send "R" ' fm85p.receive ' ' Sleep 1000, True ' ' ' Adressieren ' Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) ' fm85p.sendAttention ' ' 'fm85p.receive (500) ' ' ' Todo: Multiplikator ' fm85p.send "1s" ' ' ' keine Doppelimpulssprerre ' fm85p.send "G" ' ' ' Doppelimpuls-Zeit ' fm85p.send "0000S" ' ' ' Dämpfung ' fm85p.send "3T" ' ' ' Todo: K Wert für beide Referenzzähler sollte immer 1 sein ' fm85p.send Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K = 1 ' ' ' Referenzzähler A ' PrintStatus "Anzahl der Perioden RZA: " & AnzahlPeriodenRZA ' fm85p.send Hex(AnzahlPeriodenRZA) & "M" ' ' fm85p.receive ' ' If fm85p.getLastAnswer <> "" Then ' PrintStatus "Warnung: Periodenzahl RZA " & AnzahlPeriodenRZA & " für FM85 ausserhalb des zulässigen Bereiches" ' End If ' ' ' Referenzzähler B ' PrintStatus "Anzahl der Perioden RZB: " & AnzahlPeriodenRZB ' fm85p.send Hex(AnzahlPeriodenRZB) & "H" ' fm85p.receive ' ' If fm85p.getLastAnswer <> "" Then ' PrintStatus "Warnung: Periodenzahl RZB " & AnzahlPeriodenRZB & " für FM85 ausserhalb des zulässigen Bereiches" ' End If ' ' ' 'FEHLERBYTE ROUTINE AUSKOMMENTIERT APFEIFFER 21.06.2004 ' ' 'fm85p.send "**" & g_FM85RefZAdresse & "@" ' 'm_FMBus.receive (500) ' ' fm85p.send ("42 ") ' fm85p.receive ' strAntwort = fm85p.getLastAnswer ' ' If Mid(strAntwort, 6, 2) <> "00" Then ' If MsgBox("FM85 Nr." & g_FM85RefZAdresse & ": Fehlerbyte ist nicht '00'" & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then ' Else ' Call Abbruch ' Exit Sub ' End If ' End If ' End If ' 2 RefZ ' ' m_Pruefzeit = m_Pruefzeit * FaktorPruefzeit ' PrintStatus "Neue Prüfzeit " & m_Pruefzeit & " s" 'End Sub ' '------------------------------------------------------------------------- ' FM85 für diesen Prüfpunkt initialisieren: Private Sub initFM85fuerPPundImpulswertigkeit() Dim strAntwort As String Dim AnzahlPeriodenPZ As Double Dim AnzahlPeriodenRZ As Double Dim AnzahlPeriodenPZNeu As Long Dim AnzahlPeriodenRZA As Long Dim AnzahlPeriodenRZB As Long Dim ImpulswertigkeitRZ As Long Dim Korrekturwert As Double Dim Fehler As Double Dim fm85p As CFM85P Dim Pruefzaehler As CPruefzaehler Dim Einbauplatz As CEinbauplatz Dim Doppelimpulssperrzahl As Byte Dim Impulswertigkeit_PZ As Long Dim strDoppelimpulssperrzeit_ms As String Dim strMultiplikator As String Dim FaktorPruefzeit As Double Dim AnzahlPaletten As Integer FaktorPruefzeit = 1 PrintStatus "**********************************************" PrintStatus "Initialisierung der FM85 für Vergleichsprüfung" ' Dummy Werte sendonly "**0@" sendonly "R" Sleep 1000, True For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If m_ImpulswertigkeitPZ > 0 Then Impulswertigkeit_PZ = m_ImpulswertigkeitPZ Else Impulswertigkeit_PZ = Einbauplatz.m_ImpulseQM End If sendonly "**" & Einbauplatz.getNr & "@" PrintStatus "Doppelimpulssperrzahl= " & m_bytDoppelimpulssperrzahl Call GetDoppelimpulssperreAndMultiplikator(m_DurchflussSoll, Impulswertigkeit_PZ, m_bytDoppelimpulssperrzahl, strDoppelimpulssperrzeit_ms, strMultiplikator) If strDoppelimpulssperrzeit_ms = "0000" Then ' keine Doppelimpulssperre lblDoppelimpulssperre.caption = "keine" lblDoppelimpulssperre.BackColor = &H8000000F sendonly "G" PrintStatus "Sende 'keine Doppelimpulssperre' an FM85-" & Einbauplatz.getNr & ": 'G'" ' Doppelimpuls-Zeit PrintStatus "Sende Doppelimpuls-Zeit an FM85: '0000S'" sendonly "0000S" ' Multiplikator PrintStatus "Sende Multiplikator an FM85: '1s'" sendonly "1s" Else PrintStatus "FM85-" & Einbauplatz.getNr & ": Doppelimpulssperrzeit [ms]:" & strDoppelimpulssperrzeit_ms & " * " & strMultiplikator lblDoppelimpulssperre.caption = strDoppelimpulssperrzeit_ms & " ms * " & strMultiplikator lblDoppelimpulssperre.BackColor = vbYellow ' Doppelimpuls-Zeit PrintStatus "Sende Doppelimpuls-Zeit an FM85: '" & strDoppelimpulssperrzeit_ms & "S'" sendonly strDoppelimpulssperrzeit_ms & "S" ' Multiplikator PrintStatus "Sende Multiplikator an FM85: '" & strMultiplikator & "s'" sendonly strMultiplikator & "s" End If End If Next 'für alle gleich: ' Dämpfung für sendonly "**0@" sendonly "3T" ' K Wert PrintStatus "Sende K-Wert an FM-85: '1000K+1'" sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K ' ---------------------------------------------------------------------------------- ' Periodenzahl errechnen PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM If m_Pruefzeit < 60 Then If m_bEichpruefvorgabenIgnorieren = True Then PrintStatus "Eichpruefvorgaben ignoriert: Pruefzeit < 60 sec!" Else PrintStatus "Prüfzeit dieses PP (" & m_Pruefzeit & "s) auf 60 s korrigiert." m_Pruefzeit = 60 End If End If For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then If m_ImpulswertigkeitPZ > 0 Then AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitPZ PrintStatus "unkorrigierte AnzahlPeriodenPZ für alle Einbauplaetze (" & Einbauplatz.getNr & ") : " & AnzahlPeriodenPZ Else AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * Einbauplatz.m_ImpulseQM PrintStatus "unkorrigierte AnzahlPeriodenPZ für Einbauplatz " & Einbauplatz.getNr & " : " & AnzahlPeriodenPZ End If Call ErrechneImpulsanzahlFuerFM85(m_DurchflussSoll, Einbauplatz.m_ImpulseLwl, m_Pruefzeit, Einbauplatz.m_ImpulseQM, AnzahlPeriodenPZNeu, Korrekturwert, m_bln_LWL_PP) FaktorPruefzeit = Korrekturwert If Not g_ohneSPS Then If m_bln_LWL_PP Then m_SPS.SetLichtwellenleiter True Sleep 100, True PrintStatus "Der FM85 Eingang wurde auf LWL geschaltet." Else m_SPS.SetLichtwellenleiter False Sleep 100, True PrintStatus "Der FM85 Eingang wurde auf Opto geschaltet." End If Else MsgBox "ohne SPS: Der FM85 Eingang wird auf " & IIf(m_bln_LWL_PP, "LWL", "Opto") & " geschaltet." End If Einbauplatz.m_AnzahlPeriodenPZ = AnzahlPeriodenPZNeu AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert '''''''''''''''' AnzahlPeriodenRZ(Prüfzeit) übersteigt die Fähigkeiten des FM85 Dim neue_Pruefzeit As Long If AnzahlPeriodenRZ > 65500 Then ' maximal mögliche Prüfzeit neue_Pruefzeit = 3600 * 65500 / (m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert) Dim strTemp As String EingabePruefzeit: ' wiederholte Eingabe der neuen Prüfzeit bis sinnvoller Wert strTemp = InputBox("Die Prüfzeit (" & m_Pruefzeit & " s) dieses Prüfpunktes ist zu lang." & vbCrLf & "Die entsprechende Anzahl der Impulse kann vom FM85 nicht mehr verarbeitet werden." & vbCrLf & "Bitte geben Sie die neue Prüfzeit in Sekunden " & vbCrLf & "(maximal " & neue_Pruefzeit & ") ein:", "Prüfzeit ist zu lang!", CStr(neue_Pruefzeit)) If Not IsNumeric(strTemp) Then GoTo EingabePruefzeit If (CLng(strTemp) < 0) Or (CLng(strTemp) >= neue_Pruefzeit) Then GoTo EingabePruefzeit neue_Pruefzeit = CLng(strTemp) PrintStatus "Die Prüfzeit wurde manuell auf " & strTemp & " Sekunden verringert, damit der RZ nicht mehr als 65500 Impulse zählen muss." ' Korrektur der Prüfzeit m_Pruefzeit = neue_Pruefzeit ' Korrektur der Referenzzähler-Perioden AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ * Korrekturwert End If AnzahlPeriodenPZ = AnzahlPeriodenPZNeu AnzahlPeriodenRZ = Int(AnzahlPeriodenRZ) PrintStatus "Perioden RZ: " & AnzahlPeriodenRZ m_AnzahlPeriodenRZ = AnzahlPeriodenRZ lblImpulseRZ.caption = AnzahlPeriodenRZ sendonly "**" & Einbauplatz.getNr & "@" PrintStatus "AnzahlPeriodenRZ an FM85-" & Einbauplatz.getNr & ": " & Hex(AnzahlPeriodenRZ) & "M" sendonly Hex(AnzahlPeriodenRZ) & "M" If Einbauplatz.getPruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) Then lblPZImpulse(Einbauplatz.getNr).caption = AnzahlPeriodenPZ End If PrintStatus "Perioden PZ: " & AnzahlPeriodenPZ PrintStatus "AnzahlPeriodenPZ an FM85-" & Einbauplatz.getNr & ": " & Hex(AnzahlPeriodenPZ) & "H" sendonly Hex(AnzahlPeriodenPZ) & "H" ' fehlerbyte prüfen Set fm85p = m_FMBus.getFM85P(Einbauplatz.getNr) fm85p.send ("42 ") fm85p.receive strAntwort = Mid(fm85p.getLastAnswer, 6, 2) If strAntwort <> "00" Then PrintStatus Fehlerbyte42Meldung("FM85-" & Einbauplatz.getNr & ": " & strAntwort) If MsgBox("FM85 Fehlerbyte ist nicht '00' sondern '" & strAntwort & "':" & vbCrLf & Fehlerbyte42Meldung(strAntwort) & vbCrLf & "Möchten Sie weitermachen", vbYesNo, "FM85 Fehler") = vbYes Then ' Else ' Todo: Allgemeine Abbruchfunktion ' Prüfung abbrechen Call Abbruch Exit Sub End If End If Else 'Prüfzähler is nothing Einbauplatz.m_AnzahlPeriodenPZ = 0 End If 'Prüfzähler is not nothing If g_Abbruch Then Exit Sub End If Next If g_App.Settings.getAnzahlMIDGruppen > 1 Then ''''''''''''''''''''''''''''''''''''''''''''' ' FM85 Nr: 7 Referenzähler Vergleich: PrintStatus "Impulswertigkeit RefZ A: " & m_ReferenzzaehlerA.ImpulseQM PrintStatus "Impulswertigkeit RefZ B: " & m_ReferenzzaehlerB.ImpulseQM AnzahlPeriodenRZA = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerA.ImpulseQM) * Korrekturwert lblVerbleibRZA.caption = AnzahlPeriodenRZA AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM) * Korrekturwert lblVerbleibRZB.caption = AnzahlPeriodenRZB ' FM85 für Referenzzähler Vergleich Nr 7 setzen ' Adressieren Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) fm85p.sendAttention If g_Abbruch Then Exit Sub End If fm85p.send "R" fm85p.receive Sleep 1000, True ' Adressieren Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse) fm85p.sendAttention 'fm85p.receive (500) ' Todo: Multiplikator fm85p.send "1s" ' keine Doppelimpulssprerre fm85p.send "G" ' Doppelimpuls-Zeit fm85p.send "0000S" ' Dämpfung fm85p.send "3T" ' Todo: K Wert für beide Referenzzähler sollte immer 1 sein fm85p.send Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K = 1 ' Referenzzähler A PrintStatus "Anzahl der Perioden RZA: " & AnzahlPeriodenRZA fm85p.send Hex(AnzahlPeriodenRZA) & "M" fm85p.receive If fm85p.getLastAnswer <> "" Then PrintStatus "Warnung: Periodenzahl RZA " & AnzahlPeriodenRZA & " für FM85 ausserhalb des zulässigen Bereiches" End If ' Referenzzähler B PrintStatus "Anzahl der Perioden RZB: " & AnzahlPeriodenRZB fm85p.send Hex(AnzahlPeriodenRZB) & "H" fm85p.receive If fm85p.getLastAnswer <> "" Then PrintStatus "Warnung: Periodenzahl RZB " & AnzahlPeriodenRZB & " für FM85 ausserhalb des zulässigen Bereiches" End If 'FEHLERBYTE ROUTINE AUSKOMMENTIERT APFEIFFER 21.06.2004 'fm85p.send "**" & g_FM85RefZAdresse & "@" 'm_FMBus.receive (500) fm85p.send ("42 ") fm85p.receive strAntwort = fm85p.getLastAnswer If Mid(strAntwort, 6, 2) <> "00" Then If MsgBox("FM85 Nr." & g_FM85RefZAdresse & ": Fehlerbyte ist nicht '00'" & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then Else Call Abbruch Exit Sub End If End If End If ' 2 RefZ m_Pruefzeit = m_Pruefzeit * FaktorPruefzeit PrintStatus "Neue Prüfzeit " & m_Pruefzeit & " s" End Sub Public Function GetDoppelimpulssperreAndMultiplikator(dblQsoll As Double, lngImpulswertigkeit As Long, lngDoppelimpulssperrzahl As Byte, ByRef strFM85Doppelimpulssperrzeit As String, ByRef strFM85Multiplikator As String) As Long On Error GoTo GetDoppelimpulssperreAndMultiplikator_Error Dim lngPeriodendauer_ms As Long Dim Doppelimpulssperrzeit_ms As Long Dim lngMultiplikator As Long PrintStatus "Doppelimpulssperre" PrintStatus "dblQsoll: " & dblQsoll PrintStatus "lngImpulswertigkeit: " & lngImpulswertigkeit PrintStatus "lngDoppelimpulssperrzahl: " & lngDoppelimpulssperrzahl If lngImpulswertigkeit = 0 Then PrintStatus "Impulswertigkeit = 0 !" GoTo GetDoppelimpulssperreAndMultiplikator_Error End If lngMultiplikator = 1 ' Periodendauer in ms lngPeriodendauer_ms = 3600000 / (lngImpulswertigkeit * dblQsoll) ' Doppelimpulssperre in ms Doppelimpulssperrzeit_ms = (lngPeriodendauer_ms / lngMultiplikator) * lngDoppelimpulssperrzahl / 100 Do While Doppelimpulssperrzeit_ms > 9999 lngMultiplikator = lngMultiplikator + 1 Doppelimpulssperrzeit_ms = (lngPeriodendauer_ms / lngMultiplikator) * lngDoppelimpulssperrzahl / 100 Loop strFM85Doppelimpulssperrzeit = Format(Doppelimpulssperrzeit_ms, "0000") strFM85Multiplikator = CStr(lngMultiplikator) PrintStatus "=> FM85-Doppelimpulssperrzeit=" & strFM85Doppelimpulssperrzeit PrintStatus "=> FM85-Multiplikator=" & strFM85Multiplikator Exit Function GetDoppelimpulssperreAndMultiplikator_Error: GetDoppelimpulssperreAndMultiplikator = -1 PrintStatus "Fehler in GetDoppelimpulssperreAndMultiplikator:" strFM85Multiplikator = "1" strFM85Doppelimpulssperrzeit = "0000" PrintStatus "=> FM85-Doppelimpulssperrzeit=" & strFM85Doppelimpulssperrzeit PrintStatus "=> FM85-Multiplikator=" & strFM85Multiplikator PrintStatus "Doppelimpulssperre wird ausgeschaltet" End Function Private Sub PrintStatusTemporaer(sText As String) Dim pos As Long For pos = Len(txtStatus.text) To 1 Step -1 If Mid(txtStatus.text, pos, 2) = vbCrLf Then Exit For End If Next txtStatus.text = Mid(txtStatus.text, 1, pos + 1) & sText txtStatus.SelStart = Len(txtStatus.text) End Sub Private Sub PrintStatus(sText As String, Optional blnOhneCrLf As Boolean = False) If blnOhneCrLf Then txtStatus.text = txtStatus.text & sText Else txtStatus.text = txtStatus.text & sText & vbCrLf End If txtStatus.SelStart = Len(txtStatus.text) DebugMsg sText End Sub Private Sub sendonly(text) 'PrintStatus "SendOnly '" & text & "' " m_FMBus.send (text) m_FMBus.receive (500) End Sub Private Function FehlerSpeichern(Fehler As Double, Pruefzaehler As CPruefzaehler, Pruefgang As CPruefgang, Pruefpunkt As CPruefpunkt, PruefpunktCol As CPruefpunktCol) On Error GoTo FehlerSpeichernError Dim PruefgangNr As Long Dim SerienNr As Long Dim PPNr As Integer Dim rs As CRecordset Dim Feldname As String Dim sSQL As String PruefgangNr = Pruefgang.PruefgangNr SerienNr = Pruefzaehler.getSerienNr PPNr = PruefpunktCol.ItemNr(Pruefpunkt) Set rs = New CRecordset sSQL = "SELECT * from Prueffehler where PruefgangNr=" & PruefgangNr & " and SerienNr=" & SerienNr & ";" rs.openRS (sSQL) If rs.EOF Then rs.addNew End If Call rs.setValue("SerienNr", SerienNr) Call rs.setValue("PruefgangNr", PruefgangNr) Feldname = "PP" & CStr(PPNr) & "_Fehler" Call rs.setValue(Feldname, Fehler) Call rs.setValue("PruefDatum", Now) ' neu RH 24.7.2006 Call rs.setValue("Metrolog", Pruefzaehler.getPruefpunkte.getPruefklasseKZ) Call rs.update FehlerSpeichern = True Exit Function FehlerSpeichernError: ErrorMsg ("FehlerSpeichern fehlgeschlagen: " & Err.Number & ": " & Err.Description) End Function ' ' @return Mittelwert der beiden Fehler-Werte, die am nächsten beieinander liegen, ' sonst Mittelwert aus allen drei Fehler-Werten. ' Private Function MittelwertDerFehlerOhneAusreisser(Fehler0 As Double, Fehler1 As Double, Fehler2 As Double) As Double Dim d0 As Double Dim d1 As Double Dim d2 As Double ' Abstände bestimmen d0 = Abs(Fehler0 - Fehler1) d1 = Abs(Fehler0 - Fehler2) d2 = Abs(Fehler1 - Fehler2) ' Sonderfall wenn mind. 2 von 3 Abständen gleich MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler1 + Fehler2) / 3 ' Sonderfall wenn Abstand zw. F0 und F1 am kleinsten If d0 < d1 And d0 < d2 Then MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler1) / 2 End If ' Sonderfall wenn Abstand zw. F0 und F2 am kleinsten If d1 < d0 And d1 < d2 Then MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler2) / 2 End If ' Sonderfall wenn Abstand zw. F1 und F2 am kleinsten If d2 < d0 And d2 < d1 Then MittelwertDerFehlerOhneAusreisser = (Fehler1 + Fehler2) / 2 End If End Function Private Sub WaageZuruecksetzen() Dim Behaelter As CBehaelter Dim Waage As CWaage Dim i As Integer Set m_Waage = g_App.getWaage For i = LBound(m_ArrayBehaelter) To UBound(m_ArrayBehaelter) Set Behaelter = m_ArrayBehaelter(i) If Not Behaelter Is Nothing Then Set m_Waage = g_App.getWaage m_Waage.Initialize Behaelter.m_Nr If Behaelter.m_WaageAnwahl <> 0 Then m_Waage.Anwahl Behaelter.m_WaageAnwahl End If Sleep 1000, True If Behaelter.m_WaageGrenzwert > 0 Then m_Waage.SetNettoGrenzwert1 Behaelter.m_WaageGrenzwert, Behaelter.m_Genauigkeit PrintStatus "Waagengrenzwert für Behälter " & Behaelter.m_Nr & " auf " & Behaelter.m_WaageGrenzwert & " gesetzt" End If End If Next End Sub Private Function WaageVorbereitenFuerPP() Dim StartVolumen As Double Dim Gewicht As Double Dim letztesGewicht As Double Dim dblTemperatur As Double Dim Referenzzaehler As CRefzaehler Dim Pumpe As CPumpe Dim Fuelldurchfluss As Double Dim Fuellvolumen As Double Dim WasserDichte As Double Dim Waagengrenzwert As Double If g_App.PruefstationNr = 2010 Or g_App.PruefstationNr = 2009 Then PrintStatus "beide Waagengrenzwerte zurücksetzen" WaageZuruecksetzen End If lblQIst.caption = "0" If Not g_ohneSPS Then m_SPS.setBetrieb 0 End If m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6 PrintStatus "zu prüfendes Sollvolumen bei T=" & Format(m_Pruefzeit, "0") & " s und Q=" & Format(m_DurchflussSoll, "0.000") & "m³/h = " & Format(m_VolumenSoll, "0.000") & " l" '----------------------------------------- Set m_Behaelter = New CBehaelter If m_Behaelter.LoadForVolumen(m_VolumenSoll) = False Then MsgBox ("Es exisitiert kein Behälter für Volumen=" & Format(m_VolumenSoll, "0.000") & " l" & vbCrLf & "Abbruch empfohlen!") WaageVorbereitenFuerPP = -1 Exit Function End If PrintStatus "gewählter Behälter: Oberes Volumen=" & m_Behaelter.m_OVolumen m_Waage.Initialize m_Behaelter.m_Nr Do While m_Waage.Anwahl(m_Behaelter.m_WaageAnwahl) = False If MsgBox("Waage (Anwahl=" & m_Behaelter.m_WaageAnwahl & ") konnte nicht angewählt werden." & vbCrLf & "Bitte Waagen-Reset (C-Taste) durchführen." & vbCrLf & "Möchten Sie die Waagenanwahl wiederholen ?" & vbCrLf & "Cancel bricht die Prüfung ab", vbOKCancel, "Waagen Fehler ?") = vbCancel Then Call Abbruch Exit Do End If Loop m_Waage.TaraReset m_Waage.SoftTaraReset PrintStatus "Tara/Softtara/Grenzwert zurückgesetzt." If Not g_ohneSPS Then m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert '''''''''''''''''''' m_SPS.WassserAblassen 1 + 2 + 4 + 8 If g_App.PruefstationNr = 2010 Or g_App.PruefstationNr = 2009 Then PrintStatus "P2009/P2010 Wasser ablassen für 15 Sekunden um Prüfmenge-Erreicht-Signal zurückzusetzen." Sleep 15000, True End If Sleep 1000, True m_SPS.WassserAblassen 0 End If '----------------------------------------- If m_AnwahlLetzterBehaelter <> m_Behaelter.m_BehaelterAnwahl Then ' Behälter wurde gewechselt oder das erste mal benutzt PrintStatus "Behälter wurde gewechselt oder das erste mal benutzt: (Anwahl von " & m_AnwahlLetzterBehaelter & " nach " & m_Behaelter.m_BehaelterAnwahl & ")" m_AnwahlLetzterBehaelter = m_Behaelter.m_BehaelterAnwahl If Not g_ohneSPS Then PrintStatus "Wasser ganz ablassen aus " & m_Behaelter.m_OVolumen & " Behälter" '----------------------------------------- ' Wasser ganz ablassen StartVolumen = 0 letztesGewicht = 0 m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl Sleep 2000, True Do Sleep 1000, True Gewicht = m_Waage.GetGewicht lblGewicht = Format(Gewicht, "0.00") If Gewicht = -9999 Then DebugMsg ("Fehler: Gewicht konnte nicht gelesen werden") Sleep 200, True End If If letztesGewicht > 0 Then Debug.Print Format((letztesGewicht - Gewicht), "0.000") If Abs((letztesGewicht - Gewicht)) < 0.003 Then Exit Do End If End If If letztesGewicht = Gewicht Then Exit Do End If letztesGewicht = Gewicht If g_Abbruch = True Then Exit Function End If Loop While Gewicht > StartVolumen m_SPS.WassserAblassen 0 '--------------------------------------- ' Rohr füllen If g_blnVersuch Then Fuelldurchfluss = m_Behaelter.m_Fuelldurchfluss Else Fuelldurchfluss = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(1).getQ If Fuelldurchfluss > m_Behaelter.m_Fuelldurchfluss Then ' Bestimme den kleineren Durchfluß von Qmax-Zähler und Behälter Fuelldurchfluss = m_Behaelter.m_Fuelldurchfluss End If End If Fuellvolumen = m_Behaelter.m_Fuellvolumen If Fuellvolumen = 0 Then Fuellvolumen = m_Behaelter.m_OVolumen * 0.1 PrintStatus "Füllvolumen auf 10% gesetzt. Bitte Fuellvolumen in ini Datei pflegen!" End If Else ' keine SPS MsgBox "Bitte Wasser aus " & m_Behaelter.m_OVolumen & "l-Behälter ganz ablassen" End If ' Setze MID und MIDGruppe Set Referenzzaehler = New CRefzaehler Call Referenzzaehler.loadForDurchfluss(Fuelldurchfluss, g_App.Settings.getMIDGruppe) If Not g_ohneSPS Then m_SPS.SetMID Referenzzaehler.EinbauplatzNr m_SPS.SetQDiff 0 m_SPS.AllePumpenAbwaehlen Set Pumpe = Pumpenwahl(Fuelldurchfluss, m_ColPumpen) Pumpe.Anwahl 'PrintStatus "gewählte Pumpe: " & Pumpe.GetSPSVarname '---------------------------------------------------------- ' Füllen bis 10% des Behältervolumens PrintStatus "Rohr füllen mit Fülldurchfluß " & Fuelldurchfluss & " auf Fuellvolumen " & Fuellvolumen & " l in " & m_Behaelter.m_OVolumen & " l Behälter" m_SPS.SetServoStellung lookupFUServoStellwert(Fuelldurchfluss) m_SPS.SetQSoll Fuelldurchfluss lblSollV = Format(Fuellvolumen, "0.0") lblQsoll.caption = Fuelldurchfluss m_SPS.setBetrieb 0 Sleep 500, True m_SPS.setBetrieb 2 Do Sleep 1000, True Gewicht = m_Waage.GetGewicht lblGewicht = Gewicht If Gewicht = -9999 Then DebugMsg ("Fehler: Gewicht konnte nicht gelesen werden") Sleep 200, True End If If g_Abbruch = True Then Exit Function End If Loop While Gewicht < Fuellvolumen m_SPS.setBetrieb 0 lblQsoll.caption = 0 Else MsgBox "Bitte ein wenig Wasser ablassen und dann das Rohr füllen." End If '----------------------------------------- PrintStatus "Wasser ganz ablassen" '----------------------------------------- ' Wasser ganz ablassen StartVolumen = 0 letztesGewicht = 0 lblSollV.caption = "0" If Not g_ohneSPS Then m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl Sleep 2000, True Do Sleep 2000, True Gewicht = m_Waage.GetGewicht lblGewicht = Format(Gewicht, "0.00") If Gewicht = -9999 Then DebugMsg ("Fehler: Gewicht konnte nicht gelesen werden") Sleep 200, True End If If letztesGewicht = Gewicht Then Exit Do End If letztesGewicht = Gewicht If g_Abbruch = True Then Exit Function End If Loop While Gewicht > StartVolumen m_SPS.WassserAblassen 0 '--------------------------------------- End If End If 'Behälterwechsel '----------------------------------------- Gewicht = m_Waage.GetGewicht lblGewicht = Format(Gewicht, "0.00") ' geschätzes Volumen in Litern als Sollvolumen für Waagengrenzwert: m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6 PrintStatus "geschätztes Soll-Volumen in Litern: " & Format(m_VolumenSoll, "0") lblSollV.caption = Format(m_VolumenSoll, "0") If Not g_ohneSPS Then If m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000 > m_Behaelter.m_WaageGrenzwert Then ' Zuviel Wasser drin, also ablassen '----------------------------------------- PrintStatus "Im Behälter ist zuviel Wasser drin, also Wasser ablassen" ' Wasser ganz ablassen StartVolumen = 0 m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl Sleep 5000, True Do Sleep 1200, True Gewicht = m_Waage.GetGewicht lblGewicht = Gewicht If Gewicht = -9999 Then DebugMsg ("Fehler: Gewicht konnte nicht gelesen werden") Sleep 200, True End If If g_Abbruch = True Then Exit Function End If If letztesGewicht = Gewicht Then Debug.Print "Behälter leer bei " & Gewicht & " kg ?" Exit Do End If letztesGewicht = Gewicht Loop While Gewicht > StartVolumen m_SPS.WassserAblassen 0 '----------------------------------------- Else PrintStatus "Prüfmenge-Erreicht-Signal zurücksetzen durch Ablassen von Wasser" m_SPS.WassserAblassen 1 + 2 + 4 + 8 Sleep 3000 m_SPS.WassserAblassen 0 End If ' hier ist sichergestellt dass mind. noch das Sollvolumen hinein passt Else MsgBox "Bitte Behälter leeren um das SollVolumen " & Int(m_VolumenSoll) & " l hinzufüllen zu können." End If ' neuen Grenzwert für das Sollvolumen setzen Gewicht = m_Waage.GetGewicht lblGewicht = Format(Gewicht, "0.00") PrintStatus "Warten auf Waagen Ruhe" m_Behaelter.WarteAufRuhe Gewicht = m_Waage.GetGewicht PrintStatus "Gewicht im Behälter " & Format(Gewicht, "0.000") & " kg" lblGewicht = Format(Gewicht, "0.00") If Not g_ohneSPS Then dblTemperatur = m_SPS.GetEinlaufTemperatur PrintStatus " Einlauf-Temperatur: " & Format(dblTemperatur, "0.000") & " °C, Dichte ist " & Format(DichteVonWasser(m_SPS.GetEinlaufTemperatur), "0.0000") & " kg/m³" Else ' Ohne SPS wird 22 Grad angenommen PrintStatus " Einlauf-Temperatur: Ohne SPS wird 22 Grad angenommen: Dichte ist " & DichteVonWasser(22) & " kg/m³" dblTemperatur = 22 End If Waagengrenzwert = (m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, dblTemperatur) * 1000) / (DichteVonWasser(dblTemperatur) / 1000) PrintStatus " erwartetes Volumen im Behälter: " & Format(Errechne_Volumen_Von_Wasser_in_m3(Gewicht, dblTemperatur) * 1000, "0.000") & " l + " & Format(m_VolumenSoll, "0.000") & " l = " & Format(m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, dblTemperatur) * 1000, "0.000") & " l" PrintStatus " neues Grenzwert-Gewicht: " & Format(Waagengrenzwert, "0.0") & " kg" lblGrenzwert.caption = Format(Waagengrenzwert, "0.00") m_Waage.SetNettoGrenzwert1 Waagengrenzwert ' dieses Gewicht gilt als Startwert m_Waage.SoftTara lblGewicht = "0" Gewicht = m_Waage.GetGewicht PrintStatus "Startwert für das Gewicht im Behälter " & Format(Gewicht, "0.000") & " kg, Soft-Tara bei " & Format(m_Waage.SoftTaraGewicht, "0.000") & " kg" End Function Public Function getVoreinstellwert(ByVal dblDurchfluss As Double, ByRef blnWurdeNichtGefunden As Boolean) As Integer Dim strSQL As String Dim rs As CRecordset Dim iNennweite As Integer Dim sTyp As String On Error GoTo Errorhandler Set rs = New CRecordset iNennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite sTyp = m_ersterPruefzaehler.getIdentNrObj.getTyp strSQL = "SELECT * FROM Voreinstellwerte where Durchfluss = " & doubleToSQLString(dblDurchfluss) & " and Nennweite = " & iNennweite & " and Pruefstation= " & g_App.PruefstationNr & " and Typ = '" & sTyp & "'" rs.openRS strSQL, True If Not rs.EOF Then getVoreinstellwert = rs.getDoubleValue("Voreinstellwert") 'geändert am 02.03.2005 Andreas Pfeiffer 'Durch "True" wird immer gespeichert und aktualisiert 'blnWurdeNichtGefunden = False blnWurdeNichtGefunden = True Else blnWurdeNichtGefunden = True getVoreinstellwert = 50 End If If getVoreinstellwert > 100 Then getVoreinstellwert = 100 Exit Function Errorhandler: ErrorMsg "Fehler " & Err.Number & " in GetVoreinstellwert: " & Err.Description End Function Public Sub SetVoreinstellwert(dblDurchfluss As Double, Voreinstellwert As Integer) Dim strSQL As String Dim rs As CRecordset Dim iNennweite As Integer Dim sTyp As String On Error GoTo Errorhandler Set rs = New CRecordset iNennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite sTyp = m_ersterPruefzaehler.getIdentNrObj.getTyp strSQL = "SELECT * FROM Voreinstellwerte where Durchfluss = " & doubleToSQLString(dblDurchfluss) & " and Nennweite = " & iNennweite & " and Pruefstation= " & g_App.PruefstationNr & " and Typ = '" & sTyp & "'" rs.openRS strSQL, False If Not rs.EOF Then PrintStatus "Voreinstellwert für diesen Prüfpunkt ist vorhanden." 'Neu zugefügt, dass auch bei jeder Änderung gespeichert wird 'Andreas Pfeiffer 01.03.2005 rs.setValue "Voreinstellwert", Voreinstellwert rs.setValue "LetzteAenderung", Now() rs.setValue "Mitarbeiter", g_App.Mitarbeiter.getNr rs.update Else PrintStatus "neuer Voreinstellwert " & Voreinstellwert & " für diesen Prüfpunkt wird gespeichert." rs.addNew rs.setValue "Voreinstellwert", Voreinstellwert rs.setValue "Durchfluss", dblDurchfluss rs.setValue "Nennweite", iNennweite rs.setValue "Pruefstation", g_App.PruefstationNr rs.setValue "Typ", sTyp rs.setValue "LetzteAenderung", Now() rs.setValue "Mitarbeiter", g_App.Mitarbeiter.getNr rs.update End If Exit Sub Errorhandler: ErrorMsg "Fehler " & Err.Number & " in SetVoreinstellwert: " & Err.Description End Sub Private Sub WarteAufSolldurchflussErreicht_bei_Prf_nach_MID(lngTimeMs As Long, PPNr As Integer, dblQsoll As Double) On Error GoTo Errorhandler ' hier gelten anndere Toleranzen je nach PPNr: ' Qmin <= Q <= 1.1 * Qmin ' Qt <= Q <= 1,1 * Qt ' 0.9 * Q3 <= Q <= q3 Dim lngStartzeit As Long Dim dblQIst As Double Dim dblMinFaktor As Double Dim dblMaxFaktor As Double Dim blnSolldurchflussErreichtNachMID As Boolean PrintStatus "Warte auf stabilen Soll-Durchfluß nach MID Vorgaben:" Select Case PPNr Case 1, 2 dblMinFaktor = 1 dblMaxFaktor = 1.1 PrintStatus " Warten auf Qsoll <= Qist <= 1,1 * Qsoll" Case 3 dblMinFaktor = 0.9 dblMaxFaktor = 1 PrintStatus " Warten auf 0,9 * Qsoll <= Qist <= Qsoll" Case Else dblMinFaktor = 0.95 dblMaxFaktor = 1.05 PrintStatus "WARNUNG: Bei Prüfung nach MID dürfen nur 3 Prüfpunkte geprüft werden. PPNr=" & PPNr LogIntoDB "WARNUNG: Bei Prüfung nach MID dürfen nur 3 Prüfpunkte geprüft werden. PPNr=" & PPNr, "Pruef2000" End Select WarteNochmal: lngStartzeit = GetTickCount Do If g_Abbruch = True Or g_ohneSPS = True Then Exit Sub End If dblQIst = m_SPS.getQIst lblQIst.caption = Format(dblQIst, "0.000") Sleep 100 DoEvents blnSolldurchflussErreichtNachMID = False If dblQsoll * dblMinFaktor <= dblQIst And dblQsoll * dblMaxFaktor >= dblQIst Then blnSolldurchflussErreichtNachMID = True End If If Not blnSolldurchflussErreichtNachMID Then 'Solldurchfluß ist nicht erreicht, warte erneut lblQIst.BackColor = RGB(255, 160, 160) GoTo WarteNochmal Else ' Solldurchfluß ist erreicht, warte weiter bis Zeit abgelaufen lblQIst.BackColor = RGB(255, 255, 160) End If Loop While lngStartzeit + lngTimeMs > GetTickCount lblQIst.BackColor = RGB(160, 255, 160) PrintStatus "Soll-Durchfluß erreicht!" Exit Sub Errorhandler: LogIntoDB "Fehler " & Err.Number & " in WarteAufSolldurchflussErreicht_bei_Prf_nach_MID(): " & Err.Description, "Softwarefehler" End Sub Private Function SolldurchflussErreichtNachMID(dblQIst As Double, dblQsoll As Double, PPNr As Integer) As Boolean Dim dblMinFaktor As Double Dim dblMaxFaktor As Double End Function Private Sub WarteAufSolldurchflussErreicht(lngTimeMs As Long) ' Das Signal muss für mindestens lngTimeMs in [ms] stabil anstehen Dim lngStartzeit As Long PrintStatus "Warte auf stabilen Soll-Durchfluß..." WarteNochmal: lngStartzeit = GetTickCount Do If g_Abbruch = True Or g_ohneSPS = True Then Exit Sub End If lblQIst.caption = Format(m_SPS.getQIst, "0.000") Sleep 100 DoEvents If Not m_SPS.SolldurchflussErreicht Then 'Solldurchfluß ist nicht erreicht, warte erneut lblQIst.BackColor = RGB(255, 160, 160) GoTo WarteNochmal Else ' Solldurchfluß ist erreicht, warte weiter bis Zeit abgelaufen lblQIst.BackColor = RGB(255, 255, 160) End If Loop While lngStartzeit + lngTimeMs > GetTickCount lblQIst.BackColor = RGB(160, 255, 160) PrintStatus "Soll-Durchfluß erreicht!" End Sub Private Sub KontinuierlichePruefungInit() txtFlowMax.text = m_colUniquePP.Item(1).getQ txtFlowMin.text = m_colUniquePP.Item(m_colUniquePP.Count).getQ cmbKontSprung.ListIndex = 2 initFlexgrid End Sub Private Sub initFlexgrid() Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim PZCount As Integer PZCount = 0 MSFlexGrid1.Rows = 11 MSFlexGrid1.Cols = 1 MSFlexGrid1.Clear MSFlexGrid1.RowHeight(0) = 445 MSFlexGrid1.ColWidth(0) = 1800 MSFlexGrid1.col = 0 MSFlexGrid1.row = 0 MSFlexGrid1.text = "SNr.\[m³/h]" For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler MSFlexGrid1.row = Einbauplatz.getNr MSFlexGrid1.col = 0 If Not Pruefzaehler Is Nothing Then MSFlexGrid1.text = FormatSerienNr(Pruefzaehler.getSerienNr) End If Next Einbauplatz End Sub Private Sub KontinuierlichePruefung() Dim altePumpeNr As Integer Dim Einbauplatz As CEinbauplatz Dim EinbauplatzNr As Integer Dim lngReturn As Long Dim Pruefzaehler As CPruefzaehler Dim DurchflussRZ As Double Dim DurchflussUS As Double Dim dblVolumenRZ As Double Dim dblVolumenUS As Double Dim dblVolumenWaage As Double Dim PeriodendauerRZ As Double Dim blnFertig As Boolean Dim ResultFileHandle As Long Dim QIstSPS As Double Dim QFlow_fp As Double Dim Fehler As Double Dim bBetriebNeustart As Boolean Dim Temperatur As Double Dim blnPruefungFertig As Boolean Dim AlleImpulseFertig As Boolean Dim Impulse As Long Dim BehaelterVolumen As Double Dim PeriodendauerPZ As Double Dim FehlerRefZ As Double Dim bPPQIstSaved As Boolean Dim ImpulsTestZeit As Double Dim bImpulsTest As Boolean Dim bImpulsTestVorbei As Boolean Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz frmeRegisterPrf.Show vbModeless, Me m_SPS.setBetrieb 0 Sleep 2000 lblGesZeit.Visible = False Set m_Referenzzaehler = New CRefzaehler If g_Abbruch Then Exit Sub End If m_DurchflussSoll = CDbl(txtFlowMax.text) ' Pumpe für den Start auswählen m_SPS.AllePumpenAbwaehlen Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen) PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname bBetriebNeustart = True ' Referenzzähler für den Start auswählen Set m_Referenzzaehler = New CRefzaehler Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) m_SPS.SetQDiff 0 ' m_Referenzzaehler.letzterFehler(m_DurchflussSoll) m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr If Not m_PruefungsArtWaage Then initSPSfuerDurchlauf m_Pruefgang.KalibrierID = KALIBRIER_ID_Referenzzaehler Else ' kont Prf gegen Waage muß noch verbessert werden: interpolierte Servostellung fehlt ! ' ist wichtig, sonst können Zähler mit zu hohen Durchflüssen zerstört werden. MsgBox "Kontinuierliche Prüfung mit der Waage wird nicht unterstützt" Exit Sub m_Pruefgang.KalibrierID = KALIBRIER_ID_Waage End If Dim tMax As Long Dim tMin As Long Dim Qmax As Double Dim Qmin As Double tMin = CLng(txtPruefzeitMin.text) tMax = CLng(txtPruefzeitMax.text) Qmin = CDbl(txtFlowMin.text) Qmax = CDbl(txtFlowMax.text) Do ' Prüfzeit bestimmen PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll Debug.Print "Nennweite: " & m_ersterPruefzaehler.getIdentNrObj.getNennweite m_Pruefzeit = tMax - (m_DurchflussSoll - Qmin) * (tMax - tMin) / (Qmax - Qmin) PrintStatus "Prüfzeit: " & m_Pruefzeit ' m_Pruefzeit = 500 / m_DurchflussSoll 'Falls neue Nennweiten geprüft werden sollten ' Select Case m_ersterPruefzaehler.getIdentNrObj.getNennweite ' Case 50 ' m_Pruefzeit = 100 / m_DurchflussSoll ' Case 65 ' m_Pruefzeit = 160 / m_DurchflussSoll ' Case 80 ' m_Pruefzeit = 250 / m_DurchflussSoll ' Case 100 ' m_Pruefzeit = 400 / m_DurchflussSoll ' End Select ' 'Die Prüfzeit soll 60 Sekunden nie unterschreiten If m_Pruefzeit <= 60 Then If m_bEichpruefvorgabenIgnorieren = True Then PrintStatus "Eichpruefvorgaben ignoriert: Pruefzeit < 60 sec !" Else m_Pruefzeit = 60 End If End If ' 'neu am 21.01.2004 AP die Prüfzeit soll 600 Sekunden nicht überschreiten ' If m_Pruefzeit >= 1100 Then ' m_Pruefzeit = 1100 ' End If ' ' Ist der Referenzzähler für diesen Durchfluß geeignet ? If Not m_Referenzzaehler.IstOkFuerDurchfluss(m_DurchflussSoll) Then ' Referenzzaehler wechseln PrintStatus "Referenzzaehler wechseln" If Not m_PruefungsArtWaage Then ' Wenn im Durchfluß, dann Pumpe zuerst stoppen m_SPS.SetQSoll 0 Sleep 5000 m_SPS.setBetrieb 0 Sleep 2000 End If Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) m_SPS.SetQDiff 0 ' m_Referenzzaehler.letzterFehler(m_DurchflussSoll) PrintStatus "nutze MID " & m_Referenzzaehler.Nennweite m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr ' Neustart der Pumpe erforderlich bBetriebNeustart = True End If If Not m_Pumpe.IstOkFuerDurchfluss(m_DurchflussSoll) Then ' Pumpe wechseln PrintStatus "Pumpe wechseln" If Not m_PruefungsArtWaage Then ' Wenn im Durchfluß, dann Pumpe zuerst stoppen m_SPS.SetQSoll 0 Sleep 5000 m_SPS.setBetrieb 0 Sleep 2000 End If ' Pumpenauswahl m_SPS.AllePumpenAbwaehlen Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen) PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname ' Neustart der Pumpe erforderlich bBetriebNeustart = True End If ' hier gehts los, Pumpe und MID sind eingestellt Temperatur = m_SPS.GetEinlaufTemperatur If m_PruefungsArtWaage Then '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''' W A A G E '''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Waage soweit wie nötig füllen und leeren, ' Betrieb Stop, Grenzwert setzen, Softtara If WaageVorbereitenFuerPP() < 0 Then ' Änderung 9.9.2002: Es gibt keinen Behälter für diesen Durchfluß GoTo NextDurchfluss End If Call initFM85fuerPP_Waage ' Durchfluß einstellen m_SPS.SetQSoll m_DurchflussSoll Call SetzeVoreinstellwert lblQsoll.caption = m_DurchflussSoll ' Betrieb starten m_SPS.setBetrieb 2 Else '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''' D U R C H L A U F '''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Durchfluß einstellen m_SPS.SetQSoll m_DurchflussSoll lblQsoll.caption = m_DurchflussSoll Sleep 2000, True If bBetriebNeustart = True Then m_SPS.SetServoStellung lookupFUServoStellwert(m_DurchflussSoll) ' Pumpe starten m_Pumpe.Anwahl Call SetzeVoreinstellwert m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr ' Betrieb starten m_SPS.setBetrieb 2 bBetriebNeustart = False End If ' Warten bis Durchfluss erreicht ist PrintStatus "Warte auf 'Solldurchfluss erreicht'" Do While Not m_SPS.SolldurchflussErreicht QIstSPS = CDbl(m_SPS.getQIst) lblQIst.caption = Format(QIstSPS, "0.000") Sleep 1500, True If g_Abbruch = True Then Exit Sub End If Loop 'sleep 2000 If g_blneRegisterPruefung Then frmeRegisterPrf.Visible = True Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz frmeRegisterPrf.m_dblSolldurchfluss = m_DurchflussSoll frmeRegisterPrf.m_lSollPruefzeit_s = m_Pruefzeit QIstSPS = m_SPS.getQIst Debug.Print m_Pruefgang.Datum ' eRegister Messung durchführen If frmeRegisterPrf.eRegister_PP_Messung_durchfuehren(False) = False Then Unload frmeRegisterPrf m_SPS.setBetrieb 0 Exit Sub End If For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then Fehler = Einbauplatz.eRegister.m_dblFehler saveKontPrueffehler Fehler, QIstSPS, 0, 0, Einbauplatz.getNr, Temperatur, m_Tpruef, Einbauplatz.getPruefzaehler.getSerienNr PrintStatus "Einbauplatz " & Einbauplatz.getNr & ": Fehler = " & Fehler End If Next GoTo NextDurchfluss Else If m_ImpulswertigkeitPZ > 0 Then Call initFM85fuerPP Else Call initFM85fuerPPundImpulswertigkeit End If End If End If ' keine Waage ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PrintStatus " Prüfung läuft" m_Startzeit = GetTickCount() ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' QIstSPS = 0 blnPruefungFertig = False If m_PruefungsArtWaage Then ' Warte auf WaagengrenzwertErreicht lblGewicht.caption = m_Waage.GetGewicht Do While Not blnPruefungFertig If m_SPS.GrenzwertWaageErreicht Then blnPruefungFertig = True Else If QIstSPS = 0 And (GetTickCount - m_Startzeit) \ 1000 > m_Pruefzeit \ 2 Then QIstSPS = m_SPS.getQIst PrintStatus "IstDurchfluss zur halben Prüfzeit: " & QIstSPS & " m³/h" Temperatur = m_SPS.GetEinlaufTemperatur End If For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then EinbauplatzNr = Einbauplatz.getNr Impulse = GetHexZahlFromFM85(EinbauplatzNr, "U") ' FM85P mit entspr. Adresse ansprechen ' m_FMBus.send "**" & EinbauplatzNr & "@" ' m_FMBus.receive (500) ' m_FMBus.send "U" ' Impulse = Val("&H0" & m_FMBus.receive(500)) ' Prüfzählermpulse Anzeige aktualisieren lblPZImpulse(EinbauplatzNr).caption = Str(Impulse) End If Next lblQIst.caption = Format(m_SPS.getQIst, "0.000") lblGewicht.caption = m_Waage.GetGewicht Sleep 500 End If Sleep 100 DoEvents If g_Abbruch Then Exit Sub Loop PrintStatus "Waagen-Grenzwert erreicht" m_SPS.setBetrieb 0 ' Prüfzeit messen/stoppen in s m_Tpruef = (GetTickCount - m_Startzeit) \ 1000 m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert PrintStatus "Warte auf Waagenruhe" m_Behaelter.WarteAufRuhe 'm_Waage.WarteAufRuhe dblVolumenWaage = Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, Temperatur) ' in m³ PrintStatus "VolumenWaage: " & Format(dblVolumenWaage, "0.00000") & " m³" For Each Einbauplatz In m_colEinbauplatz EinbauplatzNr = Einbauplatz.getNr Set Pruefzaehler = Einbauplatz.getPruefzaehler If (Not Pruefzaehler Is Nothing) Then Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "U") ' Prüfzählermpulse Anzeige aktualisieren lblPZImpulse(Einbauplatz.getNr).caption = Str(Impulse) ' Fehlerermittlung ' RH 23.6.2006 Fehler = (Impulse / Pruefzaehler.GetImpulseQM - dblVolumenWaage) * 100 / dblVolumenWaage If m_ImpulswertigkeitPZ > 0 Then Fehler = (Impulse / m_ImpulswertigkeitPZ - dblVolumenWaage) * 100 / dblVolumenWaage Else Fehler = (Impulse / Einbauplatz.m_ImpulseQM - dblVolumenWaage) * 100 / dblVolumenWaage End If PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " %" '''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''' FEHLER SPEICHERN BEI MESSUNG GEGEN WAAGE ''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''# saveKontPrueffehler Fehler, QIstSPS, 0, dblVolumenWaage, EinbauplatzNr, Temperatur, m_Tpruef, Einbauplatz.getPruefzaehler.getSerienNr End If Next Else ''''''''''''''''''''''''''''''''''''''''' ' bei MID Warte bis Prüfung beendet ''''''''''''''''''''''''''''''''''''''''' For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler EinbauplatzNr = Einbauplatz.getNr If Not Pruefzaehler Is Nothing And Einbauplatz.getAktiv = False Then Einbauplatz.setAktiv True PrintStatus "Einbauplatz " & Einbauplatz.getNr & " wird wieder aktiviert" lblPZImpulse(Einbauplatz.getNr).BackColor = -2147483633 End If Next PrintStatus "Wartezeit auf 1. Impuls = " & Format(ImpulsTestZeit, "0.0") & " s" bImpulsTest = False bImpulsTestVorbei = False Do AlleImpulseFertig = True ' Zeit anzeigen PP_Ist_Zeit = Int((GetTickCount() - m_Startzeit) / 1000) lblZeit.caption = Str(PP_Ist_Zeit) & " / " & Str(m_Pruefzeit) lblQIst.caption = Format(m_SPS.getQIst, "0.000") For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler EinbauplatzNr = Einbauplatz.getNr DoEvents If g_Abbruch Then Exit Sub If bPPQIstSaved = False And PP_Ist_Zeit >= m_Pruefzeit / 2 Then QIstSPS = m_SPS.getQIst Temperatur = m_SPS.GetEinlaufTemperatur PrintStatus "nach halber Zeit des PP: QIst=" & Format(QIstSPS, "0.000") bPPQIstSaved = True End If If (Not Pruefzaehler Is Nothing) And (Einbauplatz.getAktiv = True) Then ' Pruefzaehler ist eingebaut und in Ordnung Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "U") If m_ImpulswertigkeitPZ > 0 Then ' Zeit in s in der der erste Impuls erwartet wird ImpulsTestZeit = (3600 / (m_DurchflussSoll * m_ImpulswertigkeitPZ)) * 2 Else ImpulsTestZeit = (3600 / (m_DurchflussSoll * Einbauplatz.m_ImpulseQM)) * 2 End If If (PP_Ist_Zeit > ImpulsTestZeit) Then If bImpulsTest = False Then If Impulse = 0 Then PrintStatus "kein Impuls für Zähler " & EinbauplatzNr & " nach " & PP_Ist_Zeit & "s" Einbauplatz.setAktiv False lblPZImpulse(Einbauplatz.getNr).BackColor = vbRed Else PrintStatus "(1. Impuls für Zähler " & EinbauplatzNr & " nach " & PP_Ist_Zeit & "s)" End If ' es wurde bereits auf den ersten Impuls gewartet, beim nächsten Durchlauf der PZ soll ' nicht mehr darauf gewartet werden bImpulsTestVorbei = True End If End If ' Verbleibende Pruefzaehlerimpulse auslesen Impulse = GetHexZahlFromFM85(Einbauplatz.getNr, "I") lblVerbleib(Einbauplatz.getNr).caption = Str(Impulse) ' Solange für irgendeinen Prüfling die verbleibenden Impulse <> 0 sind, ' kann nicht mit dem nächsten Pruefpunkt fortgesetzt werden If Impulse > 0 Then AlleImpulseFertig = False End If ' Verbleibende RZ Impulse, ohne erneute Adressierung Impulse = GetHexZahlFromFM85(-1, "J") lblVerbleibRZ.caption = Str(Impulse) & "(" & Einbauplatz.getNr & ")" If Impulse <> 0 Then AlleImpulseFertig = False End If End If ' Schleifenende für jeden genutzten Einbauplatz: Next Einbauplatz If bImpulsTestVorbei = True Then ' auf die ersten Impuls wurde bereits geprüft ' es braucht nicht mehr auf die ersten Impulse geprüft werden bImpulsTest = True End If If PP_Ist_Zeit > m_Pruefzeit * 2 Then ' doppelte Prüfzeit ist vergangen, hier müssten alle Pruefzähler ' und der Referenzzähler fertig gezählt haben AlleImpulseFertig = True PrintStatus "doppelte Prüfzeit ist vergangen. Nächster Prüfpunkt !" End If Loop While AlleImpulseFertig = False ' Prüfzeit messen/stoppen in s m_Tpruef = (GetTickCount - m_Startzeit) \ 1000 PrintStatus "Ende des Prüfpunktes nach " & m_Tpruef & " s" Sleep 1000 QIstSPS = Format(m_SPS.getQIst, "0.000") If g_Abbruch Then Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''' Fehlerermittlung ''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If g_Abbruch Then Exit Sub End If ' m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", m_ersterPruefzaehlerNr ' Periodendauer über n Perioden des Referenzzaehlers auslesen For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If (Not Pruefzaehler Is Nothing) Then ' And (Einbauplatz.getAktiv = True) Then PeriodendauerRZ = GetHexZahlFromFM85(Einbauplatz.getNr, "Y") PrintStatus "Referenzzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerRZ ' Pruefzaehler im Einbauplatz vorhanden Impulse = GetHexZahlFromFM85(-1, "U") ' Prüfzählermpulse Anzeige aktualisieren lblPZImpulse(Einbauplatz.getNr).caption = Str(Impulse) If m_PruefungsArtWaage Then ' Fehlerermittlung ' RH 23.6.2006 Fehler = (Impulse / Pruefzaehler.GetImpulseQM - BehaelterVolumen) * 100 / BehaelterVolumen If m_ImpulswertigkeitPZ > 0 Then Fehler = (Impulse / m_ImpulswertigkeitPZ - BehaelterVolumen) * 100 / BehaelterVolumen Else Fehler = (Impulse / Einbauplatz.m_ImpulseQM - BehaelterVolumen) * 100 / BehaelterVolumen End If PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " %" Else ' Periodendauer über n Perioden auslesen PeriodendauerPZ = GetHexZahlFromFM85(Einbauplatz.getNr, "X") ' ' Periodendauer über n Perioden auslesen ' m_FMBus.send "X" ' PeriodendauerPZ = Val("&H0000" & m_FMBus.receive(500)) PrintStatus "** Pruefzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerPZ If PeriodendauerRZ > 0 Then FehlerRefZ = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur) 'QIstSPS = m_Referenzzaehler.ImpulseQM / PeriodendauerRZ * (1 - FehlerRefZ / 100) PrintStatus "Letzter Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %" If PeriodendauerPZ > 0 Then Fehler = 100 * (PeriodendauerRZ / PeriodendauerPZ) - 100 PrintStatus "Fehler des PZ: " & Format(Fehler, "0.00") & " %" ' Korrektur des Fehlers mit dem Fehler des Referenzzählers Fehler = Fehler + FehlerRefZ PrintStatus "Summe der Fehler: " & Format(Fehler, "0.00") & " %" Else Fehler = 99 'Merker für "Keine Impulse" End If Else PrintStatus ("Fehler: Die Periodendauer des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden (=" & PeriodendauerRZ & ")") Fehler = 98 ' merker für RZ noch nicht fertig End If End If PrintStatus "ermittelter Fehler: " & Format(Fehler, "0.00") & " %" ' Fehler dieses Prüfpunktes für diesen Einbauplatz steht fest, ' SPEICHERN ! saveKontPrueffehler Fehler, QIstSPS, 0, 0, Einbauplatz.getNr, Temperatur, m_Tpruef, Einbauplatz.getPruefzaehler.getSerienNr End If ' Pruefzähler vorhanden Next Einbauplatz 'In m_colEinbauplatz End If ' keine Waage ' Durchfluss ändern NextDurchfluss: m_DurchflussSoll = CDbl(Format(m_DurchflussSoll * (100 - CDbl(Left(cmbKontSprung.text, 8))) / 100, "0.000")) If m_DurchflussSoll < CDbl(txtFlowMin) Then blnFertig = True End If Loop While Not blnFertig m_SPS.setBetrieb 0 lblGesZeit.Visible = True PrintStatus "Kontinuierliche Prüfung beendet" End Sub Private Sub saveKontPrueffehler(Fehler As Double, QIst As Double, VolumenRZ As Double, VolumenWaage As Double, EinbauplatzNr As Integer, Temperatur As Double, Pruefzeit As Long, SerienNr As Long) Dim rs As CRecordset Set rs = New CRecordset m_Pruefgang.save lblPruefgangNr = m_Pruefgang.PruefgangNr PrintStatus "Pruefgang=" & m_Pruefgang.PruefgangNr & " Platz=" & EinbauplatzNr & ": F= " & Format(Fehler, "0.00") & " gespeichert" rs.openRS "KontPrueffehler", False rs.addNew Call rs.setValue("PruefgangNr", m_Pruefgang.PruefgangNr) Call rs.setValue("Datum", Now()) Call rs.setValue("Fehler", Fehler) Call rs.setValue("Solldurchfluss", m_DurchflussSoll) Call rs.setValue("DurchflussSPS", QIst) ' Call rs.setValue("VolumenRef", VolumenRZ) Call rs.setValue("VolumenWaage", VolumenWaage) Call rs.setValue("SerienNr", SerienNr) If Not m_Pumpe Is Nothing Then Call rs.setValue("Pumpe", m_Pumpe.GetSPSVarname) End If If Not m_Referenzzaehler Is Nothing Then Call rs.setValue("MID", m_Referenzzaehler.Nennweite) End If Call rs.setValue("EinbauplatzNr", EinbauplatzNr) Call rs.setValue("Temperatur", Temperatur) Call rs.setValue("Pruefzeit", Pruefzeit) rs.update Set rs = Nothing End Sub ' Todo: für die Kontinuierliche Prüfung gegen Waage muß der Vorsteuerwert interpoliert werden Private Sub SetzeVoreinstellwert() Dim iStellwert As Integer Select Case m_Pumpe.GetRegelart Case "Servo" ' Servo vorgeschrieben m_SPS.SetRegelart ("Servo") iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen) If iStellwert > 100 Then iStellwert = 100 PrintStatus "Stellwert: " & iStellwert m_SPS.SetServoStellung iStellwert Case "FU" ' Frequenzumrichter vorgeschrieben m_SPS.SetRegelart ("FU") iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen) If iStellwert > 100 Then iStellwert = 100 PrintStatus "Stellwert: " & iStellwert m_SPS.SetServoStellung iStellwert Case Else ErrorMsg "Es ist keine Regelart für die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert." Call Abbruch Exit Sub End Select End Sub Private Function FuerdiesenZaehlerEichamtvorschriftUeberpruefen(ByRef Pruefzaehler As CPruefzaehler) As Boolean ' nun werden alle Zähler nach EIchamtsvorschrift überprüft, ' die die Prüfklasse "A", "B", "C", "2" haben. On Error GoTo Errorhandler Dim strGrund As String strGrund = "FuerdiesenZaehlerEichamtvorschriftUeberpruefen('" & Pruefzaehler.getSerienNr & "'): " ' Prüfzähler vorhanden If Not Pruefzaehler.getAuftragPosition Is Nothing Then ' Auftragposition vorhanden Select Case Pruefzaehler.getPruefklasseKZ Case "A", "B", "C", "2" FuerdiesenZaehlerEichamtvorschriftUeberpruefen = True strGrund = strGrund & "Eichamtvorschrift wird überprüft, da PruefklasseKZ = '" & Pruefzaehler.getPruefklasseKZ & "'" Case Else If Pruefzaehler.getPruefpunkte.m_bPruefung_nach_MID = True Then strGrund = strGrund & "Eichamtvorschrift wird überprüft, da Prüfung nach MID" FuerdiesenZaehlerEichamtvorschriftUeberpruefen = True Else strGrund = strGrund & "Eichamtvorschrift wird nicht überprüft, da PruefklasseKZ= '" & Pruefzaehler.getPruefklasseKZ & "'" End If End Select Else strGrund = strGrund & "Eichamtvorschrift wird nicht überprüft, da Pruefzaehler.getAuftragPosition Is Nothing " End If PrintStatus strGrund Exit Function Errorhandler: LogIntoDB "FuerdiesenZaehlerEichamtvorschriftUeberpruefen(): Fehler " & Err.Number & ": " & Err.Description, "Softwarefehler" FuerdiesenZaehlerEichamtvorschriftUeberpruefen = False End Function Private Sub EichamtvorschriftUeberpruefen() On Error GoTo Errorhandler 'früher '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' Sonderregel für beglaubigte kalte Zähler lt. Eichgesetz '' - gilt nur für kalte Zähler Pruefzaehler.getIdentNrObj.getTemperatur <= 50 '' - gilt nur für Pruefzaehler.getKZP.getPruefklasseText = "amt" '' Einer der Fehler muß kleiner sein als die Hälfte des Fehlergrenzwertes +-1,+-1, +-1.5 '' sonst bekommt dieser Zähler den Status 25 'Einseitigkeitsregel 'Falls alle Fehler innerhalb des Messbereichs eines Wasserzählers 'das gleiche Vorzeichen haben, muss mindestens einer der Fehler 'weniger betragen als die Hälfte der Fehlergrenze. Dim Pruefpunkt As CPruefpunkt Dim blnAlleFehlerPositiv As Boolean Dim blnAlleFehlerNegativ As Boolean Dim blnEinFehlerInnerhalbHalberFehlergrenzen As Boolean Dim Durchfluss As Integer Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim i As Integer Dim Fehler As Double Dim dblEichvorschriftFehlergrenze As Double Dim QIst As Double Dim AuftragpositionSerienNr As CAuftragPositionSerienNr For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then blnEinFehlerInnerhalbHalberFehlergrenzen = False blnAlleFehlerPositiv = True blnAlleFehlerNegativ = True If FuerdiesenZaehlerEichamtvorschriftUeberpruefen(Pruefzaehler) Then ' Sind alle Fehler dieses Prüfzählers entweder nur positiv oder nur negativ ? For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount Fehler = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler If Fehler >= 0 Then ' mind. ein Fehler ist schon mal positiv blnAlleFehlerNegativ = False ElseIf Fehler <= 0 Then ' mind. ein Fehler ist schon mal negativ blnAlleFehlerPositiv = False End If Next If blnAlleFehlerPositiv = False And blnAlleFehlerNegativ = True Then PrintStatus "Pruefzaehler " & FormatSerienNr(Pruefzaehler.getSerienNr) & ": alle Fehler sind negativ." ' hier sind alle Fehler negativ For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' Einer der negativen Fehler sollte positiver sein als ' Eichvorschrift-Fehlergrenze (-2,5% bei Qmin, 1% sonst) Fehler = CDbl(Format(Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler, "0.0")) QIst = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ MSFlexGrid1.col = i MSFlexGrid1.row = Einbauplatz.getNr If i = Pruefzaehler.getPruefpunkte.getPruefpunkteCount Then dblEichvorschriftFehlergrenze = -2.5 Else dblEichvorschriftFehlergrenze = -1 End If ' gibt es einen negativen Fehler OBERHALB bzw. innerhalb der Fehlergrenze ? If Fehler > dblEichvorschriftFehlergrenze Then PrintStatus " Fehler bei PP" & i & " (bei Q=" & QIst & ") = " & Fehler & " ist innerhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%" ' alles OK blnEinFehlerInnerhalbHalberFehlergrenzen = True Else ' fraglich PrintStatus " Fehler bei PP" & i & " (bei Q=" & QIst & ") =" & Format(Fehler, "0.0") & "% ist ausserhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%." End If ' nächsten Prüfpunkt untersuchen Next End If ' Alle Fehler negativ If blnAlleFehlerPositiv = True And blnAlleFehlerNegativ = False Then ' hier sind alle Fehler positiv PrintStatus "Pruefzaehler " & FormatSerienNr(Pruefzaehler.getSerienNr) & ": alle Fehler sind positiv." For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount Fehler = CDbl(Format(Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler, "0.0")) QIst = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ MSFlexGrid1.col = i MSFlexGrid1.row = Einbauplatz.getNr ' dblEichvorschriftFehlergrenze = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getFGo / 2 ' Qmin If i = Pruefzaehler.getPruefpunkte.getPruefpunkteCount Then dblEichvorschriftFehlergrenze = 2.5 Else dblEichvorschriftFehlergrenze = 1 End If ' Einer der positiven Fehler ' sollte negativer als Eichvorschrifts-Fehlergrenze sein If Fehler < dblEichvorschriftFehlergrenze Then ' alles OK PrintStatus " Fehler bei Q=" & QIst & ": Fehler " & Format(Fehler, "0.00") & "% ist innerhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%." blnEinFehlerInnerhalbHalberFehlergrenzen = True Else ' fraglich PrintStatus " Fehler bei PP" & i & " (Q=" & QIst & ") =" & Format(Fehler, "0.0") & "% ist ausserhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%." End If Next End If ' alle Fehler positiv If (blnAlleFehlerNegativ Or blnAlleFehlerPositiv) Then If blnEinFehlerInnerhalbHalberFehlergrenzen = False Then PrintStatus " Pruefzaehler überschreitet in allen Prüfpunkten die halbe Eichamt Fehlergrenze! StatusFertigung=25!" Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr AuftragpositionSerienNr.setStatusFertigung 25 AuftragpositionSerienNr.save ' alle Prüfergebnisse dieses Zählers im Grid Gelb färben ' RH 4.10.2010: ausser die, die schon rot sind For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount MSFlexGrid1.col = i MSFlexGrid1.row = Einbauplatz.getNr If chkNachpruefung.value = vbUnchecked Then If MSFlexGrid1.CellBackColor <> &HC0C0FF Then MSFlexGrid1.CellBackColor = vbYellow End If End If Next m_DruckMsg = m_DruckMsg & "Zähler " & FormatSerienNr(Pruefzaehler.getSerienNr) & " überschreitet die Eichamt-Fehlergrenze in allen Prüfpunkten." & vbCrLf Else PrintStatus " mind. einer der Pruefzaehler-Fehler des Zählers " & FormatSerienNr(Pruefzaehler.getSerienNr) & " ist innerhalb der halben Fehlergrenze. OK!" End If Else PrintStatus "Fehler des Prüfzählers sind teils positiv, teils negativ." End If End If ' Zaehler überprüfen End If ' Pruefzaehler is nothing Next ' Einbauplatz ''''''''''''''''''''''''''''''''''''''''''''''''''' Exit Sub Errorhandler: LogIntoDB "Fehler in EichamtvorschriftUeberpruefen: " & Err.Description, "Softwarefehler" End Sub 'Private Sub EichamtvorschriftUeberpruefen() 'On Error GoTo Errorhandler ' ' '' ungetestet ! ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' '' Sonderregel für beglaubigte kalte Zähler lt. Eichgesetz ' '' - gilt nur für kalte Zähler Pruefzaehler.getIdentNrObj.getTemperatur <= 50 ' '' - gilt nur für Pruefzaehler.getKZP.getPruefklasseText = "amt" ' '' Einer der Fehler muß kleiner sein als die Hälfte des Fehlergrenzwertes, ' '' sonst bekommt dieser Zähler den Status 25 ' ' ' Dim Pruefpunkt As CPruefpunkt ' Dim blnAlleFehlerPositiv As Boolean ' Dim blnAlleFehlerNegativ As Boolean ' Dim blnEinFehlerInnerhalbHalberFehlergrenzen As Boolean ' Dim Durchfluss As Integer ' Dim Einbauplatz As CEinbauplatz ' Dim Pruefzaehler As CPruefzaehler ' Dim i As Integer ' Dim Fehler As Double ' Dim dblEichvorschriftFehlergrenze As Double ' Dim QIst As Double ' Dim AuftragPositionSerienNr As CAuftragPositionSerienNr ' ' For Each Einbauplatz In m_colEinbauplatz ' blnEinFehlerInnerhalbHalberFehlergrenzen = False ' blnAlleFehlerPositiv = True ' blnAlleFehlerNegativ = True ' ' Set Pruefzaehler = Einbauplatz.getPruefzaehler ' If Not Pruefzaehler Is Nothing Then ' ' Prüfzähler ' ' If Not Pruefzaehler.getAuftragPosition Is Nothing Then ' If Not Pruefzaehler.getAuftragPosition.getKZPObj Is Nothing Then ' If Not Pruefzaehler.getAuftragPosition.getKZPObj.getPruefklasseText & "" = "" Then ' ' If Pruefzaehler.getAuftragPosition.getKZPObj.getPruefklasseText = "amt" Then ' ' amtlich ' If Pruefzaehler.getIdentNrObj.GetTemperatur <= 50 Then ' ' Kalt ' ' ' Sind alle Fehler dieses Prüfzählers entweder nur positiv oder nur negativ ? ' For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' Fehler = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler ' If Fehler >= 0 Then ' ' mind. ein Fehler ist schon mal positiv ' blnAlleFehlerNegativ = False ' ElseIf Fehler <= 0 Then ' ' mind. ein Fehler ist schon mal negativ ' blnAlleFehlerPositiv = False ' End If ' Next ' ' If blnAlleFehlerPositiv = False And blnAlleFehlerNegativ = True Then ' PrintStatus "Pruefzaehler (amt/kalt) " & FormatSerienNr(Pruefzaehler.getSerienNr) & ": alle Fehler sind negativ." ' ' ' hier sind alle Fehler negativ ' For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' ' Einer der negativen Fehler sollte positiver sein als ' ' Eichvorschrift-Fehlergrenze (-2,5% bei Qmin, 1% sonst) ' Fehler = CDbl(Format(Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler, "0.0")) ' QIst = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ ' ' MSFlexGrid1.Col = i ' MSFlexGrid1.row = Einbauplatz.getNr ' ' If i = Pruefzaehler.getPruefpunkte.getPruefpunkteCount Then ' dblEichvorschriftFehlergrenze = -2.5 ' Else ' dblEichvorschriftFehlergrenze = -1 ' End If ' ' ' gibt es einen negativen Fehler OBERHALB bzw. innerhalb der Fehlergrenze ? ' If Fehler > dblEichvorschriftFehlergrenze Then ' 'PrintStatus " Fehler = " & Fehler & " ist innerhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%" ' ' alles OK ' blnEinFehlerInnerhalbHalberFehlergrenzen = True ' Else ' ' fraglich ' PrintStatus " Fehler (bei Q=" & QIst & ") =" & Format(Fehler, "0.0") & "% ist ausserhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%." ' End If ' ' nächsten Prüfpunkt untersuchen ' Next ' End If ' Alle Fehler negativ ' ' ' If blnAlleFehlerPositiv = True And blnAlleFehlerNegativ = False Then ' ' hier sind alle Fehler positiv ' PrintStatus "Pruefzaehler (amt/kalt) " & FormatSerienNr(Pruefzaehler.getSerienNr) & ": alle Fehler sind positiv." ' For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' ' Fehler = CDbl(Format(Pruefzaehler.getPruefpunkte.getPruefpunkt(i).GetFehler, "0.0")) ' ' QIst = Pruefzaehler.getPruefpunkte.getPruefpunkt(i).getQ ' ' MSFlexGrid1.Col = i ' MSFlexGrid1.row = Einbauplatz.getNr ' ' Qmin ' If i = Pruefzaehler.getPruefpunkte.getPruefpunkteCount Then ' dblEichvorschriftFehlergrenze = 2.5 ' Else ' dblEichvorschriftFehlergrenze = 1 ' End If ' ' ' Einer der positiven Fehler ' ' sollte negativer als Eichvorschrifts-Fehlergrenze sein ' If Fehler < dblEichvorschriftFehlergrenze Then ' ' alles OK ' ' PrintStatus " Fehler bei Q=" & QIst & ": Fehler " & Format(Fehler, "0.00") & "% ist innerhalb der Fehlergrenze = " & dblEichvorschriftFehlergrenze ' blnEinFehlerInnerhalbHalberFehlergrenzen = True ' Else ' ' fraglich ' PrintStatus " Fehler (bei Q=" & QIst & ") =" & Format(Fehler, "0.0") & "% ist ausserhalb der Fehlergrenze " & dblEichvorschriftFehlergrenze & "%." ' End If ' Next ' End If ' alle Fehler positiv ' ' If (blnAlleFehlerNegativ Or blnAlleFehlerPositiv) Then ' If blnEinFehlerInnerhalbHalberFehlergrenzen = False Then ' PrintStatus " Pruefzaehler überschreitet in allen Prüfpunkten die halbe Eichamt Fehlergrenze!" ' Set AuftragPositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr ' AuftragPositionSerienNr.setStatusFertigung 25 ' AuftragPositionSerienNr.save ' ' ' alle Prüfergebnisse dieses Zählers im Grid Gelb färben ' ' RH 4.10.2010: ausser die, die schon rot sind ' For i = 1 To Pruefzaehler.getPruefpunkte.getPruefpunkteCount ' MSFlexGrid1.Col = i ' MSFlexGrid1.row = Einbauplatz.getNr ' ' If chkNachpruefung.Value = vbUnchecked Then ' If MSFlexGrid1.CellBackColor <> &HC0C0FF Then ' MSFlexGrid1.CellBackColor = vbYellow ' End If ' End If ' Next ' m_DruckMsg = m_DruckMsg & "Zähler " & FormatSerienNr(Pruefzaehler.getSerienNr) & " überschreitet die Eichamt-Fehlergrenze in allen Prüfpunkten." & vbCrLf ' Else ' ' PrintStatus " mind. einer der Pruefzaehler-Fehler des Zählers " & FormatSerienNr(Pruefzaehler.getSerienNr) & " ist innerhalb der halben Fehlergrenze. OK!" ' End If ' Else ' ' PrintStatus "Fehler des Prüfzählers sind teils positiv, teils negativ." ' End If ' End If 'T <= 50 ' End If 'amt' ' ' ' End If ' ' End If ' End If ' ' End If ' Prüfzähler ' Next ' Einbauplatz ' ''''''''''''''''''''''''''''''''''''''''''''''''''' ' Exit Sub 'Errorhandler: ' ErrorMsg "Fehler in EichamtvorschriftUeberpruefen: " & Err.Description 'End Sub Private Function GetHexZahlFromFM85(EinbauplatzNr As Integer, strSende As String) As Long Dim strAntwortAdressierung As String Dim strAntwort As String Dim Versuche As Long On Error GoTo Errorhandler Versuche = 0 startagain1: If g_Abbruch = True Then Exit Function If EinbauplatzNr > 0 Then ' FM85P mit entspr. Adresse ansprechen m_FMBus.send "**" & EinbauplatzNr & "@" strAntwortAdressierung = m_FMBus.receive(700) If InStr(1, strAntwortAdressierung, EinbauplatzNr) = 0 Then PrintStatus "FM85P-" & EinbauplatzNr & " antwortete bei Adressierung '" & strAntwortAdressierung & "'" If Versuche < 10 Then Versuche = Versuche + 1 GoTo startagain1 End If LogIntoDB "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'", "FM85 Hauptprüfung" End If End If Versuche = 0 startagain2: m_FMBus.send strSende strAntwort = m_FMBus.receive(700) If g_Abbruch = True Then Exit Function If IsNumeric("&H" & strAntwort) Then GetHexZahlFromFM85 = CLng("&H" & strAntwort) 'PrintStatus "Anwort vom FM85: " & strAntwort & " = " & GetHexZahlFromFM85 Else PrintStatus "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'" If InStr(1, strAntwort, "MESSERGEBNIS LIEGT NICHT VOR") > 0 Then GetHexZahlFromFM85 = -1 Exit Function End If If Versuche < 10 Then Versuche = Versuche + 1 GoTo startagain2 End If LogIntoDB "FM85P-" & EinbauplatzNr & " antwortete mit '" & strAntwort & "'", "FM85 Hauptprüfung" GetHexZahlFromFM85 = -1 End If Exit Function Errorhandler: LogIntoDB "Fehler " & Err.Number & " in GetHexZahlFromFM85:" & Err.Description, "Prg Fehler!" GetHexZahlFromFM85 = -1 End Function Private Sub ExtraMessage(strText As String) lblMsg.caption = strText If strText <> "" Then lblMsg.BackColor = vbYellow lblMsg.ForeColor = vbBlack lblMsg.FontBold = True lblMsg.FontSize = 11 Else lblMsg.BackColor = vbInactiveBorder End If End Sub Private Sub Form_Unload(Cancel As Integer) PrintStatus "Der FM85 Eingang wird auf Opto geschaltet." If Not g_ohneSPS Then m_SPS.SetLichtwellenleiter False Sleep 100, True Else MsgBox "Der FM85 Eingang wird auf Opto geschaltet." End If End Sub ''''''''''''''''''''''' Bemerkungen Private Sub MSFlexGrid1_DblClick() If g_blnVersuch = False Then Exit Sub Dim row As Integer Dim SerienNr As Long Dim strText As String row = MSFlexGrid1.row SerienNr = Val(MSFlexGrid1.TextMatrix(row, 0)) If SerienNr > 0 Then MSFlexGrid1.row = row MSFlexGrid1.col = 1 txtBemerkung.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left + Frame2.Left txtBemerkung.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top + Frame2.Top txtBemerkung.Width = MSFlexGrid1.Width - MSFlexGrid1.CellLeft - 100 txtBemerkung.Visible = True txtBemerkung.Enabled = True txtBemerkung.Tag = SerienNr '' Laden der Bemerkung LoadPrueffehlerInfo m_Pruefgang.PruefgangNr, SerienNr, strText txtBemerkung.text = strText txtBemerkung.SetFocus End If End Sub Private Sub SpeichereBemerkungUndSchliesseEingabe() Dim SerienNr As Long Dim strText As String SerienNr = Val(txtBemerkung.Tag) strText = txtBemerkung.text SavePrueffehlerInfo m_Pruefgang.PruefgangNr, SerienNr, strText txtBemerkung.Tag = "" txtBemerkung.Visible = False End Sub Private Sub txtBemerkung_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtBemerkung.Enabled = False If txtBemerkung.Visible = True Then SpeichereBemerkungUndSchliesseEingabe End If End If End Sub Private Sub txtBemerkung_LostFocus() txtBemerkung.Enabled = False If txtBemerkung.Visible = True Then SpeichereBemerkungUndSchliesseEingabe End If End Sub Private Sub MeistreamEntlueften() Dim iNennweite As Integer Dim iPumpe As Integer Dim dblQ As Double Dim iMIDEinbauplatz As Integer Dim i As Integer Exit Sub iNennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite nochmallesen: If g_App.Settings.GetParameterZumMeistreamEntlueften(iNennweite, iPumpe, iMIDEinbauplatz, dblQ) = False Then Select Case MsgBox("Es sind noch keine Daten für die automatische Entlüftung in der INI Datei definiert. Möchten Sie diese jetzt wirklich einmalig automatisch eintragen lassen?", vbYesNo Or vbDefaultButton2) Case vbYes g_App.Settings.WriteDefaultParameterZumMeistreamEntlueften MsgBox ("Bitte überprüfen Sie nun die Werte in der INI Datei") GoTo nochmallesen Case vbNo Exit Sub End Select Else Dim Referenzzaehler As CRefzaehler Referenzzaehler.LoadForRefzaehlerpruefung (iMIDEinbauplatz) ' hier sind die INI Daten vorhanden. If MsgBox("Möchten Sie Meistream nun entlüften? 3 * bei " & dblQ & "m³/h mit Pumpe " & iPumpe & " und MID-" & Referenzzaehler.Nennweite, vbYesNo Or vbDefaultButton2) = vbYes Then Stop m_SPS.AnwahlPumpe iPumpe m_SPS.SetMID iMIDEinbauplatz For i = 1 To 3 m_SPS.setBehaelter 1 '=Durchlauf m_SPS.setBetrieb 1 PrintStatus "Durchlauf: " & i & "/3: Betrieb start und 60 Sekunden warten..." Sleep 60000, True PrintStatus "Betrieb stop." m_SPS.setBetrieb 0 Sleep 5000 Next End If End If End Sub Private Function getHoechsterDurchfluss() As Double Dim Pruefpunkt As CPruefpunkt For Each Pruefpunkt In m_colUniquePP.getCollection If Pruefpunkt.getQ > getHoechsterDurchfluss Then getHoechsterDurchfluss = Pruefpunkt.getQ End If Next End Function Public Sub SchotteinstellungenAendern() On Error GoTo Errorhandler Unload frmSchottumdrehungen Set frmSchottumdrehungen.m_colEinbauplatz = m_colEinbauplatz frmSchottumdrehungen.setInfo "Bitte tragen Sie ggf. geänderte Schott-Umdrehungen ein." frmSchottumdrehungen.Show vbModal, Me Exit Sub Errorhandler: LogIntoDB "Fehler " & Err.Number & " in SchotteinstellungenAendern(): " & Err.Description, "Softwarefehler" End Sub