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

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