marekf/laatzen
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
main
laatzen/Pruef2000/source/frmUSFW2Hauptprf.frm
Rowlander 70e2645059 Initial commit 3
2021-10-01 11:11:04 +02:00

8219 lines
331 KiB
Plaintext
Raw Permalink Blame History

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 frmUSFW2Hauptprf
BorderStyle = 1 'Fest Einfach
Caption = "Pruef2000"
ClientHeight = 11715
ClientLeft = 150
ClientTop = 510
ClientWidth = 15255
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 11715
ScaleWidth = 15255
StartUpPosition = 3 'Windows-Standard
WindowState = 2 'Maximiert
Begin VB.Frame frMain
Height = 10305
Left = 30
TabIndex = 0
Top = 60
Width = 15195
Begin VB.CheckBox chkProtokolldruck
Caption = "Prüf-Protokoll drucken"
Height = 315
Left = 11700
TabIndex = 101
Top = 5820
Width = 1965
End
Begin VB.TextBox txtBemerkung
Height = 345
Left = 10650
TabIndex = 93
Top = 300
Visible = 0 'False
Width = 1695
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 = 675
Left = 13260
TabIndex = 88
Top = 9420
Width = 1335
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 = 675
Left = 10560
TabIndex = 87
Top = 9420
Width = 1335
End
Begin VB.Frame frameKontinuierlich
Height = 945
Left = 7500
TabIndex = 67
Top = 8400
Width = 6165
Begin VB.TextBox txtKontCount
Alignment = 1 'Rechts
Height = 315
Left = 5190
TabIndex = 73
Text = "10"
Top = 180
Width = 465
End
Begin VB.CommandButton cmdStart
Caption = "START"
Height = 285
Left = 2670
TabIndex = 70
ToolTipText = "kontinuierliche Ultraschall-Zähler Prüfung"
Top = 600
Width = 975
End
Begin VB.TextBox txtFlowMax
Alignment = 1 'Rechts
Height = 315
Left = 1020
TabIndex = 69
Top = 150
Width = 915
End
Begin VB.TextBox txtFlowMin
Alignment = 1 'Rechts
Height = 315
Left = 2640
TabIndex = 68
Top = 180
Width = 915
End
Begin VB.ComboBox cmbKontSprung
Height = 315
ItemData = "frmUSFW2Hauptprf.frx":0000
Left = 990
List = "frmUSFW2Hauptprf.frx":0010
TabIndex = 77
ToolTipText = "Hier kann auch direkt ein Wert 10-90% eingegeben werden"
Top = 540
Width = 1365
End
Begin VB.Label Label22
Caption = "Schrittweite"
Height = 285
Left = 90
TabIndex = 76
Top = 600
Width = 855
End
Begin VB.Label Label21
Caption = "%"
Height = 255
Left = 2430
TabIndex = 75
Top = 600
Width = 195
End
Begin VB.Label Label19
Caption = "verbleibene Anzahl"
Height = 195
Left = 3750
TabIndex = 74
Top = 240
Width = 1425
End
Begin VB.Label Label14
Caption = "Von Qmax"
Height = 195
Left = 60
TabIndex = 72
Top = 210
Width = 795
End
Begin VB.Label Label15
Caption = "bis Qmin"
Height = 195
Index = 0
Left = 1980
TabIndex = 71
Top = 240
Width = 645
End
End
Begin VB.Frame Frame1
Caption = "Fortschritt"
Height = 3555
Left = 120
TabIndex = 52
Top = 6540
Width = 3795
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 225
Left = 150
TabIndex = 60
Top = 2820
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 = 315
Left = 2550
TabIndex = 59
Top = 930
Width = 975
End
Begin VB.Label Label16
Alignment = 1 'Rechts
Caption = "Prüfgang Nr.:"
Height = 225
Left = 270
TabIndex = 66
Top = 3180
Width = 1035
End
Begin VB.Label lblPruefgangNr
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 1410
TabIndex = 65
Top = 3120
Width = 1065
End
Begin VB.Label Label10
Caption = "Sekunden"
Height = 285
Left = 2580
TabIndex = 64
Top = 360
Width = 855
End
Begin VB.Label Label9
Caption = "Minuten"
Height = 285
Left = 2550
TabIndex = 63
Top = 2280
Width = 825
End
Begin VB.Label Label8
Alignment = 1 'Rechts
Caption = "Ges. Zeit"
Height = 285
Left = 240
TabIndex = 62
Top = 2280
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 = 61
Top = 2220
Width = 1275
End
Begin VB.Label Label15
Alignment = 1 'Rechts
Caption = "Zeit (PP):"
Height = 285
Index = 1
Left = 240
TabIndex = 58
Top = 360
Width = 825
End
Begin VB.Label Label11
Alignment = 1 'Rechts
Caption = "Dauerprüfung:"
Height = 285
Left = 90
TabIndex = 57
Top = 960
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 = 56
Top = 930
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 = 55
Top = 300
Width = 1305
End
Begin VB.Label Label6
Alignment = 1 'Rechts
Caption = "Langprüfung:"
Height = 255
Left = 120
TabIndex = 54
Top = 1590
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 = 53
Top = 1560
Width = 1275
End
End
Begin VB.Frame Frame2
Caption = "Meßwertabweichung"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4155
Left = 3300
TabIndex = 50
Top = 720
Width = 11325
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 3855
Left = 180
TabIndex = 51
Top = 240
Width = 11055
_ExtentX = 19500
_ExtentY = 6800
_Version = 393216
Rows = 11
AllowBigSelection= 0 'False
AllowUserResizing= 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin VB.ListBox lstPruefpunkte
Height = 2400
Left = 13830
TabIndex = 48
Top = 5940
Width = 1215
End
Begin VB.Frame frameVerblImpulse
Caption = "Pruef2000"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5775
Left = 120
TabIndex = 23
Top = 720
Width = 3045
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 = 1800
TabIndex = 92
Top = 3840
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 = 600
TabIndex = 91
Top = 3840
Width = 1095
End
Begin VB.Label LblNummer
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 = 10
Left = 120
TabIndex = 90
Top = 3900
Width = 315
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 = 9
Left = 600
TabIndex = 86
Top = 3450
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 = 8
Left = 600
TabIndex = 85
Top = 3060
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 = 7
Left = 600
TabIndex = 84
Top = 2670
Width = 1095
End
Begin VB.Label LblNummer
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 = 7
Left = 180
TabIndex = 83
Top = 2730
Width = 315
End
Begin VB.Label LblNummer
Caption = "8"
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 = 180
TabIndex = 82
Top = 3120
Width = 315
End
Begin VB.Label LblNummer
Caption = "9"
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 = 180
TabIndex = 81
Top = 3510
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 = 345
Index = 8
Left = 1800
TabIndex = 80
Top = 3060
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 = 7
Left = 1800
TabIndex = 79
Top = 2670
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 = 9
Left = 1800
TabIndex = 78
Top = 3450
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 = 6
Left = 1800
TabIndex = 47
Top = 2250
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 = 5
Left = 1800
TabIndex = 46
Top = 1860
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 = 4
Left = 1800
TabIndex = 45
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 = 345
Index = 3
Left = 1800
TabIndex = 44
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 = 345
Index = 2
Left = 1800
TabIndex = 43
Top = 690
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 = 1
Left = 1800
TabIndex = 42
Top = 300
Width = 1095
End
Begin VB.Label LblNummer
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 = 180
TabIndex = 41
Top = 2310
Width = 315
End
Begin VB.Label LblNummer
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 = 5
Left = 180
TabIndex = 40
Top = 1920
Width = 315
End
Begin VB.Label LblNummer
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 = 4
Left = 180
TabIndex = 39
Top = 1530
Width = 315
End
Begin VB.Label LblNummer
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 = 3
Left = 180
TabIndex = 38
Top = 1140
Width = 315
End
Begin VB.Label LblNummer
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 = 2
Left = 180
TabIndex = 37
Top = 750
Width = 315
End
Begin VB.Label LblNummer
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 = 1
Left = 180
TabIndex = 36
Top = 360
Width = 315
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 = 1
Left = 600
TabIndex = 35
Tag = "#1"
Top = 300
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 = 2
Left = 600
TabIndex = 34
Top = 690
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 = 3
Left = 600
TabIndex = 33
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 = 345
Index = 4
Left = 600
TabIndex = 32
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 = 345
Index = 5
Left = 600
TabIndex = 31
Top = 1860
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 = 6
Left = 600
TabIndex = 30
Top = 2250
Width = 1095
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 = 60
TabIndex = 29
Top = 4350
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 = 600
TabIndex = 28
Top = 4290
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 = 600
TabIndex = 27
Top = 4710
Width = 1095
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 = 600
TabIndex = 26
Top = 5130
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 = 120
TabIndex = 25
Top = 4770
Width = 375
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 = 5160
Width = 375
End
End
Begin VB.Frame Frame4
Caption = "Soll-Durchfluss"
Height = 735
Left = 7560
TabIndex = 16
Top = 5010
Width = 3285
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
BackColor = &H00C0C0C0&
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 = 7500
TabIndex = 3
Top = 5670
Width = 4065
Begin VB.Label lblWasserdruck
Alignment = 1 'Rechts
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 = 2220
TabIndex = 99
Top = 1980
Width = 1095
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 = 3360
TabIndex = 98
Top = 2010
Width = 465
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 = 450
TabIndex = 97
Top = 2010
Width = 1635
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 = 3360
TabIndex = 96
Top = 2370
Width = 465
End
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 = 90
TabIndex = 95
Top = 2370
Width = 2025
End
Begin VB.Label lblTemperatur
Alignment = 1 'Rechts
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 = 2220
TabIndex = 94
Top = 2340
Width = 1095
End
Begin VB.Label lblGrenzwert
Alignment = 1 'Rechts
BackColor = &H80000004&
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 = 2220
TabIndex = 22
Top = 540
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 = 3390
TabIndex = 21
Top = 540
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 = 255
Left = 120
TabIndex = 20
Top = 540
Width = 1965
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 = 3390
TabIndex = 15
Top = 1290
Width = 405
End
Begin VB.Label lblFehlerRZ
Alignment = 1 'Rechts
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 = 2220
TabIndex = 14
Top = 1620
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 = 420
TabIndex = 13
Top = 1620
Width = 1635
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 = 3420
TabIndex = 12
Top = 1650
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 = 3420
TabIndex = 11
Top = 930
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 = 420
TabIndex = 10
Top = 1260
Width = 1635
End
Begin VB.Label lblSollV
Alignment = 1 'Rechts
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 = 2220
TabIndex = 9
Top = 1260
Width = 1095
End
Begin VB.Label lblQIst
Alignment = 1 'Rechts
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 = 2220
TabIndex = 8
Top = 180
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 = 510
TabIndex = 7
Top = 180
Width = 1545
End
Begin VB.Label lblGewicht
Alignment = 1 'Rechts
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 = 2220
TabIndex = 6
Top = 900
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 = 900
TabIndex = 5
Top = 870
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 = 3390
TabIndex = 4
Top = 210
Width = 645
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 = 675
Left = 7560
TabIndex = 2
Top = 9420
Width = 1335
End
Begin VB.TextBox txtStatus
Height = 5175
Left = 4110
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 1
Top = 4950
Width = 3285
End
Begin VB.Label lblAutoSize
AutoSize = -1 'True
BorderStyle = 1 'Fest Einfach
Caption = "lblAutosize"
Height = 255
Left = 8580
TabIndex = 100
Top = 300
Visible = 0 'False
Width = 1170
End
Begin VB.Label lblTitle
Alignment = 2 'Zentriert
Caption = "Ultraschallzähler Prüfung FW2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 89
Top = 210
Width = 12015
End
Begin VB.Label Label18
Caption = "Prüfpunkte:"
Height = 195
Left = 13920
TabIndex = 49
Top = 5700
Width = 1005
End
End
End
Attribute VB_Name = "frmUSFW2Hauptprf"
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_colUniqueVorPP As CVorpruefpunktCol
Public m_bKontinuierlich As Boolean
Public m_colEinbauplatz As Collection
Public m_ParentForm As Form
' Für Regulierung
Public m_Regulierdaten As CRegulierdaten
Public m_RegulierPruefpunkt As CPruefpunkt
Private m_vorPruefpunktQi As CVorpruefpunkt
Public m_bAutomatik As Boolean
' Public m_bKeineRegulierung As Boolean
Public m_AnzahlPZ As Integer
' Für Prüfzaehlerprüfung
Public m_ImpulswertigkeitPZ As Long
Private m_JustageCount As String
Public m_bDauerpruefung As Boolean
Public m_DauerpruefungAnzahl As Integer
Public m_PruefungsArtWaage As Boolean
Public m_VorPruefungsArtWaage 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 mbln_Vorpruefung As Boolean
Public mbln_Hauptpruefung As Boolean
'''Public mbln_Vorjustage As Boolean
Public mbln_Bereichsjustage As Boolean
Public mbln_nachjustage As Boolean
Public mbln_Funktionspruefung As Boolean
Public mbln_ZeroFlowMessung As Boolean
Public mbln_HeissKaltSpreizungBerechnen As Boolean
Public mbln_ZeroFlowJustage As Boolean 'OGeber bestimmen
Public mblnExternalTemperatur As Boolean
' Private Member
' --------------
Private m_PPDauerpruefung As Double
Private dummy As Variant
Private mblnAbbruch 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 m_vorPruefpunkt As CVorpruefpunkt
Private FormActivated As Boolean
Private m_ZaehlerPP As Integer
Private m_DurchflussSoll 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_PruefpunktFertig As Boolean
Private m_DauerStop As Boolean
Private m_laeuft As Boolean 'Status Prüfung läuft
Private m_QBehalten As Boolean
Private m_Startzeit As Long
Private m_Pruefzeit As Integer
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() As CBehaelter
Private m_Behaelter As CBehaelter
Private m_BehaelterNr As Integer
Private m_Waage As CWaage
Private m_DruckMsg As String
Private m_Tstart As Long 'Bezugszeitpunkt: Start der Prüfung
Private m_Tpruef As Long ' Sollprüfzeit aller US Zähler
Private m_Zeitrahmenzaehler As Long 'Index des aktuellen Zeitrahmens
Private ResultFilePath As String
Private m_AnwahlLetzterBehaelter As Long
Private mudtMessDaten(10) As TYPE_MessDaten
Private strFunktionsPruefungMsg As String
Private m_bVoreinstellwertSetzen As Boolean
Private m_dblTemperaturVergleich As Double
Private mobjMittelwertTemperatur As clsMittelwert
Private Type TypUSPruefdaten
' Enthält alle Daten, die für eine Ultraschallzähler-Prüfung relevant sind
' für einen bestimmten Zähler in einem bestimmten Prüfpunkt
' Solldurchfluß Q des Prüfpunktes
SollDurchfluss As Double ' in M^3/h
' Sollprüfzeit des Prüfpunktes in s
SollPruefzeit_s As Long
' Temperatur zur halben Prüfzeit
dblTemperatur As Double
' Ermitteltes Volumen aus den RZ/FM85 und US Zählern
VolumenRZ As Double
VolumenUS As Double
VolumenWaage As Double
' echte Prüfzeit zwischen USZaehler Start und Stop in ms
US_IstPruefzeit_ms As Double
' echte Prüfzeit zwischen Referenzzaehler Start und Stop in ms
RZ_IstPruefzeit_ms As Long '
NOWA_START_Rueckkehrzeitpunkt As Long
NOWA_STOP_Rueckkehrzeitpunkt As Long
RZ_START_Rueckkehrzeitpunkt As Long
RZ_STOP_Rueckkehrzeitpunkt As Long
StartzeitpunktRZ As Long
StartzeitpunktUS As Long
Stopzeitpunkt As Long
Fehlerinfo As String
Fehler As Double
' zukünftig:
dtmIstPruefzeit As Double
dtmStartZeit As Double
dtmMittelzeit As Double
dtmStoppzeit As Double
blnPruefungsfehler As Boolean
JustageParameter As JustageParameter_Type
End Type
' neu RH! 19.7.2002
Private Type US_ZusatzParameter_Typ
FP_Impulswertigkeit As Double '---Impulswertigkeit normale Ausgabe
FP_Impulswertigkeit_Pruef As Double '---Impulswertigkeit normale Ausgabe
PulseMode As Byte '---PulseMode (PolluFlow=1,PolluStat=2)
FP_Flow_Min As Double '---Minimaler Durchfluß
FP_Flow_Max As Double
End Type
Const dtmZEITRAHMENDAUER As Date = 1 / 24 / 60 / 60 / 1000 * 1000 'ms
Const ZEITRAHMENDAUER As Long = 4000 ' Dauer des Zeitrahmens in msec
Const DELTA_START As Long = 2000 'Zeitlicher Versatz in msec zwischen dem Start des Referenzzählers und NOWA_START
Const DELTA_FM As Long = 0 'Korrekturkonstante: Zeit in msec, um die die tatsächliche Prüfzeit des FM85 größer ist als die Sollprüfzeit, verursacht durch die längere Stopzeit
Const DELTA_US As Long = 0 'Korrekturkonstante: Zeit in msec, um die die tatsächliche Prüfzeit des US-Zählers größer ist als die Sollprüfzeit, verursacht durch die längere Stopzeit
Const FEHLER_ZUSPAET As Long = -15
Const KEIN_FEHLER As Long = 0
Const KEINE_ANTWORT_FEHLER As Long = -16
'--------------------------------------------------------------------
' @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 cmdAbbruch_Click()
g_Abbruch = True
End Sub
Private Sub cmdCancel_Click()
If m_laeuft Then
ErrorMsg ("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
'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()
If Not g_ohneSPS Then
m_DurchflussSollManuell = CDbl(Format(m_DurchflussSollManuell * 0.99, "0.000"))
m_SPS.SetQSoll m_DurchflussSollManuell
PrintStatus "Nächster Durchfluss: " & m_DurchflussSollManuell
lblQSoll.caption = m_DurchflussSollManuell
End If
End Sub
Private Sub cmdQSollPlus_Click()
If Not g_ohneSPS Then
m_DurchflussSollManuell = CDbl(Format(m_DurchflussSollManuell * 1.01, "0.000"))
m_SPS.SetQSoll m_DurchflussSollManuell
PrintStatus "Nächster Durchfluss: " & m_DurchflussSollManuell
lblQSoll.caption = m_DurchflussSollManuell
End If
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
' 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.WassserAblassen 0
m_SPS.SetServoStellung 50
End If
Call ResetPruefung
lblQIst.caption = ""
dlg.m_strGrund = strGrund
dlg.Show vbModal
m_Pruefgang.Bemerkung = dlg.m_strGrund
m_Pruefgang.save
endDialog IDCANCEL
End Sub
Private Sub cmdStop_Click()
PrintStatus "Es wurde auf Stop gedückt. Abbrechen..."
g_Abbruch = True
Call Abbruch("Es wurde auf Stop gedrückt")
End Sub
Private Sub ResetPruefung()
cmdDauerEnde.caption = "Dauer-P beenden"
cmdQSollPlus.Enabled = False
cmdQSollMinus.Enabled = False
m_laeuft = False
End Sub
Private Sub Form_Load()
Dim PPNr As Integer
Dim Index As Integer
Me.Width = Screen.Width
Me.Height = Screen.Height
Me.caption = "Pruef2000 FW2 Ultraschallzähler Konfigurationsvergleich Version" & g_App.AppVersion
Call centerFormInScreen(Me)
Set m_SPS = g_App.getSPS
' Temperatur-Mittelwert-Objekt erzeugen
Set mobjMittelwertTemperatur = New clsMittelwert
mobjMittelwertTemperatur.setMax 10
Set m_FMBus = g_App.getFMBus
Set m_ColPumpen = g_App.Settings.getPumpen
m_ZaehlerPP = 0
'cmdOK.Enabled = False
cmdCancel.Enabled = True
' Behälter Konfiguration aus Ini Lesen
' Set m_ArrayBehaelter(1) = New CBehaelter
' Set m_ArrayBehaelter(2) = New CBehaelter
' m_ArrayBehaelter(1).LoadFromIni (1)
' m_ArrayBehaelter(2).LoadFromIni (2)
For Index = 1 To 10
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadFromIni(Index) Then
ReDim Preserve m_ArrayBehaelter(Index)
Set m_ArrayBehaelter(Index) = m_Behaelter
Else
Set m_Behaelter = Nothing
Exit For
End If
Next
Set m_Waage = g_App.getWaage
If Not g_ohneSPS Then
m_SPS.setBehaelter 1 ' durchlauf
m_SPS.SetQSoll 0
m_SPS.setBetrieb 8 ' Bits zurücksetzen
Sleep 100, True
m_SPS.setBetrieb 0 ' kein Start, kein Stop, kein Programmende
End If
MSFlexGrid1.Clear
If g_blnVorpruefung3malQiMittelwert Then
MSFlexGrid1.Cols = 1 + m_colUniqueVorPP.Count + 3
Else
MSFlexGrid1.Cols = 1 + m_colUniqueVorPP.Count
End If
If MSFlexGrid1.Cols < 2 Then MSFlexGrid1.Cols = 2
MSFlexGrid1.Rows = g_App.Settings.EinbauplaetzeJeStrang + 1
MSFlexGrid1.row = 0
MSFlexGrid1.col = 0
MSFlexGrid1.text = "FabNr SNr.\ Q [m³/h]"
txtBemerkung.Visible = False
' Listbox mit allen Durchflüssen füllen
lstPruefpunkte.Clear
PPNr = 0
For Each m_vorPruefpunkt In m_colUniqueVorPP.getCollection
PPNr = PPNr + 1
MSFlexGrid1.row = 0
MSFlexGrid1.col = PPNr
MSFlexGrid1.text = m_vorPruefpunkt.getQ
lstPruefpunkte.AddItem (CStr(m_vorPruefpunkt.getQ))
Next m_vorPruefpunkt
If m_bKontinuierlich Then
frameKontinuierlich.Visible = True
Else
frameKontinuierlich.Visible = False
End If
m_AnwahlLetzterBehaelter = 0
For Index = 1 To 10
If Index > g_App.Settings.EinbauplaetzeJeStrang Then
lblVerbleib(Index).Visible = False
lblPZImpulse(Index).Visible = False
LblNummer(Index).Visible = False
End If
Next
If g_blnPruefprotokoll Then chkProtokolldruck.value = vbChecked
End Sub
Private Sub Form_Activate()
If Not FormActivated Then
FormActivated = True
DoEvents
Call Hauptpruefung
End If
FormActivated = True
End Sub
Private Sub DurchflussLstAktualisieren()
Dim i As Integer
' Balkenanzeige in der Liste der Durchflüsse aktualisieren
For i = 0 To lstPruefpunkte.ListCount - 1
If Format(lstPruefpunkte.List(i), "0.000") = Format(m_DurchflussSoll, "0.000") Then
lstPruefpunkte.Selected(i) = True
Else
lstPruefpunkte.Selected(i) = False
End If
Next
End Sub
' Hauptprüfung mit Referenzzaehler
Private Sub Hauptpruefung()
Dim dummy As Variant
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim bFehlerermittelt As Boolean
Dim Impulse As Long
Dim blnPruefungFertig As Boolean
Dim blnHalbzeit As Boolean
Dim PeriodendauerPZ As Long
Dim PeriodendauerRZ As Long
Dim PeriodendauerRefZ1 As Long
Dim PeriodendauerRefZ2 As Long
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 PPZeit As Date
Dim StartZeit As Date
Dim PPSollZeit As Long
Dim dblTemperatur As Double
Dim PZCount As Integer
Dim bImpulsTest As Boolean
Dim bPPQIstSaved As Boolean
Dim i As Integer
Dim lngRet As Long
Dim lngStartzeit As Long
Dim EinbauplatzNr As Integer
Dim Gewicht As Double
Dim BehaelterVolumen As Double
Dim Waagengrenzwert As Double
Dim GesZeit As Double
Dim tmpPruefpunkt As CPruefpunkt
Dim tmpVorpruefpunkt As CVorpruefpunkt
Dim dblVolumenRZ As Double
Dim dblVolumenUS As Double
Dim dblDurchflussRZ As Double
Dim dblDurchflussUS As Double
Dim US_COMport As Integer
Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
Dim Voreinstellwert As Integer
On Error GoTo Errorhandler
' SPS Parameter zurücksetzen
' Durchlauf
'm_SPS.setBehaelter 1
g_Abbruch = False
' Formular und Flags zurücksetzen
cmdStop.Enabled = True
m_SPS.setBetrieb 8
Sleep 300
m_SPS.setBetrieb 0
m_laeuft = True
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
' Einstellung für Vergleichsprüfung-Modus in der SPS testen
TestReferenzPrf:
If Not g_ohneSPS Then
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
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
Debug.Print g_App.PruefstationTyp
If g_App.PruefstationNr = 2020 Then
' es darf kein warmes Wasser im Behälter kalt werden
Call BeideBehaelterLeeren
End If
End If
If m_PruefungsArtWaage Then
Call WaageZuruecksetzen
End If
' klären Todo: warum diesen Behälter ?
'm_SPS.setBehaelter 2
PrintStatus "alle Behälter leeren bis Prüfmenge nicht mehr erreicht..."
If Not g_ohneSPS Then
m_SPS.WassserAblassen 0
' beide Behälter leeren bis Prüfmenge nicht mehr erreicht
Sleep 500
m_SPS.WassserAblassen 1 + 2 + 4 + 8
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 ' Testmodus
' klären Todo: warum diesen Behälter ?
'm_SPS.setBehaelter 1
' Pruefgang Daten setzen mit Eigenschaften des ersten Zählers
For Each Einbauplatz In m_colEinbauplatz
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
'If Not SindPruefzeitenOK() Then
' Call Abbruch("falsche Prüfzeiten für Behälter")
' Exit Sub
'End If
' Flag für PruefgangLang im Pruefgang-Objekt für Tabelle Pruefgang setzen:
m_Pruefgang.PruefgangLang = m_bPruefgangLang
PrintStatus "Pruefgang Lang: " & CStr(m_bPruefgangLang)
' Pruefpunkte absteigend sortieren nach Durchfluessen
'm_colUniquePP.sortQ
If Not g_ohneSPS Then
' Einstellung für Automatik-Modus in der SPS testen
m_SPS.setBetrieb 8 ' Bits zurücksetzen
Sleep 300
m_SPS.setBetrieb 0 ' kein Start, kein Stop, kein Programmende
PrintStatus "Teste auf Prüfbereitschaft"
Sleep 3000, True
If Not m_SPS.IstStreckePruefbereit Then
' Betrieb Vorbereiten
If MsgBox("Soll die Strecke jetzt automatisch gespannt u. gefüllt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht prüfbereit") = vbYes Then
'??? m_SPS.setBehaelter DURCHLAUF
' beim Abbrechen war kein Prüfbereit. Hier kommt die SPS Meldung: Füllen in kl Behälter nicht möglich
m_SPS.setBetrieb 1
PrintStatus "Betrieb vorbereiten: Spannen und Füllen..."
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
End If
'------------------------------------------------------------------------
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
End If
PrintStatus "Strecke ist Prüfbereit !"
'---------------------------------------------------------------
' 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")
' vor einer Justage die Temperatur für alle Ultraschallzählung einmal messen und in alle Rechenwerk setzten
If mblnExternalTemperatur Then
UpdateTemperaturInZaehlerFW2 True
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Vorprüfung mit Justage bei Qmax und Qmin
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If mbln_Vorpruefung Then
lblTitle.caption = "FW2 Ultraschall-Zähler Vorprüfung (Justage)"
' Zu beginn der Vorprüfung die Systemzeit zurücksetzen wegen OptoTimeout
If g_blnFW2_Systemzeit_setzen = True Then
Call FW2_SetTimeToZero(Einbauplatz)
End If
Dim intJustageCount As Integer
For intJustageCount = 1 To g_intAnzahlFW2Justage
'''''''''''''''''''''''''' Vorprüfung / Justage '''''''''''''''''''''''''
lblTitle.caption = "FW2 Ultraschall-Zähler Vorprüfung (Justage) " & intJustageCount & " / " & g_intAnzahlFW2Justage
m_JustageCount = intJustageCount & " / " & g_intAnzahlFW2Justage
PrintStatus intJustageCount & ". Durchlauf der Justage"
' Todo erste Vorprüfung gegen RefZ , 2. gegen Waage
If False Then
If intJustageCount = 1 Then
' Prf gegen RefZ
m_VorPruefungsArtWaage = False
Else
m_VorPruefungsArtWaage = True
End If
End If
If Vorpruefung() < 0 Then
g_Abbruch = True
End If
Next
Call Sleep(2000, True)
'If g_blnPruefprotokoll Then
' PrintGrid MSFlexGrid1, 15, 50, 10, 10, "Fehlerwerte der Justage", Format(Now, "dd.mm.yyyy hh:mm"), 0
'End If
If m_VorPruefungsArtWaage Then
PrintStatus "Behälter-Wasser von der Justage ablassen..."
BeideBehaelterLeeren
End If
End If
If g_Abbruch Then
'Call Abbruch("Es ist ein Fehler in der Vorprüfung aufgetreten.")
Exit Sub
End If
If m_bKontinuierlich Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Kontinuierliche
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call KontinuierlichePruefungInit
Exit Sub
End If
If Not mbln_Hauptpruefung Then
GoTo EndeDerHauppruefung
Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Hauptprüfung
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
lblTitle.caption = "FW2 Ultraschall-Zähler Hauptprüfung"
End If
If g_Abbruch Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Schleifenbeginn Hauptprüfung / Dauerprüfung
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
StartZeit = Now()
m_DauerStop = False
If m_DauerpruefungAnzahl > 1 Then
cmdDauerEnde.Enabled = True
End If
For m_DauerpruefungZaehler = 1 To m_DauerpruefungAnzahl
m_DruckMsg = ""
' 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
' Neuer Pruefgang-Eintrag in der Datenbank
m_Pruefgang.save
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 gestartet"
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
End If
'Geändert 28.04.2004 Andreas Pfeiffer
'zur Zeit darf diese Zuweisung nur bei St. 2015 und 2016 erfolgen
'diese Abfrage erweitern um die Stationen, die entsprechende Messungen
'in ProTool zu Verfügung stellen
'If m_Pruefgang.PruefstationNr = 2015 Or m_Pruefgang.PruefstationNr = 2016 Then
' m_Pruefgang.RelativeFeuchte = m_SPS.GetRelativeFeuchte
' m_Pruefgang.Lufttemperatur = m_SPS.GetLuftTemperatur
'End If
' Pruefgang abspeichern und neue Prüfgangnummer erzeugen
m_Pruefgang.save
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.000")
Next
' Anzahl der Pruefzähler zählen, wird in Pruefgang Tabelle eingetragen
' FlexGrid dimensionieren
MSFlexGrid1.Clear
PZCount = 0
MSFlexGrid1.Cols = 1 + m_colUniquePP.Count
MSFlexGrid1.row = 0
MSFlexGrid1.col = 0
MSFlexGrid1.text = "FabNr SNr.\ Q "
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
MSFlexGrid1.row = Einbauplatz.getNr
MSFlexGrid1.col = 0
If Not Pruefzaehler Is Nothing Then
WriteToFW2Logfile Einbauplatz, "PrüfgangNr=" & vbTab & m_Pruefgang.PruefgangNr
If m_DauerpruefungAnzahl > 1 Then
WriteToFW2Logfile Einbauplatz, "Dauerprüfung=" & vbTab & m_DauerpruefungZaehler & " / " & m_DauerpruefungAnzahl
End If
''MSFlexGrid1.text = FormatSerienNr(Pruefzaehler.getSerienNr) & " F:" & Pruefzaehler.getAuftragPositionSerienNr.getFabNr
MSFlexGrid1_AnzeigeSerienNrFabNr Pruefzaehler
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
' AuftragPositionsobjekt als neuen Datensatz speichern
PrintStatus "neuer Datensatz in AuftragPosSerNr mit Pruefgang=" & m_Pruefgang.PruefgangNr & ", SerNr=" & FormatSerienNr(Pruefzaehler.getSerienNr) & ", Wdh=" & Pruefzaehler.getAuftragPositionSerienNr.getWiederholungen
Pruefzaehler.getAuftragPositionSerienNr.SetEinbaulage Einbauplatz.m_strEinbaulage
Pruefzaehler.getAuftragPositionSerienNr.save True
' Der aktuelle Status des Zählers wird in das Rechenwerk übertragen.
' Prüfung läuft oder geprüft FAIL (vor der Prüfung)
Call modUSchall.FW2_writeVar(Einbauplatz, "u8_hydraulik_flag_KEV1", CByte(1))
'''''''''''''''''''''''''''''''''''''
' neu RH 4.12.2013, 9.12.2013
' RW Werte vor der Prüfung dokumentieren
'''''''''''''''''''''''''''''''''''''
Dim dblWert As Double
dblWert = 0
If modUSchall.FW2_ReadVar(Einbauplatz, "f_fp_k_geber1", dblWert) = 0 Then
WriteToFW2Logfile Einbauplatz, "f_fp_k_geber1=" & vbTab & dblWert
End If
dblWert = 0
If modUSchall.FW2_ReadVar(Einbauplatz, "f_fp_k_geber2", dblWert) = 0 Then
WriteToFW2Logfile Einbauplatz, "f_fp_k_geber2=" & vbTab & dblWert
End If
dblWert = 0
If modUSchall.FW2_ReadVar(Einbauplatz, "f_fp_o_geber_roh", dblWert) = 0 Then
WriteToFW2Logfile Einbauplatz, "f_fp_o_geber_roh=" & vbTab & dblWert
End If
End If
Next Einbauplatz
For i = 1 To m_colUniquePP.Count
MSFlexGrid1.row = 0
MSFlexGrid1.col = i
If m_colUniquePP.Item(i).getQ = Int(m_colUniquePP.Item(i).getQ) Then
'Ganze Zahl
MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "0") & " "
Else
'Liter Angabe erforderlich mit 3 Stellen hinter Komma
MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "0.###") & " "
End If
Next
m_Pruefgang.Anzahl = PZCount
PrintStatus "Anzahl eingebaute Pruefzähler: " & CStr(PZCount)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Schleife für alle Pruefpunkte
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each m_Pruefpunkt In m_colUniquePP.getCollection
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
lblVerbleib(i).caption = ""
lblPZImpulse(i).caption = ""
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
PrintStatus "nächster Pruefpunkt (" & PPNr & " / " & m_colUniquePP.Count & "): " & m_Pruefpunkt.getQ
' Dauer dieses Pruefpunktes
m_Pruefzeit = m_Pruefpunkt.GetTime
PrintStatus "Soll-Pruefzeit für diesen PP: " & m_Pruefzeit & " sec"
m_DurchflussSoll = m_Pruefpunkt.getQ
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
Call DurchflussLstAktualisieren
' Referenzzähler wechseln
' ----------------------
' für den Referenzzaehler-Vergleich herangezogene Referenzzaehler
Set m_ReferenzzaehlerA = New CRefzaehler
' Referenzzaehler in Abbhängigkeit vom Durchfluß und INI Datei bestimmen
m_ReferenzzaehlerA.loadForDurchfluss m_DurchflussSoll, 1
If Not g_ohneSPS Then
mobjMittelwertTemperatur.AddWert m_SPS.GetEinlaufTemperatur
Else
mobjMittelwertTemperatur.AddWert 20
End If
dblTemperatur = mobjMittelwertTemperatur.GetWert
FehlerRefZA = m_ReferenzzaehlerA.letzterFehler(m_DurchflussSoll, dblTemperatur)
PrintStatus "Letzter Fehler des Referenzzählers A(interpoliert): " & Format(FehlerRefZA, "0.00") & "% bei T=" & Format(dblTemperatur, "0") & " °C"
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
Set m_ReferenzzaehlerB = New CRefzaehler
m_ReferenzzaehlerB.loadForDurchfluss m_DurchflussSoll, 2
FehlerRefZB = m_ReferenzzaehlerB.letzterFehler(m_DurchflussSoll, dblTemperatur)
PrintStatus "Letzter Fehler des Referenzzählers B(interpoliert): " & Format(FehlerRefZB, "0.00") & "% bei T=" & Format(dblTemperatur, "0") & " °C"
' 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 "Aktive RefZ-Gruppe ist A"
FehlerRefZ = FehlerRefZA
End If
lblFehlerRZ.caption = Format(FehlerRefZ, "0.00")
' Referenzzaehler Daten für Pruefpunkt speichern
m_Pruefgang.PP_RefZSerienNr(PPNr) = m_Referenzzaehler.SerienNr
If m_DurchflussSoll = 0 Then
PrintStatus "Durchfluß ist 0, wird übersprungen"
Else
' Schleife PruefgangLang initialisieren
ZaehlerPruefgangLang = 0
PruefgangLangPruefpunktWiederholen = False
SchleifenanfangPruefgangLang:
' SchleifenanfangPruefgangLang:
' PPNr und Q bleibt
' -----------------------------
PrintStatus "Schleifenbeginn Prüfgang Lang, Zaehler=" & ZaehlerPruefgangLang
lblLang.caption = ZaehlerPruefgangLang
' Startzeit für diesen Pruefpunkt festhalten
PPZeit = Now
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Einbauplatz.getPruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) Then
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_Pruefzeit
WriteToFW2Logfile Einbauplatz, ""
WriteToFW2Logfile Einbauplatz, "-----------"
WriteToFW2Logfile Einbauplatz, "Prüfpunkt Nr=" & vbTab & PPNr
WriteToFW2Logfile Einbauplatz, "Soll-Durchfluss [m³/h]=" & vbTab & m_DurchflussSoll
WriteToFW2Logfile Einbauplatz, "Soll-Prüfzeit [s]=" & vbTab & m_Pruefzeit
Else
' Dieser Zähler wird in diesem PP nicht geprüft
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = 0
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = 0
End If
If g_blnFW2_Systemzeit_setzen = True Then
Call FW2_SetTimeToZero(Einbauplatz)
End If
End If
Next
If mblnExternalTemperatur Then
UpdateTemperaturInZaehlerFW2 True
End If
If Not m_PruefungsArtWaage Then
' 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
' Da neuer Pruefpunkt, Pruefpunkt neu initialisieren
If Not g_ohneSPS Then
Call initSPSfuerPP
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
End If ' testModus
PrintStatus "Warten auf Solldurchfluß erreicht..."
If Not g_ohneSPS Then
' Vergleichsprüfung gegen RefZ
' Pruefung starten
m_SPS.setBetrieb 2
Do While Not m_SPS.SolldurchflussErreicht
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
Sleep 500, True
'Debug.Print m_SPS.GetStellwert
mobjMittelwertTemperatur.AddWert m_SPS.GetEinlaufTemperatur
If g_Abbruch = True Then
Exit Sub
End If
Loop
' Durchflußanzeige RefIstWert korrigiert
QIst = m_SPS.getQIst
PrintStatus "Solldurchfluss erreicht bei Q=" & Format(QIst, "0.000")
lblQIst.caption = Format(QIst, "0.000")
' FM85 für Periodendauermessung für diesen Pruefpunkt initialisieren
Call initFM85fuerPP
End If ' g_ohneSPS
Else
'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
' Pruefung mit Waage
' --------------------
' geschätzes Volumen in Litern
' Behälterauswahl
' Waagenauswahl
' Behälter leeren oder füllen
' Tara
' Waagengrenzwert setzen
BeideBehaelterLeeren
If WaageVorbereitenFuerPP() < 0 Then
Call Abbruch("Waage konnte nicht vorbereitet werden (falsches SollVolumen)")
Exit Sub
End If
If g_Abbruch Then
Exit Sub
End If
Call initSPSfuerPP
If g_Abbruch Then
Exit Sub
End If
' Anzeige Füllmenge
lblGewicht.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
PrintStatus "Warte auf Startfreigabe"
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
Exit Sub
End If
Loop
' Impulszählung programmieren
' Call initFM85fuerPP_Waage
If g_Abbruch Then
Exit Sub
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
dblTemperatur = m_SPS.GetEinlaufTemperatur
m_Pruefgang.PP_T_Start(PPNr) = dblTemperatur
' Prüfgang Daten in DB synchronisieren
m_Pruefgang.save
' ' 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."
' ImpulsTestZeit = ImpulsTestZeit
' PrintStatus "Wartezeit auf 1. Impuls = " & Format(ImpulsTestZeit, "0.0") & " s"
' AnzahlZaehlerOhneImpulse = 0
' bImpulsTest = False
'''''''''''''''''''''''''''''''''''''
' M E S S U N G
'''''''''''''''''''''''''''''''''''''
m_Startzeit = GetTickCount()
If g_ohneSPS Then
dblTemperatur = 20
Else
mobjMittelwertTemperatur.AddWert m_SPS.GetEinlaufTemperatur
dblTemperatur = mobjMittelwertTemperatur.GetWert
PrintStatus "Einlauftemperatur für diesen PP: " & Format(dblTemperatur, "0.00") & "°C"
End If
For Each Einbauplatz In m_colEinbauplatz
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).dblTemperatur = dblTemperatur
Next
If m_PruefungsArtWaage Then
''''''''''''''''''''''' mit Waage ''''''''''''''
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) And Einbauplatz.getAktiv Then
' dieser Zähler soll geprüft werden
'Die Temperatur muss einmal vor jedem Prüfpunkt gesetzt werden.
If mblnExternalTemperatur Then
lblTemperatur.caption = Format(dblTemperatur, "0.0")
lngRet = FW2_USSetTemperatur(Einbauplatz, dblTemperatur)
If lngRet = 0 Then
PrintStatus "USSetTemperatur OK"
Else
PrintStatus "USSetTemperatur Fehler" & lngRet
End If
End If
'lngRet = FW2_StarteUSundRZZaehler(Einbauplatz)
lngRet = FW2_Starte_NOWA(Einbauplatz)
If lngRet = 0 Then
PrintStatus "NOWA_START OK"
Else
PrintStatus "NOWA_START Fehler:" & lngRet
End If
End If ' PZ is nothing and GetAktive
If g_Abbruch = True Then Exit Sub
Next Einbauplatz
' neu RH 15.2.2013
PrintStatus "warte 2 Sek bevor Pumpe gestartet wird"
Sleep 2000
' Prüfung starten
m_SPS.setBetrieb 2
m_Tstart = GetTickCount
PrintStatus "Pumpe gestartet"
Do While Not ((m_Pumpe.GetStatus And 4) = 4)
If m_SPS.GrenzwertWaageErreicht Then
PrintStatus "Grenzwert erreicht bevor Pumpe läuft"
Exit Do
End If
Sleep 500, True
If g_Abbruch Then
Exit Sub
End If
Loop
PrintStatus "Pumpe läuft"
blnHalbzeit = False
blnPruefungFertig = False
Do While Not blnPruefungFertig
If m_SPS.GrenzwertWaageErreicht Then
PrintStatus "Grenzwert Waage erreicht"
blnPruefungFertig = True
End If
If g_Abbruch Then
Exit Sub
End If
If Not m_Waage Is Nothing Then
lblGewicht.caption = Format(m_Waage.GetGewicht, "0.00")
End If
AnzeigeAktualisieren
'Neu RH 13.3.2008
If (Not blnHalbzeit) And (m_Pruefzeit * CLng(1000)) / 2 + m_Tstart < GetTickCount Then
blnHalbzeit = True
PrintStatus "nach halber Prüfzeit " & (m_Pruefzeit * CLng(1000)) / 2 & " s"
QIst = m_SPS.getQIst
' Wasserdruck messen für Zulassungspruefdaten
g_dblWasserdruck = Round(MesseWasserdruck(), 3)
If g_dblWasserdruck <> -1 Then
PrintStatus "Wasserdruck: " & g_dblWasserdruck
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 "bei Durchfluss: " & Format(QIst, "0.000") & " m³/h (" & m_DurchflussSoll & ")"
PrintStatus "=> Voreinstellwert " & Voreinstellwert & " speichern"
SetVoreinstellwert m_DurchflussSoll, Voreinstellwert
End If
End If
' Temperatur in den Zähler schreiben
If mblnExternalTemperatur Then
UpdateTemperaturInZaehlerFW2
End If
If g_Abbruch Then
Exit Sub
End If
Sleep 100
DoEvents
Loop
Call m_Behaelter.WarteAufRuhe
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) And Einbauplatz.getAktiv Then
lngRet = FW2_StoppeUSundRZZaehler(Einbauplatz)
If lngRet = 0 Then
PrintStatus "RZ-STOP und NOWA_STOP OK"
Else
PrintStatus "RZ-STOP und NOWA_STOP Fehler:" & lngRet
End If
End If ' PZ is nothing and GetActive
Next Einbauplatz
Else
' Prüfung gegen Referenzzähler
Call UltraschallPruefung(udtPruefdaten_imPP_mitEBP())
If g_Abbruch = True Then Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
' PrintStatus "Warten, bis der Referenzzaehler alle Impulse gezählt hat..."
' AlleImpulseFertig = True
' Do
' ' Verbleibende Referenzzaehlerimpulse in FM85 für RefZ-Vergleich auslesen
' m_FMBus.send "**" & g_FM85RefZAdresse & "@"
' m_FMBus.receive (500)
'
' m_FMBus.send "J"
' Impulse = Val("&H0000" & m_FMBus.receive(500))
' lblVerbleibRZA.Caption = Str(Impulse)
' If Impulse > 0 Then
' AlleImpulseFertig = False
' End If
'
' m_FMBus.send "I"
' Impulse = Val("&H0000" & m_FMBus.receive(500))
' lblVerbleibRZB.Caption = Str(Impulse)
' If Impulse > 0 Then
' AlleImpulseFertig = False
' End If
' Loop While Not AlleImpulseFertig
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PP_Ist_Zeit = m_Tpruef
m_GesZeitZaehler = m_GesZeitZaehler + PP_Ist_Zeit
lblGesZeit.caption = Format(m_GesZeitZaehler, "#0.0") & "/" & Format(GesZeit, "#0.0")
Stopphase:
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
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
End If
' nach dem Qmax soll Wassertemperatur für Prüfgang ermittelt und gespeichert werden
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
Else
dblTemperatur = 20
End If
PrintStatus "Temperatur: " & Format(dblTemperatur, "0.00") & " °C"
m_Pruefgang.PP_T_Ende(PPNr) = dblTemperatur
mobjMittelwertTemperatur.Clear
mobjMittelwertTemperatur.AddWert dblTemperatur
dblTemperatur = mobjMittelwertTemperatur.GetWert
If PPNr = 1 Then
m_Pruefgang.Vorlauftemperatur = dblTemperatur
End If
m_Pruefgang.save
'----------------------------------------------------------------
' Fehlerermittung
'----------------------------------------------------------------
PrintStatus "Fehlerermittlung:"
PrintStatus "-----------------"
If m_PruefungsArtWaage Then
'PrintStatus "Beruhigungsphase..."
'sleep 3000, True
'm_Waage.WarteAufRuhe
If g_Abbruch Then
Call Abbruch("")
Exit Sub
End If
If g_App.Settings.GetBenutzeFuellstandStattWaage() Then
m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Behaelter
Else
m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Waage
End If
Gewicht = m_Waage.GetGewicht
lblGewicht.caption = Format(Gewicht, "0.000")
PrintStatus "Gewicht: " & Format(Gewicht, "0.000") & " kg"
' Volumen in der Waage ermitteln
BehaelterVolumen = Errechne_Volumen_Von_Wasser_in_m3(Gewicht, dblTemperatur)
m_Pruefgang.PP_Waage(PPNr) = m_Behaelter.m_Nr
m_Pruefgang.save
PrintStatus "Volumen in der Waage " & m_BehaelterNr & " : " & BehaelterVolumen & " m³"
Else
m_Pruefgang.KalibrierID = KALIBRIERUNG.KALIBRIER_ID_Referenzzaehler
End If
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
If Einbauplatz.getAktiv Then
If (Not Pruefzaehler.getPruefpunkte Is Nothing) Then
If (Pruefzaehler.getPruefpunkte.hasQ(m_DurchflussSoll) = True) Then
MSFlexGrid1.col = PPNr
MSFlexGrid1.row = Einbauplatz.getNr
dummy = FW2_GetUSVolumen(Einbauplatz, dblVolumenUS)
If dummy = 0 Then
PrintStatus "Volumen des US-" & Einbauplatz.getNr & " [m³]: " & dblVolumenUS
Else
dblVolumenUS = 0
PrintStatus "FW2_GetUSVolumen Fehler: " & dummy & ": " & modMBUS_SMS.Errorstring(CInt(dummy))
End If
If m_PruefungsArtWaage Then
WriteToFW2Logfile Einbauplatz, "Gewicht im Behälter [kg]=" & vbTab & Gewicht
WriteToFW2Logfile Einbauplatz, "Temperatur=" & vbTab & dblTemperatur
WriteToFW2Logfile Einbauplatz, "BehaelterVolumen=" & vbTab & BehaelterVolumen
If BehaelterVolumen > 0 Then
' Fehlerermittlung
' Fehler = (Impulse / Pruefzaehler.GetImpulseQM - BehaelterVolumen) * 100 / BehaelterVolumen
' PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " %"
If g_objExternePruefformel Is Nothing Then
PrintStatus "Interne Pruefformel"
PrintStatus " dblVolumenUS = " & dblVolumenUS
PrintStatus " BehaelterVolumen = " & BehaelterVolumen
Fehler = ((dblVolumenUS - BehaelterVolumen) / BehaelterVolumen) * 100
Else
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dblVolumenUS, BehaelterVolumen, 0)
PrintStatus g_objExternePruefformel.GetLogText
End If
PrintStatus "ermittelter Fehler: " & Format(Fehler, "0.00") & " %"
WriteToFW2Logfile Einbauplatz, "ermittelter Fehler=" & vbTab & Round(Fehler, 3)
Else
Fehler = -99
WriteToFW2Logfile Einbauplatz, "Der Fehler konnte nicht ermittelt werden, weil das gemessene Behältervolumen=" & BehaelterVolumen & " ist."
End If
m_Pruefgang.PP_Ist_V(PPNr) = BehaelterVolumen * 1000
'''''''''''''''''''
Call MesseWetterdaten
m_Pruefgang.LuftDruck = g_dblLuftDruck
If g_dblLuftDruck > 0 Then
DebugMsg "speichern im Prüfgang: LuftDruck [hPa]=" & g_dblLuftDruck
WriteToFW2Logfile Einbauplatz, "Luftdruck [hPa]=" & vbTab & g_dblLuftDruck
End If
m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur
If g_dblLuftTemperatur > 0 Then
WriteToFW2Logfile Einbauplatz, "Lufttemperatur [°C]=" & vbTab & g_dblLuftTemperatur
DebugMsg "speichern im Prüfgang: Lufttemperatur [°C]=" & g_dblLuftTemperatur
End If
m_Pruefgang.RelativeFeuchte = g_dblLuftFeuchte
If g_dblLuftFeuchte > 0 Then
DebugMsg "speichern im Prüfgang: Relative Feuchte [%]=" & g_dblLuftFeuchte
WriteToFW2Logfile Einbauplatz, "Luftfeuchte [%]=" & vbTab & g_dblLuftFeuchte
End If
m_Pruefgang.save
'''''''''''''''''''
WriteToLog "SchreibeZulassungspruefdaten " & g_blnZulassungspruefung & ", Waage, Q=" & m_DurchflussSoll
If g_blnZulassungspruefung Then
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, dblVolumenUS, dblVolumenRZ, Fehler, dblTemperatur, PPZeit, True)
End If
Else ' (not m_PruefungsArtWaage) Prüfung gegen Refeenzzähler
Call GetRZVolumen(Einbauplatz.getNr, m_Referenzzaehler, dblVolumenRZ)
' Korrektur
DebugMsg "ermitteltes Volumen des RZ: " & dblVolumenRZ & " m³"
WriteToFW2Logfile Einbauplatz, "FM85 Volumen=" & vbTab & dblVolumenRZ
If Not g_ohneSPS Then
mobjMittelwertTemperatur.AddWert m_SPS.GetEinlaufTemperatur
dblTemperatur = mobjMittelwertTemperatur.GetWert
Else
dblTemperatur = 20
End If
WriteToFW2Logfile Einbauplatz, "Fehler RZ=" & vbTab & m_Referenzzaehler.letzterFehler(m_DurchflussSoll, dblTemperatur) & "%"
dblVolumenRZ = dblVolumenRZ / (1 + m_Referenzzaehler.letzterFehler(m_DurchflussSoll, dblTemperatur) / 100)
WriteToFW2Logfile Einbauplatz, "Referenzvolumen [m³]=" & vbTab & dblVolumenRZ
m_Pruefgang.PP_Ist_V(PPNr) = dblVolumenRZ * 1000
Call MesseWetterdaten
m_Pruefgang.RelativeFeuchte = g_dblLuftFeuchte
m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur
m_Pruefgang.LuftDruck = g_dblLuftDruck
DebugMsg "speichern im Prüfgang: LuftDruck [hPa]=" & g_dblLuftDruck
DebugMsg "speichern im Prüfgang: Lufttemperatur [°C]=" & g_dblLuftTemperatur
DebugMsg "speichern im Prüfgang: Relative Feuchte [%]=" & g_dblLuftFeuchte
WriteToFW2Logfile Einbauplatz, "Luftdruck [hPa]=" & vbTab & g_dblLuftDruck
WriteToFW2Logfile Einbauplatz, "Lufttemperatur [°C]=" & vbTab & g_dblLuftTemperatur
WriteToFW2Logfile Einbauplatz, "Luftfeuchte [%]=" & vbTab & g_dblLuftFeuchte
m_Pruefgang.save
DebugMsg "korrigiertes Volumen des RZ: " & dblVolumenRZ & " m³"
If Not dblVolumenRZ = 0 Then
'PrintStatus "Letzter Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %"
' 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 Not dblVolumenUS = 0 Then
' die Unterschiedlichen Zeiten eliminieren
WriteToFW2Logfile Einbauplatz, "RZ_IstPruefzeit_ms=" & vbTab & udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).RZ_IstPruefzeit_ms
dblDurchflussRZ = dblVolumenRZ / udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).RZ_IstPruefzeit_ms
WriteToFW2Logfile Einbauplatz, "Durchfluss RZ=" & vbTab & dblDurchflussRZ
If udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms = 0 Then
PrintStatus "Fehler des US-Zählers konnte nicht ermittelt werden, da Stop-Zeitpunkt verpasst (.US_IstPruefzeit_ms = 0)"
Fehler = 98 'Merker für "STOP Zeitpunkt verpasst"
Else
WriteToFW2Logfile Einbauplatz, "US_IstPruefzeit_ms=" & vbTab & udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms
dblDurchflussUS = dblVolumenUS / udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms
WriteToFW2Logfile Einbauplatz, "Durchfluss US=" & vbTab & dblDurchflussUS
PrintStatus "Durchfluss RZ:" & Format(dblDurchflussRZ, "0.00000000")
PrintStatus "Durchfluss US:" & Format(dblDurchflussUS, "0.00000000")
If g_objExternePruefformel Is Nothing Then
PrintStatus "Interne Pruefformel"
PrintStatus " dblDurchflussUS = " & dblDurchflussUS
PrintStatus " dblDurchflussRZ = " & dblDurchflussRZ
Fehler = ((dblDurchflussUS - dblDurchflussRZ) / dblDurchflussRZ) * 100
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
PrintStatus "ermittelter Fehler: " & Format(Fehler, "0.00") & " %"
WriteToFW2Logfile Einbauplatz, "ermittelter Fehler=" & vbTab & Round(Fehler, 3)
WriteToLog "SchreibeZulassungspruefdaten " & g_blnZulassungspruefung & ", RZ, Q=" & m_DurchflussSoll
If g_blnZulassungspruefung Then
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, dblVolumenUS, dblVolumenRZ, Fehler, dblTemperatur, PPZeit, False)
End If
End If
Else
Fehler = 99 'Merker für "Keine Impulse"
PrintStatus "Fehler: Das Volumen des US Zählers konnte nicht bestimmt werden für Einbauplatz " & Einbauplatz.getNr
End If
Else 'VolumenRZ = 0
PrintStatus ("Fehler: Das Volumen des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden (=0)")
GoTo Fehler_speichern_ueberspringen
End If
End If ' (not m_PruefungsArtWaage )
' 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
WriteToFW2Logfile Einbauplatz, "PruefgangLang: Mittelung der Fehler"
' ------------------------------------------
' 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
AutoSpaltenBreite MSFlexGrid1, lblAutosize
DoEvents
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 'm_bPruefgangLang And PPNr = m_colUniquePP.Count
' ------------------------------------------
' Behandlung sonst, wenn kein Pruefgang Lang
' ------------------------------------------
bFehlerermittelt = True
End If ' Prüfgang lang
' -------------------------------
' Behandlung aller Pruefungen
' -------------------------------
If bFehlerermittelt = True Then
' Fehler steht fest:
' speichern
'WriteToFW2Logfile Einbauplatz, "speichern des Fehlers " & vbTab & Fehler
Call FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, m_Pruefpunkt, m_colUniquePP)
MSFlexGrid1.text = Format(Fehler, "0.00")
AutoSpaltenBreite MSFlexGrid1, lblAutosize
DoEvents
' 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
' Neu RH 14.05.2007
If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then
' alt: If GrenzwertUeberschritten(m_Pruefpunkt.getFGo, Fehler, m_Pruefpunkt.getFGu) Then
AuftragpositionSerienNr.setStatusFertigung 25
PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !"
MSFlexGrid1.CellBackColor = &HC0C0FF
End If
AutoSpaltenBreite MSFlexGrid1, lblAutosize, 1
Else ' bFehlerermittelt
' bFehlerermittelt = false:
End If ' bFehlerermittelt
PrintStatus " ermittelter Fehler = " & Format(Fehler, "0.00") & "%"
Fehler_speichern_ueberspringen:
End If ' Prüfzähler hat diesen Prüfpunkt
End If ' Prüfpunkte vorhanden
Else
m_Pruefgang.save
PrintStatus "Ebp " & Einbauplatz.getNr & " wurde deaktiviert: Fehler-Ermittlung/Speicherung wurde übersprungen."
' Einbauplatz Active = false
End If ' Einbauplatz Active
End If 'Pruefzaehler vorhanden
Next Einbauplatz 'In m_colEinbauplatz
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
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
m_FMBus.send "X"
PeriodendauerRefZ1 = Hex2Long(m_FMBus.receive(500))
m_FMBus.send "Y"
PeriodendauerRefZ2 = Hex2Long(m_FMBus.receive(500))
PrintStatus "Referenzzaehler1 Periodendauer = " & PeriodendauerRefZ1
PrintStatus "Referenzzaehler2 Periodendauer = " & PeriodendauerRefZ2
' Referenzzähler Vergleich
If PeriodendauerRefZ1 = 0 Or PeriodendauerRefZ2 = 0 Then
PrintStatus ("Periodendauer eines RefZ (FM85P-13)liegt noch nicht vor.")
Else
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)
' 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") & "% " & vbCrLf & "ist größer als " & g_App.Settings.getMaxDiffRZ() & " % bei Q=" & Format(m_DurchflussSoll, "0.000") & "m³/h" & vbCrLf
PrintStatus "Warnung: der Fehler zwischen Referenzzaehlern " & Format(Fehler, "0.000") & "% ist größer als " & g_App.Settings.getMaxDiffRZ() & " % bei Q=" & Format(m_DurchflussSoll, "0.000") & "m³/h"
End If ' Fehler > MaxDiff
End If ' Periodendauer (nicht) liegt vor
End If ' 2 Referenzzähler zum Vergleichen
Else
Call WaageZuruecksetzen
End If ' Prüfungsart Vergleichsprüfung, not Waage
lblZeit.caption = ""
PrintStatus "Schleifenende Pruefgang Lang: Zähler=" & ZaehlerPruefgangLang
' Schleifenende für Pruefgang Lang
If PruefgangLangPruefpunktWiederholen Then
PrintStatus "Wg. Pruefgang Lang: Pruefpunkt wiederholen..."
m_QBehalten = True
GoTo SchleifenanfangPruefgangLang
End If
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
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
If m_PruefungsArtWaage Then
' es darf kein warmes Wasser im Behälter kalt werden
'Call BeideBehaelterLeeren
PrintStatus "Wasser ablassen beginnen"
m_SPS.WassserAblassen 1 + 2 + 4 + 8
End If
' Schleifenende Pruefpukte: nächster Pruefpunkt
Next m_Pruefpunkt
If m_PruefungsArtWaage And g_App.PruefstationNr = 2020 Then
AlleBehaelterLeeren Me, m_SPS, m_Waage
End If
PPZeit = Now()
' Kompletter Pruefgang bendet
' ----------------------------
' Für jeden geprüften Pruefzähler:
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
WriteToLog "SchreibeZulassungspruefdaten " & g_blnZulassungspruefung & " , Q=0(Timestamp)"
If g_blnZulassungspruefung Then
' Zeitstempel schreiben
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, 0, 0, 0, 0, 0, dblTemperatur, PPZeit)
End If
If Einbauplatz.getAktiv = False Then
' neu RH 2015-11-18: Zähler ist bei der Justage oder Prüfung ausgefallen
AuftragpositionSerienNr.setStatusFertigung 23
PrintStatus "Da Ebp " & Einbauplatz.getNr & " nicht aktiv: StatusFertigung = 23"
End If
Select Case AuftragpositionSerienNr.getStatusFertigung
Case 25
' Grenzwertüberschreitung in einem Prüfpunkt
Case 23
' Ausfall in einem Prüfpunkt oder bei der Justage
Case 22
' Geprüft in allen Prüfpunkten ohne Ausfall und Grenzwertüberschreitung
AuftragpositionSerienNr.setStatusFertigung 30
' " 0x00 = geprüft PASS
modUSchall.FW2_writeVar Einbauplatz, "u8_hydraulik_flag_KEV1", CByte(0)
' Todo:
' AuftragPosition.FertigemeldeTermin FertigmeldeMitarbeiter
' FertMeld_Pterm_MA = Mitarbeiter.GetNr
' P_IstTerm = now()
' Fertmeld_Pterm_Dat = now()
End Select
AuftragpositionSerienNr.save
End If
Next Einbauplatz
If g_blnPruefprotokoll Then
PrintStatus "Prüfergebnisse werden gedruckt..."
DoEvents
Call PruefgangDruck(m_Pruefgang, dblTemperatur, m_colEinbauplatz, PZCount, m_DruckMsg)
End If
' Neu RH 28.3.2017
Verschiebe_Prueffehler_Befundpruefung_Eichung m_Pruefgang.PruefgangNr
PrintStatus "Schleifenende Dauerprüfung. " & m_DauerpruefungZaehler
If m_DauerStop = True Then
PrintStatus "Dauerprüfung wurde vorzeitig gestopt"
Exit For
End If
Next m_DauerpruefungZaehler ' Schleifenende Dauerprüfung
PrintStatus "Prüfergebnisse werden gespeichert..."
DoEvents
' Speichern der PruefgangDaten
m_Pruefgang.save
' SPS Betrieb Programmende
PrintStatus "Ende der Hauppruefung"
EndeDerHauppruefung:
DoEvents
' Stoppen
m_SPS.setBetrieb 0
Sleep 1000
'If mbln_Funktionspruefung = True Then
' lblTitle.Caption = "FW2 Funktionsprüfung"
' Call Funktionspruefung
' m_DruckMsg = m_DruckMsg & vbCrLf & "Ergebnisse der Funktionsprüfung: " & vbCrLf & strFunktionsPruefungMsg
'End If
lblTitle.caption = "Ultraschall-Zähler Prüfung"
If g_blnVersuch Then
MsgBox ("Hauptprüfung schließen und mit Prüfungsabschluss fortfahren?")
End If
If False Then
' Programmende einleiten
If MsgBox("Automatisch beenden (SPS: entleeren & lösen)?", vbYesNo) = vbNo Then
GoTo Fertig ' nicht öffnen
Else
' lösen
m_SPS.setBetrieb 4
Sleep 1000
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
End If
Fertig:
If Not g_ohneSPS Then
' Jetzt kann Betrieb = 0 gesetzt werden
m_SPS.SetQSoll 0
Sleep 1000
m_SPS.setBetrieb 0
Sleep 1000
m_SPS.SetServoStellung 50
End If
Call ResetPruefung
If m_PruefungsArtWaage = True And Not m_Waage Is Nothing Then
Call m_Waage.releaseMScomm
End If
endDialog IDOK
Exit Sub
Errorhandler:
MsgBox "Fehler " & Err.Number & " in Hauptprüfung: " & Err.Description
Exit Sub
Resume
End Sub
Private Sub initSPSfuerDurchlauf()
' Durchlauf auswählen
If Not g_ohneSPS Then
m_SPS.setBehaelter 1
End If
lblGewichtLabel.Enabled = False
lblGewicht.Enabled = False
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 Einbauplatz As CEinbauplatz
Dim i As Integer
Dim iStellwert As Integer
Dim AnzahlPP As Integer
'Dim Waagengrenzwert As Double
If Not g_ohneSPS Then
' Betrieb Start zurücksetzen
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
m_SPS.SetQSoll m_DurchflussSoll
End If
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
If Not g_ohneSPS Then
Select Case m_Pumpe.GetRegelart
Case "Servo"
' Servo vorgeschrieben
m_SPS.SetRegelart ("Servo")
' Wenn letzter PP
'AnzahlPP = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkteCount
'If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(AnzahlPP).getQ Then
' iStellwert = getUSVoreinstellwert(m_DurchflussSoll, True)
'Else
' ' Formel für ServoPosition zur Feinregulierung des Durchflusses
' iStellwert = CInt(lookupFUServoStellwert(m_DurchflussSoll, "Servo"))
'End If
iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen)
Case "FU"
' Frequenzumrichter vorgeschrieben
m_SPS.SetRegelart ("FU")
' Formel für ServoPosition zur Feinregulierung des Durchflusses
iStellwert = getVoreinstellwert(m_DurchflussSoll, m_bVoreinstellwertSetzen)
' If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(1).getQ Then
' iStellwert = getUSVoreinstellwert(m_DurchflussSoll, False)
' Else
' iStellwert = 50
' End If
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
End If
If iStellwert > 100 Then iStellwert = 100
PrintStatus "Stellwert: " & iStellwert
If Not g_ohneSPS Then
m_SPS.SetServoStellung iStellwert
' Vorwahl Referenzzaehler
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
m_SPS.SetQDiff 0
End If
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
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
' 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
lblGrenzwert.caption = ""
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
' 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 Function WaageVorbereitenFuerPP()
Dim StartVolumen As Double
Dim Gewicht As Double
Dim letztesGewicht As Double
Dim Referenzzaehler As CRefzaehler
Dim Pumpe As CPumpe
Dim Fuelldurchfluss As Double
Dim Fuellvolumen As Double
Dim Waagengrenzwert As Double
PrintStatus "Waage vorbereiten für diesen Prüfpunkt:"
lblQIst.caption = "0"
'neu RH 28.2.2013
WaageZuruecksetzen
If Not g_ohneSPS Then
m_SPS.setBetrieb 0
m_SPS.WassserAblassen 3
Sleep 1000, True
m_SPS.WassserAblassen 0
End If
PrintStatus "Softtara reset + Tara reset"
m_Waage.TaraReset
m_Waage.SoftTaraReset
m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6
PrintStatus "Sollvolumen:" & 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=" & m_VolumenSoll & vbCrLf & "Bitte abbrechen und Prüfzeit anpassen!")
WaageVorbereitenFuerPP = -1
Exit Function
End If
PrintStatus "gewählter Behälter: OVolumen=" & m_Behaelter.m_OVolumen
If Not g_ohneSPS Then
m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl
Else
MsgBox "Behälter mit " & m_Behaelter.m_OVolumen & "l wählen!"
End If
m_Waage.Initialize m_Behaelter.m_Nr
m_Waage.SoftTaraReset
m_Waage.TaraReset
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
'-----------------------------------------
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
PrintStatus "Wasser ganz ablassen"
'-----------------------------------------
' Wasser ganz ablassen
StartVolumen = 0
letztesGewicht = 0
If Not g_ohneSPS Then
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 = Gewicht Then Exit Do
letztesGewicht = Gewicht
If g_Abbruch = True Then
Exit Function
End If
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'---------------------------------------
' Rohr füllen, aber nicht mit mehr, als Qmax
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
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
' Setze MID und MIDGruppe
Set Referenzzaehler = New CRefzaehler
Call Referenzzaehler.loadForDurchfluss(Fuelldurchfluss, g_App.Settings.getMIDGruppe)
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 2
Do
Sleep 1000, True
Gewicht = m_Waage.GetGewicht
lblGewicht = Gewicht
lblQIst = Format(m_SPS.getQIst, 3)
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
'-----------------------------------------
PrintStatus "Wasser ganz ablassen"
'-----------------------------------------
' Wasser ganz ablassen und (nicht mehr) Nullstellen
lblSollV.caption = "0"
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
Sleep 2000, True
m_Waage.WarteAufRuhe
m_SPS.WassserAblassen 0
Sleep 1000, True
' Bizerba an P2020 kann nicht Nullstellen
'PrintStatus "Nullstellen bei " & m_Waage.GetGewicht
'm_Waage.Nullstellen
'---------------------------------------
Else
MsgBox "Bitte Rohr füllen und Wasser ganz ablassen!", , "Keine SPS"
End If ' g_OhneSPS
End If 'Behälterwechsel
'-----------------------------------------
Gewicht = m_Waage.GetGewicht
lblGewicht = Format(Gewicht, "0.000")
' 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 "Zuviel Wasser drin, also ablassen."
'-----------------------------------------
' Wasser ganz ablassen
StartVolumen = 0
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
Sleep 2000, True
Do
Sleep 200, 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 Exit Do
letztesGewicht = Gewicht
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'-----------------------------------------
End If
Else
MsgBox "Bitte Wasser ablassen um " & m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, 22) * 1000 & " l füllen zu können.", , "keine SPS"
End If
' hier ist sichergestellt dass mind. noch das Sollvolumen hinein passt
' neuen Grenzwert für das Sollvolumen setzen
Gewicht = m_Waage.GetGewicht
lblGewicht = Format(Gewicht, "0.00")
PrintStatus "Warten auf Waagen Ruhe"
'm_Waage.WarteAufRuhe
m_Behaelter.WarteAufRuhe
Gewicht = m_Waage.GetGewicht
' If Gewicht = -9999 Then
' ' Waage evtl. in Unterlast
' PrintStatus "Gewicht konnte nicht gelesen werden. Nullstellen versuchen..."
' m_Waage.Nullstellen
' Sleep 1000, True
' Gewicht = m_Waage.GetGewicht
' End If
lblGewicht = Format(Gewicht, "0.000")
If Not g_ohneSPS Then
Waagengrenzwert = m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000 - m_DurchflussSoll * m_Behaelter.m_nUeberlaufFaktor
PrintStatus " neuer Grenzwert :" & Format(Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000, "0.000") & " + " & Format(m_VolumenSoll, "0.000") & " = " & Format(Waagengrenzwert, "0.000")
lblGrenzwert.caption = Format(Waagengrenzwert, "0.00")
If Waagengrenzwert >= m_Behaelter.m_OVolumen Then
PrintStatus "Der errechnete Grenzwert erreicht bzw. übersteigt das Volumen des Behälters."
PrintStatus "Bitte Prüfzeit für diesen Prüfpunkt anpassen! Der Grenzwert wird auf 95% des Behältervolumens gesetzt."
Waagengrenzwert = m_Behaelter.m_OVolumen * 0.95
End If
End If
m_Waage.SetNettoGrenzwert1 Waagengrenzwert
Gewicht = m_Waage.GetGewicht
' dieses Gewicht gilt als Startwert
m_Waage.SoftTara
Gewicht = m_Waage.GetGewicht
lblGewicht.caption = Format(Gewicht, "0.000") ' sollte 0 sein
PrintStatus "Gewicht nach Softtara: " & Format(Gewicht, "0.000") & " kg"
End Function
Private Sub initFM85fuerPP_Waage()
Dim strMeldung As String
' FM85 für Impulszählung für diesen Pruefpunkt initialisieren
sendonly "**0@"
sendonly "R"
Sleep 1000, True
' Todo s-Befehl weil Fehlerbyte = 03
' Todo faktor k weil Fehlerbyte = 03
' PZ Impulse zählen
sendonly "Q"
' RZ Impulse zählen
sendonly "O"
m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", ""
m_FMBus.send "42 "
dummy = Mid(m_FMBus.receive(500), 6, 2)
If dummy <> "00" And dummy <> "03" Then
strMeldung = Fehlerbyte42Meldung(dummy)
If MsgBox("Das FM85-Fehlerbyte ist weder '00' noch '03' sondern '" & dummy & "':" & vbCrLf & strMeldung & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = 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 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 Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
PrintStatus "**********************************************"
PrintStatus "Initialisierung der FM85 für Vergleichsprüfung"
' Dummy Werte
sendonly "**0@"
sendonly "R"
Sleep 1000, True
sendonly "**0@"
' Multiplikator
sendonly "1s"
' keine Doppelimpulssperre
sendonly "G"
' Doppelimpuls-Zeit
sendonly "0000S"
' Dämpfung
sendonly "3T"
' K Wert
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
PrintStatus "Prüfzeit dieses PP (" & m_Pruefzeit & "s) auf 60 s korrigiert."
m_Pruefzeit = 60
End If
' AnzahlPeriodenPZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitPZ
' PrintStatus "unkorrigierter AnzahlPeriodenPZ: " & AnzahlPeriodenPZ
' AnzahlPeriodenPZNeu = Int(AnzahlPeriodenPZ / 10 + 0.9) * 10
' If AnzahlPeriodenPZNeu < 20 Then
' DebugMsg "Anzahl der Perioden (" & AnzahlPeriodenPZNeu & ") auf 20 Pulse korrigiert."
' AnzahlPeriodenPZNeu = 20
' End If
' PrintStatus "AnzahlPeriodenPZNeu: " & AnzahlPeriodenPZNeu
' Korrekturwert = AnzahlPeriodenPZNeu / AnzahlPeriodenPZ
' PrintStatus "AnzahlPeriodenPZNeu / AnzahlPeriodenPZ = Korrekturwert= " & Korrekturwert
' AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ '* Korrekturwert
' AnzahlPeriodenPZ = AnzahlPeriodenPZNeu
' PrintStatus "Perioden RZ: " & AnzahlPeriodenRZ
' PrintStatus "AnzahlPeriodenRZ an FM85: " & Hex(AnzahlPeriodenRZ) & "M"
' m_FMBus.send 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"
' m_FMBus.send Hex(AnzahlPeriodenPZ) & "H"
' If m_FMBus.receive(500) <> "" Then
' PrintStatus "Warnung: Periodenzahl PZ " & AnzahlPeriodenPZ & " für FM85 ausserhalb des zulässigen Bereiches"
' End If
' m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", ""
' If g_Abbruch Then
' Exit Sub
' End If
' m_FMBus.send "42 "
' If Mid(m_FMBus.receive(500), 6, 2) <> "00" Then
' If MsgBox("FM85 Fehlerbyte ist nicht '00'" & 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
''''''''''''''''''''''''''''''''''''''''''''
' FM85 Nr: 7 Referenzähler Vergleich:
PrintStatus "Impulswertigkeit RefZ A: " & m_ReferenzzaehlerA.ImpulseQM
AnzahlPeriodenRZA = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerA.ImpulseQM) '* Korrekturwert
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
PrintStatus "Impulswertigkeit RefZ B: " & m_ReferenzzaehlerB.ImpulseQM
AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM) '* Korrekturwert
' FM85 für Referenzzähler Vergleich Nr 7 setzen
' Adressieren
m_FMBus.dialog "**" & g_FM85RefZAdresse & "@", ""
If g_Abbruch Then
Exit Sub
End If
m_FMBus.send "R"
m_FMBus.receive (500)
Sleep 1000, True
' Adressieren
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
' Todo: Multiplikator
sendonly "1s"
' keine Doppelimpulssprerre
sendonly "G"
' Doppelimpuls-Zeit
sendonly "0000S"
' Dämpfung
sendonly "3T"
' Todo: K Wert für beide Referenzzähler sollte immer 1 sein
sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K = 1
' Referenzzähler A
PrintStatus "Anzahl der Perioden RZA: " & AnzahlPeriodenRZA
m_FMBus.send Hex(AnzahlPeriodenRZA) & "M"
If m_FMBus.receive(500) <> "" 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
m_FMBus.send Hex(AnzahlPeriodenRZB) & "H"
If m_FMBus.receive(500) <> "" Then
PrintStatus "Warnung: Periodenzahl RZB " & AnzahlPeriodenRZB & " für FM85 ausserhalb des zulässigen Bereiches"
End If
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
Dim strTmp As String
m_FMBus.send "42 "
strTmp = Mid(m_FMBus.receive(500), 6, 2)
If strTmp <> "00" Then
If MsgBox("FM85 Nr.7 Fehlerbyte ist nicht '00' sondern '" & strTmp & "'" & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then
Else
Call Abbruch
Exit Sub
End If
End If
End If '2 RefZ
End Sub
Private Sub PrintStatusNoCrLf(sText As String)
If Len(txtStatus.text & sText) > 32768 Then
txtStatus.text = ""
End If
txtStatus.text = txtStatus.text & sText
txtStatus.SelStart = Len(txtStatus.text)
DebugMsg sText
DoEvents
End Sub
Private Sub PrintStatus(sText As String)
If Len(txtStatus.text & sText) > 32768 Then
txtStatus.text = ""
End If
txtStatus.text = txtStatus.text & sText & vbCrLf
txtStatus.SelStart = Len(txtStatus.text)
DebugMsg sText
DoEvents
End Sub
Private Sub 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)
Call rs.update
FehlerSpeichern = True
Exit Function
FehlerSpeichernError:
MsgBox ("FehlerSpeichern fehlgeschlagen: " & 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 i As Integer
If m_Waage Is Nothing Then Exit Sub
PrintStatus "Waagen Grenzwerte zurücksetzen"
Set m_Waage = g_App.getWaage
For i = 1 To UBound(m_ArrayBehaelter)
Set Behaelter = m_ArrayBehaelter(i)
If Behaelter.m_OVolumen > 0 Then
m_Waage.Initialize Behaelter.m_Nr
If Behaelter.m_WaageAnwahl > 0 Then
m_Waage.Anwahl Behaelter.m_WaageAnwahl
End If
Sleep 1000, True
PrintStatus "Waage " & i & ": Grenzwert=" & Behaelter.m_WaageGrenzwert & " setzen..."
If Behaelter.m_WaageGrenzwert > 0 Then
m_Waage.SetNettoGrenzwert1 Behaelter.m_WaageGrenzwert, Behaelter.m_Genauigkeit
lblGrenzwert.caption = ""
End If
End If
Next
End Sub
' Führt eine komplette Ultraschallzählerprüfung für einen Prüfpunkt durch.
' Übergabe der Daten durch udtPruefdaten
Private Function UltraschallPruefung(ByRef udtPruefdaten() As TypUSPruefdaten) As Long
' kein Fehler annehmen
UltraschallPruefung = 0
Dim Einbauplatz As CEinbauplatz
Dim EinbauplatzNr As Integer
Dim Zeitrahmenzaehler As Long
Dim Fehler As Long
Dim FehlerRZ As Long
Dim lngTemp As Long
Dim Stopzeitpunkt(10) As Long 'Zeitpunkt zum Stoppen des jeweiligen FM Zählers
Dim Pruefzaehler As CPruefzaehler
Dim dblTemperatur As Double
Dim StartzeitpunktRZ As Long
Dim lngReturn As Long
Dim blnHalbzeit As Boolean
Dim lngZeitpunktms As Long
Dim lngZeitpunktTemperaturmessungMs As Long
Dim Voreinstellwert As Integer
Dim i As Integer
' Bezugszeit
m_Tstart = GetTickCount()
' Starte alle Zähler
Zeitrahmenzaehler = 0
PrintStatus " Start-Phase"
PrintStatus "----------------------------------"
m_Tpruef = 0
AnzeigeAktualisieren
' Für alle Einbauplätze
For EinbauplatzNr = 1 To g_App.Settings.EinbauplaetzeJeStrang
With udtPruefdaten(EinbauplatzNr)
.Stopzeitpunkt = 0
.Fehlerinfo = ""
.blnPruefungsfehler = False
' Soll dieser Zähler geprüft werden
If .SollPruefzeit_s > 0 Then
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
' Temperatur für diese Ultraschallzählung messen und im Rechenwerk setzten
udtPruefdaten(EinbauplatzNr).dblTemperatur = dblTemperatur
' Eine Prüfzeit für alle Zähler aus dem ersten zu prüfenden Zähler
' Notwendig, da alle Zähler der Einbauplatz-Reihe nach gestartet und gestopt werden.
If m_Tpruef = 0 Then
m_Tpruef = udtPruefdaten(EinbauplatzNr).SollPruefzeit_s * 1000
End If
' mit Beginn eines Zeitrahmens synchronisieren
Do
Zeitrahmenzaehler = Zeitrahmenzaehler + 1
' Stopzeitpunkt dieses Zählers bestimmen
' RZ Zaehler starten
PrintStatus "RZ soll zum Zeitpunkt " & Zeitrahmenzaehler * ZEITRAHMENDAUER & " starten"
Fehler = StarteRZZaehlerZumZeitpunkt(EinbauplatzNr, m_Tstart + Zeitrahmenzaehler * ZEITRAHMENDAUER, .RZ_START_Rueckkehrzeitpunkt, lngZeitpunktms)
' Todo Zeitpunkt in Funktion einbauen
udtPruefdaten(EinbauplatzNr).StartzeitpunktRZ = .RZ_START_Rueckkehrzeitpunkt
PrintStatus lngZeitpunktms - m_Tstart & " RZ_START begonnen"
PrintStatus .RZ_START_Rueckkehrzeitpunkt - m_Tstart & " RZ_START abgeschlossen"
PrintStatus "RZ_START Dauer: " & .RZ_START_Rueckkehrzeitpunkt - lngZeitpunktms
Select Case Fehler
Case KEIN_FEHLER
PrintStatus "RZ_START im Zeitrahmen " & Zeitrahmenzaehler & " OK"
Fehler = StarteUSZaehlerZumZeitpunkt(Einbauplatz, m_Tstart + Zeitrahmenzaehler * ZEITRAHMENDAUER + DELTA_START, .NOWA_START_Rueckkehrzeitpunkt, lngZeitpunktms)
PrintStatus lngZeitpunktms - m_Tstart & " NOWA_START begonnen"
PrintStatus .NOWA_START_Rueckkehrzeitpunkt - m_Tstart & " NOWA_START abgeschlossen"
Select Case Fehler
Case KEIN_FEHLER
' hat geklappt
PrintStatus "NOWA_START im Zeitrahmen " & Zeitrahmenzaehler & " OK"
WriteToFW2Logfile Einbauplatz, "NOWA_START OK"
' nur bei erfolgreichem Start den Stopzeitpunkt setzen
.Stopzeitpunkt = m_Tstart + (Zeitrahmenzaehler * ZEITRAHMENDAUER) + m_Tpruef
PrintStatus "RZ soll zum Zeitpunkt " & .Stopzeitpunkt - m_Tstart & " gestopt werden"
DoEvents
Case FEHLER_ZUSPAET
PrintStatus lngZeitpunktms & " Zeitfenster für Start des US-Zähler verpasst. DELTA_START zu niedrig?"
Case Else
PrintStatus "Fehlercode beim Starten des US-Zählers: " & Fehler
.Fehlerinfo = .Fehlerinfo & "Fehlercode beim Starten des US-Zählers " & EinbauplatzNr & ".Fehler:" & Fehler & vbCrLf
.blnPruefungsfehler = True
End Select
Case FEHLER_ZUSPAET
PrintStatus " Zeitfenster für Start des RZ-Zähler " & EinbauplatzNr & " verpasst."
Case KEINE_ANTWORT_FEHLER
PrintStatus " keine Antwort beim Starten des RZ-Zählers " & EinbauplatzNr
.Fehlerinfo = .Fehlerinfo & "keine Antwort beim Starten des RZ-Zählers " & EinbauplatzNr & vbCrLf
.blnPruefungsfehler = True
End Select
Loop While Fehler = FEHLER_ZUSPAET
PrintStatus "----------------------------------"
End If ' SollPruefzeit_s > 0
End With
Next EinbauplatzNr
Do
Sleep 1000, True
' Verbleibende Zeit 1s bis zum Zeitrahmen vor dem ersten Stop
lngTemp = m_Tpruef + m_Tstart - (1 * ZEITRAHMENDAUER) - GetTickCount()
AnzeigeAktualisieren
If mblnExternalTemperatur Then
' Bis 10s vor Ende geänderte Temperatur in alle Zähler schreiben, wenn sie sich geändert hat
If (lngTemp And (2 ^ 31 - 1)) > 10000 Then
Debug.Print "verbleibende Zeit " & Int(lngTemp / 1000) & " s"
UpdateTemperaturInZaehlerFW2
Else
Debug.Print "das ende ist nah in " & Int(lngTemp / 1000) & " s"
End If
End If
' Halbzeit nur einmal abwarten
If Not blnHalbzeit And m_Tpruef / 2 + m_Tstart < GetTickCount Then
blnHalbzeit = True
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
Else
dblTemperatur = 20
End If
PrintStatus "Halbzeit Temperatur=" & Format(dblTemperatur, "0.00") & "°C"
' Wasserdruck messen für Zulassungspruefdaten
g_dblWasserdruck = Round(MesseWasserdruck(), 3)
If g_dblWasserdruck <> -1 Then
PrintStatus "Wasserdruck: " & g_dblWasserdruck
End If
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
' Halbzeit-Temperatur merken
udtPruefdaten(EinbauplatzNr).dblTemperatur = dblTemperatur
End If ' Pruefzaehler is nothing
Next Einbauplatz
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 "Anzahl eingeb.Zähler:" & g_App.Settings.GetAnzahlFuerVoreinstellwert
PrintStatus "=> Voreinstellwert " & Voreinstellwert & " speichern"
SetVoreinstellwert m_DurchflussSoll, Voreinstellwert
End If
End If
DoEvents
If g_Abbruch Then
Exit Function
End If
Loop While lngTemp > 1000 'Zeit bis zum Ende
PrintStatus "----------------------------------"
PrintStatus GetTickCount - m_Tstart & " Stop-Phase"
' alle US-Zähler und MIDs Stoppen
Zeitrahmenzaehler = 0
For EinbauplatzNr = 1 To g_App.Settings.EinbauplaetzeJeStrang
Set Einbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
If Not Einbauplatz.getPruefzaehler Is Nothing Then
With udtPruefdaten(EinbauplatzNr)
.RZ_IstPruefzeit_ms = 0
.US_IstPruefzeit_ms = 0
If .Stopzeitpunkt <> 0 Then 'Wenn Stopzeit <> 0 dann war Start für diesen Zähler erfolgreich
PrintStatus "Zähler-Einbauplatz: " & EinbauplatzNr
Do
PrintStatus "Warte auf Zeitpunkt zum Stoppen des RZ: " & .Stopzeitpunkt + Zeitrahmenzaehler * ZEITRAHMENDAUER - m_Tstart
FehlerRZ = StoppeRZZaehlerZumZeitpunkt(EinbauplatzNr, .Stopzeitpunkt + Zeitrahmenzaehler * ZEITRAHMENDAUER, .RZ_STOP_Rueckkehrzeitpunkt, lngZeitpunktms)
PrintStatus "RZ_STOP zum Zeitpunkt " & lngZeitpunktms - m_Tstart & " begonnen"
PrintStatus "RZ_STOP zum Zeitpunkt " & .RZ_STOP_Rueckkehrzeitpunkt - m_Tstart & " abgeschlossen"
PrintStatus "RZ_STOP Dauer: " & .RZ_STOP_Rueckkehrzeitpunkt - lngZeitpunktms
.RZ_IstPruefzeit_ms = .RZ_STOP_Rueckkehrzeitpunkt - .RZ_START_Rueckkehrzeitpunkt
PrintStatus "reine RZ Prüfzeit gemessen (Rückkehr): " & .RZ_IstPruefzeit_ms
Select Case FehlerRZ
Case KEIN_FEHLER
PrintStatus "RZ_STOP im Zeitrahmen " & Zeitrahmenzaehler & " OK"
' hat geklappt
Fehler = StoppeUSZaehlerZumZeitpunkt(Einbauplatz, udtPruefdaten(EinbauplatzNr).Stopzeitpunkt + Zeitrahmenzaehler * ZEITRAHMENDAUER + DELTA_START + DELTA_FM, .NOWA_STOP_Rueckkehrzeitpunkt, lngZeitpunktms)
.US_IstPruefzeit_ms = .NOWA_STOP_Rueckkehrzeitpunkt - .NOWA_START_Rueckkehrzeitpunkt
PrintStatus lngZeitpunktms - m_Tstart & " NOWA_STOP begonnen"
PrintStatus .NOWA_STOP_Rueckkehrzeitpunkt - m_Tstart & " NOWA_STOP abgeschlossen"
PrintStatus "reine NOWA Prüfzeit gemessen (Rückkehr): " & .US_IstPruefzeit_ms
'.RZ_IstPruefzeit_ms = .Stopzeitpunkt + Zeitrahmenzaehler * ZEITRAHMENDAUER + DELTA_START + DELTA_FM
'.RZ_IstPruefzeit_ms = .RZ_STOP_Rueckkehrzeitpunkt - .RZ_START_Rueckkehrzeitpunkt
Select Case Fehler
Case KEIN_FEHLER
' hat geklappt
'PrintStatus " NOWA_STOP für Einbauplatz " & EinbauplatzNr & " OK"
' .US_IstPruefzeit_ms = .Stopzeitpunkt + Zeitrahmenzaehler * ZEITRAHMENDAUER + DELTA_START + DELTA_FM
WriteToFW2Logfile Einbauplatz, "NOWA_STOP OK"
Dim dblTemp As Double
If FW2_GetUS_NOWA_Zeit(Einbauplatz, dblTemp) = 0 Then
'OK
.US_IstPruefzeit_ms = dblTemp
WriteToFW2Logfile Einbauplatz, "NOWA Zeit: " & .US_IstPruefzeit_ms & " ms"
PrintStatus "NOWA-Zeit aus Rechenwerk: " & .US_IstPruefzeit_ms
PrintStatus "zum Vergleich von vb gemessene Zeit zw. NOWA Start und NOWA STOP: " & .NOWA_STOP_Rueckkehrzeitpunkt - .NOWA_START_Rueckkehrzeitpunkt
Else
.US_IstPruefzeit_ms = .NOWA_STOP_Rueckkehrzeitpunkt - .NOWA_START_Rueckkehrzeitpunkt
PrintStatus "Fallback auf die von VB gemessene Zeit zw. NOWA Start und NOWA STOP: " & .US_IstPruefzeit_ms
WriteToFW2Logfile Einbauplatz, "gemessene Prf-Zeit: " & .US_IstPruefzeit_ms & " ms"
End If
DoEvents
Case FEHLER_ZUSPAET
' Dieses Volumen kann nicht mehr synchron gemessen werden
Debug.Print " Zeitfenster für Stopp des US-Zählers " & EinbauplatzNr & " verpasst."
.Fehlerinfo = .Fehlerinfo & "Zeitfenster für Stopp des US-Zählers verpasst." & vbCrLf
.blnPruefungsfehler = True
Case Else
' Dieses Volumen kann nicht mehr synchron gemessen werden
.Fehlerinfo = .Fehlerinfo & "Fehler beim Stoppen des RZ-Zählers für EinbauplatzNr " & EinbauplatzNr & ". IECCOM-Fehler: " & Fehler & vbCrLf
Debug.Print " Fehler beim Stoppen des RZ-Zählers für EinbauplatzNr " & EinbauplatzNr & ". IECCOM-Fehler: " & Fehler & vbCrLf
.blnPruefungsfehler = True
End Select
Case FEHLER_ZUSPAET
PrintStatus GetTickCount - m_Tstart & " Zeitfenster für Stopp des RZ-Zähler " & EinbauplatzNr & " verpasst."
Zeitrahmenzaehler = Zeitrahmenzaehler + 1
Case Else
' Dieses Volumen kann nicht mehr geprüft werden
.Fehlerinfo = .Fehlerinfo & "Fehler '" & Fehler & "' beim stoppen des RZ-Zählers für Einbauplatznr " & EinbauplatzNr & vbCrLf
.RZ_IstPruefzeit_ms = 0
.blnPruefungsfehler = True
End Select
Loop While FehlerRZ = FEHLER_ZUSPAET
PrintStatus "----------------------------------"
End If ' Stopzeitpunkt <> 0
End With
End If
If g_Abbruch = True Then Exit For
Next EinbauplatzNr
AnzeigeAktualisieren
End Function
'Private Function FW2_NOWA_Start(Einbauplatz As CEinbauplatz) As Long
' FW2_NOWA_Start = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
' If FW2_NOWA_Start <> 0 Then
' PrintStatus "Fehler " & FW2_NOWA_Start & " in FW2_NOWA_Start(" & Einbauplatz.getNr & ") bei fw2_open_comport: " & modMBUS_SMS.Errorstring(CInt(FW2_NOWA_Start))
' Exit Function
' End If
' FW2_NOWA_Start = modMBUS_SMS.NOWA_START_FW2
'
' If FW2_NOWA_Start <> 0 Then
' PrintStatus "Fehler " & FW2_NOWA_Start & " in FW2_NOWA_Start(" & Einbauplatz.getNr & ") bei modMBUS_SMS.NOWA_START_FW2: " & modMBUS_SMS.Errorstring(CInt(FW2_NOWA_Start))
' Exit Function
' End If
'
'End Function
'Private Function FW2_NOWA_Stop(Einbauplatz As CEinbauplatz) As Long
' FW2_NOWA_Stop = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
' If FW2_NOWA_Stop <> 0 Then
' PrintStatus "Fehler " & FW2_NOWA_Stop & " in FW2_NOWA_Stop(" & Einbauplatz.getNr & ") bei fw2_open_comport: " & modMBUS_SMS.Errorstring(CInt(FW2_NOWA_Stop))
' Exit Function
' End If
' FW2_NOWA_Stop = modMBUS_SMS.NOWA_STOP_FW2
'
' If FW2_NOWA_Stop <> 0 Then
' PrintStatus "Fehler " & FW2_NOWA_Stop & " in FW2_NOWA_Stop(" & Einbauplatz.getNr & ") bei modMBUS_SMS.NOWA_STOP_FW2: " & modMBUS_SMS.Errorstring(CInt(FW2_NOWA_Stop))
' Exit Function
' End If
'End Function
Public Function FW2_Starte_NOWA(Einbauplatz As CEinbauplatz) As Long
Dim Wiederholung As Integer
FW2_Starte_NOWA = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If FW2_Starte_NOWA <> 0 Then Exit Function
Wiederholung = 0
NochmalNowaStart:
FW2_Starte_NOWA = modMBUS_SMS.NOWA_START_FW2
If FW2_Starte_NOWA = MBUS_SMS_ERR_OK Then
' alles OK
ElseIf Wiederholung < 3 Then
PrintStatus "modMBUS_SMS.NOWA_START_FW2 Ebp=" & Einbauplatz.getNr & " Fehler: " & FW2_Starte_NOWA & ": " & modMBUS_SMS.Errorstring(CInt(FW2_Starte_NOWA)) & ", wdh = " & Wiederholung
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
Else
PrintStatus "modMBUS_SMS.NOWA_START_FW2 Ebp=" & Einbauplatz.getNr & " wiederholter Fehler: " & FW2_Starte_NOWA & ": " & modMBUS_SMS.Errorstring(CInt(FW2_Starte_NOWA))
Exit Function
End If
' Taskbyte lesen. Bei den 65 NW gehen die Zähler manchmal nicht in den Prüfmodus
Dim intRet As Integer
Dim bytTaskbyte As Byte
intRet = modMBUS_SMS.ReadValue("u8_nowa_task_byte", bytTaskbyte)
If intRet = MBUS_SMS_ERR_OK Then
Select Case bytTaskbyte
Case &H0 'NOWA_OFF
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & "( NOWA_OFF: Zähler nicht im Prüfmodus, NOWA_START wiederholen)"
' Zähler nicht im Prüfmodus, NOWA_START wiederholen
If Wiederholung < 3 Then
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
End If
Case &H55 'NOWA_ON
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & " ( = 85 OK)"
' alles gut
Case Else
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & " (nicht definiert)"
' nicht definiert
End Select
Else
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte in FW2_Starte_NOWA() Fehler = " & intRet & " = " & modMBUS_SMS.Errorstring(intRet)
End If
'modMBUS_SMS.IECCOM_CloseCom
End Function
Public Function FW2_StarteUSundRZZaehler(Einbauplatz As CEinbauplatz, Optional lngIdentNrForVeriaction As Long = -1) As Long
Dim Wiederholung As Integer
Wiederholung = 0
FW2_StarteUSundRZZaehler = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If FW2_StarteUSundRZZaehler <> 0 Then Exit Function
Wiederholung = 0
nochmalRZansprechen:
m_FMBus.send "**" & Einbauplatz.getNr & "@"
If m_FMBus.receive(500) = "" Then
PrintStatus "Fehler in StarteUSundRZZaehler mit FM85 an Einbauplatz " & Einbauplatz.getNr & ": keine Antwort. wdh=" & Wiederholung
If Wiederholung < 3 Then
Wiederholung = Wiederholung + 1
GoTo nochmalRZansprechen
Else
FW2_StarteUSundRZZaehler = KEINE_ANTWORT_FEHLER
PrintStatus "wiederholt Fehler in StarteUSundRZZaehler mit FM85 an Einbauplatz " & Einbauplatz.getNr & ": keine Antwort."
Exit Function
End If
End If
m_FMBus.send "O"
Wiederholung = 0
NochmalNowaStart:
FW2_StarteUSundRZZaehler = modMBUS_SMS.NOWA_START_FW2
If FW2_StarteUSundRZZaehler = MBUS_SMS_ERR_OK Then
' alles OK
ElseIf Wiederholung < 3 Then
PrintStatus "modMBUS_SMS.NOWA_START_FW2 Ebp=" & Einbauplatz.getNr & " Fehler: " & FW2_StarteUSundRZZaehler & ": " & modMBUS_SMS.Errorstring(CInt(FW2_StarteUSundRZZaehler)) & ", wdh = " & Wiederholung
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
Else
PrintStatus "modMBUS_SMS.NOWA_START_FW2 Ebp=" & Einbauplatz.getNr & " Fehler: " & FW2_StarteUSundRZZaehler & ": " & modMBUS_SMS.Errorstring(CInt(FW2_StarteUSundRZZaehler))
Exit Function
End If
' Taskbyte lesen. Bei den 65 NW gehen die Zähler manchmal nicht in den Prüfmodus
Dim intRet As Integer
Dim bytTaskbyte As Byte
intRet = modMBUS_SMS.ReadValue("u8_nowa_task_byte", bytTaskbyte)
If intRet = MBUS_SMS_ERR_OK Then
Select Case bytTaskbyte
Case &H0 'NOWA_OFF
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & "( NOWA_OFF: Zähler nicht im Prüfmodus, NOWA_START wiederholen)"
' Zähler nicht im Prüfmodus, NOWA_START wiederholen
If Wiederholung < 1 Then
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
End If
Case &H55 'NOWA_ON
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & " ( = 85 OK)"
' alles gut
Case Else
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte & " (nicht definiert)"
' nicht definiert
End Select
Else
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte in FW2_StarteUSundRZZaehler() Fehler = " & intRet & " = " & modMBUS_SMS.Errorstring(intRet)
End If
End Function
Private Function FW2_Stoppe_NOWA(Einbauplatz As CEinbauplatz) As Long
Dim Wiederholung As Integer
FW2_Stoppe_NOWA = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If FW2_Stoppe_NOWA <> 0 Then Exit Function
Wiederholung = 0
nochmalNOWAStop:
FW2_Stoppe_NOWA = modMBUS_SMS.NOWA_STOP_FW2()
If FW2_Stoppe_NOWA <> MBUS_SMS_ERR_OK Then
If Wiederholung < 3 Then
PrintStatus "FW2_Stoppe_NOWA Ebp=" & Einbauplatz.getNr & " & Fehler: " & FW2_Stoppe_NOWA & ": " & modMBUS_SMS.Errorstring(CInt(FW2_Stoppe_NOWA)) & ", wdh=" & Wiederholung
Wiederholung = Wiederholung + 1
GoTo nochmalNOWAStop
Else
PrintStatus "FW2_Stoppe_NOWA NOWA_STOP_FW2 Ebp=" & Einbauplatz.getNr & " & wiederholter Fehler: " & FW2_Stoppe_NOWA & ": " & modMBUS_SMS.Errorstring(CInt(FW2_Stoppe_NOWA))
Exit Function
End If
End If
End Function
Private Function FW2_StoppeUSundRZZaehler(Einbauplatz As CEinbauplatz) As Long
Dim Wiederholung As Integer
FW2_StoppeUSundRZZaehler = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If FW2_StoppeUSundRZZaehler <> 0 Then Exit Function
Wiederholung = 0
nochmalRZansprechen:
m_FMBus.send "**" & Einbauplatz.getNr & "@"
If m_FMBus.receive(500) = "" Then
FW2_StoppeUSundRZZaehler = KEINE_ANTWORT_FEHLER
If Wiederholung < 3 Then
Wiederholung = Wiederholung + 1
PrintStatus "FW2_StoppeUSundRZZaehler: keine Antwort beim Adressieren des FM85, wdh=" & Wiederholung
GoTo nochmalRZansprechen
Else
PrintStatus "FW2_StoppeUSundRZZaehler: wiederholt keine Antwort beim Adressieren des FM85!"
Exit Function
End If
End If
m_FMBus.send "q"
Wiederholung = 0
nochmalNOWAStop:
FW2_StoppeUSundRZZaehler = modMBUS_SMS.NOWA_STOP_FW2()
If FW2_StoppeUSundRZZaehler <> MBUS_SMS_ERR_OK Then
If Wiederholung < 3 Then
PrintStatus "FW2_StoppeUSundRZZaehler NOWA_STOP_FW2 Ebp=" & Einbauplatz.getNr & " & Fehler: " & FW2_StoppeUSundRZZaehler & ": " & modMBUS_SMS.Errorstring(CInt(FW2_StoppeUSundRZZaehler)) & ", wdh=" & Wiederholung
Wiederholung = Wiederholung + 1
GoTo nochmalNOWAStop
Else
PrintStatus "FW2_StoppeUSundRZZaehler NOWA_STOP_FW2 Ebp=" & Einbauplatz.getNr & " & wiederholter Fehler: " & FW2_StoppeUSundRZZaehler & ": " & modMBUS_SMS.Errorstring(CInt(FW2_StoppeUSundRZZaehler))
Exit Function
End If
End If
End Function
Private Function StarteRZZaehlerZumZeitpunkt(EinbauplatzNr As Integer, Zeitpunkt As Long, Rueckkehrzeitpunkt As Long, Optional ByRef lngZeitpunktms As Long) As Long
Dim Wiederholung As Integer
Wiederholung = 0
nochmalFM85adressieren:
m_FMBus.send "**" & EinbauplatzNr & "@"
If m_FMBus.receive(500) = "" Then
StarteRZZaehlerZumZeitpunkt = KEINE_ANTWORT_FEHLER
Wiederholung = Wiederholung + 1
If Wiederholung < 3 Then
GoTo nochmalFM85adressieren
Else
Exit Function
End If
End If
StarteRZZaehlerZumZeitpunkt = FEHLER_ZUSPAET ' zu Spät
Do While Zeitpunkt > GetTickCount()
StarteRZZaehlerZumZeitpunkt = KEIN_FEHLER
Loop
If StarteRZZaehlerZumZeitpunkt = FEHLER_ZUSPAET Then
' zu spät
Exit Function
End If
lngZeitpunktms = GetTickCount()
m_FMBus.send "O"
Rueckkehrzeitpunkt = GetTickCount()
End Function
Private Function StoppeRZZaehlerZumZeitpunkt(EinbauplatzNr As Integer, Zeitpunkt As Long, Rueckkehrzeitpunkt As Long, Optional ByRef lngZeitpunktms As Long) As Long
Dim Wiederholung As Integer
Wiederholung = 0
nochmalFM85adressieren:
m_FMBus.send "**" & EinbauplatzNr & "@"
If m_FMBus.receive(500) = "" Then
StoppeRZZaehlerZumZeitpunkt = KEINE_ANTWORT_FEHLER
If Wiederholung < 3 Then
Wiederholung = Wiederholung + 1
GoTo nochmalFM85adressieren
Else
PrintStatus "StoppeRZZaehlerZumZeitpunkt(): wiederholt keine Antwort beim Adresseieren von FM85-" & EinbauplatzNr
Exit Function
End If
End If
If Not m_PruefungsArtWaage Then
StoppeRZZaehlerZumZeitpunkt = FEHLER_ZUSPAET ' zu Spät
Do While Zeitpunkt > GetTickCount()
StoppeRZZaehlerZumZeitpunkt = KEIN_FEHLER
lblZeit.caption = Int((Zeitpunkt - GetTickCount()) / 1000)
DoEvents
Loop
If StoppeRZZaehlerZumZeitpunkt = FEHLER_ZUSPAET Then
' zu spät
Exit Function
End If
End If
lngZeitpunktms = GetTickCount
m_FMBus.send "q"
Rueckkehrzeitpunkt = GetTickCount
End Function
Private Function JustageArt(strText As String) As String
JustageArt = ""
If g_blnbedingteQiJustage Then
JustageArt = JustageArt & "bedingte "
End If
If g_bGetrennteJustage Then
JustageArt = JustageArt & "getrennte "
End If
JustageArt = JustageArt & "Justage"
If strText <> "" Then
JustageArt = JustageArt & " " & strText
End If
JustageArt = JustageArt & " " & IIf(m_VorPruefungsArtWaage, "g.Wg", "g.RZ")
If m_JustageCount <> "" Then
JustageArt = JustageArt & " " & m_JustageCount
End If
End Function
Private Function StoppeUSZaehlerZumZeitpunkt(Einbauplatz As CEinbauplatz, Zeitpunkt As Long, Rueckkehrzeitpunkt As Long, Optional ByRef lngZeitpunktms As Long) As Long
Dim US_COM_Port As Integer
Rueckkehrzeitpunkt = GetTickCount
lngZeitpunktms = GetTickCount
Debug.Print "Zeit bis zum US-Zähler Stoppen:" & Zeitpunkt - GetTickCount()
US_COM_Port = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If Not m_PruefungsArtWaage Then
StoppeUSZaehlerZumZeitpunkt = FEHLER_ZUSPAET ' zu Spät
Do While Zeitpunkt > GetTickCount()
StoppeUSZaehlerZumZeitpunkt = KEIN_FEHLER
Loop
If StoppeUSZaehlerZumZeitpunkt = FEHLER_ZUSPAET Then
' zu spät
Exit Function
End If
End If
lngZeitpunktms = GetTickCount
StoppeUSZaehlerZumZeitpunkt = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
If StoppeUSZaehlerZumZeitpunkt = 0 Then
StoppeUSZaehlerZumZeitpunkt = modMBUS_SMS.NOWA_STOP_FW2()
End If
modMBUS_SMS.IECCOM_CloseCom
Rueckkehrzeitpunkt = GetTickCount
End Function
' Rückgabe: 0 wenn kein Fehler
Private Function StarteUSZaehlerZumZeitpunkt(Einbauplatz As CEinbauplatz, Zeitpunkt As Long, Rueckkehrzeitpunkt As Long, Optional ByRef lngZeitpunktms As Long) As Integer
Dim US_COM_Port As Integer
Dim Wiederholung As Integer
StarteUSZaehlerZumZeitpunkt = FEHLER_ZUSPAET ' Zu spät annehmen
US_COM_Port = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
Do While Zeitpunkt > GetTickCount()
' noch innerhalb des Zeitrahmens
StarteUSZaehlerZumZeitpunkt = KEIN_FEHLER
Loop
If StarteUSZaehlerZumZeitpunkt = FEHLER_ZUSPAET Then
' zu spät, ggf Aufruf der Funktion zu einem späteren Zeitpunkt wiederholen
Exit Function
End If
lngZeitpunktms = GetTickCount
StarteUSZaehlerZumZeitpunkt = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True, 3)
If StarteUSZaehlerZumZeitpunkt = 0 Then
Wiederholung = 0
NochmalNowaStart:
StarteUSZaehlerZumZeitpunkt = modMBUS_SMS.NOWA_START_FW2
If StarteUSZaehlerZumZeitpunkt = MBUS_SMS_ERR_OK Then
WriteToFW2Logfile Einbauplatz, "NOWA_START_FW2 OK"
Else
WriteToFW2Logfile Einbauplatz, "NOWA_START_FW2 Fehler " & StarteUSZaehlerZumZeitpunkt & ": " & modMBUS_SMS.Errorstring(StarteUSZaehlerZumZeitpunkt) & ", wdh=" & Wiederholung
If Wiederholung < 3 Then
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
Else
Exit Function
End If
End If
Else
' Schnittstellen Fehler
Exit Function
End If
'StarteUSZaehlerZumZeitpunkt = modIECCOM.NOWA_START(US_COM_Port)
Rueckkehrzeitpunkt = GetTickCount()
' Taskbyte lesen. Bei den 65 NW gehen die Zähler manchmal nicht in den Prüfmodus
Dim intRet As Integer
Dim bytTaskbyte As Byte
intRet = modMBUS_SMS.ReadValue("u8_nowa_task_byte", bytTaskbyte)
If intRet = MBUS_SMS_ERR_OK Then
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte=" & vbTab & bytTaskbyte
Select Case bytTaskbyte
Case 0 'NOWA_OFF
' Zähler nicht im Prüfmodus, NOWA_START 1 * wiederholen
If Wiederholung < 1 Then
Wiederholung = Wiederholung + 1
GoTo NochmalNowaStart
End If
Case 85 'NOWA_ON
' alles gut
Case Else
' nicht definiert
End Select
Else
WriteToFW2Logfile Einbauplatz, "lese u8_nowa_task_byte Fehler = " & intRet & " = " & modMBUS_SMS.Errorstring(intRet)
End If
modMBUS_SMS.IECCOM_CloseCom
End Function
Private Function Vorpruefung() As Long
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim USVolumen As Double
Dim RefVolumen As Double
Dim PPNr As Integer
Dim EinbauplatzNr As Integer
Dim dblFehler As Double
Dim lngReturn As Long
Dim lngError As Long
Dim Identitaetsnummer As Long
Dim QIst As Double
Dim dblTemperatur As Double
Dim RefZFehler As Double
Dim lngUSPruefZeit_ms As Long
Dim lngRZPruefZeit_ms As Long
Dim dblPruefzeit As Double
Dim Fehler As Double
Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
Dim firmwareVersion As Byte
Dim comport As Integer
Dim lngRet As Long
Dim dblLetzterRZFehler As Double
Dim udtUSParameter(10) As JustageParameter_Type
Dim Mittelwert_udtUSParameter(10) As JustageParameter_Type
Dim udtUSZusatzParameter(10) As US_ZusatzParameter_Typ
''''''''''''''''''''''''''''''
Dim dblFehlerInQb(10) As Double
Dim dblIstFlussInQb(10) As Double
Dim dblSollFlussInQb(10) As Double
Dim dblTemperaturInQb(10) As Double
Dim dblNeuIstFluss1_m3ph As Double
Dim dblQminFehler As Double
Dim objJustageWerte(10) As CJustagewerte
Set m_Referenzzaehler = New CRefzaehler
Dim QiDurchlauf As Integer
Dim strTemp As String
' 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 Function
End If
GoTo TestAutomatik
End If
If Not m_SPS.IstStreckePruefbereit Then
If MsgBox("Soll die Strecke jetzt automatisch gespannt u. gefüllt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht prüfbereit") = vbYes Then
' Betrieb Vorbereiten
m_SPS.setBetrieb 1
PrintStatus "Betrieb vorbereiten: Spannen und Füllen..."
Do While Not m_SPS.IstStreckeGefuellt
Sleep 1000, True
If g_Abbruch = True Then
Exit Function
End If
Loop
' nach dem Füllen: Betrieb auf 0
Sleep 500
m_SPS.setBetrieb 0
End If
'------------------------------------------------------------------------
PrintStatus "Warte auf Pruefbereitschaft der SPS..."
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
Exit Function
End If
Loop
End If ' Pruefbereit
PrintStatus "Strecke ist Prüfbereit !"
PrintStatus "***** Vorprüfung ******"
'''''''''''''''''''''''''''
' Schleife Vorprüfpunkte
'''''''''''''''''''''''''''
m_colUniqueVorPP.sortQ
Set m_vorPruefpunktQi = m_colUniqueVorPP.getCollection.Item(m_colUniqueVorPP.getCollection.Count)
' Je Einbauplatz werden die aktuellen Daten aus dem Zähler gelesen
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
' neu RH 31.10.2013 21= Justage begonnen
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 21
Pruefzaehler.getAuftragPositionSerienNr.save
' OffsetJustage / Tabelle USJustageWerte
Set objJustageWerte(EinbauplatzNr) = New CJustagewerte
objJustageWerte(EinbauplatzNr).SerienNr = Pruefzaehler.getSerienNr
objJustageWerte(EinbauplatzNr).FabNr = Pruefzaehler.getAuftragPositionSerienNr.getFabNr
objJustageWerte(EinbauplatzNr).Einbauplatz = EinbauplatzNr
objJustageWerte(EinbauplatzNr).comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
objJustageWerte(EinbauplatzNr).DatumVorpruefung = m_Pruefgang.Datum
udtUSParameter(EinbauplatzNr).Offset_Qmin = Pruefzaehler.getVorpruefpunkte.getOffset_Qmin
udtUSParameter(EinbauplatzNr).Offset_Qp = Pruefzaehler.getVorpruefpunkte.getOffset_Qp
If g_blnJustageWerteNICHTschreiben = False Then
If Einbauplatz.getAktiv = True Then
' Sicherstellen, dass im RW f_fp_o_geber auf Null gesetzt ist
FW2_writeVar Einbauplatz, "f_fp_o_geber", 0
objJustageWerte(EinbauplatzNr).FP_O_Geber = 0
Else
WriteToFW2Logfile Einbauplatz, "Der Wert von f_fp_o_geber wird wegen Ausfall NICHT auf 0 gesetzt."
End If
Else
WriteToFW2Logfile Einbauplatz, "Der Wert von f_fp_o_geber wird auf Wunsch NICHT auf 0 gesetzt."
End If
'Daten aus dem Rechenwerk auslesen
If LeseJustageParameterAusZaehler(Einbauplatz, udtUSParameter(Einbauplatz.getNr)) <> 0 Then
' Fehler
WriteToFW2Logfile Einbauplatz, "Fehler in LeseJustageParameterAusZaehler()" & vbTab & "Prüfung für diesen Zähler wurde deaktiviert."
Einbauplatz.setAktiv False
Else
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter aus Zähler", Einbauplatz.getNr
End If
End If
Next Einbauplatz
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''' eigentliche Vorprüfung ''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''' 1. Prüfpunkt bei Qmax ''''''''''''''''''''''
PPNr = 1
Set m_vorPruefpunkt = m_colUniqueVorPP.getCollection.Item(PPNr)
m_DurchflussSoll = m_vorPruefpunkt.getQ
m_Pruefzeit = m_vorPruefpunkt.GetTime
m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6
PrintStatus "geschätztes Soll-Volumen in Litern: " & m_VolumenSoll
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
WriteToFW2Logfile Einbauplatz, "Justage Qmax [m³/h]=" & vbTab & m_DurchflussSoll
WriteToFW2Logfile Einbauplatz, "Soll-Pruefzeit [s]=" & vbTab & m_Pruefzeit
WriteToFW2Logfile Einbauplatz, "geschätztes Soll-Volumen in Litern=" & vbTab & m_VolumenSoll
End If
Next
lblSollV.caption = Format(m_VolumenSoll, "0")
Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
m_SPS.SetQDiff 0
PrintStatus "Vorprüfung im Vorprüfpunkt 1 (QNenn):"
lngRet = VorpruefungImPP(PPNr, udtPruefdaten_imPP_mitEBP())
If lngRet < 0 Then
g_Abbruch = True
Vorpruefung = -1
End If
If g_Abbruch Then Exit Function
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).blnPruefungsfehler = False Then
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo <> "" Then
PrintStatus udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
End If
' kein Fehler aufgetreten
Call modUSchall.FW2_GetUSVolumen(Einbauplatz, USVolumen)
WriteToFW2Logfile Einbauplatz, "NOWA Volumen=" & vbTab & USVolumen
Call modUSchall.FW2_GetUS_NOWA_Zeit(Einbauplatz, dblPruefzeit)
PrintStatus "NOWA Prüfzeit: " & dblPruefzeit & " ms"
WriteToFW2Logfile Einbauplatz, "NOWA Prüfzeit=" & vbTab & dblPruefzeit
If USVolumen = 0 Then
WriteToFW2Logfile Einbauplatz, "Da das NOWA-Volumen nicht ermittelt werden konnte, wird dieser Zähler nicht weiter justiert."
Vorpruefung = -20
Einbauplatz.setAktiv False
'Stop
End If
lngUSPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms
lngRZPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).RZ_IstPruefzeit_ms
PrintStatus "US Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngUSPruefZeit_ms & " ms"
PrintStatus "RZ Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngRZPruefZeit_ms & " ms"
PrintStatus "US Volumen am Einbauplatz " & EinbauplatzNr & " [m³]:" & USVolumen
' Refererenz Volumen bestimmen
If Not m_VorPruefungsArtWaage Then
' Refererenz Volumen bestimmen aus Referenzzähler
Call GetRZVolumen(EinbauplatzNr, m_Referenzzaehler, RefVolumen)
WriteToFW2Logfile Einbauplatz, "Referenzvolumen FM85 [m³]=" & vbTab & RefVolumen
PrintStatus "FM85 Volumen [m³]:" & RefVolumen
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
End If
dblLetzterRZFehler = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, dblTemperatur)
WriteToFW2Logfile Einbauplatz, "Fehler RZ=" & vbTab & dblLetzterRZFehler
PrintStatus "Fehler des RZ in diesem Prüfpunkt: " & Format(dblLetzterRZFehler, "0.0")
RefVolumen = RefVolumen / (1 + dblLetzterRZFehler / 100)
PrintStatus "Ist-Volumen (korrigiert mit Fehler des RZ): " & RefVolumen
WriteToFW2Logfile Einbauplatz, "korrigiertes Referenzvolumen [m³]=" & vbTab & RefVolumen
Else
' Refererenz Volumen bestimmen aus Gewicht der Waage
RefVolumen = Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, udtPruefdaten_imPP_mitEBP(EinbauplatzNr).dblTemperatur)
WriteToFW2Logfile Einbauplatz, "Referenzvolumen Waage [m³]=" & vbTab & RefVolumen
PrintStatus "Ist-Volumen [m³] (aus Waage, korrigiert mit Temperatur): " & RefVolumen
' Hier sind die Prüfzeiten rechnerisch gleich
lngRZPruefZeit_ms = lngUSPruefZeit_ms
End If
If RefVolumen = 0 Then
MsgBox ("Referenz Volumen (Waage oder Referenzzähler) konnte nicht ermittelt werden")
Vorpruefung = -21
WriteToFW2Logfile Einbauplatz, "Referenz Volumen konnte nicht ermittelt werden."
Einbauplatz.setAktiv False
'Stop
End If
MSFlexGrid1.row = Einbauplatz.getNr
MSFlexGrid1.col = PPNr
If Not lngUSPruefZeit_ms = 0 Then
If Not m_VorPruefungsArtWaage Then
'Offset_Qp abziehen, um Kurve nach oben zu bekommen
'geändert am 20.01.2004 AP mit Gepräch mit UD
If udtUSParameter(Einbauplatz.getNr).Offset_Qp <> 0 Then
WriteToFW2Logfile Einbauplatz, "Offset_Qp=" & vbTab & udtUSParameter(Einbauplatz.getNr).Offset_Qp
RefVolumen = RefVolumen * (1 - udtUSParameter(Einbauplatz.getNr).Offset_Qp / 100 * (-1))
WriteToFW2Logfile Einbauplatz, "Qp RefVolumen (- Offset_Qp) =" & vbTab & RefVolumen
End If
' mit den wahren Prüfzeiten korrigierter Fehler
Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms)
PrintStatus "Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms) =" & Format(Fehler, "0.00")
WriteToFW2Logfile Einbauplatz, "Fehler Qp =" & vbTab & Format(Fehler, "0.00")
Else
'Offset_Qp abziehen, um Kurve nach oben zu bekommen
'geändert am 20.01.2004 AP mit Gepräch mit UD
If udtUSParameter(Einbauplatz.getNr).Offset_Qp <> 0 Then
WriteToFW2Logfile Einbauplatz, "Offset_Qp=" & vbTab & udtUSParameter(Einbauplatz.getNr).Offset_Qp
RefVolumen = RefVolumen * (1 - udtUSParameter(Einbauplatz.getNr).Offset_Qp / 100 * (-1))
WriteToFW2Logfile Einbauplatz, "Qp RefVolumen (-Qffset_Qp)=" & vbTab & RefVolumen
End If
Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen
PrintStatus "Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen =" & Format(Fehler, "0.00")
WriteToFW2Logfile Einbauplatz, "Fehler Qp=" & vbTab & Format(Fehler, "0.00")
End If
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
End If
MSFlexGrid1.text = Format(Fehler, "0.00")
AutoSpaltenBreite MSFlexGrid1, lblAutosize
DoEvents
udtUSParameter(Einbauplatz.getNr).Istfluss2_m3ph = USVolumen / (lngUSPruefZeit_ms / 1000 / 60 / 60)
udtUSParameter(Einbauplatz.getNr).Sollfluss2_m3ph = RefVolumen / (lngRZPruefZeit_ms / 1000 / 60 / 60)
udtUSParameter(Einbauplatz.getNr).Temperatur2_°C = dblTemperatur
udtUSParameter(Einbauplatz.getNr).Fehler2 = Fehler
PrintStatus "gemessenes Q vom US = (USVolumen / (lngUSPruefZeit_ms / 1000 / 60 / 60)=" & udtUSParameter(Einbauplatz.getNr).Istfluss2_m3ph
PrintStatus "gemessenes Q vom FM85 = RefVolumen / (lngRZPruefZeit_ms / 1000 / 60 / 60) =" & udtUSParameter(Einbauplatz.getNr).Sollfluss2_m3ph
WriteToFW2Logfile Einbauplatz, "Prüfzeit [s]=" & vbTab & lngUSPruefZeit_ms / 1000
WriteToFW2Logfile Einbauplatz, "Istfluss2_m3ph=" & vbTab & udtUSParameter(Einbauplatz.getNr).Istfluss2_m3ph
WriteToFW2Logfile Einbauplatz, "Sollfluss2_m3ph=" & vbTab & udtUSParameter(Einbauplatz.getNr).Sollfluss2_m3ph
If g_bGetrennteJustage Then
WriteToFW2Logfile Einbauplatz, "getrennte K-Geber Justageformel "
gudtUSParameter = udtUSParameter(Einbauplatz.getNr)
Justage1_Execute_FW2 m_vorPruefpunktQi.getQ
udtUSParameter(Einbauplatz.getNr) = gudtUSParameter
If g_blnJustageWerteNICHTschreiben = False Then
If Einbauplatz.getAktiv = True Then
modUSchall.FW2_writeVar Einbauplatz, "f_fp_k_geber1", udtUSParameter(Einbauplatz.getNr).Geberkonstante_Neu1_m
modUSchall.FW2_writeVar Einbauplatz, "f_fp_k_geber2", udtUSParameter(Einbauplatz.getNr).Geberkonstante_Neu2_m
Else
WriteToFW2Logfile Einbauplatz, "f_fp_k_geber1,2 werden wegen Ausfall nicht ins RW geschrieben"
End If
Else
WriteToFW2Logfile Einbauplatz, "f_fp_k_geber1,2 werden nicht ins RW geschrieben"
End If
End If
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter nach 1. Vor-Prüfpunkt Qmax", Einbauplatz.getNr
Else
WriteToFW2Logfile Einbauplatz, "Da USPruefZeit_ms = 0: Vorprüfung für Einbauplatz " & Einbauplatz.getNr & " fehlgeschlagen."
Einbauplatz.setAktiv False
MSFlexGrid1.text = "?"
Vorpruefung = -23
End If
Else
WriteToFW2Logfile Einbauplatz, "Vorprüfung für Einbauplatz " & EinbauplatzNr & " fehlgeschlagen:"
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo <> "" Then
WriteToFW2Logfile Einbauplatz, udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
End If
Einbauplatz.setAktiv False
End If
gudtUSParameter = udtUSParameter(Einbauplatz.getNr)
End If ' Pruefzaehler is nothing
Next Einbauplatz
If m_PruefungsArtWaage = True Then
If g_App.PruefstationNr = 2020 Then
' es darf kein warmes Wasser im Behälter kalt werden
Call BeideBehaelterLeeren
End If
End If
'''''''''''''''''''''''' Qmin ''''''''''''''''''''''
' Qmin
PPNr = m_colUniqueVorPP.getCollection.Count
Set m_vorPruefpunkt = m_colUniqueVorPP.getCollection.Item(PPNr)
m_DurchflussSoll = m_vorPruefpunkt.getQ
m_Pruefzeit = m_vorPruefpunkt.GetTime
m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6
PrintStatus "geschätztes Soll-Volumen in Litern: " & Format(m_VolumenSoll, "0.000")
lblSollV.caption = Format(m_VolumenSoll, "0")
Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
m_SPS.SetQDiff 0
PrintStatus "Vorprüfung im Vorprüfpunkt (Qmin):"
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
WriteToFW2Logfile Einbauplatz, "-----------"
WriteToFW2Logfile Einbauplatz, "Justage Qmin [m³/h]=" & vbTab & m_DurchflussSoll
WriteToFW2Logfile Einbauplatz, "Pruefzeit [s]=" & vbTab & m_Pruefzeit
WriteToFW2Logfile Einbauplatz, "geschätztes Soll-Volumen [l]=" & vbTab & m_VolumenSoll
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
QiDurchlauf = 0
EinsprungQiWiederholung:
If g_blnVorpruefung3malQiMittelwert Then
QiDurchlauf = QiDurchlauf + 1 ' 1,2,3
End If
lngRet = VorpruefungImPP(PPNr, udtPruefdaten_imPP_mitEBP())
If lngRet < 0 Then
Vorpruefung = -1
g_Abbruch = True
End If
If g_Abbruch Then Exit Function
Simulation:
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).blnPruefungsfehler = False Then
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo <> "" Then
PrintStatus udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
End If
' kein Fehler aufgetreten
Call FW2_GetUSVolumen(Einbauplatz, USVolumen)
WriteToFW2Logfile Einbauplatz, "NOWA Volumen=" & vbTab & USVolumen
PrintStatus "US Volumen am Einbauplatz " & EinbauplatzNr & " [m³]:" & USVolumen
If USVolumen = 0 Then
MsgBox ("US Volumen konnte nicht ermittelt werden")
Vorpruefung = -20
Einbauplatz.setAktiv False
'Stop
End If
Call FW2_GetUS_NOWA_Zeit(Einbauplatz, dblPruefzeit)
PrintStatus "NOWA Prüfzeit: " & dblPruefzeit & " ms"
WriteToFW2Logfile Einbauplatz, "NOWA Prüfzeit= " & vbTab & dblPruefzeit
lngUSPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms
lngRZPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).RZ_IstPruefzeit_ms
WriteToFW2Logfile Einbauplatz, "US-Zähler Prüfzeit [ms] t=" & vbTab & lngUSPruefZeit_ms
WriteToFW2Logfile Einbauplatz, "Ref-Zähler Prüfzeit [ms]=" & vbTab & lngRZPruefZeit_ms
PrintStatus "US Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngUSPruefZeit_ms & " ms"
PrintStatus "RZ Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngRZPruefZeit_ms & " ms"
' Refererenz Volumen bestimmen
If Not m_VorPruefungsArtWaage Then
' Refererenz Volumen bestimmen aus Referenzzähler
Call GetRZVolumen(EinbauplatzNr, m_Referenzzaehler, RefVolumen)
PrintStatus "RZ Volumen [m³]:" & RefVolumen
WriteToFW2Logfile Einbauplatz, "Referenzvolumen FM85 [m³]=" & vbTab & RefVolumen
If Not g_ohneSPS Then
dblLetzterRZFehler = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
End If
WriteToFW2Logfile Einbauplatz, "Fehler RZ=" & vbTab & dblLetzterRZFehler
PrintStatus "Fehler des RZ in diesem Prüfpunkt: " & Format(dblLetzterRZFehler, "0.0")
RefVolumen = RefVolumen / (1 + dblLetzterRZFehler / 100)
PrintStatus "Ist-Volumen (korrigiert mit Fehler des RZ): " & RefVolumen
WriteToFW2Logfile Einbauplatz, "korrigiertes Referenzvolumen [m³]=" & vbTab & RefVolumen
Else
' Refererenz Volumen bestimmen aus Gewicht der Waage
RefVolumen = Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, udtPruefdaten_imPP_mitEBP(EinbauplatzNr).dblTemperatur)
PrintStatus "Ist-Volumen [m³] (aus Waage, korrigiert mit Temperatur): " & RefVolumen
WriteToFW2Logfile Einbauplatz, "Referenzvolumen Waage [m³]=" & vbTab & RefVolumen
' Hier sind die Prüfzeiten rechnerisch gleich
lngRZPruefZeit_ms = lngUSPruefZeit_ms
End If
If RefVolumen = 0 Then
MsgBox ("Referenz Volumen (Waage oder Referenzzähler) konnte nicht ermittelt werden")
Vorpruefung = -21
'Stop
End If
If g_blnVorpruefung3malQiMittelwert Then
MSFlexGrid1.col = PPNr + (QiDurchlauf - 1)
MSFlexGrid1.row = 0
MSFlexGrid1.text = m_DurchflussSoll & " (" & QiDurchlauf & ")"
MSFlexGrid1.row = Einbauplatz.getNr
Else
MSFlexGrid1.col = PPNr
MSFlexGrid1.row = Einbauplatz.getNr
End If
If Not lngUSPruefZeit_ms = 0 Then
If Not m_VorPruefungsArtWaage Then
' Referenzzähler
'Offset_Qmin abziehen, um Kurve nach oben zu bekommen
'geändert am 20.01.2004 AP mit Gepräch mit UD
If udtUSParameter(Einbauplatz.getNr).Offset_Qmin <> 0 Then
PrintStatus "Offset_Qmin % wird vom RZ Volumen abgezogen: " & udtUSParameter(Einbauplatz.getNr).Offset_Qmin & " %"
WriteToFW2Logfile Einbauplatz, "Offset_Qmin=" & vbTab & udtUSParameter(Einbauplatz.getNr).Offset_Qmin
RefVolumen = RefVolumen * (1 - udtUSParameter(Einbauplatz.getNr).Offset_Qmin / 100 * (-1))
WriteToFW2Logfile Einbauplatz, "RefVolumen (- Offset_Qmin)=" & vbTab & RefVolumen
End If
' mit den wahren Prüfzeiten korrigierter Fehler
Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms)
PrintStatus "Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms) =" & Format(Fehler, "0.00")
WriteToFW2Logfile Einbauplatz, "Fehler Qmin=" & vbTab & Format(Fehler, "0.00")
Else
' Waage
'Offset_Qmin abziehen, um Kurve nach oben zu bekommen
'geändert am 20.01.2004 AP mit Gepräch mit UD
If udtUSParameter(Einbauplatz.getNr).Offset_Qmin <> 0 Then
PrintStatus "Offset_Qmin % wird vom Waagen-Volumen abgezogen: " & udtUSParameter(Einbauplatz.getNr).Offset_Qmin & " %"
WriteToFW2Logfile Einbauplatz, "Offset_Qmin=" & vbTab & udtUSParameter(Einbauplatz.getNr).Offset_Qmin
RefVolumen = RefVolumen * (1 - udtUSParameter(Einbauplatz.getNr).Offset_Qmin / 100 * (-1))
WriteToFW2Logfile Einbauplatz, "RefVolumen (- Offset_Qmin)=" & vbTab & RefVolumen
End If
Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen
PrintStatus "Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen =" & Format(Fehler, "0.00")
WriteToFW2Logfile Einbauplatz, "Fehler Qmin=" & vbTab & Format(Fehler, "0.00")
End If
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
End If
MSFlexGrid1.text = Format(Fehler, "0.00")
AutoSpaltenBreite MSFlexGrid1, lblAutosize
DoEvents
udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph = USVolumen / (lngUSPruefZeit_ms / 1000 / 60 / 60)
udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph = RefVolumen / (lngRZPruefZeit_ms / 1000 / 60 / 60)
udtUSParameter(Einbauplatz.getNr).Temperatur1_°C = dblTemperatur
udtUSParameter(Einbauplatz.getNr).Fehler1 = Fehler
WriteToFW2Logfile Einbauplatz, "Prüfzeit [s]=" & vbTab & lngUSPruefZeit_ms / 1000
WriteToFW2Logfile Einbauplatz, "Istfluss1_m3ph= " & vbTab & udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph
WriteToFW2Logfile Einbauplatz, "Sollfluss1_m3ph= " & vbTab & udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph
objJustageWerte(EinbauplatzNr).IstFluss1 = udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph
objJustageWerte(EinbauplatzNr).SollFluss1 = udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph
objJustageWerte(EinbauplatzNr).Temperatur1 = udtUSParameter(Einbauplatz.getNr).Temperatur1_°C
objJustageWerte(EinbauplatzNr).Fehler1 = udtUSParameter(Einbauplatz.getNr).Fehler1
objJustageWerte(EinbauplatzNr).IstFluss2 = udtUSParameter(Einbauplatz.getNr).Istfluss2_m3ph
objJustageWerte(EinbauplatzNr).SollFluss2 = udtUSParameter(Einbauplatz.getNr).Sollfluss2_m3ph
objJustageWerte(EinbauplatzNr).Temperatur2 = udtUSParameter(Einbauplatz.getNr).Temperatur2_°C
objJustageWerte(EinbauplatzNr).Fehler2 = udtUSParameter(Einbauplatz.getNr).Fehler2
' neu RH 11.7.2013
objJustageWerte(EinbauplatzNr).f_fp_o_geber_roh = udtUSParameter(Einbauplatz.getNr).OGeber_Roh_Neu_ns / 10 ^ 9
' neu RH 6.8.2013 Originalwert aus dem rechenwerk
objJustageWerte(EinbauplatzNr).f_fp_o_geber_roh_RW = udtUSParameter(Einbauplatz.getNr).OGeber_Roh_Neu_ns / 10 ^ 9
PrintStatus "gemessenes Q vom US = (USVolumen / (lngUSPruefZeit_ms / 1000 / 60 / 60)=" & udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph
PrintStatus "gemessenes Q vom FM85 = RefVolumen / (lngRZPruefZeit_ms / 1000 / 60 / 60) =" & udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph
'' *******************************************************************************************************
FertigVorpruefung:
'###############################################################################################################
' Mittelwert bilden über 3 Qi Durchläufe
'###############################################################################################################
If g_blnVorpruefung3malQiMittelwert Then
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter, " & QiDurchlauf & ". Mittelwert-Beitrag nach Qi Messung", Einbauplatz.getNr
' als Neu abspeichern
objJustageWerte(EinbauplatzNr).JustageArt = JustageArt(QiDurchlauf & ". Mittelwert-Beitrag bei Qi")
objJustageWerte(EinbauplatzNr).DatumVorpruefung = Now()
objJustageWerte(EinbauplatzNr).save
' zum Mittelwert aufaddieren
Mittelwert_udtUSParameter(EinbauplatzNr).Istfluss1_m3ph = Mittelwert_udtUSParameter(EinbauplatzNr).Istfluss1_m3ph + udtUSParameter(EinbauplatzNr).Istfluss1_m3ph
Mittelwert_udtUSParameter(EinbauplatzNr).Sollfluss1_m3ph = Mittelwert_udtUSParameter(EinbauplatzNr).Sollfluss1_m3ph + udtUSParameter(EinbauplatzNr).Sollfluss1_m3ph
Mittelwert_udtUSParameter(EinbauplatzNr).Fehler1 = Mittelwert_udtUSParameter(EinbauplatzNr).Fehler1 + udtUSParameter(EinbauplatzNr).Fehler1
Mittelwert_udtUSParameter(EinbauplatzNr).Temperatur1_°C = Mittelwert_udtUSParameter(EinbauplatzNr).Temperatur1_°C + udtUSParameter(EinbauplatzNr).Temperatur1_°C
If QiDurchlauf = 3 Then
' Mittelwert bilden
udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph = Mittelwert_udtUSParameter(EinbauplatzNr).Istfluss1_m3ph / 3
udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph = Mittelwert_udtUSParameter(EinbauplatzNr).Sollfluss1_m3ph / 3
udtUSParameter(Einbauplatz.getNr).Fehler1 = Mittelwert_udtUSParameter(EinbauplatzNr).Fehler1 / 3
udtUSParameter(Einbauplatz.getNr).Temperatur1_°C = Mittelwert_udtUSParameter(EinbauplatzNr).Temperatur1_°C / 3
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "(gemittelte) Justage Parameter nach 2. Vor-Prüfpunkt(Qi) vor Justage", Einbauplatz.getNr
' RH 13.6.2013 Mittelwerte setzen für Datenbank Justagewerte
objJustageWerte(EinbauplatzNr).JustageArt = JustageArt("Mittelwert bei Qi")
Sleep 1000 ' eine neue Zeit bekommen um einen neuen objJustageWerte Datensatz zu speichern
objJustageWerte(EinbauplatzNr).DatumVorpruefung = Now()
objJustageWerte(EinbauplatzNr).IstFluss1 = udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph
objJustageWerte(EinbauplatzNr).SollFluss1 = udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph
objJustageWerte(EinbauplatzNr).Temperatur1 = udtUSParameter(Einbauplatz.getNr).Temperatur1_°C
objJustageWerte(EinbauplatzNr).Fehler1 = udtUSParameter(Einbauplatz.getNr).Fehler1
objJustageWerte(EinbauplatzNr).save
End If
Else
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter nach 2. Vor-Prüfpunkt vor Justage", Einbauplatz.getNr
End If
Else
PrintStatus "Vorprüfung für Einbauplatz " & EinbauplatzNr & " fehlgeschlagen."
Einbauplatz.setAktiv False
MSFlexGrid1.text = "?"
'Vorpruefung = -23
'Stop
End If
Else
PrintStatus "Vorprüfung für Einbauplatz " & EinbauplatzNr & " fehlgeschlagen:"
PrintStatus udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
Einbauplatz.setAktiv False
End If
gudtUSParameter = udtUSParameter(Einbauplatz.getNr)
End If ' Pruefzaehler is nothing
Next Einbauplatz
' Bei Mittelwerbildung den Prüfpunkt bis zu 2 mal wiederholen
If g_blnVorpruefung3malQiMittelwert = True Then
If QiDurchlauf < 3 Then
GoTo EinsprungQiWiederholung ' Nochmal Qi messen
Else
MSFlexGrid1.col = MSFlexGrid1.Cols - 1
MSFlexGrid1.row = 0
MSFlexGrid1.text = m_DurchflussSoll & " (M)"
End If
End If
' Justage durchführen
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
If Einbauplatz.getAktiv = True Then
Fehler = udtUSParameter(EinbauplatzNr).Fehler1
MSFlexGrid1.row = EinbauplatzNr
MSFlexGrid1.text = Format(Fehler, "0.00")
AutoSpaltenBreite MSFlexGrid1, lblAutosize
DoEvents
If False Then
udtUSParameter(7).Istfluss1_m3ph = 0.259629137619682
udtUSParameter(7).Sollfluss1_m3ph = 0.253828356111453
udtUSParameter(7).Fehler1 = 100 * (udtUSParameter(7).Istfluss1_m3ph - udtUSParameter(7).Sollfluss1_m3ph) / udtUSParameter(7).Sollfluss1_m3ph
udtUSParameter(7).Temperatur1_°C = 57.3
End If
' Justage durchführen
gudtUSParameter = udtUSParameter(EinbauplatzNr)
If g_bGetrennteJustage Then
WriteToFW2Logfile Einbauplatz, "getrennte O-Geber Justageformel "
If g_blnbedingteQiJustage Then
'bedingte Qi Justage
If Abs(udtUSParameter(EinbauplatzNr).Fehler1) >= 1 Then
' bedingte Qi Justage nur wenn Fehler bei Qi >= 1 % ist
Call Justage_o_geber_roh
WriteToFW2Logfile Einbauplatz, "Justage_o_geber_roh da der Fehler Qi " & udtUSParameter(EinbauplatzNr).Fehler1 & " % >= 1%"
Else
' hier braucht nicht justiert werden
WriteToFW2Logfile Einbauplatz, "Justage_o_geber_roh übersprungen da der Fehler Qi " & udtUSParameter(EinbauplatzNr).Fehler1 & "% < 1%"
End If
Else
' unbedingte Justage
Call Justage_o_geber_roh
End If
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter nach Justage3_mit_Zeroflow_FW2 vor Justage_Execute_FW2", Einbauplatz.getNr
Else
Call Justage_mit_Zeroflow_FW2
ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter nach Justage_mit_Zeroflow_FW2 vor Justage_Execute_FW2", Einbauplatz.getNr
modUS2000_Algorithmen.Justage_Execute_FW2
ShowUSParameter gudtUSParameter, udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter nach Justage_FW2", Einbauplatz.getNr
End If
udtUSParameter(EinbauplatzNr) = gudtUSParameter
End If
End If
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PrintStatus "SetOffsetAndGeberAndBereich f.a. Zähler"
For Each Einbauplatz In m_colEinbauplatz
If Einbauplatz.getAktiv Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
If g_blnJustageWerteNICHTschreiben = False Then
' Justage soll soweit durchgeführt werden
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Neu RH 2015-11-05
' Einbauplatz deaktivieren, wenn bei der Justage Fehler-Grenzwerte überschritten werden.
'
strTemp = Trim(g_App.Settings.readStringValue("USFirmware2", "Justage_FG_Qi", ""))
If strTemp <> "" Then
strTemp = Replace(strTemp, ",", ".")
If Abs(udtUSParameter(Einbauplatz.getNr).Fehler1) > Val(strTemp) Then
Einbauplatz.setAktiv False
PrintStatus "Justage Fehler Qi=" & Format(udtUSParameter(Einbauplatz.getNr).Fehler1, "0.00") & " ist ausserhalb der erlaubten Fehlergrenzen +-" & strTemp & "%. Zähler am Ebp " & EinbauplatzNr & " wird nicht weiter geprüft!"
End If
End If
strTemp = Trim(g_App.Settings.readStringValue("USFirmware2", "Justage_FG_Qp", ""))
If strTemp <> "" Then
strTemp = Replace(strTemp, ",", ".")
If Abs(udtUSParameter(Einbauplatz.getNr).Fehler2) > Val(strTemp) Then
Einbauplatz.setAktiv False
PrintStatus "Justage Fehler Qp=" & Format(udtUSParameter(Einbauplatz.getNr).Fehler1, "0.00") & " ist ausserhalb der erlaubten Fehlergrenzen +-" & strTemp & "%. Zähler am Ebp " & EinbauplatzNr & " wird nicht weiter geprüft!"
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Einbauplatz.getAktiv = True Then
modUSchall.FW2_writeVar Einbauplatz, "f_fp_k_geber1", udtUSParameter(Einbauplatz.getNr).Geberkonstante_Neu1_m
modUSchall.FW2_writeVar Einbauplatz, "f_fp_k_geber2", udtUSParameter(Einbauplatz.getNr).Geberkonstante_Neu2_m
' umwandeln in m³/s => 0 reinschreiben
modUSchall.FW2_writeVar Einbauplatz, "f_fp_qoffset1", udtUSParameter(Einbauplatz.getNr).Offset_Neu1_m3ph
modUSchall.FW2_writeVar Einbauplatz, "f_fp_qoffset2", udtUSParameter(Einbauplatz.getNr).Offset_Neu2_m3ph
modUSchall.FW2_writeVar Einbauplatz, "f_fp_o_geber", 0
If g_blnbedingteQiJustage Then
' bedingte Qi Justage
If Abs(udtUSParameter(EinbauplatzNr).Fehler1) >= 1 Then
' bedingte Qi Justage nur wenn Fehler bei Qi >= 1 % ist
modUSchall.FW2_writeVar Einbauplatz, "f_fp_o_geber_roh", udtUSParameter(Einbauplatz.getNr).OGeber_Roh_Neu_ns / 10 ^ 9
Else
' Es wird der f_fp_o_geber_roh Wert im RW belassen
WriteToFW2Logfile Einbauplatz, "schreiben von f_fp_o_geber_roh übersprungen da Fehler Qi " & udtUSParameter(EinbauplatzNr).Fehler1 & " < 1%"
End If
Else
' unbedingte Justage
modUSchall.FW2_writeVar Einbauplatz, "f_fp_o_geber_roh", udtUSParameter(Einbauplatz.getNr).OGeber_Roh_Neu_ns / 10 ^ 9
End If
' TEST_CS durchführen, um Checksumme im Flash zu korrigieren
Call modMBUS_SMS.do_test2(&HE8, &H5A)
WriteToFW2Logfile Einbauplatz, "Justagewerte geschrieben."
Else
WriteToFW2Logfile Einbauplatz, "alle Justagewerte werden wegen Ausfall NICHT in den Zähler geschrieben"
End If
Else
WriteToFW2Logfile Einbauplatz, "alle Justagewerte werden auf Wunsch NICHT in den Zähler geschrieben"
End If
Debug_UeberspringeSchreiben:
' bleibt wie es ist
' USParameter.SteilheitGeber_nsp°C,
' modUSchall.FW2_writeVar Einbauplatz, "f_fp_st_geber", udtUSParameter(Einbauplatz.getNr).SteilheitGeber_nsp°C
' USParameter.Bereich_ns
' modUSchall.FW2_writeVar Einbauplatz, "f_fp_bereich", udtUSParameter(Einbauplatz.getNr).Bereich_ns
End If ' Pruefzaehler is nothing
Else
' Einbauplatz ist wegen eines Fehlers nicht aktiv
WriteToFW2Logfile Einbauplatz, "Wegen eines Fehler während der Justage werden die Justagewerte NICHT in den Zähler am Einbauplatz " & Einbauplatz.getNr & " geschrieben."
End If
Next Einbauplatz
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PrintStatus "OffsetJustage Werte in Tabelle USJustageWerte speichern"
Sleep 1000
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
' OffsetJustage / Tabelle USJustageWerte
' --------------------------------------
objJustageWerte(EinbauplatzNr).JustageArt = JustageArt("")
objJustageWerte(EinbauplatzNr).FP_Bereich = udtUSParameter(EinbauplatzNr).Bereich_ns
objJustageWerte(EinbauplatzNr).FP_K_Geber1 = udtUSParameter(EinbauplatzNr).Geberkonstante_Neu1_m
objJustageWerte(EinbauplatzNr).FP_K_Geber2 = udtUSParameter(EinbauplatzNr).Geberkonstante_Neu2_m
objJustageWerte(EinbauplatzNr).FP_O_Geber = udtUSParameter(EinbauplatzNr).OffsetGeber_ns / 10 ^ 9
' neu RH 7.11.2013
objJustageWerte(EinbauplatzNr).f_fp_o_geber_roh = udtUSParameter(EinbauplatzNr).OGeber_Roh_Neu_ns / 10 ^ 9
objJustageWerte(EinbauplatzNr).FP_QOffset1 = udtUSParameter(EinbauplatzNr).Offset_Neu1_m3ph
objJustageWerte(EinbauplatzNr).FP_QOffset2 = udtUSParameter(EinbauplatzNr).Offset_Neu2_m3ph
objJustageWerte(EinbauplatzNr).FP_ST_Geber = udtUSParameter(EinbauplatzNr).SteilheitGeber_nsp°C / 10 ^ 9
objJustageWerte(EinbauplatzNr).DatumVorpruefung = Now()
' Die eigentliche Berechnung der Justage ist etwas später
objJustageWerte(EinbauplatzNr).DatumJustage = Now()
' Die Offsets, die für diese Justage aus der Datenbank vorgegeben waren
objJustageWerte(EinbauplatzNr).Offset_Qp = udtUSParameter(EinbauplatzNr).Offset_Qp
objJustageWerte(EinbauplatzNr).Offset_Bereich = udtUSParameter(EinbauplatzNr).Offset_QBereich
objJustageWerte(EinbauplatzNr).Offset_Qmin = udtUSParameter(EinbauplatzNr).Offset_Qmin
' nach einer Vorprüfung alle Justage-Werte für OffsetJustage speichern
objJustageWerte(EinbauplatzNr).save
End If
Next
PrintStatus "***** Vorprüfung beendet ******"
Vorpruefung = 0
End Function
Private Function VorpruefungImPP(PPNr As Integer, udtPruefdaten_imPP_mitEBP() As TypUSPruefdaten) As Long
Dim QIst As Double
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim dblTemperatur As Double
Dim EinbauplatzNr As Integer
Dim Identitaetsnummer As Long
Dim comport As Integer
Dim lngRet As Long
Dim QIstSPS As Double
Dim blnPruefungFertig As Boolean
Dim dblVolumenWaage As Double
Dim dblVolumenRZ As Double
Dim lngReturn As Long
Dim dblVolumenUS As Double
Dim Fehler As Double
Dim SteilheitGeber_nsp(10) As Double
' muss gesetzt sein
' m_vorPruefpunkt
m_SPS.setBetrieb 0
Sleep 1000
m_DurchflussSoll = m_vorPruefpunkt.getQ
lblQSoll.caption = m_DurchflussSoll
' Pumpe, MID, Regelart
Call initSPSfuerPP
Call DurchflussLstAktualisieren
DoEvents
Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
If Not g_ohneSPS Then
lblFehlerRZ.caption = Format(m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur), "0.00")
End If
PrintStatus "Neuer Prüfpunkt: " & m_DurchflussSoll
If m_VorPruefungsArtWaage = True Then
''''''''''''''''''''''''''''''' W A A G E A N F A N G ''''''''''''''''''''''''''''''''''''
'Call initSPSfuerWaage
If WaageVorbereitenFuerPP() < 0 Then
VorpruefungImPP = -1
Exit Function
End If
PrintStatus "Warten auf Prüfbereitschaft der Strecke"
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
Exit Function
End If
Loop
dblTemperatur = m_SPS.GetEinlaufTemperatur
PrintStatus "Temperatur: " & Format(dblTemperatur, "0.00") & " °C"
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
' Pruefzaehler ist eingebaut
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If (Pruefzaehler.getVorpruefpunkte.hasQ(m_DurchflussSoll) = True) Then
Call FW2_USSetTemperatur(Einbauplatz, dblTemperatur)
PrintStatus "Temperatur in den Zähler schreiben an Einbauplatz " & Einbauplatz.getNr
End If
End If
End If
Next
' US Messung starten
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
' Pruefzaehler ist eingebaut
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If (Pruefzaehler.getVorpruefpunkte.hasQ(m_DurchflussSoll) = True) Then
MSFlexGrid1.row = Einbauplatz.getNr
MSFlexGrid1.col = 0
MSFlexGrid1_AnzeigeSerienNrFabNr Einbauplatz.getPruefzaehler
''MSFlexGrid1.text = FormatSerienNr(Einbauplatz.getPruefzaehler.getSerienNr)
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).dblTemperatur = dblTemperatur
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_vorPruefpunkt.GetTime
'If FW2_StarteUSundRZZaehler(Einbauplatz) = 0 Then
If FW2_Starte_NOWA(Einbauplatz) = 0 Then
PrintStatus "NOWA_START für Einbauplatz " & Einbauplatz.getNr & " OK"
Else
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).blnPruefungsfehler = True
udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo = "NOWA_START für Einbauplatz " & Einbauplatz.getNr & " fehlgeschlagen."
PrintStatus "NOWA_START für Einbauplatz " & Einbauplatz.getNr & " fehlgeschlagen."
If Err.Number <> 0 Then
PrintStatus "Fehler " & Err.Number & " :" & Err.Description
End If
End If
Else
PrintStatus "Warnung: Prüfzähler am Einbauplatz " & Einbauplatz.getNr & " enthält nicht den Vorprüfpunkt Q=" & m_DurchflussSoll
End If
End If
End If
Next
Call initSPSfuerPP
m_SPS.setBetrieb 2
PrintStatus "Pumpe gestartet"
m_Tstart = GetTickCount
Do While Not ((m_Pumpe.GetStatus And 4) = 4)
DoEvents
If g_Abbruch = True Then
Exit Function
End If
Loop
PrintStatus "Pumpe läuft"
QIstSPS = 0
blnPruefungFertig = False
' Waagen SPS-Grenzwert abwarten
Do While Not blnPruefungFertig
If m_SPS.GrenzwertWaageErreicht Then
blnPruefungFertig = True
Else
If QIstSPS = 0 And (GetTickCount - m_Tstart) \ 1000 > m_Pruefzeit \ 2 Then
QIstSPS = m_SPS.getQIst
PrintStatus "IstDurchfluss zur halben Prüfzeit: " & Format(QIstSPS, "0.000") & " m³/h"
End If
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
lblGewicht.caption = Format(m_Waage.GetGewicht, "0.000")
Sleep 500
End If
AnzeigeAktualisieren
If mblnExternalTemperatur And (GetTickCount - m_Tstart) \ 1000 < Int(m_Pruefzeit - 30) Then
' nicht in den letzten 30 sekunden
UpdateTemperaturInZaehlerFW2
End If
Sleep 100
DoEvents
If g_Abbruch Then Exit Function
Loop
' Prüfzeit messen/stoppen in s BEVOR die Waage beruhigt wird
m_Tpruef = (GetTickCount - m_Tstart) \ 1000
PrintStatus "Waagen-Grenzwert erreicht nach " & m_Tpruef & " sec."
' Wasser stoppen
m_SPS.setBetrieb 0
m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert, m_Behaelter.m_Genauigkeit
' Waagenruhe abwarten
PrintStatus "Warte auf Waagenruhe"
'm_Waage.WarteAufRuhe
m_Behaelter.WarteAufRuhe
' Referenz-Volumen aus Waagen-Gewicht ermitteln
dblVolumenWaage = Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, dblTemperatur) ' in m³
PrintStatus "VolumenWaage: " & Format(dblVolumenWaage, "0.000") & " m³"
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
''lngReturn = FW2_StoppeUSundRZZaehler(Einbauplatz)
lngReturn = FW2_Stoppe_NOWA(Einbauplatz)
If lngReturn = 0 Then
'PrintStatus "RZ-STOP und NOWA_STOP OK"
PrintStatus "NOWA_STOP OK"
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).RZ_IstPruefzeit_ms = m_Tpruef * 1000
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms = m_Tpruef * 1000
' 'Die NOWA_PUEFZEIT ist zu lang und kann hier nicht genommen werden. Damit würden wir den Durchfluss zu niedrig berechnen
' Call FW2_GetUS_NOWA_Zeit(Einbauplatz, udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms)
' PrintStatus "NOWA Prüfzeit=" & udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).US_IstPruefzeit_ms & " ms"
Else
'PrintStatus "RZ-STOP und NOWA_STOP Fehler:" & lngReturn
PrintStatus "NOWA_STOP Fehler:" & lngReturn
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).blnPruefungsfehler = True
End If
End If ' PZ is nothing and GetActive
Next Einbauplatz
' Volumen aus US Zaehler lesen
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
dblVolumenUS = 0
lngReturn = FW2_GetUSVolumen(Einbauplatz, dblVolumenUS)
If dblVolumenUS = 0 Then
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).blnPruefungsfehler = True
End If
PrintStatus "Volumen des US: " & dblVolumenUS & " m³"
Fehler = (dblVolumenUS - dblVolumenWaage) / dblVolumenWaage * 100
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).VolumenWaage = dblVolumenWaage
End If
Next
Debug.Print
''''''''''''''''''''''''''''''' W A A G E E N D E ''''''''''''''''''''''''''''''''''''''''
Else
''''''''''''''''''''''''''''''' V E R G L E I C H ''''''''''''''''''''''''''''''''''''''''
Call initSPSfuerDurchlauf
' If mbln_ZeroFlowMessung = True And PPNr = 1 Then
' Setze_FP_St_GeberKonstanteZeroflow SteilheitGeber_nsp()
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' EinbauplatzNr = Einbauplatz.getNr
' If Not Pruefzaehler Is Nothing Then
' comport = g_App.Settings.getUSComPort(EinbauplatzNr)
' If SteilheitGeber_nsp(EinbauplatzNr) <> 0 Then
' PrintStatus "Einbauplatz " & EinbauplatzNr & " SteilheitGeber=" & Format(SteilheitGeber_nsp(EinbauplatzNr) * 1000000000, "0.00000") & " ns/'C"
'
' udtPruefdaten_imPP_mitEBP(EinbauplatzNr).JustageParameter.SteilheitGeber_nsp°C = SteilheitGeber_nsp(EinbauplatzNr)
' lngReturn = modIECCOM.SetOffsetAndGeberAndBereich(comport, udtPruefdaten_imPP_mitEBP(EinbauplatzNr).JustageParameter)
' End If
' End If
' Next
' End If
' Vergleichsprüfung gegen RefZ.: Betrieb starten
m_SPS.setBetrieb 2
' auf konsten Durchfluß warten
PrintStatus "Warten auf Solldurchfluß erreicht..."
If Not g_ohneSPS Then
Do While Not m_SPS.SolldurchflussErreicht
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
Sleep 500, True
If g_Abbruch = True Then
Exit Function
End If
Loop
End If
' ' Durchflußanzeige RefIstWert korrigiert
If Not g_ohneSPS Then
QIst = m_SPS.getQIst
Else
QIst = 99
End If
PrintStatus "Solldurchfluss erreicht bei Q=" & Format(QIst, "0.000")
lblQIst.caption = Format(QIst, "0.000")
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
' Pruefzaehler ist eingebaut
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If (Pruefzaehler.getVorpruefpunkte.hasQ(m_DurchflussSoll) = True) Then
MSFlexGrid1.row = Einbauplatz.getNr
MSFlexGrid1.col = 0
MSFlexGrid1_AnzeigeSerienNrFabNr Einbauplatz.getPruefzaehler
''MSFlexGrid1.text = FormatSerienNr(Einbauplatz.getPruefzaehler.getSerienNr) & " F:" & Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
AutoSpaltenBreite MSFlexGrid1, lblAutosize
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_vorPruefpunkt.GetTime
Else
PrintStatus "Warnung: Prüfzähler am Einbauplatz " & Einbauplatz.getNr & " enthält nicht den Vorprüfpunkt Q=" & m_DurchflussSoll
End If
End If
End If
Next
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
Else
dblTemperatur = 21.99
End If
Call UltraschallPruefung(udtPruefdaten_imPP_mitEBP())
For EinbauplatzNr = 1 To g_App.Settings.EinbauplaetzeJeStrang
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo <> "" Then
PrintStatus "Fehler bei der Vorprüfung:" & udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo = ""
End If
Next EinbauplatzNr
DoEvents
If g_Abbruch Then
Exit Function
End If
' Wasser stoppen
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
''''''''''''''''''''''''''''''' V E R G L E I C H E N D E '''''''''''''''''''''''''''''''''''
End If
End Function
'Private Function Bereichsjustage() As Long
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
' Dim USVolumen As Double
' Dim RefVolumen As Double
' Dim PPNr As Integer
' Dim EinbauplatzNr As Integer
' Dim dblFehler As Double
' Dim lngReturn As Long
' Dim lngError As Long
' Dim Identitaetsnummer As Long
' Dim QIst As Double
' Dim dblTemperatur As Double
' Dim RefZFehler As Double
'
' Dim lngUSPruefZeit_ms As Long
' Dim lngRZPruefZeit_ms As Long
'
' Dim Fehler As Double
' Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
' Dim udtPruefdaten_Bereichsgrenze(10) As TypUSPruefdaten
'
' Dim ComPort As Integer
' Dim lngRet As Long
'
' Dim udtUSParameter(10) As JustageParameter_Type
' Dim udtUSZusatzParameter(10) As US_ZusatzParameter_Typ
'
' Set m_Referenzzaehler = New CRefzaehler
'
'
' ' 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 Function
' End If
' GoTo TestAutomatik
' End If
'
' If Not m_SPS.IstStreckePruefbereit Then
' ' Betrieb Vorbereiten
' m_SPS.setBetrieb 1
'
' PrintStatus "Betrieb vorbereiten: Spannen und Füllen..."
' Do While Not m_SPS.IstStreckeGefuellt
' Sleep 1000, True
' If g_Abbruch = True Then
' Exit Function
' End If
' Loop
' ' nach dem Füllen: Betrieb auf 0
' Sleep 500
' m_SPS.setBetrieb 0
'
' '------------------------------------------------------------------------
'
' PrintStatus "Warte auf Pruefbereitschaft der SPS..."
' Do While Not m_SPS.IstStreckePruefbereit
' Sleep 1000, True
' If g_Abbruch = True Then
' Exit Function
' End If
' Loop
' End If ' Pruefbereit
' PrintStatus "Strecke ist Prüfbereit !"
'
' PrintStatus "***** Bereichsjustage ******"
'
'
'' Justage Zählerdaten bestimmen
'
'
' PPNr = 0
' m_colUniqueVorPP.sortQ
'
'
' '''''''''''''''''''''''' Prüfpunkt bei Q2 ''''''''''''''''''''''
' ' Qmax
' Set m_vorPruefpunkt = m_colUniqueVorPP.getCollection.Item(2)
' PPNr = 2
'
' m_DurchflussSoll = m_vorPruefpunkt.getQ
' m_Pruefzeit = m_vorPruefpunkt.GetTime
'
' m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6
' PrintStatus "geschätztes Soll-Volumen in Litern: " & m_VolumenSoll
' lblSollV.Caption = Format(m_VolumenSoll, "0")
'
' Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
' m_SPS.SetQDiff 0 'm_Referenzzaehler.letzterFehler(m_DurchflussSoll)
'
'
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' EinbauplatzNr = Einbauplatz.getNr
' ComPort = g_App.Settings.getUSComPort(EinbauplatzNr)
'
' ' Die sieben Justage Parameter aus Zähler lesen
' ' Geberkonstante1_IST_m
' ' Geberkonstante2_IST_m
' ' SteilheitGeber_nsp°C
' ' OffsetGeber_ns
' If modIECCOM.GetOffsetAndGeberAndBereich(ComPort, udtUSParameter(Einbauplatz.getNr)) <> 0 Then
'
' ' leider überschreibt GetOffsetAndGeberAndBereich die Offset_Qmin, Offset_QBereich, Offset_Qp, also nochmal aus DB lesen
' udtUSParameter(Einbauplatz.getNr).Offset_Qmin = Pruefzaehler.getVorpruefpunkte.getOffset_Qmin
' udtUSParameter(Einbauplatz.getNr).Offset_QBereich = Pruefzaehler.getVorpruefpunkte.getOffset_QBereich
' udtUSParameter(Einbauplatz.getNr).Offset_Qp = Pruefzaehler.getVorpruefpunkte.getOffset_Qp
'
' MsgBox "GetOffsetAndGeberAndBereich konten nicht ausgelesen werden. Bereichsjustage wird abgebrochen."
' Bereichsjustage = -1
' Exit Function
' Else
'
' ' leider überschreibt GetOffsetAndGeberAndBereich die Offset_Qmin, Offset_QBereich, Offset_Qp, also nochmal aus DB lesen
' udtUSParameter(Einbauplatz.getNr).Offset_Qmin = Pruefzaehler.getVorpruefpunkte.getOffset_Qmin
' udtUSParameter(Einbauplatz.getNr).Offset_QBereich = Pruefzaehler.getVorpruefpunkte.getOffset_QBereich
' udtUSParameter(Einbauplatz.getNr).Offset_Qp = Pruefzaehler.getVorpruefpunkte.getOffset_Qp
'
' Call ShowUSParameter(udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "Justage Parameter aus Zähler gelesen:", Einbauplatz.getNr)
' End If
' End If
' Next
'
' PrintStatus "Vorprüfung im Vorprüfpunkt 2:"
'
' lngRet = VorpruefungImPP(PPNr, udtPruefdaten_imPP_mitEBP())
' If lngRet = -1 Then
' Exit Function
' End If
'
'
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' EinbauplatzNr = Einbauplatz.getNr
' ComPort = g_App.Settings.getUSComPort(EinbauplatzNr)
'
' If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).blnPruefungsfehler = False Then
'
' ' Volumen bestimmen
' Call GetRZVolumen(EinbauplatzNr, m_Referenzzaehler, RefVolumen)
' PrintStatus "RZ Volumen [m³]:" & RefVolumen
' PrintStatus "Fehler des RZ in diesem Prüfpunkt: " & Format(m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur), "0.0")
' RefVolumen = RefVolumen / (1 + m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur) / 100)
'
' PrintStatus "Ist-Volumen:" & RefVolumen
'
' Call GetUSVolumen(EinbauplatzNr, USVolumen)
' PrintStatus "US Volumen [m³]:" & Format(USVolumen, "0.0000")
'
' If USVolumen = 0 Then
' MsgBox ("US Volumen ist 0")
' Bereichsjustage = -24
' Stop
' 'Exit Function
' End If
' If RefVolumen = 0 Then
' Stop
' MsgBox ("Ref. Volumen ist 0")
' Bereichsjustage = -25
' 'Exit Function
' End If
'
'
' MSFlexGrid1.row = Einbauplatz.getNr
' MSFlexGrid1.Col = PPNr
'
' lngUSPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms
' lngRZPruefZeit_ms = udtPruefdaten_imPP_mitEBP(EinbauplatzNr).RZ_IstPruefzeit_ms
'
' PrintStatus "US Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngUSPruefZeit_ms & " ms"
' PrintStatus "RZ Zähler Prüfzeit(" & EinbauplatzNr & ")= " & lngRZPruefZeit_ms & " ms"
'
' If Not lngUSPruefZeit_ms = 0 Then
' If Not lngUSPruefZeit_ms = 0 Then
' udtUSParameter(Einbauplatz.getNr).Istfluss1_m3ph = USVolumen / (lngUSPruefZeit_ms / 1000 / 60 / 60)
' udtUSParameter(Einbauplatz.getNr).Sollfluss1_m3ph = RefVolumen / (lngRZPruefZeit_ms / 1000 / 60 / 60)
' udtUSParameter(Einbauplatz.getNr).Temperatur1_°C = m_SPS.GetEinlaufTemperatur
'
' If Not m_VorPruefungsArtWaage Then
' ' mit den wahren Prüfzeiten korrigierter Fehler
' Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms)
' PrintStatus "Fehler = 100 * (USVolumen / lngUSPruefZeit_ms - RefVolumen / lngRZPruefZeit_ms) / (RefVolumen / lngRZPruefZeit_ms) =" & Format(Fehler, "0.00")
' Else
' Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen
' PrintStatus "Fehler = 100 * (USVolumen - RefVolumen) / RefVolumen =" & Format(Fehler, "0.00")
' End If
'
' udtUSParameter(Einbauplatz.getNr).Unlinearitaet = -Fehler
'
' MSFlexGrid1.text = Format(Fehler, "0.00")
' Else
' MsgBox ("US PP Zeit = 0 !")
' Bereichsjustage = -26
' Exit Function
' End If
' Else
' MsgBox ("RZ PP Zeit = 0 !")
' Bereichsjustage = -27
' Exit Function
' End If
'
' gudtUSParameter = udtUSParameter(EinbauplatzNr)
' ShowUSParameter gudtUSParameter, udtUSZusatzParameter(EinbauplatzNr), "Justage Parameter vor Bereichs Justage", Einbauplatz.getNr
'
' 'Eingefügt provisorisch am 18.08.02
' modUS2000_Algorithmen.Justage_Execute
'
' ShowUSParameter gudtUSParameter, udtUSZusatzParameter(EinbauplatzNr), "Justage Parameter nach Bereichs Justage", Einbauplatz.getNr
' udtUSParameter(EinbauplatzNr) = gudtUSParameter
' Else
' PrintStatus "Einbauplatz " & EinbauplatzNr & " konnte nicht justiert werden"
' PrintStatus udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo
' udtPruefdaten_imPP_mitEBP(EinbauplatzNr).Fehlerinfo = ""
' End If
' End If ' Pruefzaehler is nothing
' Next Einbauplatz
'
'
' PrintStatus "SetOffsetAndGeberAndBereich f.a. Zähler"
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' EinbauplatzNr = Einbauplatz.getNr
' ComPort = g_App.Settings.getUSComPort(EinbauplatzNr)
'
' If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).blnPruefungsfehler = False Then
' lngRet = modIECCOM.SetOffsetAndGeberAndBereich(ComPort, udtUSParameter(Einbauplatz.getNr))
' If lngRet <> 0 Then
' DebugMsg ("SetOffsetAndGeberAndBereich für Einbauplatz " & EinbauplatzNr & " gab Fehler " & lngRet & " zurück")
' Bereichsjustage = -29
' Stop
' End If
' Else
' PrintStatus "SetOffsetAndGeber für Einbauplatz " & EinbauplatzNr & " nicht erfolgt"
' End If
'
' End If ' Pruefzaehler is nothing
' Next Einbauplatz
'
'
' PrintStatus "***** Bereichs-Justage beendet ******"
'
'End Function
Private Sub AnzeigeAktualisieren()
lblZeit.caption = (GetTickCount - m_Tstart) \ 1000 & "/" & m_Pruefzeit
If Not g_ohneSPS Then
lblQIst = Format(m_SPS.getQIst, "0.000")
End If
Dim dummy As Variant
dummy = MesseWasserdruck()
If dummy >= 0 Then
lblWasserdruck.caption = Round(dummy, 2)
Else
lblWasserdruck.caption = ""
End If
End Sub
Private Sub AnzeigeAktualisieren_mit_Waage()
lblZeit.caption = (GetTickCount - m_Tstart) \ 1000 & "/" & m_Pruefzeit
lblQIst = Format(m_SPS.getQIst, "0.000")
If m_PruefungsArtWaage Then
lblGewicht.caption = Format(m_Waage.GetGewicht, "0.00")
End If
dummy = MesseWasserdruck()
If dummy >= 0 Then
lblWasserdruck.caption = Round(dummy, 2)
Else
lblWasserdruck.caption = ""
End If
End Sub
'Private Sub KontinuierlichePruefung()
'Dim altePumpeNr As Integer
'Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
'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 blnFertig As Boolean
'Dim ResultFilePath As String
'Dim ResultFileHandle As Long
'Dim QIstSPS As Double
'Dim QFlow_fp As Double
'Dim Fehler As Double
'Dim bBetriebNeustart As Boolean
'
'
' Set m_Referenzzaehler = New CRefzaehler
'
' m_SPS.setBetrieb 0
' sleep 2000
'
'
' ResultFilePath = "C:\kont.txt"
' On Error Resume Next
' Kill ResultFilePath
' On Error GoTo 0
'
'
' ResultFileHandle = FreeFile()
' Open ResultFilePath For Append As ResultFileHandle
'
' Print #ResultFileHandle, "Ergebnisse der Kontinuierlichen Prüfung"
' If m_PruefungsArtWaage Then
' Print #ResultFileHandle, "gegen Waage"
' Else
' Print #ResultFileHandle, "gegen Referenzzähler"
' End If
' Print #ResultFileHandle, ""
'
' Print #ResultFileHandle, "EinbauplatzNr" & vbTab & "DurchflussSoll" & vbTab & "QIstSPS" & vbTab & "Fehler" & vbTab & "Prüfzeit" & vbTab & "MID/Pumpe"
' Close #ResultFileHandle
'
' m_DurchflussSoll = CDbl(txtFlowMax.Text)
'
' Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
' m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
'
' ' Pumpenauswahl
' m_SPS.AllePumpenAbwaehlen
' Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen)
' m_Pumpe.Anwahl
'
' ' Durchlauf auswählen
' m_SPS.setBehaelter 1
'
' bBetriebNeustart = True
'
' Do
' PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll
' m_SPS.SetQSoll m_DurchflussSoll
' lblQSoll.Caption = m_DurchflussSoll
'
' If Not m_Referenzzaehler.IstOkFuerDurchfluss(m_DurchflussSoll) Then
' m_SPS.SetQSoll 0
' sleep 5000
'
' m_SPS.setBetrieb 0
' sleep 2000
'
' Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
' m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
' bBetriebNeustart = True
' End If
'
' If Not m_Pumpe.IstOkFuerDurchfluss(m_DurchflussSoll) Then
' m_SPS.SetQSoll 0
' sleep 5000
'
' m_SPS.setBetrieb 0
' sleep 2000
'
'
' ' Pumpenauswahl
' m_SPS.AllePumpenAbwaehlen
' Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen)
' m_Pumpe.Anwahl
' PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname
'
' bBetriebNeustart = True
'
' End If
'
' If bBetriebNeustart = True Then
'
' m_SPS.SetServoStellung lookupFUServoStellwert(m_DurchflussSoll)
' m_SPS.SetQSoll m_DurchflussSoll
' lblQSoll.Caption = m_DurchflussSoll
'
' 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 = Format(m_SPS.getQIst, "0.000")
' lblQIst.Caption = QIstSPS
' sleep 500, True
' If g_Abbruch = True Then
' Exit Sub
' End If
' Loop
' sleep 2000
'
'
' ' Prüfzeit in s ausrechnen
' m_Pruefzeit = 240 / m_DurchflussSoll
' If m_Pruefzeit < 60 Then
' m_Pruefzeit = 60
' End If
'
'
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' EinbauplatzNr = Einbauplatz.getNr
'
'
' If Not Pruefzaehler Is Nothing Then
'
' udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
' udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_Pruefzeit
'
' End If
' Next
' DoEvents
'
' m_Tstart = GetTickCount
' QIstSPS = Format(m_SPS.getQIst, "0.000")
' lngReturn = UltraschallPruefung(udtPruefdaten_imPP_mitEBP)
'
' ' lngReturn = 0
'
' If lngReturn = 0 Then
' ' Fehlerermittlung
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' EinbauplatzNr = Einbauplatz.getNr
'
' If Not Pruefzaehler Is Nothing Then
' lngReturn = GetUSVolumen(EinbauplatzNr, dblVolumenUS, Einbauplatz.getPruefzaehler.getSerienNr) And 0
' If lngReturn = 0 Then
' PrintStatus "Volumen des USZ: " & dblVolumenUS & " m³"
' lngReturn = GetRZVolumen(EinbauplatzNr, m_Referenzzaehler, dblVolumenRZ)
' If lngReturn = 0 Then
'
' PrintStatus "Volumen des RZ: " & dblVolumenRZ & " m³"
' dblVolumenRZ = dblVolumenRZ / (1 + m_Referenzzaehler.letzterFehler(m_DurchflussSoll) / 100)
' PrintStatus "Fehler des RZ in diesem PP:" & m_Referenzzaehler.letzterFehler(m_DurchflussSoll)
' PrintStatus "korrigiertes Volumen: " & dblVolumenRZ & " m³"
'
'
' ' unterschiedliche Prüfzeiten eliminieren
' DurchflussRZ = dblVolumenRZ / udtPruefdaten_imPP_mitEBP(EinbauplatzNr).RZ_IstPruefzeit_ms
' DurchflussUS = dblVolumenUS / udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms
'
' 'Simulation
' 'DurchflussRZ = m_DurchflussSoll
' 'DurchflussUS = DurchflussRZ * (1 + (Rnd(1) * 0.1 - 0.05))
'
' PrintStatus "US Durchfluss: " & DurchflussUS
' PrintStatus "Ist-Durchfluss: " & DurchflussRZ
'
' Fehler = ((DurchflussUS - DurchflussRZ) / DurchflussRZ) * 100
' PrintStatus "ergibt Fehler: " & Format(Fehler, "0.0") & " %"
'
' ResultFileHandle = FreeFile()
' Open ResultFilePath For Append As ResultFileHandle
'
' Print #ResultFileHandle, EinbauplatzNr & vbTab & Format(m_DurchflussSoll, "0.000") & vbTab & Format(QIstSPS, "0.000") & vbTab & Format(Fehler, "0.00") & vbTab & m_Pruefzeit & vbTab & "MID" & m_Referenzzaehler.Nennweite & "," & m_Pumpe.GetSPSVarname
' Close #ResultFileHandle
' Else
' PrintStatus " GETRZVolumen Fehlfunktion:" & lngReturn
' End If
' Else
' PrintStatus " GETUSVolumen Fehlfunktion:" & lngReturn
' End If
' End If
' Next
' End If ' UltraschallPruefung
'
' ' Durchfluss ändern
' m_DurchflussSoll = CDbl(Format(m_DurchflussSoll * 0.9, "0.000"))
'
' If m_DurchflussSoll < CDbl(txtFlowMin) Then
' blnFertig = True
' End If
'
' Loop While Not blnFertig
'
' PrintStatus "Kontinuierliche Prüfung beendet"
'End Sub
Private Sub KontinuierlichePruefungWaage()
Dim altePumpeNr As Integer
Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
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 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 strMsg As String
strMsg = "Die kontinuierliche Prüfung ist kaum getestet und erhebt noch keinen Anspruch auf richtige Ergnisse." & vbCrLf
strMsg = strMsg & "Die Prüfzeiten (und Prüfvolumen) sind abhängig vom Durchfluss und der Nennweite und optimiert für die kontinuerliche Prüfung gegen Referenzzähler!"
strMsg = strMsg & "t = V / Q mit V(NW 50)=100 l,V(NW 65)=160 l, V(NW 80)=250 l,V(NW 100)=400 l, sonst V=500. Mit 60s <= t <= 1100s!"
MsgBox strMsg
PrintStatus strMsg
m_SPS.setBetrieb 0
Sleep 2000
lblGesZeit.Visible = False
Set m_Referenzzaehler = New CRefzaehler
If g_Abbruch Then
Exit Sub
End If
PrintStatus "kontinuierliche Prüfung von FW2 US Zählern gegen " & IIf(m_PruefungsArtWaage, "Waage", "Referenzzähler") & " wurde gestartet."
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
Set m_Referenzzaehler = New CRefzaehler
Call m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe)
m_SPS.SetQDiff 0 ' m_Referenzzaehler.letzterFehler(m_DurchflussSoll)
Do
PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll
Debug.Print m_ersterPruefzaehler.getIdentNrObj.getNennweite
'geändert am 22.01.2004 AP
Select Case m_ersterPruefzaehler.getIdentNrObj.getNennweite
Case 50
PrintStatus "Prüfvolumen=100 l"
m_Pruefzeit = 100 / m_DurchflussSoll
Case 65
PrintStatus "Prüfvolumen=160 l"
m_Pruefzeit = 160 / m_DurchflussSoll
Case 80
PrintStatus "Prüfvolumen=250 l"
m_Pruefzeit = 250 / m_DurchflussSoll
Case 100
PrintStatus "Prüfvolumen=400 l"
m_Pruefzeit = 400 / m_DurchflussSoll
Case Else
'Falls neue Nennweiten geprüft werden sollten
PrintStatus "Prüfvolumen=500 l"
m_Pruefzeit = 500 / m_DurchflussSoll
End Select
' RH wieder entfernt 22.5.2008
' 'RH 21.5.2008,
' m_Pruefzeit = 900 / m_DurchflussSoll
' 'neu RH 21.5.2008: Die Prüfzeit soll 120 Sekunden nie unterschreiten
' If m_Pruefzeit <= 120 Then
' m_Pruefzeit = 120
' End If
' 'neu UD RH 21.5.2008
' If m_Pruefzeit >= 720 Then
' m_Pruefzeit = 720
' End If
'Die Prüfzeit soll 60 Sekunden nie unterschreiten
If m_Pruefzeit <= 60 Then
m_Pruefzeit = 60
End If
'neu am 21.01.2004 AP die Prüfzeit soll 1100 Sekunden nicht überschreiten
If m_Pruefzeit >= 1100 Then
m_Pruefzeit = 1100
End If
PrintStatus "Prüfzeit: " & m_Pruefzeit
' 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
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
bBetriebNeustart = True
End If
If Not m_Pumpe.IstOkFuerDurchfluss(m_DurchflussSoll) Then
' Pumpe wechseln
PrintStatus "Pumpe wechseln"
If Not m_PruefungsArtWaage Then
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
bBetriebNeustart = True
End If
' hier gehts los, Pumpe und MID sind eingestellt
If m_PruefungsArtWaage Then
' da WaageVorbereitenFuerPP nicht mehr zuwiegt
Call BeideBehaelterLeeren
' Waage soweit wie nötig füllen und leeren, Grenzwert setzen
If WaageVorbereitenFuerPP() < 0 Then
' Änderung 9.9.2002
GoTo NextDurchfluss
End If
Else
' Durchlauf (kein Beählter) auswählen
m_SPS.setBehaelter 1
m_SPS.SetQSoll m_DurchflussSoll
lblQSoll.caption = m_DurchflussSoll
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
m_SPS.SetQSoll m_DurchflussSoll
lblQSoll.caption = m_DurchflussSoll
If bBetriebNeustart = True Then
m_SPS.SetServoStellung lookupFUServoStellwert(m_DurchflussSoll)
' Pumpe starten
m_Pumpe.Anwahl
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
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 500, True
If g_Abbruch = True Then
Exit Sub
End If
Loop
'sleep 2000
End If ' keine Waage
' Wenn keine Waage: Wasser läuft
' Wenn Waage: Wasser läuft nicht, Waage tariert
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
EinbauplatzNr = Einbauplatz.getNr
If Not Pruefzaehler Is Nothing Then
' OptoTimer reset
'Call USSetOptoOffTimerMax(Einbauplatz.getNr)
' Pruefdaten setzen für Ultraschallprüfung
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_Pruefzeit
End If
Next
DoEvents
Temperatur = m_SPS.GetEinlaufTemperatur
If m_PruefungsArtWaage Then
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
EinbauplatzNr = Einbauplatz.getNr
If Not Pruefzaehler Is Nothing Then
If mblnExternalTemperatur Then
lngReturn = FW2_USSetTemperatur(Einbauplatz, Temperatur)
lblTemperatur.caption = Format(Temperatur, "0.0")
If lngReturn = 0 Then
PrintStatus "USSetTemperatur OK"
Else
PrintStatus "USSetTemperatur Fehler" & lngReturn
End If
End If
lngReturn = FW2_StarteUSundRZZaehler(Einbauplatz)
If lngReturn = 0 Then
PrintStatus "RZ-START und NOWA_START OK"
Else
PrintStatus "RZ-START und NOWA_START Fehler:" & lngReturn
End If
End If
Next
' Waage virtuell tarieren
m_Waage.SoftTara
PrintStatus "Soft Taragewicht=" & m_Waage.SoftTaraGewicht & " kg"
PrintStatus "Nettogewicht=" & m_Waage.GetGewicht & " kg (sollte = 0 sein)"
lblGewicht.caption = Format(m_Waage.GetGewicht, "0.00") ' sollte 0 sein
' Prüfung starten
m_SPS.AllePumpenAbwaehlen
m_Pumpe.Anwahl
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
m_SPS.SetRegelart m_Pumpe.GetRegelart
m_SPS.SetServoStellung lookupFUServoStellwert(m_DurchflussSoll, m_Pumpe.GetRegelart)
m_SPS.SetQSoll m_DurchflussSoll
m_SPS.setBetrieb 2
m_Tstart = GetTickCount
PrintStatus "Pumpe gestartet"
Do While Not ((m_Pumpe.GetStatus And 4) = 4)
Sleep 500, True
If g_Abbruch = True Then
Exit Sub
End If
Loop
PrintStatus "Pumpe läuft: (PT_P" & m_Pumpe.getNr & "Status=4)"
' Prüfung startet
lblGewicht.caption = m_Waage.GetGewicht
QIstSPS = 0
blnPruefungFertig = False
Do While Not blnPruefungFertig
If m_SPS.GrenzwertWaageErreicht Then
blnPruefungFertig = True
Else
If QIstSPS = 0 And (GetTickCount - m_Tstart) \ 1000 > m_Pruefzeit \ 2 Then
QIstSPS = m_SPS.getQIst
PrintStatus "IstDurchfluss zur halben Prüfzeit: " & Format(QIstSPS, "0.00") & " m³/h"
End If
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
lblGewicht = m_Waage.GetGewicht
Sleep 500
End If
AnzeigeAktualisieren_mit_Waage
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_Tstart) \ 1000
m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert
PrintStatus "Warte auf Waagenruhe"
m_Behaelter.WarteAufRuhe
PrintStatus "Temperatur=" & Round(Temperatur, 2) & " °C"
PrintStatus "Gewicht=" & m_Waage.GetGewicht & " kg"
PrintStatus "wegen SoftTara sind abzüglich " & m_Waage.SoftTaraGewicht & " kg enthalten."
'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
lngReturn = FW2_StoppeUSundRZZaehler(Einbauplatz)
If lngReturn = 0 Then
PrintStatus "RZ-STOP und NOWA_STOP OK"
Else
PrintStatus "RZ-STOP und NOWA_STOP Fehler:" & lngReturn
End If
End If ' PZ is nothing and GetActive
Next Einbauplatz
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
lngReturn = FW2_GetUSVolumen(Einbauplatz, dblVolumenUS)
PrintStatus "Volumen des US: " & dblVolumenUS & " m³"
PrintStatus "Fehler = (dblVolumenUS - dblVolumenWaage) / dblVolumenWaage * 100"
Fehler = (dblVolumenUS - dblVolumenWaage) / dblVolumenWaage * 100
PrintStatus "ergibt Fehler: " & Format(Fehler, "0.0") & " %"
saveKontPrueffehler Fehler, QIstSPS, dblVolumenUS, dblVolumenRZ, dblVolumenWaage, EinbauplatzNr, Temperatur, m_Tpruef, Einbauplatz.getPruefzaehler.getSerienNr
'auskommentiert am 29.08.02 Pfeiffer
'ResultFileHandle = FreeFile()
'Open ResultFilePath For Append As ResultFileHandle
' Print #ResultFileHandle, EinbauplatzNr & vbTab & Format(m_DurchflussSoll, "0.000") & vbTab & Format(QIstSPS, "0.000") & vbTab & Format(Fehler, "0.00") & vbTab & m_Tpruef & vbTab & "MID" & m_Referenzzaehler.Nennweite & "," & m_Pumpe.GetSPSVarname & vbTab & Format(dblVolumenUS, "0.00000") & vbTab & Format(dblVolumenWaage, "0.00000")
' Close #ResultFileHandle
End If
Next
Else
' keine Waage
Sleep 1000
QIstSPS = Format(m_SPS.getQIst, "0.000")
lngReturn = UltraschallPruefung(udtPruefdaten_imPP_mitEBP)
If g_Abbruch Then
Exit Sub
End If
If lngReturn = 0 Then
' Fehlerermittlung
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
EinbauplatzNr = Einbauplatz.getNr
If Not Pruefzaehler Is Nothing Then
lngReturn = FW2_GetUSVolumen(Einbauplatz, dblVolumenUS) 'And 0
If lngReturn = 0 Then
PrintStatus "Volumen des USZ: " & dblVolumenUS & " m³"
lngReturn = GetRZVolumen(EinbauplatzNr, m_Referenzzaehler, dblVolumenRZ) And 0
If lngReturn = 0 Then
PrintStatus "Volumen des RZ: " & dblVolumenRZ & " m³"
PrintStatus "Fehler des RZ in diesem PP:" & m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
dblVolumenRZ = dblVolumenRZ / (1 + m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur) / 100)
PrintStatus "korrigiertes Volumen:" & dblVolumenRZ & " m³"
' unterschiedliche Prüf-Zeiten elimienieren
DurchflussRZ = dblVolumenRZ / udtPruefdaten_imPP_mitEBP(EinbauplatzNr).RZ_IstPruefzeit_ms
If udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms = 0 Then
PrintStatus ".US_IstPruefzeit_ms = 0, dh. Fehler konnte nicht ermittelt werden"
Else
DurchflussUS = dblVolumenUS / udtPruefdaten_imPP_mitEBP(EinbauplatzNr).US_IstPruefzeit_ms
'Simulation
'DurchflussRZ = m_DurchflussSoll
'DurchflussUS = DurchflussRZ * (1 + (Rnd(1) * 0.1 - 0.05))
PrintStatus "US Durchfluss: " & DurchflussUS
PrintStatus "Ist-Durchfluss: " & DurchflussRZ
Fehler = ((DurchflussUS - DurchflussRZ) / DurchflussRZ) * 100
PrintStatus "ergibt Fehler: " & Format(Fehler, "0.0") & " %"
'Hier werden die Daten für die Prüfung gegen Referenzzähler angespeichert
saveKontPrueffehler Fehler, QIstSPS, dblVolumenUS, dblVolumenRZ, dblVolumenWaage, EinbauplatzNr, Temperatur, m_Tpruef, Einbauplatz.getPruefzaehler.getSerienNr
' ResultFileHandle = FreeFile()
' Open ResultFilePath For Append As ResultFileHandle
'
' Print #ResultFileHandle, EinbauplatzNr & vbTab & Format(m_DurchflussSoll, "0.000") & vbTab & Format(QIstSPS, "0.000") & vbTab & Format(Fehler, "0.00") & vbTab & m_Pruefzeit & vbTab & "MID" & m_Referenzzaehler.Nennweite & "," & m_Pumpe.GetSPSVarname
' Close #ResultFileHandle
End If
Else
PrintStatus " GETRZVolumen Fehlfunktion:" & lngReturn
End If
Else
PrintStatus "FW2_GETUSVolumen Fehlfunktion:" & lngReturn
End If
End If
Next
End If ' UltraschallPruefung
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
lblGesZeit.Visible = True
PrintStatus "Kontinuierliche Prüfung beendet"
End Sub
Private Sub KontinuierlichePruefungInit()
On Error Resume Next
Kill ResultFilePath
On Error GoTo 0
txtFlowMax = m_colUniqueVorPP.Item(1).getQ
txtFlowMin = m_colUniqueVorPP.Item(m_colUniqueVorPP.Count).getQ
'geändert am 22.01.2004 AP Vorbesetzung der ComboBox mit dem 2.Wert
cmbKontSprung.ListIndex = 2
lblTitle.caption = "kontinuierliche Ultraschall-Zähler Prüfung gegen " & IIf(m_PruefungsArtWaage, "Waage", "Referenzzähler")
End Sub
Public Sub cmdStart_Click()
If Not m_SPS.IstStreckePruefbereit Then
MsgBox "SPS: nicht Prüfbereit!"
Exit Sub
End If
If Not m_SPS.IstAutomatik Then
MsgBox "SPS: Bitte Automatik wählen"
Exit Sub
End If
Dim i As Integer
Dim Ende As Integer
m_Pruefgang.save
lblTitle.caption = "kontinuierliche Ultraschall-Zähler Prüfung"
Ende = CInt(txtKontCount.text)
For i = Ende To 1 Step -1
If g_Abbruch Then Exit Sub
txtKontCount.text = i
PrintStatus "kontinuierlicher Prüfgang " & Ende - i & "/" & Ende
cmdStart.Enabled = False
Call KontinuierlichePruefungWaage
cmdStart.Enabled = True
Set m_Pruefgang = Nothing
Set m_Pruefgang = New CPruefgang
m_Pruefgang.save
If g_Abbruch Then Exit Sub
Next
End Sub
Private Sub ShowUSParameter(udtUSJustageParameter As JustageParameter_Type, udtUSZusatzParameter As US_ZusatzParameter_Typ, sUeberschrift As String, EinbauplatzNr As Integer)
On Error Resume Next
PrintStatus "---------------------------------------------------------"
PrintStatus sUeberschrift
PrintStatus "---------------------------------------------------------"
PrintStatus "Einbauplatz : " & EinbauplatzNr
PrintStatus "---------------------------------------------------------"
If udtUSJustageParameter.Geberkonstante1_IST_m <> 0 Then
PrintStatus "Geberkonstante1_IST_m : " & Format(udtUSJustageParameter.Geberkonstante1_IST_m, "0.00000000000000000") & " m"
Else
PrintStatus "Geberkonstante1_IST_m : " & Format(udtUSJustageParameter.Geberkonstante1_IST_m, "") & " m"
End If
If udtUSJustageParameter.Geberkonstante_Neu1_m <> 0 Then
PrintStatus "Geberkonstante_Neu1_m : " & Format(udtUSJustageParameter.Geberkonstante_Neu1_m, "0.00000000000000000") & " m"
Else
PrintStatus "Geberkonstante_Neu1_m : " & Format(udtUSJustageParameter.Geberkonstante_Neu1_m, "") & " m"
End If
If udtUSJustageParameter.Geberkonstante2_IST_m <> 0 Then
PrintStatus "Geberkonstante2_IST_m : " & Format(udtUSJustageParameter.Geberkonstante2_IST_m, "0.00000000000000000") & " m"
Else
PrintStatus "Geberkonstante2_IST_m : " & Format(udtUSJustageParameter.Geberkonstante2_IST_m, "") & " m"
End If
If udtUSJustageParameter.Geberkonstante_Neu2_m <> 0 Then
PrintStatus "Geberkonstante_Neu2_m : " & Format(udtUSJustageParameter.Geberkonstante_Neu2_m, "0.00000000000000000") & " m"
Else
PrintStatus "Geberkonstante_Neu2_m : " & Format(udtUSJustageParameter.Geberkonstante_Neu2_m, "") & " m"
End If
If udtUSJustageParameter.Offset1_IST_m3ph <> 0 Then
PrintStatus "Offset1_IST_m3ph : " & Format(udtUSJustageParameter.Offset1_IST_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Offset1_IST_m3ph : " & Format(udtUSJustageParameter.Offset1_IST_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Offset_Neu1_m3ph <> 0 Then
PrintStatus "Offset_Neu1_m3ph : " & Format(udtUSJustageParameter.Offset_Neu1_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Offset_Neu1_m3ph : " & Format(udtUSJustageParameter.Offset_Neu1_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Offset2_IST_m3ph <> 0 Then
PrintStatus "Offset2_IST_m3ph : " & Format(udtUSJustageParameter.Offset2_IST_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Offset2_IST_m3ph : " & Format(udtUSJustageParameter.Offset2_IST_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Offset_Neu2_m3ph <> 0 Then
PrintStatus "Offset_Neu2_m3ph : " & Format(udtUSJustageParameter.Offset_Neu2_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Offset_Neu2_m3ph : " & Format(udtUSJustageParameter.Offset_Neu2_m3ph, "") & " m³/h"
End If
PrintStatus "---------------------------------------------------------"
If udtUSJustageParameter.Istfluss2_m3ph <> 0 Then
PrintStatus "Istfluss2_m3ph : " & Format(udtUSJustageParameter.Istfluss2_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Istfluss2_m3ph : " & Format(udtUSJustageParameter.Istfluss2_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Sollfluss2_m3ph <> 0 Then
PrintStatus "Sollfluss2_m3ph : " & Format(udtUSJustageParameter.Sollfluss2_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Sollfluss2_m3ph : " & Format(udtUSJustageParameter.Sollfluss2_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Istfluss2_m3ph > 0 And udtUSJustageParameter.Sollfluss2_m3ph > 0 Then
PrintStatus "Fehler Qnenn : " & Format((100 - (udtUSJustageParameter.Istfluss2_m3ph / udtUSJustageParameter.Sollfluss2_m3ph * 100)) * (-1), "0.##") & " %"
End If
If udtUSJustageParameter.Temperatur2_°C <> 0 Then
PrintStatus "Temperatur2_°C : " & Format(udtUSJustageParameter.Temperatur2_°C, "0.00000000000000000") & " °C"
Else
PrintStatus "Temperatur2_°C : " & Format(udtUSJustageParameter.Temperatur2_°C, "") & " °C"
End If
PrintStatus "---------------------------------------------------------"
If udtUSJustageParameter.Istfluss1_m3ph <> 0 Then
PrintStatus "Istfluss1_m3ph : " & Format(udtUSJustageParameter.Istfluss1_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Istfluss1_m3ph : " & Format(udtUSJustageParameter.Istfluss1_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Sollfluss1_m3ph <> 0 Then
PrintStatus "Sollfluss1_m3ph : " & Format(udtUSJustageParameter.Sollfluss1_m3ph, "0.00000000000000000") & " m³/h"
Else
PrintStatus "Sollfluss1_m3ph : " & Format(udtUSJustageParameter.Sollfluss1_m3ph, "") & " m³/h"
End If
If udtUSJustageParameter.Istfluss1_m3ph > 0 And udtUSJustageParameter.Sollfluss1_m3ph > 0 Then
PrintStatus "Fehler Qmin : " & Format((100 - (udtUSJustageParameter.Istfluss1_m3ph / udtUSJustageParameter.Sollfluss1_m3ph * 100)) * (-1), "0.##") & " %"
End If
If udtUSJustageParameter.Temperatur1_°C <> 0 Then
PrintStatus "Temperatur1_°C : " & Format(udtUSJustageParameter.Temperatur1_°C, "0.00000000000000000") & " °C"
Else
PrintStatus "Temperatur1_°C : " & Format(udtUSJustageParameter.Temperatur1_°C, "") & " °C"
End If
PrintStatus "---------------------------------------------------------"
PrintStatus "Bereich_ns : " & udtUSJustageParameter.Bereich_ns
If udtUSJustageParameter.OffsetGeber_ns <> 0 Then
PrintStatus "OffsetGeber_ns : " & Format(udtUSJustageParameter.OffsetGeber_ns, "0.00000000000000000") & " ns"
Else
PrintStatus "OffsetGeber_ns : " & Format(udtUSJustageParameter.OffsetGeber_ns, "") & " ns"
End If
If udtUSJustageParameter.SteilheitGeber_nsp°C <> 0 Then
PrintStatus "SteilheitGeber : " & Format(udtUSJustageParameter.SteilheitGeber_nsp°C, "0.00000000000000000") & " ns/°C"
Else
PrintStatus "SteilheitGeber : " & Format(udtUSJustageParameter.SteilheitGeber_nsp°C, "") & " ns/°C"
End If
If udtUSJustageParameter.Unlinearitaet <> 0 Then
PrintStatus "Unlinearitaet : " & Format(udtUSJustageParameter.Unlinearitaet, "0.00000000000000000") & " %"
Else
PrintStatus "Unlinearitaet : " & Format(udtUSJustageParameter.Unlinearitaet, "") & " %"
End If
PrintStatus "FP_Impulswert. : " & udtUSZusatzParameter.FP_Impulswertigkeit & " m³/Impuls"
PrintStatus "FP_Impulswert.Pruef : " & udtUSZusatzParameter.FP_Impulswertigkeit_Pruef & " m³/Impuls"
PrintStatus "PulseMode : " & udtUSZusatzParameter.PulseMode
PrintStatus "FP_Flow_Min : " & udtUSZusatzParameter.FP_Flow_Min & " das entspricht: " & udtUSZusatzParameter.FP_Flow_Min / 3.6 & " l"
PrintStatus "FP_Flow_Max : " & udtUSZusatzParameter.FP_Flow_Max & " m³/h"
PrintStatus "-----------------------------------------------------"
PrintStatus "Offset_Qmin : " & udtUSJustageParameter.Offset_Qmin & " %"
PrintStatus "Offset_QBereich : " & udtUSJustageParameter.Offset_QBereich & " %"
PrintStatus "Offset_Qmax : " & udtUSJustageParameter.Offset_Qp & " %"
PrintStatus "-----------------------------------------------------"
PrintStatus "----------------- Neu FW2 ---------------------------"
PrintStatus "OGeber_Roh_Neu_ns= " & udtUSJustageParameter.OGeber_Roh_Neu_ns & " ns = " & udtUSJustageParameter.OGeber_Roh_Neu_ns / 10 ^ 9 & " s"
PrintStatus "OGeber=" & udtUSJustageParameter.OGeber
PrintStatus "Fehler1=" & udtUSJustageParameter.Fehler1
PrintStatus "Fehler2=" & udtUSJustageParameter.Fehler2
PrintStatus "DiffTof1_ns = " & udtUSJustageParameter.DiffTof1_ns & " ns = " & udtUSJustageParameter.DiffTof1_ns / 10 ^ 9 & " s"
PrintStatus "DiffTof2_ns = " & udtUSJustageParameter.DiffTof2_ns & " ns = " & udtUSJustageParameter.DiffTof2_ns / 10 ^ 9 & " s"
PrintStatus "Geberkonstante_Neu1_m = " & udtUSJustageParameter.Geberkonstante_Neu1_m & " m"
PrintStatus "Geberkonstante_Neu2_m = " & udtUSJustageParameter.Geberkonstante_Neu2_m & " m"
PrintStatus "OffsetGeber_Neu_ns =" & udtUSJustageParameter.OffsetGeber_Neu_ns & " ns = " & udtUSJustageParameter.OffsetGeber_Neu_ns / 10 ^ 9 & " s"
End Sub
Private Function UltraschallpruefungWaage_() As Double
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim udtPruefdaten_imPP_mitEBP(10) As TypUSPruefdaten
Dim Temperatur As Double
Dim dblVolumenWaage As Double
' Folgende Werte mussen gesetzt sein:
' m_ersterPruefzaehler (QMax bestimmen zum Füllen)
' m_DurchflussSoll
' m_PruefungsartWaage
' m_Pruefzeit
' Waage (m_Waage) vorbereiten
' Call WaageVorbereitenFuerPP
' Referenzzazehler m_Referenzzaehler setzen
' m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
' SPS.MID, m_Referenzzaehler muss ausgewählt sein
' m_waage muss ausgewählt sein
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' EinbauplatzNr = Einbauplatz.getNr
'
' If Not Pruefzaehler Is Nothing Then
' ' OptoTimer reset
' Call USSetOptoOffTimerMax(Einbauplatz.getNr)
' ' Pruefdaten setzen für Ultraschallprüfung
' udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollDurchfluss = m_DurchflussSoll
' udtPruefdaten_imPP_mitEBP(Einbauplatz.getNr).SollPruefzeit_s = m_Pruefzeit
' End If
' Next
' DoEvents
'
' Temperatur = m_SPS.GetEinlaufTemperatur
'
' m_Tstart = GetTickCount ' Startzeitpunkt
'
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' EinbauplatzNr = Einbauplatz.getNr
' If Not Pruefzaehler Is Nothing Then
' lngReturn = StarteUSundRZZaehler(Einbauplatz.getNr, Einbauplatz.getPruefzaehler.getSerienNr)
' If lngReturn = 0 Then
' PrintStatus "RZ-START und NOWA_START OK"
' Else
' PrintStatus "RZ-START und NOWA_START Fehler:" & lngReturn
' End If
' End If
' Next
'
' ' Prüfung starten
'
' m_SPS.setBetrieb 2
' PrintStatus "Pumpe läuft, Ventil ist noch geschlossen"
' Do While Not ((m_Pumpe.GetStatus And 4) = 4)
' sleep 500, True
' Loop
' PrintStatus "Prüfung läuft, Ventil offen."
'
' blnPruefungFertig = False
' Do While Not blnPruefungFertig
' If m_SPS.GrenzwertWaageErreicht Then
' blnPruefungFertig = True
' Else
' sleep 300, True
' End If
' AnzeigeAktualisieren
' sleep 100
' DoEvents
'
' If g_Abbruch Then Exit Function
' Loop
' PrintStatus "Waagen-Grenzwert erreicht"
'
' m_SPS.setBetrieb 0
' PrintStatus "Warte auf Waagenruhe"
' Call m_Waage.WarteAufRuhe
'
' For Each Einbauplatz In m_colEinbauplatz
' EinbauplatzNr = Einbauplatz.getNr
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If (Not Pruefzaehler Is Nothing) Then
'
' lngReturn = StoppeUSundRZZaehler(EinbauplatzNr)
' If lngReturn = 0 Then
' PrintStatus "RZ-STOP und NOWA_STOP OK"
' Else
' PrintStatus "RZ-STOP und NOWA_STOP Fehler:" & lngReturn
' End If
' End If ' PZ is nothing
' Next Einbauplatz
'
End Function
Private Sub saveKontPrueffehler(Fehler As Double, QIst As Double, VolumenUS 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
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("VolumenUS", VolumenUS)
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
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
modMBUS_SMS.IECCOM_CloseCom
If Not m_Waage Is Nothing Then
m_Waage.releaseMScomm
Set m_Waage = Nothing
End If
End Sub
'Private Function SindPruefzeitenOK() As Boolean
'PrintStatus "SIndPruefzeitenOK..."
'
' SindPruefzeitenOK = True
' ' Exit Function
'
'Dim Vorpruefpunkt As CVorpruefpunkt
'Dim Pruefpunkt As CPruefpunkt
'Dim dblSollVolumen As Double
'Dim Behaelter As CBehaelter
'
'
'If m_VorPruefungsArtWaage And mbln_Vorpruefung Then
' For Each Vorpruefpunkt In m_ersterPruefzaehler.getVorpruefpunkte.getPruefpunkte.getCollection
' dblSollVolumen = Vorpruefpunkt.getQ * Vorpruefpunkt.GetTime / 3.6
'
' Set Behaelter = New CBehaelter
' If Behaelter.IstOkFuerVolumen(dblSollVolumen) = True Then
' PrintStatus "Behälter für Prüfpunkt Q=" & Vorpruefpunkt.getQ & ", " & Vorpruefpunkt.GetTime & "s gefunden."
' PrintStatus "Behälter grenzwert:" & Behaelter.m_WaageGrenzwert
' Else
' MsgBox "### kein Behälter mit" & dblSollVolumen & "l für VorPrüfpunkt Q=" & Vorpruefpunkt.getQ & " und Tprüf=" & Vorpruefpunkt.GetTime & "s gefunden."
' PrintStatus "### kein Behälter mit" & dblSollVolumen & "l für VorPrüfpunkt Q=" & Vorpruefpunkt.getQ & " und Tprüf=" & Vorpruefpunkt.GetTime & "s gefunden."
' SindPruefzeitenOK = False
' End If
' Next
'End If
'
'If m_PruefungsArtWaage And mbln_Hauptpruefung Then
' For Each Pruefpunkt In m_ersterPruefzaehler.getPruefpunkte.getPruefpunkte.getCollection
' dblSollVolumen = Pruefpunkt.getQ * Pruefpunkt.GetTime / 3.6
'
' Set Behaelter = New CBehaelter
' If Behaelter.LoadForVolumen(dblSollVolumen) Then
' PrintStatus "Behälter mit " & dblSollVolumen & " l für Prüfpunkt Q=" & Pruefpunkt.getQ & " und Tprüf=" & Pruefpunkt.GetTime & "s gefunden."
' PrintStatus "Behälter grenzwert:" & Behaelter.m_WaageGrenzwert
' Else
' MsgBox "### kein Behälter mit " & dblSollVolumen & " l für Prüfpunkt Q=" & Pruefpunkt.getQ & ", " & Pruefpunkt.GetTime & "s gefunden."
' PrintStatus "### kein Behälter mit " & dblSollVolumen & " l für Prüfpunkt Q=" & Pruefpunkt.getQ & " und Tprüf=" & Pruefpunkt.GetTime & "s gefunden."
' SindPruefzeitenOK = False
' End If
' Next
'End If
'
'End Function
'Function ResetTemperaturTransferLock(intPortNr As Integer, Optional lngIdentNoForVerification As Long = -1) As Long
'Dim lngReturn As Long
'Dim blnResult As Boolean
'
'lngReturn = SetTemperatureTransferLock(intPortNr, False, lngIdentNoForVerification)
' If lngReturn <> 0 Then
' ResetTemperaturTransferLock = lngReturn
' Exit Function
' End If
' 'Überprüfen !
' lngReturn = GetTemperatureTransferLock(intPortNr, blnResult, lngIdentNoForVerification)
' If lngReturn <> 0 Then
' ResetTemperaturTransferLock = lngReturn
' Exit Function
' End If
' If blnResult = True Then 'Temperatur kann nicht gemessen werden -> Zähler darf so nicht ausgeliefert werden !!!
' ResetTemperaturTransferLock = -55
' Exit Function
' End If
'End Function
'Function getVoreinstellwert(dblDurchfluss As Double, Sortierung As Boolean) As Integer
'Dim strSQL As String
'Dim rs As CRecordset
'Dim iNennweite As Integer
'Dim iTyp As String
'Dim SortInfo As String
'Dim dblObererDurchfluss As Double
'Dim dblUntererDurchfluss As Double
'Dim dblObererVoreinstellwert As Double
'Dim dblUntererVoreinstellwert As Double
'
'On Error GoTo Errorhandler
'Set rs = New CRecordset
'iNennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite
'iTyp = m_ersterPruefzaehler.getIdentNrObj.getTyp
'
''absteigent für ersten Prüfpunkt = False, sonst kleinster zuerst
'If Sortierung = False Then
' 'ersterPrüfpunkt
' SortInfo = "' order by Durchfluss desc"
'Else
' 'letzter Prüfpunkt
' SortInfo = "' order by Durchfluss"
'End If
'strSQL = "SELECT * FROM USVoreinstellwerte where Nennweite = " & iNennweite & " and Pruefstation= " & g_App.PruefstationNr & " and Typ = '" & iTyp & SortInfo
'
'rs.openRS strSQL, True
'
'dblObererDurchfluss = 0
'dblUntererDurchfluss = 0
'
'Do While Not rs.EOF
' Debug.Print "Durchfluss aus DB: " & rs.getDoubleValue("Durchfluss")
' dblObererDurchfluss = rs.getDoubleValue("Durchfluss")
' dblObererVoreinstellwert = rs.getDoubleValue("Voreinstellwert")
'
'
' If dblObererDurchfluss >= dblDurchfluss And dblDurchfluss >= dblUntererDurchfluss Then
' getUSVoreinstellwert = dblObererVoreinstellwert - (dblObererVoreinstellwert - dblUntererVoreinstellwert) * (dblObererDurchfluss - dblDurchfluss) / (dblObererDurchfluss - dblUntererDurchfluss)
' PrintStatus "Aus DB gelesen " & dblObererVoreinstellwert & " bei " & dblObererDurchfluss & " m³/h"
' PrintStatus "USVoreinstellwert (interpoliert)= " & getUSVoreinstellwert
' Exit Function
' End If
'
' dblUntererDurchfluss = dblObererDurchfluss
' dblUntererVoreinstellwert = dblObererVoreinstellwert
'
' rs.MoveNext
'Loop
' ErrorMsg "bitte Tabelle USVoreinstellwert pflegen"
' getUSVoreinstellwert = 50
'Exit Function
'
'Errorhandler:
' ErrorMsg "Fehler " & Err.Number & " in GetUSVoreinstellwert: " & Err.Description
'End Function
'Private Sub Setze_FP_St_GeberKonstanteZeroflow(ByRef SteilheitGeber_nsp() As Double)
' Dim EinbauplatzNr As Integer
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
' Dim comport As Integer
' Dim lngReturn As Long
'
' Dim dblFlpDiffTof As Double
' Dim dblFP_Zeroflow_DiffTof As Double
' Dim dblFP_Zeroflow_Temp As Double
' Dim dblFP_ST_Geber As Double
' Dim dblTemperatur As Double
'
' Dim intMessdauer As Integer
' Dim lngStartzeit As Long
' Dim i As Integer
'
' Dim mlngCountMessungenLaufzeit(10) As Long
' Dim mdblLaufzeitMittelSumme(10) As Double
'
' Dim mdblTemperaturMittelSumme(10) As Double
' Dim mlngCountMessungenTemp(10) As Double
'
'
' dblTemperatur = m_SPS.GetEinlaufTemperatur
'
' ' zur Berechnung der Mittelwerte auf Null setzen
' For i = 1 To 10
' mdblLaufzeitMittelSumme(i) = 0
' mdblTemperaturMittelSumme(i) = 0
' mlngCountMessungenLaufzeit(i) = 0
' mlngCountMessungenTemp(i) = 0
' Next
'
' ' Messdauer aus INI Datei holen
' intMessdauer = g_App.Settings.GETUSZeroflowMesszeit
' PrintStatus "Zeroflow Messung gestartet (Dauer " & intMessdauer & " s)"
'
'
' ' durchschnittliche Zeroflow Laufzeit für alle Einbauplätze bestimmen
' lngStartzeit = GetTickCount
' ' für die Dauer der Prüfzeit
' Do While (GetTickCount - lngStartzeit) / 1000 < intMessdauer
' lblZeit.Caption = Format((GetTickCount - lngStartzeit) / 1000, "0") & "/" & intMessdauer
' DoEvents
' ' für jeden Prüfzaehler
' For Each Einbauplatz In m_colEinbauplatz
' EinbauplatzNr = Einbauplatz.getNr
' comport = g_App.Settings.getUSComPort(EinbauplatzNr)
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' Debug.Print "Einbauplatz " & EinbauplatzNr
' ' Hole die aktuelle Laufzeit im stehenden kalten Wasser für diesen Prüfzähler
' lngReturn = modIECCOM.Get_FLP_DIffTof(comport, dblFlpDiffTof)
' Debug.Print "Get_FLP_DIffTof: " & dblFlpDiffTof
' DoEvents
' If lngReturn = 0 Then
' ' Errechne den Mittelwert
' mlngCountMessungenLaufzeit(EinbauplatzNr) = mlngCountMessungenLaufzeit(EinbauplatzNr) + 1
' Debug.Print "Messung Nr " & mlngCountMessungenLaufzeit(EinbauplatzNr)
' mdblLaufzeitMittelSumme(EinbauplatzNr) = mdblLaufzeitMittelSumme(EinbauplatzNr) + dblFlpDiffTof
' Debug.Print "mdblLaufzeitMittelSumme(" & EinbauplatzNr & "): " & mdblLaufzeitMittelSumme(EinbauplatzNr)
' Else
' PrintStatus "Fehler in Get_FLP_DIffTof " & lngReturn & " für Einbauplatz " & EinbauplatzNr
' End If
' End If
' Next
' Loop
'
'
' For Each Einbauplatz In m_colEinbauplatz
' EinbauplatzNr = Einbauplatz.getNr
' comport = g_App.Settings.getUSComPort(EinbauplatzNr)
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' ' Hole die im Zähler gespeicherte Temperatur der warmen Zeroflow Messung
' If modIECCOM.Get_FP_Zeroflow_DiffTof(comport, dblFP_Zeroflow_DiffTof) = 0 Then
' ' Hole die im Zähler gespeicherte Laufzeit der warmen Zeroflow Messung
' If modIECCOM.Get_FP_ZeroflowTemperature(comport, dblFP_Zeroflow_Temp) = 0 Then
'
' ' aktuelle kalte Laufzeit - gespeicherte warme Laufzeit
' 'd ns/°C = -----------------------------------------------------------
' ' aktuelle kalte Temperatur - gespeicherte warme Temperatur
'
' dblFP_ST_Geber = (dblFP_Zeroflow_DiffTof - dblFlpDiffTof) / (dblFP_Zeroflow_Temp - dblTemperatur)
' ' Setze den JustageParameter
' SteilheitGeber_nsp(EinbauplatzNr) = dblFP_ST_Geber
' Else
' 'Get_FP_ZeroflowTemperature
' Stop
' End If
' Else
' 'Get_FP_Zeroflow_DiffTof
' Stop
' End If
' End If
' Next
'End Sub
'
Sub UpdateTemperaturInZaehlerFW2(Optional blnForceToSetTemp As Boolean = False)
'zyklische Temperatur Erfassung
'Wenn die aktuelle Temperatur dem vorherigen Wert um 0,5 Grad abweicht,
'muss die neue Temperatur im Zähler aktualisiert werden.
Dim Einbauplatz As CEinbauplatz
Dim EinbauplatzNr As Integer
Dim Pruefzaehler As CPruefzaehler
Dim dblTemperatur As Double
Dim lngRet As Long
Dim Fehler As Boolean
Dim MerkerEinbauplatz As Byte
Dim dblDeltaTemp As Double
dblDeltaTemp = GetDeltaTemp()
If Not g_ohneSPS Then
dblTemperatur = m_SPS.GetEinlaufTemperatur
Else
'dblTemperatur = Val(InputBox("Temperatur", "", 23))
dblTemperatur = 23 + Rnd(1) * 2
End If
mobjMittelwertTemperatur.AddWert dblTemperatur
' Mittelwert bilden
dblTemperatur = mobjMittelwertTemperatur.GetWert
If Abs(m_dblTemperaturVergleich - dblTemperatur) < dblDeltaTemp And blnForceToSetTemp = False Then
' Temperatur weicht nicht mehr als 0,5°C ab und es muss die Temperatur nicht UNBEDINGT in den Zähler geschrieben werden
Exit Sub
Else
PrintStatus "Temperaturdifferenz: " & m_dblTemperaturVergleich - dblTemperatur & " °C >= " & dblDeltaTemp & " °C"
' Temperatur merken
m_dblTemperaturVergleich = dblTemperatur
lblTemperatur.caption = Format(dblTemperatur, "0.0")
End If
'PrintStatus "Stations Temperatur ermittelt =" & Format(dblTemperatur, "0.00") & "Grad"
For Each Einbauplatz In m_colEinbauplatz
DoEvents
If g_Abbruch = True Then Exit Sub
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) And Einbauplatz.getAktiv Then
' dieser Zähler soll geprüft werden
lngRet = FW2_USSetTemperatur(Einbauplatz, dblTemperatur)
If lngRet = 0 Then
PrintStatus "FW2_USSetTemperatur OK: T=" & Format(dblTemperatur, "0.00") & " Ebp " & EinbauplatzNr
Else
Fehler = True
MerkerEinbauplatz = EinbauplatzNr
PrintStatus "USSetTemperatur Fehler" & lngRet
End If
End If
Next
If Not Fehler Then
'PrintStatus "In alle USZähler übertragen"
Else
PrintStatus "UpdateTemperaturInZaehlerFW2: Übertragungsfehler nach USZähler " & MerkerEinbauplatz
End If
End Sub
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 USVoreinstellwerte 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 USVoreinstellwerte where Durchfluss = " & doubleToSQLString(dblDurchfluss) & " and Nennweite = " & iNennweite & " and Pruefstation= " & g_App.PruefstationNr & " and Typ = '" & sTyp & "'"
rs.openRS strSQL, False
DebugMsg strSQL
If Not rs.EOF Then
PrintStatus "Voreinstellwert für diesen Prüfpunkt ist vorhanden."
'Neu zugefügt, dass bei jeder Änderung auch neu abgespeichert wird
'Andreas Pfeiffer 01.03.2005
rs.setValue "Voreinstellwert", Voreinstellwert
rs.setValue "LetzteAenderung", Now()
rs.setValue "Mitarbeiter", g_App.Mitarbeiter.getNr
rs.update
DebugMsg "Voreinstellwert " & Voreinstellwert & " wurde aktualisiert."
Else
PrintStatus "Voreinstellwert " & Voreinstellwert & " für diesen Prüfpunkt wird neu 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 gewaehltenBehaelterLeeren()
Dim StartVolumen As Double
Dim Gewicht As Double
Dim letztesGewicht As Double
If g_ohneSPS Then
MsgBox "Bitte Wasser aus " & m_Behaelter.m_OVolumen & "l-Behälter ganz ablassen!"
End If
' Wasser ganz ablassen
StartVolumen = 0
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
Sleep 2000, True
Do
Sleep 500, True
If m_Waage Is Nothing Then Exit Sub
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 Sub
End If
If letztesGewicht = Gewicht Then Exit Do
letztesGewicht = Gewicht
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'-----------------------------------------
Exit Sub
Errorhaendler:
ErrorMsg "Fehler " & Err.Number & " in gewaehltenBehaelterLeeren(): " & Err.Description
End Sub
Private Sub BeideBehaelterLeeren()
'Todo: hier durch alle Behälter in der INI gehen
Dim i As Integer
On Error GoTo Errorhandler
Dim byteBeideAblassen As Byte
Dim Behaelter As CBehaelter
If Not g_ohneSPS Then
PrintStatus "Beide Behälter ganz leeren"
' byteBeideAblassen bestimmen um beide Behälter leeren
For i = 1 To 4
Set Behaelter = New CBehaelter
Behaelter.LoadFromIni (i)
byteBeideAblassen = byteBeideAblassen Or Behaelter.m_AblassAnwahl
Next
' alle Behälter nacheinander
For i = 1 To 4
Set Behaelter = New CBehaelter
Behaelter.LoadFromIni (i)
''''''''' Ablass auf''''''''''''''''
If g_App.Settings.GetBehaelterAlleinLeeren(i) = True Then
' Es soll nur ein Behälter gleichzeitig geleert werden
' der andere soll warten
Behaelter.LoadFromIni (i)
m_SPS.WassserAblassen Behaelter.m_AblassAnwahl
PrintStatus "Wasser Ablassen aus " & i & ". Behälter mit " & Behaelter.m_OVolumen & " l beginnt"
Else
' beide Behälter gleichzeitig leeren
If i = 1 Then
m_SPS.WassserAblassen byteBeideAblassen
PrintStatus "Wasser Ablassen aus beiden Behältern beginnt"
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''
Sleep 4000, True
''''''''''''''''''''''''''''''''''''''' Warten bis Behälter leer ist ''''''''''''''''''''''''''''''''''''''
If Behaelter.m_OVolumen > 0 Then
Set m_Waage = g_App.getWaage
m_Waage.Initialize (i)
If Behaelter.m_WaageAnwahl > 0 Then
m_Waage.Anwahl Behaelter.m_WaageAnwahl
Debug.Print "Waage " & Behaelter.m_WaageAnwahl
End If
PrintStatus "Warte bis " & Behaelter.m_OVolumen & " l-Behälter ganz leer ist."
'klären: Unnötig?
Behaelter.WarteAufRuhe
End If
Next
' Behälter leeren beenden, Pumpe aus oder Ventil zu
m_SPS.WassserAblassen 0
PrintStatus "Wasser Ablassen beendet."
End If
Exit Sub
Errorhandler:
ErrorMsg "Fehler " & Err.Number & " in Funktion 'BeideBehaelterLeeren': " & Err.Description
End Sub
'Private Sub BeideBehaelterLeeren()
'Dim i As Integer
'On Error GoTo Errorhandler
'Dim byteAblass As Byte
'
' If Not g_ohneSPS Then
' PrintStatus "Beide Behälter ganz leeren."
' For i = 1 To 2
' Set m_Behaelter = New CBehaelter
' m_Behaelter.LoadFromIni (i)
' byteAblass = byteAblass Or m_Behaelter.m_AblassAnwahl
' Next
' ' beide Behälter
' m_SPS.WassserAblassen byteAblass
'
' Sleep 4000, True
' For i = 1 To 2
' If g_App.Settings.GetBehaelterLeeren(i) = 1 Then
' Set m_Behaelter = New CBehaelter
' m_Behaelter.LoadFromIni (i)
' m_Waage.Initialize (i)
' ' Anwahl erfolgt in Behälter.WarteAufRuhe
' PrintStatus "Warte bis " & m_Behaelter.m_OVolumen & " l-Behälter ganz leer ist..."
' m_Behaelter.WarteAufRuhe
' End If
' Next
' m_SPS.WassserAblassen 0
' End If
'Exit Sub
'Errorhandler:
' ErrorMsg "Fehler " & Err.Number & " in Funktion 'BeideBehaelterLeeren': " & Err.Description
'End Sub
'Private Sub Vorjustage(ByRef udtUSParameter As JustageParameter_Type)
'Dim Einbauplatz As CEinbauplatz
'Dim Pruefzaehler As CPruefzaehler
'Dim comport As Integer
'Dim EinbauplatzNr As Integer
'
' ' neu RH 16.1.2006
'
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' '''''''''''''''''''' Vorjustage Vorjustage bei Qmin solange bis Fehler < 10% '''''''''
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' load frmVorjustage
' Set frmVorjustage.m_colEinbauplatz = m_colEinbauplatz
' Set frmVorjustage.m_colUniquePP = m_colUniquePP
' Screen.MousePointer = vbNormal
' frmVorjustage.Show vbModal, Me
' Unload frmVorjustage
'
'
' ' von der Vorjustage geänderte Offset Werte wieder aus Zähler lesen
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
'
' EinbauplatzNr = Einbauplatz.getNr
' comport = g_App.Settings.getUSComPort(EinbauplatzNr)
' Call modIECCOM.GetOffsetAndGeberAndBereich(comport, udtUSParameter(Einbauplatz.getNr))
'
' ' leider überschreibt GetOffsetAndGeberAndBereich die Offset_Qmin, Offset_QBereich, Offset_Qp, also nochmal aus DB lesen
' udtUSParameter(Einbauplatz.getNr).Offset_Qmin = Pruefzaehler.getVorpruefpunkte.getOffset_Qmin
' udtUSParameter(Einbauplatz.getNr).Offset_QBereich = Pruefzaehler.getVorpruefpunkte.getOffset_QBereich
' udtUSParameter(Einbauplatz.getNr).Offset_Qp = Pruefzaehler.getVorpruefpunkte.getOffset_Qp
'
' ShowUSParameter udtUSParameter(Einbauplatz.getNr), udtUSZusatzParameter(Einbauplatz.getNr), "geänderte Offset Werte nach der Vorjustage", Einbauplatz.getNr
' End If
' Next
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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 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 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 Function LeseZusatzParameterAusZaehler(ByRef Einbauplatz As CEinbauplatz, ByRef USZusatzParameter As US_ZusatzParameter_Typ) As Integer
On Error GoTo Errorhandler
LeseZusatzParameterAusZaehler = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If LeseZusatzParameterAusZaehler <> 0 Then
GoTo Errorhandler
End If
LeseZusatzParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_flow_min", USZusatzParameter.FP_Flow_Min)
If LeseZusatzParameterAusZaehler <> 0 Then
PrintStatus "f_fp_flow_min konnte nicht gelesen werden."
GoTo Errorhandler
Else
PrintStatus "lese f_fp_flow_min= " & USZusatzParameter.FP_Flow_Min
End If
LeseZusatzParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_flow_max", USZusatzParameter.FP_Flow_Max)
If LeseZusatzParameterAusZaehler <> 0 Then
PrintStatus "f_fp_flow_max konnte nicht gelesen werden."
GoTo Errorhandler
Else
PrintStatus "lese f_fp_flow_max= " & USZusatzParameter.FP_Flow_Min
End If
modMBUS_SMS.IECCOM_CloseCom
Exit Function
Errorhandler:
If LeseZusatzParameterAusZaehler <> 0 Then
PrintStatus "Fehler in LeseZusatzParameterAusZaehler(): " & modMBUS_SMS.Errorstring(LeseZusatzParameterAusZaehler)
End If
If Err.Number <> 0 Then
PrintStatus "Fehler " & Err.Number & " in LeseZusatzParameterAusZaehler(): " & Err.Description
LeseZusatzParameterAusZaehler = -1
Exit Function
End If
modMBUS_SMS.IECCOM_CloseCom
End Function
Private Function LeseJustageParameterAusZaehler(ByRef Einbauplatz As CEinbauplatz, ByRef USParameter As JustageParameter_Type) As Integer
On Error GoTo Errorhandler
Dim dblTemp As Double
LeseJustageParameterAusZaehler = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "modMBUS_SMS.fw2_open_comport" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
GoTo Errorhandler
End If
'Geberkonstante1_IST_m As Double '---Geberkonstante im unteren Bereich ' Einheit [m]
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_k_geber1", USParameter.Geberkonstante1_IST_m)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_k_geber1" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_k_geber1 konnte nicht gelesen werden."
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_k_geber1 [m]=" & vbTab & USParameter.Geberkonstante1_IST_m
' Einheit [m]
PrintStatus "lese f_fp_k_geber1 = Geberkonstante1_IST_m = " & USParameter.Geberkonstante1_IST_m
End If
'Geberkonstante2_IST_m As Double '---Geberkonstante im oberen Bereich
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_k_geber2", USParameter.Geberkonstante2_IST_m)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_k_geber2=" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_k_geber2 konnte nicht gelesen werden."
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_k_geber2 [m]=" & vbTab & USParameter.Geberkonstante2_IST_m & vbCrLf
' Einheit [m]
PrintStatus "lese f_fp_k_geber2 = Geberkonstante2_IST_m = " & USParameter.Geberkonstante2_IST_m
End If
' Offset1_IST_m3ph As Double '---Offset im unteren Bereich [m³/h]
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_qoffset1", dblTemp)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_qoffset1=" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_qoffset1 konnte nicht gelesen werden."
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_qoffset1 [m³/s]=" & vbTab & dblTemp
' f_fp_qoffset1 ist in m³/s
PrintStatus "lese f_fp_qoffset1 = " & dblTemp & " m³/s"
USParameter.Offset1_IST_m3ph = dblTemp * 3600
PrintStatus " * 3600 s/h = Offset1_IST_m3ph = " & USParameter.Offset1_IST_m3ph & " m³/h"
WriteToFW2Logfile Einbauplatz, "Offset1_IST_m3ph [m³/h]=" & vbTab & USParameter.Offset1_IST_m3ph
End If
'Offset2_IST_m3ph As Double '---Offset im oberen Bereich [m³/h]
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_qoffset2", dblTemp)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_qoffset2" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_qoffset2 konnte nicht gelesen werden."
Exit Function
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_qoffset2 [m³/s]=" & vbTab & dblTemp
PrintStatus "lese f_fp_qoffset2 = " & dblTemp & " m³/s"
USParameter.Offset2_IST_m3ph = dblTemp * 3600
PrintStatus " * 3600 s/h = Offset2_IST_m3ph = " & USParameter.Offset2_IST_m3ph & " m³/h"
WriteToFW2Logfile Einbauplatz, "* 3600 s/h =" & vbCrLf
WriteToFW2Logfile Einbauplatz, "Offset2_IST_m3ph [m³/h]=" & vbTab & USParameter.Offset2_IST_m3ph
End If
'OffsetGeber_ns As Double '---Offset Zeroflow [ns] wie im µC
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_o_geber", dblTemp)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_o_geber=" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_o_geber konnte nicht gelesen werden."
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_o_geber [s]=" & vbTab & dblTemp
PrintStatus "lese f_fp_o_geber = " & dblTemp & " s"
USParameter.OffsetGeber_ns = dblTemp * 10 ^ 9
PrintStatus " * 10^9 = OffsetGeber_ns = " & USParameter.OffsetGeber_ns & " ns"
WriteToFW2Logfile Einbauplatz, "* 10^9 =OffsetGeber_ns=" & vbTab & USParameter.OffsetGeber_ns
End If
' f_fp_o_geber_roh
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_o_geber_roh", dblTemp)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_o_geber_roh=" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_o_geber_roh konnte nicht gelesen werden."
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_o_geber_roh =" & vbTab & dblTemp
PrintStatus "lese f_fp_o_geber_roh = " & dblTemp & " s"
'USParameter.OGeber_Roh_Neu_ns = dblTemp * 10 ^ 9
' neu RH Leidel 20.8.2013: in OffsetGeber_ns reinschreiben
USParameter.OffsetGeber_ns = dblTemp * 10 ^ 9
PrintStatus " * 10^9 = f_fp_o_geber_roh = " & USParameter.OffsetGeber_ns & " ns"
WriteToFW2Logfile Einbauplatz, "* 10^9 = OffsetGeber_ns =" & vbTab & USParameter.OffsetGeber_ns
End If
' 'Bereich_ns As Double '---Trennpunkt für Bereich oben/unten [ns]
' LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_bereich", USParameter.Bereich_ns)
' If LeseJustageParameterAusZaehler <> 0 Then
' PrintStatus "f_fp_bereich konnte nicht gelesen werden."
' GoTo Errorhandler
' Else
' PrintStatus "lese f_fp_bereich = " & USParameter.Bereich_ns
' End If
'SteilheitGeber_nsp°C As Double '---Steilheit Zeroflow [ns/°C]
LeseJustageParameterAusZaehler = modMBUS_SMS.ReadValue("f_fp_st_geber", dblTemp)
If LeseJustageParameterAusZaehler <> 0 Then
WriteToFW2Logfile Einbauplatz, "lese f_fp_st_geber=" & vbTab & "Fehler " & LeseJustageParameterAusZaehler & ":" & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
PrintStatus "f_fp_st_geber konnte nicht gelesen werden: " & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
GoTo Errorhandler
Else
WriteToFW2Logfile Einbauplatz, "lese f_fp_st_geber=" & vbTab & dblTemp
PrintStatus "lese f_fp_st_geber = " & dblTemp
USParameter.SteilheitGeber_nsp°C = dblTemp * 10 ^ 9
PrintStatus " * 10^9 = SteilheitGeber_nsp°C = " & USParameter.SteilheitGeber_nsp°C
WriteToFW2Logfile Einbauplatz, "*10^9=SteilheitGeber_nsp°C=" & vbTab & USParameter.SteilheitGeber_nsp°C
End If
modMBUS_SMS.IECCOM_CloseCom
Exit Function
Errorhandler:
If LeseJustageParameterAusZaehler <> 0 Then
PrintStatus "Fehler in LeseJustageParameterAusZaehler(): " & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
WriteToFW2Logfile Einbauplatz, "Fehler " & LeseJustageParameterAusZaehler & ": " & modMBUS_SMS.Errorstring(LeseJustageParameterAusZaehler)
End If
If Err.Number <> 0 Then
PrintStatus "Fehler " & Err.Number & " in LeseJustageParameterAusZaehler(): " & Err.Description
WriteToFW2Logfile Einbauplatz, "Fehler " & Err.Number & ": " & Err.Description
LeseJustageParameterAusZaehler = -1
Exit Function
End If
modMBUS_SMS.IECCOM_CloseCom
End Function
'Private Function Get_FW2_USVolumen(Einbauplatz As CEinbauplatz, ByRef USVolumen As Double, ByRef lngUSPruefZeit_ms As Long) As Integer
'' todo: lngUSPruefzeit als Double wegen vielfaches von 62.5
'On Error GoTo Errorhandler
'
' Get_FW2_USVolumen = modMBUS_SMS.fw2_open_comport(Einbauplatz.m_iComport, 2400, Einbauplatz.m_strMapfile, True)
' If Get_FW2_USVolumen <> 0 Then GoTo Errorhandler
'
' Get_FW2_USVolumen = modMBUS_SMS.ReadValue("f_nowa_volume", USVolumen)
' If Get_FW2_USVolumen <> 0 Then GoTo Errorhandler
' PrintStatus "f_nowa_volume = " & USVolumen
'
'
' Get_FW2_USVolumen = modMBUS_SMS.ReadValue("u16_nowa_timer", lngUSPruefZeit_ms)
' PrintStatus "u16_nowa_timer = " & lngUSPruefZeit_ms
'
' If Get_FW2_USVolumen <> 0 Then GoTo Errorhandler
' lngUSPruefZeit_ms = lngUSPruefZeit_ms * 62.5
' PrintStatus "u16_nowa_timer * 62,5ms = " & lngUSPruefZeit_ms
'
' Exit Function
'Errorhandler:
' modMBUS_SMS.IECCOM_CloseCom
'End Function
Private Function GetDeltaTemp() As Double
Dim strTemp As String
Const DELTATEMP_DEFAULT = "0,40"
strTemp = g_App.Settings.GetOrSetIniWert("USFirmware2", "DeltaTemperatur", DELTATEMP_DEFAULT)
strTemp = Replace(strTemp, ".", ",")
If IsNumeric(strTemp) Then
GetDeltaTemp = CDbl(strTemp)
Else
GetDeltaTemp = CDbl(DELTATEMP_DEFAULT)
End If
End Function
Private Sub chkProtokolldruck_Click()
If chkProtokolldruck.value = vbChecked Then
g_blnPruefprotokoll = True
g_App.Settings.saveStringValue "Vorbelegung", "Protokolldruck", "1"
Else
g_blnPruefprotokoll = False
g_App.Settings.saveStringValue "Vorbelegung", "Protokolldruck", "0"
End If
End Sub
Private Sub MSFlexGrid1_AnzeigeSerienNrFabNr(Pruefzaehler As CPruefzaehler)
''MSFlexGrid1.text = "S:" & FormatSerienNr(Pruefzaehler.getSerienNr) & " F:" & Pruefzaehler.getAuftragPositionSerienNr.getFabNr
MSFlexGrid1.text = "F:" & Pruefzaehler.getAuftragPositionSerienNr.getFabNr & " " & "S:" & FormatSerienNr(Pruefzaehler.getSerienNr)
End Sub
Reference in New Issue View Git Blame Copy Permalink