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

6162 lines
229 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 frmTurbop2eHauptprf
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 = 11025
Left = 0
TabIndex = 0
Top = 60
Width = 15195
Begin VB.TextBox txtBemerkung
Height = 375
Left = 6000
MaxLength = 250
TabIndex = 102
ToolTipText = "Geben Sie hier einen Text ein. Dieser wird in Pruffehler.info gespeichert."
Top = 1170
Width = 1425
End
Begin VB.CommandButton cmdVorzeitigBeenden
Caption = "Prüfpunkt vorzeitig beenden"
Enabled = 0 'False
Height = 495
Left = 10950
TabIndex = 101
Top = 9510
Width = 2295
End
Begin VB.Frame Frame3
Caption = "Breiten"
Height = 1395
Left = 13080
TabIndex = 97
Top = 5820
Width = 1005
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 = 1155
Left = 7380
TabIndex = 82
Top = 8220
Width = 6855
Begin VB.TextBox txtPruefzeitMax
Alignment = 1 'Rechts
Height = 255
Left = 1800
TabIndex = 95
Text = "10"
Top = 780
Width = 615
End
Begin VB.ComboBox cmbKontSprung
Height = 315
Left = 3780
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 = 3240
TabIndex = 87
Top = 240
Width = 915
End
Begin VB.TextBox txtFlowMax
Alignment = 1 'Rechts
Height = 315
Left = 1140
TabIndex = 86
Top = 240
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 = "10"
Top = 780
Width = 495
End
Begin VB.TextBox txtKontCount
Alignment = 1 'Rechts
Height = 315
Left = 6240
TabIndex = 83
Text = "1"
Top = 210
Width = 465
End
Begin VB.Label Label23
Caption = "bis"
Height = 615
Left = 1560
TabIndex = 96
Top = 780
Width = 255
End
Begin VB.Label Label15
Caption = "bis Qmin="
Height = 195
Index = 0
Left = 2460
TabIndex = 94
Top = 300
Width = 855
End
Begin VB.Label Label14
Caption = "von Qmax="
Height = 195
Left = 180
TabIndex = 93
Top = 300
Width = 975
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 = 10230
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 = 10230
Width = 1935
End
Begin VB.Frame Frame1
Caption = "Fortschritt"
Height = 3735
Left = 180
TabIndex = 46
Top = 6300
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 = 4875
Left = 3390
TabIndex = 44
Top = 600
Width = 11475
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 4575
Left = 180
TabIndex = 45
Top = 240
Width = 11205
_ExtentX = 19764
_ExtentY = 8070
_Version = 393216
Rows = 11
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 = 5820
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 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 = 630
TabIndex = 29
Top = 4650
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 = 1140
TabIndex = 28
Top = 4650
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 = 1590
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 = 5520
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 = 2115
Left = 7380
TabIndex = 3
Top = 6120
Width = 4305
Begin VB.Label lblGrenzwert
BackColor = &H80000004&
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2460
TabIndex = 22
Top = 540
Width = 1095
End
Begin VB.Label Label13
Caption = "kg"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 3630
TabIndex = 21
Top = 540
Width = 375
End
Begin VB.Label Label12
Alignment = 1 'Rechts
Caption = "Waagengrenzwert:"
BeginProperty Font
Name = "Arial"
Size = 12
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 = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 3630
TabIndex = 15
Top = 1290
Width = 405
End
Begin VB.Label lblFehlerRZ
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 = 2460
TabIndex = 14
Top = 1620
Width = 1095
End
Begin VB.Label lblLabelFehlerRZ
Alignment = 1 'Rechts
Caption = "Fehler RZ:"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 780
TabIndex = 13
Top = 1650
Width = 1515
End
Begin VB.Label Label5
Caption = "%"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3660
TabIndex = 12
Top = 1650
Width = 255
End
Begin VB.Label Label4
Caption = "kg"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3660
TabIndex = 11
Top = 930
Width = 375
End
Begin VB.Label Label2
Alignment = 1 'Rechts
Caption = "Soll Volumen:"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 660
TabIndex = 10
Top = 1230
Width = 1635
End
Begin VB.Label lblSollV
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 = 2460
TabIndex = 9
Top = 1260
Width = 1095
End
Begin VB.Label lblQIst
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 = 2460
TabIndex = 8
Top = 180
Width = 1095
End
Begin VB.Label Label3
Alignment = 1 'Rechts
Caption = "Durchfluß:"
BeginProperty Font
Name = "Arial"
Size = 12
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 = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2460
TabIndex = 6
Top = 900
Width = 1095
End
Begin VB.Label lblGewichtLabel
Alignment = 1 'Rechts
Caption = "Gewicht:"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1140
TabIndex = 5
Top = 870
Width = 1155
End
Begin VB.Label Label20
Caption = "m³/h"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3630
TabIndex = 4
Top = 210
Width = 645
End
End
Begin VB.CommandButton cmdStop
Caption = "STOP"
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 7470
TabIndex = 2
Top = 10230
Width = 1335
End
Begin VB.TextBox txtStatus
Height = 4425
Left = 3990
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 1
Top = 5610
Width = 3285
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 = "Turbo2e Hauptprüfung"
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 = 11820
TabIndex = 43
Top = 5580
Width = 1155
End
End
End
Attribute VB_Name = "frmTurbop2eHauptprf"
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_dblWinkelQ As Double
Public m_Regulierwert As Double
Public m_bAutomatik As Boolean
' Public m_bKeineRegulierung As Boolean
' Für Prüfzaehlerprüfung
Private m_AnwahlLetzterBehaelter As Long
Public m_bDauerpruefung As Boolean
Public m_bRegulierungDurchfuehren 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_blnDoWinkelmessung As Boolean
' Private Member
' --------------
Private m_PPDauerpruefung As Double
Private dummy As Variant
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_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_QBehalten As Boolean
Private m_Startzeit As Long
Private m_Pruefzeit As Integer
Private m_DauerpruefungZaehler As Integer
Private m_GesZeitZaehler As Long
Private PP_Ist_Zeit As Integer
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(2) 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
'--------------------------------------------------------------------
' @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 cmdCancel_Click()
PrintStatus "Prüfung soll beendet werden."
If m_laeuft Then
ErrorMsg ("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 = "1470|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 = "1470|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 = "1470|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 = "1470|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
PrintStatus "Betrieb gestoppt"
DoEvents
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 = dlg.m_strGrund
m_Pruefgang.save
PrintStatus "Prüfungsabbruch: " & dlg.m_strGrund
End If
'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 MsgBox("Die kontinuierliche Pruefung des Turbo2e ist noch im Enwicklungs-Stadium und wurde nicht ausreichend getestet." & vbCrLf & "Möchten Sie die Prüfung dennoch durchführen ?", vbOKCancel Or vbDefaultButton2) = vbCancel Then
Exit Sub
End If
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", , "Kontinuierliche Prüfung"
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!", , "Kontinuierliche Prüfung"
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", , "Kontinuierliche Prüfung"
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!", , "Kontinuierliche Prüfung"
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!", , "Kontinuierliche Prüfung"
txtFlowMax.SetFocus
Exit Sub
End If
Else
MsgBox "der maximale Durchfluß muß ein Wert im Format '" & CDbl(11 / 10) & "' sein!", , "Kontinuierliche Prüfung"
txtFlowMax.SetFocus
Exit Sub
End If
m_Pruefgang.save
lblTitle.caption = "kontinuierliche Turbo2e Prüfzähler Prüfung"
cmdStartKontinuierlich.Enabled = False
Ende = CInt(txtKontCount.text)
For i = Ende To 1 Step -1
If g_Abbruch Then
PrintStatus "Kontinuierliche Prüfung wurde abgebrochen"
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()
Call Abbruch("")
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 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
Me.Width = Screen.Width
Me.Height = Screen.Height
Call centerFormInScreen(Me)
If Not g_ohneSPS Then
Set m_SPS = g_App.getSPS
Else
MsgBox "Es ist keine SPS verfügbar!"
cmdQSollMinus.Enabled = False
cmdQSollPlus.Enabled = False
End If
Set m_FMBus = g_App.getFMBus
Set m_ColPumpen = g_App.Settings.getPumpen
m_ZaehlerPP = 0
'cmdOK.Enabled = False
cmdCancel.Enabled = True
txtBemerkung.Visible = False
Set m_ArrayBehaelter(1) = New CBehaelter
Set m_ArrayBehaelter(2) = New CBehaelter
If m_PruefungsArtWaage = True Then
Set m_Waage = g_App.getWaage
m_Waage.SoftTaraReset
End If
m_ArrayBehaelter(1).LoadFromIni (1)
m_ArrayBehaelter(2).LoadFromIni (2)
End Sub
Private Sub Form_Activate()
If Not FormActivated Then
FormActivated = True
DoEvents
Call Hauptpruefung
End If
End Sub
Private Sub Regulierung()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim dbl_NOWA_Volume As Double
Dim dbl_NOWA_time As Double
Dim Impulse As Long
Dim strTitle As String
Dim PeriodendauerRZ As Long
Dim FehlerRefZ As Double
Dim dblQ_PZ As Double
Dim dblQ_RZ As Double
Dim dblFehler As Double
Dim dblCorrection As Double
strTitle = lblTitle.caption
lblTitle.caption = lblTitle.caption & "(Regulierung)"
If g_Abbruch Then
PrintStatus "Regulierung abgebrochen..."
Exit Sub
End If
For Each Einbauplatz In m_colEinbauplatz
If g_Abbruch Then
PrintStatus "Regulierung abgebrochen..."
Exit Sub
End If
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
PrintStatus " Setzte Factorycorrection auf 0 für Einbauplatz " & Einbauplatz.getNr
SetFactoryCorrection Einbauplatz.getNr, 0
End If
Next
PrintStatus "Regulierung bei Q=" & m_RegulierPruefpunkt.getQ & " und " & m_RegulierPruefpunkt.GetTime & " s."
m_Pruefzeit = m_RegulierPruefpunkt.GetTime
initFM85undTurbofuerPP
m_Startzeit = GetTickCount()
Do
m_PruefpunktFertig = True
Set m_FMBus = g_App.getFMBus
' Verbleibende Referenzzaehlerimpulse auslesen
m_FMBus.send "**" & m_ersterPruefzaehlerNr & "@"
m_FMBus.receive (500)
m_FMBus.send "J"
Impulse = Hex2Long(m_FMBus.receive(500))
lblVerbleibRZ = Impulse
If Impulse > 0 Then
m_PruefpunktFertig = False
Else
Debug.Print "verbleibende Referenzzähler Impulse = 0"
End If
PP_Ist_Zeit = Int((GetTickCount() - m_Startzeit) / 1000)
lblZeit.caption = Str(PP_Ist_Zeit) & " / " & Str(m_Pruefzeit)
If PP_Ist_Zeit < m_Pruefzeit Then
m_PruefpunktFertig = False
Else
Debug.Print "PP_Ist_Zeit >= m_Pruefzeit !"
End If
If g_Abbruch = True Then
PrintStatus "Regulierung abgebrochen..."
Exit Do
End If
Loop While Not m_PruefpunktFertig
m_FMBus.send "Y"
PeriodendauerRZ = Hex2Long(m_FMBus.receive(500))
PrintStatus "Referenzzaehler Periodendauer = " & PeriodendauerRZ
'sollte schon gesetzt sein: m_AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * m_ImpulswertigkeitPZ
FehlerRefZ = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
PrintStatus "Letzter Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %"
If PeriodendauerRZ = 0 Then
'MsgBox "fake PeriodendauerRZ für Regulierung"
' RZ misst zuviel (Fehler get positiv in Periodendauer ein)
PeriodendauerRZ = CDbl(m_Pruefzeit) * 2994 * (1 + FehlerRefZ / 100)
End If
dblQ_RZ = (m_AnzahlPeriodenRZ * 3600) / (m_Referenzzaehler.ImpulseQM * PeriodendauerRZ / 2994) * (1 - FehlerRefZ / 100)
NOWA_STOP
Call Sleep(2000, True)
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If g_Abbruch = True Then
PrintStatus "Regulierung abgebrochen..."
Exit Sub
End If
Dim lngSuccess As Long
Dim lngVersuche As Long
lngVersuche = 0
lngSuccess = 0
Do While lngVersuche < g_CONSTTURBOVERSUCHE And lngSuccess <> 1
lngSuccess = NOWA_Read_Volume_Time(Einbauplatz.getNr, dbl_NOWA_Volume, dbl_NOWA_time)
'dbl_NOWA_Volume
lngVersuche = lngVersuche + 1
Loop
If dbl_NOWA_time > 0 Then
dblQ_PZ = dbl_NOWA_Volume / (dbl_NOWA_time / 3600000)
PrintStatus "Einbauplatz " & Einbauplatz.getNr & ": V=" & Format(dbl_NOWA_Volume, "0.000") & " m³, T=" & Format(dbl_NOWA_time / 1000, "0.00") & " s, Q=" & dblQ_PZ & " m³/h"
dblFehler = 100 * (dblQ_PZ - dblQ_RZ) / dblQ_RZ ' in %
dblCorrection = 100 * (dblQ_RZ - dblQ_PZ) / dblQ_PZ ' in %
PrintStatus " Fehler = " & Format(dblFehler, "0.00") & " %"
PrintStatus " Korrekturwert =" & dblCorrection
PrintStatus " Regulierwert=" & m_Regulierwert
'geändert am 17.02.2006 A. Pfeiffer
dblCorrection = dblCorrection + CDbl(m_Regulierwert)
PrintStatus " Korrekturwert + Regulierwert = "
PrintStatus " Factory Correction = " & Format(dblCorrection, "0.00") & " %"
If Abs(dblCorrection) > 12.7 Then
MsgBox "Der Zähler an Einbauplatz " & Einbauplatz.getNr & " kann nicht reguliert werden," & vbCrLf & "da der Fehler F=" & dblFehler & " die maximal mögliche FactoryCorrection von +/- 12.7% übersteigt."
' Todo Pruefprotokoll
Else
If SetFactoryCorrection(Einbauplatz.getNr, dblCorrection) Then
PrintStatus "Der Zähler am Einbauplatz " & Einbauplatz.getNr & " wurde erfolgreich reguliert."
Else
' Was tun wenn Fehler ?
PrintStatus "Beim Schreiben der FactoryCorrection am Einbauplatz " & Einbauplatz.getNr & " trat ein Fehler auf."
End If
End If
End If
End If
Next
lblTitle.caption = strTitle
End Sub
' Hauptprüfung mit Referenzzaehler
Private 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 strImpulse As String
Dim AlleImpulseFertig As Boolean
Dim PeriodendauerRZ As Long
Dim PeriodendauerRefZ1 As Long
Dim PeriodendauerRefZ2 As Long
Dim k As Double
Dim Fehler As Double
Dim FehlerRefZ As Double
Dim FehlerRefZA As Double
Dim FehlerRefZB As Double
Dim QIst As Double
Dim PPNr As Integer
Dim tmpPPNr As Integer
Dim PPZeit As Date
Dim StartZeit As Date
Dim Temperatur As Double
Dim PZCount As Integer
Dim bImpulsTest As Boolean
Dim bPPQIstSaved As Boolean
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 comport As Integer
Dim objSensusInterface As SensusIF2.Interface
Dim lngSuccess As Long
Dim dbl_NOWA_time As Double
Dim dbl_NOWA_Volume As Double
Dim udtEinheit As SensusIF2.SENSUSIF_EINHEIT
g_Abbruch = False
cmdVorzeitigBeenden.Enabled = False
If m_bKontinuierlich Then
frameKontinuierlich.Visible = True
Else
frameKontinuierlich.Visible = False
End If
If Not g_ohneSPS Then
m_SPS.SetQSoll 0
m_SPS.setBetrieb 8
Sleep 300
m_SPS.setBetrieb 0
Sleep 300
' Durchlauf
m_SPS.setBehaelter 1
Else
Temperatur = Val(InputBox("Bitte Temperatur angeben"))
End If
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
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
' auf Wunsch von J.R. am 11.9.2011
' 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 500
' 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
' PrintStatus "Hauptprüfung wurde abgebrochen!"
' Exit Sub
' End If
' Loop
' End If
' m_SPS.WassserAblassen 0
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
' 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
'------------------------------------------------------------------------
' Prüfbereitschaft herstellen
'------------------------------------------------------------------------
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
If Not m_SPS.IstStreckePruefbereit Then
' Betrieb Vorbereiten
If MsgBox("Soll die Strecke jetzt automatisch gespannt u. gefüllt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht prüfbereit") = vbYes Then
m_SPS.setBetrieb 1
PrintStatus "Betrieb vorbereiten: Spannen und Füllen..."
Do While Not m_SPS.IstStreckeGefuellt
Sleep 1000, True
If g_Abbruch = True Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
Loop
' nach dem Füllen: Betrieb auf 0
Sleep 500
m_SPS.setBetrieb 0
End If
'------------------------------------------------------------------------
PrintStatus "Warte auf Pruefbereitschaft der SPS..."
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
Loop
End If
PrintStatus "Strecke ist Prüfbereit !"
Else
'
End If ' not ohne SPS
MSFlexGrid1.Clear
MSFlexGrid1.RowHeight(0) = 445
PZCount = 0
MSFlexGrid1.ColWidth(0) = 1800
MSFlexGrid1.Cols = 2 + m_colUniquePP.Count
MSFlexGrid1.row = 0
MSFlexGrid1.col = 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
'------------------------------------------------------------------------
' Winkelmessung
'------------------------------------------------------------------------
If m_dblWinkelQ > 0 And m_blnDoWinkelmessung Then
'Prüfpunkt für Winkelmessung bestimmen
m_DurchflussSoll = m_dblWinkelQ
lblQSoll.caption = m_DurchflussSoll
PrintStatus "Winkelmessung bei Q= " & m_DurchflussSoll
' Durchfluß ist nun änderbar
cmdQSollPlus.Enabled = True
cmdQSollMinus.Enabled = True
m_DurchflussSollManuell = m_DurchflussSoll
MSFlexGrid1.col = 1
MSFlexGrid1.row = 0
MSFlexGrid1.text = "Winkel"
'------------------------------------------------------------------------
' Referenzzaehler in Abbhängigkeit vom Durchfluß und INI Datei bestimmen
m_ReferenzzaehlerA.loadForDurchfluss m_DurchflussSoll, 1
FehlerRefZA = m_ReferenzzaehlerA.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
m_ReferenzzaehlerB.loadForDurchfluss m_DurchflussSoll, 2
FehlerRefZB = m_ReferenzzaehlerB.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
' 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
lblFehlerRZ.caption = Format(FehlerRefZ, "0.00")
'--------------------------------------
If Not g_ohneSPS Then
' SPS für Winkelmessung initialisieren:
Call initSPSfuerPP
Call initSPSfuerDurchlauf
m_SPS.setBetrieb 0
Sleep 500, True
' Prüfung starten
m_SPS.setBetrieb 2
Else
MsgBox ("Bitte Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen")
End If
Call WarteAufSolldurchflussErreicht(2000)
' hier Winkelmessung
m_Pruefgang.save
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
Call LeseWinkel
' Betrieb stop
If Not g_ohneSPS Then
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
Sleep 1000
Else
MsgBox "Bitte Wasser stoppen"
End If
End If 'm_dblWinkelQ >0
'------------------------------------------------------------------------
'Prüfpunkt für Regulierung bestimmen
'------------------------------------------------------------------------
Set m_Pruefpunkt = m_RegulierPruefpunkt
m_DurchflussSoll = m_RegulierPruefpunkt.getQ
lblQSoll.caption = m_DurchflussSoll
PrintStatus "Regulierprüfpunkt Q= " & m_DurchflussSoll
'------------------------------------------------------------------------
' Referenzzaehler in Abbhängigkeit vom Durchfluß und INI Datei bestimmen
m_ReferenzzaehlerA.loadForDurchfluss m_DurchflussSoll, 1
FehlerRefZA = m_ReferenzzaehlerA.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
m_ReferenzzaehlerB.loadForDurchfluss m_DurchflussSoll, 2
FehlerRefZB = m_ReferenzzaehlerB.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur)
' 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
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 " & 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
'--------------------------------------
' Prüfbereitschaft herstellen
'--------------------------------------
If Not g_ohneSPS Then
' Einstellung für Automatik-Modus in der SPS testen
TestAutomatik1:
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 TestAutomatik1
End If
m_SPS.setBetrieb 8 ' Bits zurücksetzen
Sleep 300
m_SPS.setBetrieb 0 ' kein Start, kein Stop, kein Programmende
If Not m_SPS.IstStreckePruefbereit Then
If MsgBox("Soll die Strecke jetzt automatisch gespannt u. gefüllt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht prüfbereit") = vbYes Then
' Betrieb Vorbereiten
m_SPS.setBetrieb 1
PrintStatus "Betrieb vorbereiten: Spannen und Füllen..."
Do While Not m_SPS.IstStreckeGefuellt
Sleep 1000, True
If g_Abbruch = True Then
PrintStatus "Hauptprüfung wurde abgebrochen"
Exit Sub
End If
Loop
' nach dem Füllen: Betrieb auf 0
Sleep 500
m_SPS.setBetrieb 0
End If
'------------------------------------------------------------------------
PrintStatus "Warte auf Pruefbereitschaft der SPS..."
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
Loop
End If
PrintStatus "Strecke ist Prüfbereit !"
Else
'
End If ' not ohne SPS
'--------------------------------------
' Prüfbereitschaft ist hergestellt
'--------------------------------------
'---------------------------------------------------------------
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")
'---------------------------------------------------------------
If Not m_RegulierPruefpunkt Is Nothing Then
If Not g_ohneSPS Then
' SPS für Regulierung initialisieren:
Call initSPSfuerPP
Call initSPSfuerDurchlauf
m_SPS.setBetrieb 0
Sleep 500, True
' Prüfung starten
m_SPS.setBetrieb 2
Else
MsgBox ("Bitte Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen")
End If
Call WarteAufSolldurchflussErreicht(2000)
If m_bRegulierungDurchfuehren = True Then
' ' **************************** REGULIERUNG ****************************
Call Regulierung
' ' ***********************************************************************
If g_Abbruch = True Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
PrintStatus "Regulierung beendet"
Else
PrintStatus "Regulierung ü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
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
Sleep 1000
End If
m_QBehalten = False
Else
PrintStatus "Durchlauf beibehalten, da Regulierung im höchsten Durchfluss."
m_QBehalten = True
End If
Else
PrintStatus "Regulierung wurde übersprungen da kein Regulier-PP definiert"
End If
'-----------------------------------------------------------------------------
' Regulierung beendet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Schleifenbeginn Dauerprüfung
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
StartZeit = Now()
m_DruckMsg = ""
m_DauerStop = False
If m_DauerpruefungAnzahl > 1 Then
cmdDauerEnde.Enabled = True
End If
For m_DauerpruefungZaehler = 1 To m_DauerpruefungAnzahl
' 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.RelativeFeuchte = g_dblLuftFeuchte
m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur
m_Pruefgang.LuftDruck = g_dblLuftDruck
PrintStatus "Relative Luft Feuchte: " & g_dblLuftFeuchte
PrintStatus "Lufttemperatur: " & g_dblLuftTemperatur
PrintStatus "Luftdruck: " & g_dblLuftDruck
' 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.000")
Next
'' FlexGrid dimensionieren
'MSFlexGrid1.Clear
'MSFlexGrid1.RowHeight(0) = 445
'MSFlexGrid1.ColWidth(0) = 1800
'MSFlexGrid1.Cols = 2 + m_colUniquePP.Count
'MSFlexGrid1.row = 0
'MSFlexGrid1.Col = 0
'MSFlexGrid1.text = "SNr.\[m³/h]"
' Anzahl der Pruefzähler zählen, wird in Pruefgang Tabelle eingetragen
PZCount = 0
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
' MSFlexGrid1.text = FormatSerienNr(Pruefzaehler.getSerienNr)
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.save True
End If
Next Einbauplatz
For i = 1 To m_colUniquePP.Count
MSFlexGrid1.row = 0
MSFlexGrid1.col = i + 1
'Ganze Zahl größer 1m³
If m_colUniquePP.Item(i).getQ >= 1 And (m_colUniquePP.Item(i).getQ - Int(m_colUniquePP.Item(i).getQ) = 0) Then
MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "0")
End If
'Nachkommazahl größer 1m³ eine Nachkommastelle
If m_colUniquePP.Item(i).getQ >= 1 And m_colUniquePP.Item(i).getQ * 10 - Int(m_colUniquePP.Item(i).getQ) * 10 <> 0 Then
MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "#.#")
End If
'kleiner 1m³
If m_colUniquePP.Item(i).getQ < 1 Then
MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "0.###")
End If
MSFlexGrid1.CellAlignment = flexAlignGeneral
'MSFlexGrid1.Text = Format(m_colUniquePP.Item(i).getQ, "0.#") & " m³[%]"
'If m_colUniquePP.Item(i).getQ >= 0.099 Then
' MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ, "0,#") & "m³"
'Else
' MSFlexGrid1.text = Format(m_colUniquePP.Item(i).getQ * 1000, "0.###") & " L"
'End If
Next
'Breite der Spalte bestimmen
Call FlexGridReadBreite
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
PrintStatus "--------------------------------------"
' Für diesen PP wurde noch kein QIst gespeichert
bPPQIstSaved = False
' Zähler für PP in PP Collection: PPNr = 1 bei Qmax
PPNr = PPNr + 1
PrintStatus "nächster Pruefpunkt (" & PPNr & " / " & m_colUniquePP.Count & "): " & m_Pruefpunkt.getQ
' Dauer dieses Pruefpunktes
m_Pruefzeit = m_Pruefpunkt.GetTime
PrintStatus "Soll-Pruefzeit für diesen PP: " & m_Pruefzeit & " sec"
m_DurchflussSoll = m_Pruefpunkt.getQ
lblQSoll.caption = m_DurchflussSoll
' Durchfluß ist nun änderbar
cmdQSollPlus.Enabled = True
cmdQSollMinus.Enabled = True
m_DurchflussSollManuell = m_DurchflussSoll
' Balkenanzeige in der Liste der Durchflüsse aktualisieren
For i = 0 To lstPruefpunkte.ListCount - 1
If Format(lstPruefpunkte.List(i), "0.000") = Format(m_DurchflussSoll, "0.000") Then
lstPruefpunkte.Selected(i) = True
Else
lstPruefpunkte.Selected(i) = False
End If
Next
' 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()
End If
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
lblFehlerRZ.caption = Format(FehlerRefZ, "0.00")
' Referenzzaehler Daten für Pruefpunkt speichern
m_Pruefgang.PP_RefZSerienNr(PPNr) = m_Referenzzaehler.SerienNr
If m_DurchflussSoll = 0 Then
PrintStatus "Durchfluß ist 0, wird übersprungen"
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
Temperatur = m_SPS.GetEinlaufTemperatur
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 + 1
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
' neu RH 14.05.2007
If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then
'alt: If GrenzwertUeberschritten(m_Pruefpunkt.getFGo, Fehler, m_Pruefpunkt.getFGu) Then
AuftragpositionSerienNr.setStatusFertigung 25
AuftragpositionSerienNr.save
PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !"
'PrintStatus "Grenzwert überschritten. " & m_Pruefpunkt.getFGu & " < " & Fehler & " < " & m_Pruefpunkt.getFGo & " ?"
MSFlexGrid1.CellBackColor = &HC0C0FF
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
' Startzeit für diesen Pruefpunkt festhalten
PPZeit = Now
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_QBehalten = False 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
PrintStatus "Hauptprüfung wurde abgebrochen!"
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
Call WarteAufSolldurchflussErreicht(2000)
Else
MsgBox "Bitte Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen", vbInformation, "SPS ist nicht erreichbar!"
End If ' ohne SPS
Else
If m_RegulierungVerwenden Then
PrintStatus "erster Prüfpunkt = Regulierprüfpunkt: Pumpen laufen lassen!"
Else
If Not g_ohneSPS Then
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")
FM85FuerPeriodendauermessungInit:
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
' FM85 für Periodendauermessung für diesen Pruefpunkt initialisieren
PrintStatus "FM85 für Periodendauermessung für diesen Pruefpunkt initialisieren"
' Pruefung starten
Call initFM85undTurbofuerPP
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
If Not g_ohneSPS Then
Call initSPSfuerPP
End If
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
Loop
End If
' Impulszählung programmieren
Call initFM85fuerPP_Waage
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
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
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"
Else
MsgBox "Bitte Prüfpunkt mit Q=" & m_DurchflussSoll & " einstellen", vbInformation, "SPS ist nicht erreichbar!"
End If
End If
' wieder beide Prüfungsarten (Waage und Vergleich)
m_QBehalten = False
' 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
' 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."
'PrintStatus "Wartezeit auf 1. Impuls = " & Format(ImpulsTestZeit, "0.0") & " s"
'AnzahlZaehlerOhneImpulse = 0
'bImpulsTest = False
' Flag für Beendigung dieses Pruefpunktes zurücksetzen
m_PruefpunktFertig = False
cmdVorzeitigBeenden.Enabled = False
' Schleife: Einsprung solange Messung läuft
Do While Not m_PruefpunktFertig
Messung:
' Initialisieren des Flags zur Beendung der Prüfung
AlleImpulseFertig = True
' For Each Einbauplatz In m_colEinbauplatz
DoEvents
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
' 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
' Solange die Prüfzeit nicht abgelaufen ist, muss noch weiter gemessen werden
If PP_Ist_Zeit < m_Pruefzeit Then
AlleImpulseFertig = False
Else
Debug.Print "PP_Ist_Zeit >= m_Pruefzeit !"
End If
'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
' 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))
' ' Todo: Nur zeigen wenn Waage:
' lblPZImpulse(Einbauplatz.getNr).Caption = Str(Impulse)
'
'
' 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 " & ImpulsTestZeit & "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."
' 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
' 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
' 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
' 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
MsgBox "Grenzwert der Waage erreicht ?", vbInformation, "SPS ist nicht erreichbar!"
m_PruefpunktFertig = True
End If
Set m_Waage = g_App.getWaage
lblGewicht.caption = m_Waage.GetGewicht
Else
If Not PP_Ist_Zeit >= m_Pruefzeit Then
AlleImpulseFertig = False
Else
Debug.Print "Prüfzeit (" & m_Pruefzeit & "s) ist abgelaufen"
End If
' Verbleibende Referenzzaehlerimpulse auslesen
m_FMBus.send "**" & m_ersterPruefzaehlerNr & "@"
m_FMBus.receive (500)
m_FMBus.send "J"
Impulse = Hex2Long(m_FMBus.receive(500))
lblVerbleibRZ.caption = Str(Impulse)
If Impulse > 0 Then
AlleImpulseFertig = False
Else
Debug.Print "verbleibende Referenzzähler Impulse = 0"
End If
If g_App.Settings.getAnzahlMIDGruppen Then
' Verbleibende Referenzzaehlerimpulse in FM85 für RefZ-Vergleich auslesen
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
m_FMBus.send "J"
Impulse = Hex2Long(m_FMBus.receive(500))
lblVerbleibRZA.caption = Str(Impulse)
If Impulse > 0 Then
AlleImpulseFertig = False
Else
cmdVorzeitigBeenden.Enabled = True
Debug.Print "verbleibende Impulse des Referenzzählers A=0 (Vergleich zw. den RZ)"
End If
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
m_FMBus.send "I"
Impulse = Hex2Long(m_FMBus.receive(500))
lblVerbleibRZB.caption = Str(Impulse)
If Impulse > 0 Then
AlleImpulseFertig = False
Else
Debug.Print "verbleibende Impulse des Referenzzählers B=0 (Vergleich zw. den RZ)"
End If
End If
End If
If AlleImpulseFertig = True Then
m_PruefpunktFertig = True
End If
End If
' Nach halber Zeit im Pruefpunkt wird Ist-Durchfluss gespeichert
If bPPQIstSaved = False And PP_Ist_Zeit >= m_Pruefzeit / 2 Then
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
bPPQIstSaved = True
If m_bVoreinstellwertSetzen And Not g_ohneSPS Then
' 2% höher regeln, um den Durchfluß schneller zu erreichen
' Todo: diese Formel von g_App.Settings.GetAnzahlFuerVoreinstellwert abhängig machen
Voreinstellwert = m_SPS.GetStellwert + 2 '
PrintStatus "Stellwert: " & m_SPS.GetStellwert
'PrintStatus "Anzahl eingeb.Zähler:" & g_App.Settings.GetAnzahlFuerVoreinstellwert
PrintStatus "+2% => Voreinstellwert " & Voreinstellwert & " speichern"
SetVoreinstellwert m_DurchflussSoll, Voreinstellwert
End If
End If
DoEvents
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
' ' Neu RH 13.12.2004
' If PP_Ist_Zeit > m_Pruefzeit * 2 Then
' ' doppelte Prüfzeit ist verstrichen
' If PP_Ist_Zeit > (3600 / (m_DurchflussSoll * m_ImpulswertigkeitPZ)) * 20 * 2 Then
' 'In dieser Zeit (doppelt veranschlagt) hätten auch mind. 20 Impulse gekommen sein müssen
' PrintStatus "Doppelte Prüfzeit ist verstrichen!"
' 'welche Zähler haben noch nicht alle Impulse gezählt ?
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' ' Pruefzähler ist eingebaut
' If Einbauplatz.getAktiv = True Then
' ' und noch nicht deaktiviert
' ' FM85P mit entspr. Adresse ansprechen
' Debug.Print "**" & Einbauplatz.getNr & "@"
' m_FMBus.send "**" & Einbauplatz.getNr & "@"
' Call m_FMBus.receive(500)
'
' ' Verbleibende Impulse auslesen
' m_FMBus.send "I"
' Debug.Print "-> I"
' strTemp = m_FMBus.receive(500)
' Impulse = Val("&H0000" & strTemp)
' 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
' Next
' ' Dieser Prüfpunkt muss abgebrochen werden
' m_PruefpunktFertig = True
' End If
' End If
' Schleifenende
DoEvents
Loop ' m_PruefpunktFertig
' dieser Pruefpunkt ist fertig
cmdVorzeitigBeenden.Enabled = False
m_GesZeitZaehler = m_GesZeitZaehler + PP_Ist_Zeit
' Nowa_Stop für alle angeschlossenen Zaehler
lngSuccess = NOWA_STOP
Call Sleep(2000, True)
Stopphase:
m_Pruefgang.PP_Zeit(PPNr) = m_Pruefpunkt.GetTime
m_Pruefgang.save
' Betrieb stop: es ist hier ungewiss, ob Pruefpunkt wiederholt wird wenn Prüefgang Lang
If m_bPruefgangLang And PPNr = m_colUniquePP.Count And Not m_PruefungsArtWaage Then
' Betrieb wird später gestoppt
Else
If Not g_ohneSPS Then
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
PrintStatus "Wasser gestoppt"
Else
'MsgBox "Bitte Wasser stoppen!", vbInformation, "SPS ist nicht erreichbar!"
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 = 22
End If
m_Pruefgang.Vorlauftemperatur = Temperatur
PrintStatus "Temperatur: " & Format(Temperatur, "0.00") & " °C"
m_Pruefgang.save
End If
'----------------------------------------------------------------
' Fehlerermittung
'----------------------------------------------------------------
PrintStatus "Fehlerermittlung:"
PrintStatus "-----------------"
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
If m_PruefungsArtWaage Then
PrintStatus "Beruhigungsphase..."
Sleep 3000, True
'm_Waage.WarteAufRuhe
m_Behaelter.WarteAufRuhe
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
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: " & BehaelterVolumen & " m³"
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 & "@", CStr(m_ersterPruefzaehlerNr)
If g_Abbruch Then
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
' Periodendauer über n Perioden des Referenzzaehlers auslesen
m_FMBus.send "Y"
Dim strAntwort As String
strAntwort = m_FMBus.receive(500)
PeriodendauerRZ = Hex2Long(strAntwort)
PrintStatus "Referenzzaehler Periodendauer = " & PeriodendauerRZ
' If PeriodendauerRZ = 0 Then
' Stop
' MsgBox "Fake PeriodendauerRZ für Hauptprüfung"
' PeriodendauerRZ = CDbl(m_Pruefzeit) * 2994 * (1 + FehlerRefZ / 100)
' End If
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 + 1
MSFlexGrid1.row = Einbauplatz.getNr
lngSuccess = NOWA_Read_Volume_Time(Einbauplatz.getNr, dbl_NOWA_Volume, dbl_NOWA_time)
PrintStatus "NOWA_READ: Volumen=" & dbl_NOWA_Volume & " m³/h"
PrintStatus "NOWA_READ: Zeit =" & dbl_NOWA_time & " ms"
' ' FM85P mit entspr. Adresse ansprechen
' m_FMBus.send "**" & Einbauplatz.getNr & "@"
' m_FMBus.receive (500)
' m_FMBus.send "U"
' Impulse = CLng("&H0" & m_FMBus.receive(500))
' PrintStatus "Impulse von Prüfzähler " & Einbauplatz.getNr & "= " & Impulse
'
' ' Prüfzählermpulse Anzeige aktualisieren
' lblPZImpulse(Einbauplatz.getNr).Caption = Str(Impulse)
If m_PruefungsArtWaage Then
' Fehlerermittlung
If g_objExternePruefformel Is Nothing Then
PrintStatus "Interne Pruefformel"
PrintStatus " dbl_NOWA_Volume = " & dbl_NOWA_Volume
PrintStatus " BehaelterVolumen = " & BehaelterVolumen
Fehler = (dbl_NOWA_Volume - BehaelterVolumen) * 100 / BehaelterVolumen
PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " % (interne Fehlerberechnung)"
Else
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dbl_NOWA_Volume, BehaelterVolumen, 0)
PrintStatus g_objExternePruefformel.GetLogText
End If
Else
' ' Periodendauer über n Perioden auslesen
' m_FMBus.send "X"
' PeriodendauerPZ = Val("&H0000" & m_FMBus.receive(500))
' PrintStatus "** Pruefzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerPZ
'
If Not PeriodendauerRZ = 0 Then
PrintStatus "Letzter Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %"
' ' Speichern des IstDurchflusses, berechnet aus Referenzzähler Werten
' Wenn der RZ einen positiven Fehler hat, ist falsche gemessene Wert höher als der Richtige
QIst = (m_AnzahlPeriodenRZ * 3600) / (m_Referenzzaehler.ImpulseQM * (PeriodendauerRZ / 2994))
PrintStatus "unkorrigiertes Q vom RZ Qist=" & QIst
QIst = QIst * (1 - FehlerRefZ / 100)
PrintStatus "korrigiertes Q vom RZ Qist=" & QIst
m_Pruefgang.PP_Ist(PPNr) = QIst
PrintStatus "Gespeichertes Q-ist= " & Int(QIst * 100000 + 0.5) / 100000 & " m³/h"
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 dbl_NOWA_time > 0 And dbl_NOWA_Volume > 0 Then
Dim dblQsoll As Double
dblQsoll = dbl_NOWA_Volume / (dbl_NOWA_time / 3600000)
PrintStatus "NOWA Volumen=" & dblQsoll & "m³/h"
If g_objExternePruefformel Is Nothing Then
' Interne Prüfformel
Fehler = (dblQsoll - QIst) / QIst * 100
Else
' Fehlerberechnung in Externer DLL, neu RH 24.7.2017
Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dblQsoll, QIst, 0)
PrintStatus g_objExternePruefformel.GetLogText
End If
PrintStatus "Fehler des PZ: " & Format(Fehler, "0.00") & " %"
' Korrektur des Fehlers mit dem Fehler des Referenzzählers
'' ist oben schon berückssichtigt Fehler = Fehler + FehlerRefZ
'' PrintStatus "Summe der Fehler: " & Format(Fehler, "0.00") & " %"
Else
PrintStatus "da NOWA_Time oder NOWA_V = 0 => kein Fehler berechenbar"
Fehler = 99 'Merker für "Keine Impulse"
End If
Else
ErrorMsg ("Die Periodendauer des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden: " & strAntwort)
Fehler = 98 'Merker für "keine Periodendauer vom RZ"
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
Call FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, m_Pruefpunkt, m_colUniquePP)
If Fehler < 98 Then
MSFlexGrid1.text = Format(Fehler, "0.00")
Else
MSFlexGrid1.text = " ? "
End If
' 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
' neu RH 14.05.2007
If GrenzwertUeberschritten(Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo, Fehler, Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu) Then
'alt: If GrenzwertUeberschritten(m_Pruefpunkt.getFGo, Fehler, m_Pruefpunkt.getFGu) Then
AuftragpositionSerienNr.setStatusFertigung 25
AuftragpositionSerienNr.save
PrintStatus "Grenzwert überschritten. " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGu & " < " & Fehler & " < " & Pruefzaehler.getPruefpunkte.getPruefpunkte.getPP(m_DurchflussSoll).getFGo & " !"
'PrintStatus "Grenzwert überschritten. " & m_Pruefpunkt.getFGu & " < " & Fehler & " < " & m_Pruefpunkt.getFGo & " ?"
MSFlexGrid1.CellBackColor = &HC0C0FF
End If
End If ' bFehlerermittelt
PrintStatus " ermittelter Fehler = " & Format(Fehler, "0.00") & "%"
Else
'PrintStatus "Achtung, dieser Zähler hat den gewünschten Prüfpunkt nicht"
End If ' Prüfzähler hat diesen Prüfpunkt
End If ' Prüfpunkte vorhanden
End If 'Pruefzaehler vorhanden
Next Einbauplatz 'In m_colEinbauplatz
If m_bPruefgangLang And PPNr = m_colUniquePP.Count Then
ZaehlerPruefgangLang = ZaehlerPruefgangLang + 1
lblLang.caption = (ZaehlerPruefgangLang + 1) & " ."
DebugMsg "Zähler PGang Lang: " & ZaehlerPruefgangLang
End If
If Not m_PruefungsArtWaage Then
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
' Abweichung zwischen den Referenzzaehlern ermitteln
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
m_FMBus.send "X"
PeriodendauerRefZ1 = Hex2Long(m_FMBus.receive(500))
PrintStatus "Referenzzaehler1 Periodendauer = " & PeriodendauerRefZ1
m_FMBus.send "Y"
PeriodendauerRefZ2 = Hex2Long(m_FMBus.receive(500))
If PeriodendauerRefZ1 = 0 Or PeriodendauerRefZ2 = 0 Then
ErrorMsg ("Periodendauer eines RefZ (FM85P-13)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..."
m_QBehalten = True
GoTo SchleifenanfangPruefgangLang
End If
If Not g_ohneSPS Then
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
lblQIst.caption = ""
Else
'MsgBox "Bitte Wasser stoppen", vbInformation, "SPS ist nicht erreichbar!"
End If
PrintStatus "Wasser gestoppt"
lblFehlerRZ.caption = ""
' Alle Einbauplätze wieder aktivieren
For Each Einbauplatz In m_colEinbauplatz
lblPZImpulse(Einbauplatz.getNr).BackColor = &H8000000F
lblVerbleib(Einbauplatz.getNr).BackColor = &H8000000F
Einbauplatz.setAktiv True
Next
End If ' m_DurchflussSoll > 0 und RZ-Vergleichs-Prüfung erfolgt
' Schleifenende Pruefpukte: nächster Pruefpunkt
Next m_Pruefpunkt
' Kompletter Pruefgang bendet
' ----------------------------
' Für jeden geprüften Pruefzähler:
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
Select Case AuftragpositionSerienNr.getStatusFertigung
Case 25
' Grenzwertüberschreitung in einem Prüfpunkt
Case 23
' Ausfall in einem Prüfpunkt
Case Else
' Geprüft in allen Prüfpunkten ohne Ausfall und Grenzwertüberschreitung
AuftragpositionSerienNr.setStatusFertigung 30
' Todo:
' AuftragPosition.FertigemeldeTermin FertigmeldeMitarbeiter
' FertMeld_Pterm_MA = Mitarbeiter.GetNr
' P_IstTerm = now()
' Fertmeld_Pterm_Dat = now()
End Select
AuftragpositionSerienNr.save
End If
Next Einbauplatz
DoEvents
If g_blnPruefprotokoll Then
PrintStatus "Prüfergebnisse werden gedruckt..."
Call PruefgangDruck(m_Pruefgang, Temperatur, m_colEinbauplatz, PZCount, m_DruckMsg)
End If
' Neu RH 28.3.2017: Vorgabe der MEN, Verschiebung der Messergebnisse der Eichung / Befundprüfung in gesonderte Tabelle "Prüeffehler_Eichung"
Verschiebe_Prueffehler_Befundpruefung_Eichung m_Pruefgang.PruefgangNr
PrintStatus "Schleifenende Dauerprüfung. " & m_DauerpruefungZaehler
If m_DauerStop = True Then
Exit For
End If
Next m_DauerpruefungZaehler ' Schleifenende Dauerprüfung
PrintStatus "Prüfergebnisse werden gespeichert..."
DoEvents
' Speichern der PruefgangDaten
m_Pruefgang.save
' SPS Betrieb Programmende
PrintStatus "Programmende..."
DoEvents
' Stoppen
If Not g_ohneSPS Then
m_SPS.setBetrieb 0
Sleep 1000
' Programmende einleiten
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
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
Exit Sub
End If
Loop
PrintStatus "Lösen..."
End If
Fertig:
' Jetzt kann Betrieb = 0 gesetzt werden
If Not g_ohneSPS Then
m_SPS.setBetrieb 0
m_SPS.SetServoStellung 50
End If
Sleep 1000
End If 'ohne SPS
Call PruefungFertigmeldenDialog("Die Prüfung ist beendet.", m_colEinbauplatz)
Call ResetPruefung
If m_PruefungsArtWaage = True Then
Call m_Waage.releaseMScomm
End If
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 & "Nein=Weiter, Abbruch=Prüfung abbrechen", vbYesNoCancel, "Fehlerbehandlung")
If returnwert = vbYes Then
Resume
ElseIf returnwert = vbNo Then
Resume Next
Else
Call Abbruch("Fehler " & errnum & " in Hauptprüfung: " & strErr)
End If
End Sub
Private Sub initSPSfuerDurchlauf()
' Durchlauf auswählen
If Not g_ohneSPS Then
m_SPS.setBehaelter 1
lblGewichtLabel.Enabled = False
lblGewicht.Enabled = False
End If
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()
' SPS für diesen Prüfpunkt initialisieren, unabhängig von Waage/Behälter oder Durchlauf
' -------------------------------------------------------------------------------------
' Betrieb stoppen und Pumpen Abwählen
' Durchfluß vorgabe
' Pumpe auswählen und anwählen
' Regelart und Regel-Position setzen
' MID Strang setzen
Dim Einbauplatz As CEinbauplatz
Dim i As Integer
Dim iStellwert As Integer
Dim AnzahlPP As Integer
'Dim Waagengrenzwert As Double
' 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
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ß
If Not g_ohneSPS Then
m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl
Else
MsgBox "Bitte Behälter mit " & m_Behaelter.m_OVolumen & "l auswählen!"
End If
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
PrintStatus "Hauptprüfung wurde aufgrund eines Fehlers abgebrochen!"
Exit Function
End If
If Not g_ohneSPS Then
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
PrintStatus "Hauptprüfung wurde abgebrochen!"
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
PrintStatus "Initialisieren der Waage abgebrochen..."
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
Else
MsgBox "Bitte Wasser ablassen und OK klicken wenn Waage in Ruhe ist!"
End If
'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."
If MsgBox("Nullstellen wiederholen?", vbYesNo) = vbYes Then
GoTo WaageAufNull1
End If
End If
WaageTarieren1:
' Waage tarieren
PrintStatus "Waage Tarieren"
If m_Waage.Tara = False Then
ErrorMsg "Achtung: Tarieren fehlgeschlagen!" & vbCrLf & " Bitte Fehler beheben und 'Ignorien' klicken oder abbrechen."
If MsgBox("Tarieren wiederholen?", vbYesNo) = vbYes Then
GoTo WaageTarieren1
End If
End If
Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen)
PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname
If Not g_ohneSPS Then
m_Pumpe.Anwahl
End If
' 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
If Not g_ohneSPS Then
' Der Durchfluß Wert soll unbereinigt angezeigt werden
m_SPS.SetQDiff 0
End If
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
PrintStatus "initilaisieren der FM85 abgebrochen..."
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 & "':" & Fehlerbyte42Meldung(dummy) & vbCrLf & "Möchten Sie weitermachen?", vbYesNo) = vbYes Then
Else
' Todo: Allgemeine Abbruchfunktion
' Prüfung abbrechen
g_Abbruch = True
PrintStatus "initialisieren der FM85 wurde abgebrochen..."
Exit Sub
End If
End If
Call NOWA_START
End Sub
'-------------------------------------------------------------------------
' FM85 für diesen Prüfpunkt initialisieren:
Private Sub initFM85undTurbofuerPP()
Dim strAntwort As String
Dim AnzahlPeriodenRZ As Double
Dim AnzahlPeriodenRZA As Long
Dim AnzahlPeriodenRZB As Long
Dim ImpulswertigkeitRZ As Long
Dim Fehler As Double
Dim fm85p As CFM85P
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Doppelimpulssperrzahl As Byte
Dim strDoppelimpulssperrzeit_ms As String
Dim strMultiplikator As String
PrintStatus "**********************************************"
PrintStatus "Initialisierung der FM85 für Vergleichsprüfung"
' Dummy Werte
sendonly "**0@"
sendonly "R"
Sleep 1000, True
sendonly "**0@"
' keine Doppelimpulssperre
sendonly "G"
' Doppelimpuls-Zeit
sendonly "0000S"
' Multiplikator
sendonly "1s"
' Dämpfung
sendonly "3T"
' K Wert
sendonly Trim("1000K+1") ' entspricht k* 0.1000 * 10 ^1 = K
' ----------------------------------------------------------------------------------
' Periodenzahl errechnen
ImpulswertigkeitRZ = m_Referenzzaehler.ImpulseQM
PrintStatus "ImpulswertigkeitRZ: " & ImpulswertigkeitRZ
'Andreas Pfeiffer am 08.11.2007 auskommentiert
' 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
AnzahlPeriodenRZ = (m_Pruefzeit / 3600) * m_DurchflussSoll * ImpulswertigkeitRZ
'''''''''''''''' 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)
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
End If
PrintStatus "Perioden RZ: " & AnzahlPeriodenRZ
m_AnzahlPeriodenRZ = AnzahlPeriodenRZ
PrintStatus "AnzahlPeriodenRZ an FM85: " & Hex(AnzahlPeriodenRZ) & "M"
m_FMBus.send Hex(AnzahlPeriodenRZ) & "M"
'If m_FMBus.receive(500) <> "" Then
' PrintStatus "Warnung: Periodenzahl RZ " & AnzahlPeriodenRZ & " für FM85 ausserhalb des zulässigen Bereiches"
'End If
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)
AnzahlPeriodenRZB = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_ReferenzzaehlerB.ImpulseQM)
' FM85 für Referenzzähler Vergleich Nr 7 setzen
' Adressieren
Set fm85p = m_FMBus.getFM85P(g_FM85RefZAdresse)
fm85p.sendAttention
If g_Abbruch Then
PrintStatus "initilaisiewren der FM85 und Turbo2e abgebrochen..."
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 = Mid(fm85p.getLastAnswer, 6, 2)
If strAntwort <> "00" Then
If MsgBox("FM85 Nr." & g_FM85RefZAdresse & ": Fehlerbyte ist nicht '00' sondern '" & strAntwort & "':" & vbCrLf & Fehlerbyte42Meldung(strAntwort) & vbCrLf & "Möchten Sie weitermachen", vbYesNo) = vbYes Then
Else
Call Abbruch
Exit Sub
End If
End If
End If ' 2 RefZ
NOWA_START
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)
'Exit Function
'
'GetDoppelimpulssperreAndMultiplikator_Error:
' GetDoppelimpulssperreAndMultiplikator = -1
'
' PrintStatus "Fehler in GetDoppelimpulssperreAndMultiplikator:"
'
' strFM85Multiplikator = "1"
' strFM85Doppelimpulssperrzeit = "0000"
'
'
' PrintStatus "Doppelimpulssperre wird ausgeschaltet"
'End Function
Private Sub PrintStatus(sText As String)
txtStatus.text = txtStatus.text & sText & vbCrLf
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)
Call rs.update
FehlerSpeichern = True
Exit Function
FehlerSpeichernError:
MsgBox ("FehlerSpeichern fehlgeschlagen: " & Err.Description)
End Function
'
' @return Mittelwert der beiden Fehler-Werte, die am nächsten beieinander liegen,
' sonst Mittelwert aus allen drei Fehler-Werten.
'
Private Function MittelwertDerFehlerOhneAusreisser(Fehler0 As Double, Fehler1 As Double, Fehler2 As Double) As Double
Dim d0 As Double
Dim d1 As Double
Dim d2 As Double
' Abstände bestimmen
d0 = Abs(Fehler0 - Fehler1)
d1 = Abs(Fehler0 - Fehler2)
d2 = Abs(Fehler1 - Fehler2)
' Sonderfall wenn mind. 2 von 3 Abständen gleich
MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler1 + Fehler2) / 3
' Sonderfall wenn Abstand zw. F0 und F1 am kleinsten
If d0 < d1 And d0 < d2 Then
MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler1) / 2
End If
' Sonderfall wenn Abstand zw. F0 und F2 am kleinsten
If d1 < d0 And d1 < d2 Then
MittelwertDerFehlerOhneAusreisser = (Fehler0 + Fehler2) / 2
End If
' Sonderfall wenn Abstand zw. F1 und F2 am kleinsten
If d2 < d0 And d2 < d1 Then
MittelwertDerFehlerOhneAusreisser = (Fehler1 + Fehler2) / 2
End If
End Function
Private Sub WaageZuruecksetzen()
Dim Behaelter As CBehaelter
Dim i As Integer
Set m_Waage = g_App.getWaage
For i = 1 To 2
Set Behaelter = m_ArrayBehaelter(i)
Set m_Waage = g_App.getWaage
If Behaelter.m_WaageAnwahl <> 0 Then
m_Waage.Anwahl Behaelter.m_WaageAnwahl
End If
Sleep 1000, True
m_Waage.SetNettoGrenzwert1 Behaelter.m_WaageGrenzwert, Behaelter.m_Genauigkeit
Next
End Sub
Private Function WaageVorbereitenFuerPP()
Dim StartVolumen As Double
Dim Gewicht As Double
Dim letztesGewicht As Double
Dim Referenzzaehler As CRefzaehler
Dim Pumpe As CPumpe
Dim Fuelldurchfluss As Double
Dim Fuellvolumen As Double
Dim Waagengrenzwert As Double
PrintStatus "Waage vorbereiten für diesen Prüfpunkt:"
lblQIst.caption = "0"
m_SPS.setBetrieb 0
m_VolumenSoll = m_Pruefzeit * m_DurchflussSoll / 3.6
PrintStatus "Sollvolumen:" & Format(m_VolumenSoll, "0.000") & " l"
'-----------------------------------------
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadForVolumen(m_VolumenSoll) = False Then
MsgBox ("Es exisitiert kein Behälter für Volumen=" & m_VolumenSoll & vbCrLf & "Abbruch empfohlen!")
WaageVorbereitenFuerPP = -1
Exit Function
End If
PrintStatus "gewählter Behälter: OVolumen=" & m_Behaelter.m_OVolumen
m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl
m_Waage.SetNettoGrenzwert1 m_Behaelter.m_WaageGrenzwert
m_SPS.WassserAblassen 3
Sleep 1000, True
m_SPS.WassserAblassen 0
m_Waage.TaraReset
m_Waage.SoftTaraReset
Do While m_Waage.Anwahl(m_Behaelter.m_WaageAnwahl) = False
If MsgBox("Waage (Anwahl=" & m_Behaelter.m_WaageAnwahl & ") konnte nicht angewählt werden." & vbCrLf & "Bitte Waagen-Reset (C-Taste) durchführen." & vbCrLf & "Möchten Sie die Waagenanwahl wiederholen ?" & vbCrLf & "Cancel bricht die Prüfung ab", vbOKCancel, "Waagen Fehler ?") = vbCancel Then
Call Abbruch
Exit Do
End If
Loop
'-----------------------------------------
If m_AnwahlLetzterBehaelter <> m_Behaelter.m_BehaelterAnwahl Then
' Behälter wurde gewechselt oder das erste mal benutzt
PrintStatus "Behälter wurde gewechselt oder das erste mal benutzt: (Anwahl von " & m_AnwahlLetzterBehaelter & " nach " & m_Behaelter.m_BehaelterAnwahl & ")"
m_AnwahlLetzterBehaelter = m_Behaelter.m_BehaelterAnwahl
PrintStatus "Wasser ganz ablassen"
'-----------------------------------------
' Wasser ganz ablassen
StartVolumen = 0
letztesGewicht = 0
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
PrintStatus ("Fehler: Gewicht konnte nicht gelesen werden")
Sleep 200, True
End If
If letztesGewicht = Gewicht Then Exit Do
letztesGewicht = Gewicht
If g_Abbruch = True Then
PrintStatus "initialisieren der Waage abgebrochen..."
Exit Function
End If
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'---------------------------------------
' Rohr füllen
Fuelldurchfluss = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(1).getQ
If Fuelldurchfluss > m_Behaelter.m_Fuelldurchfluss Then
' Bestimme den kleineren Durchfluß von Qmax-Zähler und Behälter
Fuelldurchfluss = m_Behaelter.m_Fuelldurchfluss
End If
Fuellvolumen = m_Behaelter.m_Fuellvolumen
If Fuellvolumen = 0 Then
Fuellvolumen = m_Behaelter.m_OVolumen * 0.1
PrintStatus "Füllvolumen auf 10% gesetzt. Bitte Fuellvolumen in ini Datei pflegen!"
End If
' Setze MID und MIDGruppe
Set Referenzzaehler = New CRefzaehler
Call Referenzzaehler.loadForDurchfluss(Fuelldurchfluss, g_App.Settings.getMIDGruppe)
m_SPS.SetMID Referenzzaehler.EinbauplatzNr
m_SPS.SetQDiff 0
m_SPS.AllePumpenAbwaehlen
Set Pumpe = Pumpenwahl(Fuelldurchfluss, m_ColPumpen)
Pumpe.Anwahl
PrintStatus "gewählte Pumpe: " & Pumpe.GetSPSVarname
'----------------------------------------------------------
' Füllen bis 10% des Behältervolumens
PrintStatus "Rohr füllen mit Fülldurchfluß " & Fuelldurchfluss & " auf Fuellvolumen " & Fuellvolumen & " l in " & m_Behaelter.m_OVolumen & " l Behälter"
m_SPS.SetServoStellung lookupFUServoStellwert(Fuelldurchfluss)
m_SPS.SetQSoll Fuelldurchfluss
lblSollV = Format(Fuellvolumen, "0.0")
lblQSoll.caption = Fuelldurchfluss
m_SPS.setBetrieb 0
Sleep 500, True
m_SPS.setBetrieb 2
Do
Sleep 1000, True
Gewicht = m_Waage.GetGewicht
lblGewicht = Gewicht
If Gewicht = -9999 Then
PrintStatus ("Fehler: Gewicht konnte nicht gelesen werden")
Sleep 200, True
End If
If g_Abbruch = True Then
PrintStatus "initialisieren abgebrochen..."
Exit Function
End If
Loop While Gewicht < Fuellvolumen
m_SPS.setBetrieb 0
lblQSoll.caption = 0
'-----------------------------------------
PrintStatus "Wasser ganz ablassen"
'-----------------------------------------
' Wasser ganz ablassen
StartVolumen = 0
letztesGewicht = 0
lblSollV.caption = "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 = Gewicht Then Exit Do
letztesGewicht = Gewicht
If g_Abbruch = True Then
PrintStatus "initialisieren abgebrochen..."
Exit Function
End If
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'---------------------------------------
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 m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000 > m_Behaelter.m_WaageGrenzwert Then
' Zuviel Wasser drin, also ablassen
'-----------------------------------------
PrintStatus "Zuviel Wasser drin, also ablassen"
' Wasser ganz ablassen
StartVolumen = 0
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
Sleep 2000, True
Do
Sleep 200, True
Gewicht = m_Waage.GetGewicht
lblGewicht = Gewicht
If Gewicht = -9999 Then
DebugMsg ("Fehler: Gewicht konnte nicht gelesen werden")
Sleep 200, True
End If
If g_Abbruch = True Then
PrintStatus "initialisieren abgebrochen..."
Exit Function
End If
If letztesGewicht = Gewicht Then Exit Do
letztesGewicht = Gewicht
Loop While Gewicht > StartVolumen
m_SPS.WassserAblassen 0
'-----------------------------------------
Else
PrintStatus "Prüfmenge-Erreicht-Signal zurücksetzen"
m_SPS.WassserAblassen 3
Sleep 1000
m_SPS.WassserAblassen 0
End If
' hier ist sichergestellt dass mind. noch das Sollvolumen hinein passt
' neuen Grenzwert für das Sollvolumen setzen
Gewicht = m_Waage.GetGewicht
lblGewicht = Format(Gewicht, "0.00")
PrintStatus "Warten auf Waagen Ruhe"
'm_Waage.WarteAufRuhe
m_Behaelter.WarteAufRuhe
Gewicht = m_Waage.GetGewicht
lblGewicht = Format(Gewicht, "0.00")
PrintStatus " neuer Grenzwert :" & Format(Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000, "0.000") & " + " & Format(m_VolumenSoll, "0.000") & " = " & Format(m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000, "0.000")
Waagengrenzwert = m_VolumenSoll + Errechne_Volumen_Von_Wasser_in_m3(Gewicht, m_SPS.GetEinlaufTemperatur) * 1000
lblGrenzwert.caption = Format(Waagengrenzwert, "0.00")
m_Waage.SetNettoGrenzwert1 Waagengrenzwert
' dieses Gewicht gilt
m_Waage.SoftTara
lblGewicht = "0"
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 "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(lngTimeMs As Long)
If g_ohneSPS = True Then
MsgBox ("Ist Solldurchfluß erreicht ?")
Exit Sub
End If
' 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 Then
PrintStatus "warten auf Solldurchfluss abgebrochen..."
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!" & " bei " & Format(m_SPS.getQIst, "0.000") & " m³/h"
End Sub
Private Sub KontinuierlichePruefungInit()
txtFlowMax.text = m_colUniquePP.Item(1).getQ
txtFlowMin.text = m_colUniquePP.Item(m_colUniquePP.Count).getQ
cmbKontSprung.AddItem "10"
cmbKontSprung.ListIndex = cmbKontSprung.ListCount - 1
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
initFlexgrid
End Sub
Private Sub initFlexgrid()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim PZCount As Integer
PZCount = 0
MSFlexGrid1.Rows = 10
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
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.row = Einbauplatz.getNr
MSFlexGrid1.col = 0
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 bImpulsTest As Boolean
Dim bImpulsTestVorbei As Boolean
Dim lngSuccess As Long
Dim dbl_Volumen_PZ As Double
Dim dbl_Time_PZ As Double
m_bEichpruefvorgabenIgnorieren = True
If m_SPS Is Nothing Then
Set m_SPS = New CSPS
m_SPS.setBetrieb 0
End If
Sleep 2000
lblGesZeit.Visible = False
Set m_Referenzzaehler = New CRefzaehler
If g_Abbruch Then
PrintStatus "kontinuierliche Prüfung abgebrochen."
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)
If Not g_ohneSPS Then
m_SPS.SetQDiff 0 ' m_Referenzzaehler.letzterFehler(m_DurchflussSoll)
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
End If
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 g_ohneSPS Then
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
End If
If Not m_Pumpe.IstOkFuerDurchfluss(m_DurchflussSoll) Then
' Pumpe wechseln
If Not g_ohneSPS Then
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
End If
If g_ohneSPS Then
Temperatur = 22
Else
' hier gehts los, Pumpe und MID sind eingestellt
Temperatur = m_SPS.GetEinlaufTemperatur
End If
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 ''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not g_ohneSPS Then
' Durchfluß einstellen
m_SPS.SetQSoll m_DurchflussSoll
Else
'MsgBox "Bitte den Durchfluß " & m_DurchflussSoll & " m³/h einstellen ", vbInformation, "SPS ist nicht erreichbar!"
End If
lblQSoll.caption = m_DurchflussSoll
If bBetriebNeustart = True Then
' Pumpe oder MID wechseln
If Not g_ohneSPS 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
End If
bBetriebNeustart = False
End If
Call WarteAufSolldurchflussErreicht(3000)
If m_blnDoWinkelmessung Then
LeseWinkel
End If
'sleep 2000
Call initFM85undTurbofuerPP
End If ' keine Waage
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PrintStatus " Prüfung läuft, Qist=" & Format(m_SPS.getQIst, "0.000") & ", QSoll=" & m_DurchflussSoll
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
' FM85P mit entspr. Adresse ansprechen
m_FMBus.send "**" & EinbauplatzNr & "@"
m_FMBus.receive (500)
m_FMBus.send "U"
Impulse = CLng("&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
PrintStatus "kontinuierliche Prüfung abgebrochen."
Exit Sub
End If
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³"
MSFlexGrid1.Cols = MSFlexGrid1.Cols + 1
For Each Einbauplatz In m_colEinbauplatz
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then
NOWA_STOP
' ' FM85P mit entspr. Adresse ansprechen
' m_FMBus.send "**" & Einbauplatz.getNr & "@"
' m_FMBus.receive (500)
'
' m_FMBus.send "U"
' Impulse = CLng("&H0" & m_FMBus.receive(500))
' ' Prüfzählermpulse Anzeige aktualisieren
' lblPZImpulse(Einbauplatz.getNr).Caption = Str(Impulse)
lngSuccess = NOWA_Read_Volume_Time(EinbauplatzNr, dbl_Volumen_PZ, dbl_Time_PZ)
PrintStatus "NOWA_READ: Volumen=" & dbl_Volumen_PZ & " m³/h"
PrintStatus "NOWA_READ: Zeit =" & dbl_Time_PZ & " ms"
' Fehlerermittlung
' Fehler = (Impulse / Pruefzaehler.GetImpulseQM - dblVolumenWaage) * 100 / dblVolumenWaage
Fehler = (dbl_Volumen_PZ - dblVolumenWaage) * 100 / dblVolumenWaage
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
' 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."
'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)
If Not g_ohneSPS Then
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
End If
' 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
'
' ' 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))
' lblPZImpulse(Einbauplatz.getNr) = Impulse
'
' 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
' 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
' 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
'
' 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
' Verbeleibende Zeit für die Turbo2e Messung
If PP_Ist_Zeit >= m_Pruefzeit Then
AlleImpulseFertig = True
Else
Debug.Print "PP_Ist_Zeit = m_Pruefzeit !"
End If
If g_Abbruch Then
PrintStatus "kontinuierliche Prüfung abgebrochen."
Exit Sub
End If
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
m_FMBus.receive (500)
'Verbleibende RZ Impuse
m_FMBus.send "J"
Impulse = Hex2Long(m_FMBus.receive(500))
lblVerbleibRZ.caption = Str(Impulse)
If Impulse > 0 Then
AlleImpulseFertig = False
Else
Debug.Print "Verbleibende RZ Impulse=0"
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
If PP_Ist_Zeit < m_Pruefzeit Then
AlleImpulseFertig = False
End If
Loop While AlleImpulseFertig = False
' Prüfzeit messen/stoppen in s
m_Tpruef = (GetTickCount - m_Startzeit) \ 1000
NOWA_STOP
Sleep 1000
If Not g_ohneSPS Then
QIstSPS = Format(m_SPS.getQIst, "0.000")
End If
If g_Abbruch Then
PrintStatus "kontinuierliche Prüfung abgebrochen."
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''' Fehlerermittlung '''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_FMBus.dialog "**" & m_ersterPruefzaehlerNr & "@", "" ', m_ersterPruefzaehlerNr
If g_Abbruch Then
PrintStatus "kontinuierliche Prüfung abgebrochen."
Exit Sub
End If
' Periodendauer über n Perioden des Referenzzaehlers auslesen
m_FMBus.send "Y"
PeriodendauerRZ = Hex2Long(m_FMBus.receive(500))
PrintStatus "Referenzzaehler Periodendauer = " & PeriodendauerRZ
MSFlexGrid1.Cols = MSFlexGrid1.Cols + 1
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If (Not Pruefzaehler Is Nothing) Then ' And (Einbauplatz.getAktiv = True) Then
' Pruefzaehler im Einbauplatz vorhanden
' ' FM85P mit entspr. Adresse ansprechen
' m_FMBus.send "**" & Einbauplatz.getNr & "@"
' m_FMBus.receive (500)
'
' m_FMBus.send "U"
' Impulse = CLng("&H0" & m_FMBus.receive(500))
' ' Prüfzählermpulse Anzeige aktualisieren
' lblPZImpulse(Einbauplatz.getNr).Caption = Str(Impulse)
NOWA_Read_Volume_Time Einbauplatz.getNr, dbl_Volumen_PZ, dbl_Time_PZ
PrintStatus "NOWA_READ: Volumen=" & dbl_Volumen_PZ & " m³/h"
PrintStatus "NOWA_READ: Zeit =" & dbl_Time_PZ & " ms"
If m_PruefungsArtWaage Then
' Fehlerermittlung
' ' Fehler = (Impulse / Pruefzaehler.GetImpulseQM - BehaelterVolumen) * 100 / BehaelterVolumen
Fehler = (dbl_Volumen_PZ - BehaelterVolumen) * 100 / BehaelterVolumen
PrintStatus " PZ" & Einbauplatz.getNr & " Fehler=" & Format(Fehler, "0.00") & " %"
Else
' ' Periodendauer über n Perioden auslesen
' m_FMBus.send "X"
' PeriodendauerPZ = Val("&H0000" & m_FMBus.receive(500))
'
' PrintStatus "** Pruefzaehler " & Einbauplatz.getNr & " Periodendauer = " & PeriodendauerPZ
If Not PeriodendauerRZ = 0 Then
FehlerRefZ = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, m_SPS.GetEinlaufTemperatur())
PrintStatus "letzter Fehler des RZ: " & FehlerRefZ
Dim QIst As Double
' Speichern des IstDurchflusses, berechnet aus Referenzzähler Werten
QIst = (m_AnzahlPeriodenRZ / m_Referenzzaehler.ImpulseQM) / (PeriodendauerRZ / 2994) * 3600 * (1 - FehlerRefZ / 100)
PrintStatus "Durchfluss vom RZ korrigiert Qist=" & Int(QIst * 100000 + 0.5) / 100000 & " m³/h"
' 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 dbl_Time_PZ > 0 And dbl_Volumen_PZ > 0 Then
Dim dblQsoll As Double
dblQsoll = dbl_Volumen_PZ / (dbl_Time_PZ / 3600000) ' m³
PrintStatus "NOWA Durchfluss Qsoll=" & dblQsoll
Dim AnzahlPulse As Long
AnzahlPulse = (m_Pruefzeit / 3600) * m_DurchflussSoll * (m_Referenzzaehler.ImpulseQM)
dblVolumenRZ = AnzahlPulse / m_Referenzzaehler.ImpulseQM ' in m³
QIstSPS = 3600 * dblVolumenRZ / (PeriodendauerRZ / 2994)
'QIstSPS = m_Referenzzaehler.ImpulseQM() / PeriodendauerRZ * (1 - FehlerRefZ / 100)
PrintStatus "Letzter Fehler des Referenzzählers : " & Format(FehlerRefZ, "0.00") & " %"
If dbl_Volumen_PZ <> 0 Then
Fehler = (dblQsoll - QIst) * 100 / QIst
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 "NOWA_READ lieferte falsche Werte"
Fehler = 97 'Merker für NOWA_READ lieferte falsche Werte
End If
Else
PrintStatus ("Fehler: Die Periodendauer des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden (=0)")
Fehler = 98 'Merker für Periodendauer des Referenz-Zählers konnte aus den FM85 nicht ermittelt werden
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
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
''''''''''''''''''''''''''''''''''''''''''''''''
''MSFlexGrid1.Cols = MSFlexGrid1.Cols + 1
MSFlexGrid1.row = 0
MSFlexGrid1.col = MSFlexGrid1.Cols - 1
MSFlexGrid1.text = Left(Format(m_DurchflussSoll, "0.000"), 5)
'If m_DurchflussSoll >= 1 Then
' MSFlexGrid1.text = Left(Format(m_DurchflussSoll, "0.000"), 5) & " m³/h"
'Else
' MSFlexGrid1.text = Left(Format(m_DurchflussSoll * 1000, "0"), 5) & " l/h"
'End If
MSFlexGrid1.row = EinbauplatzNr
MSFlexGrid1.text = Format(Fehler, "0.00")
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 NOWA_START() As Long
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim lngSuccess As Long
Dim objSensusInterface As SensusIF2.Interface
Dim comport As Integer
Dim lngAnzahlVersuche As Long
Const MAXANZAHLVERSUCHE = 3
For Each Einbauplatz In m_colEinbauplatz
Debug.Print "Einbauplatz: " & Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If (Not Pruefzaehler.getPruefpunkte Is Nothing) Then
comport = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If comport <> 0 Then
Set objSensusInterface = New SensusIF2.Interface
objSensusInterface.CommPortNr = comport
objSensusInterface.DebugWindowsIsVisible = False
lngSuccess = objSensusInterface.PortInit
If lngSuccess = 1 Then
lngAnzahlVersuche = 0
Do
lngSuccess = objSensusInterface.Do_NOWA_Start
If lngSuccess = 1 Then
PrintStatus "NOWA_START an Einbauplatz " & Einbauplatz.getNr & " OK"
Else
lngAnzahlVersuche = lngAnzahlVersuche + 1
PrintStatus "Versuch " & lngAnzahlVersuche & "/" & MAXANZAHLVERSUCHE & ": Fehler & " & lngSuccess & " bei NOWA_START an Einbauplatz " & Einbauplatz.getNr & ": " & objSensusInterface.GetErrorMessage(lngSuccess)
PrintStatus "letzte Frage war '" & text2hex(objSensusInterface.lastInput) & "'"
PrintStatus "letzte Antwort war '" & text2hex(objSensusInterface.lastOutput) & "'"
End If
Loop While lngSuccess <> 1 And lngAnzahlVersuche < MAXANZAHLVERSUCHE
Else
PrintStatus "Fehler & " & lngSuccess & " bei PortInit (NOWA_START) an Einbauplatz " & Einbauplatz.getNr & ": " & objSensusInterface.GetErrorMessage(lngSuccess)
End If
Set objSensusInterface = Nothing
End If
End If 'pruefzaehler.getPruefpunkte Is Nothing
End If ' pruefzaehler Is Nothing
Next
End Function
Private Function NOWA_STOP() As Long
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim objSensusInterface As SensusIF2.Interface
Dim comport As Integer
Dim lngAnzahlVersuche As Long
Const MAXANZAHLVERSUCHE = 3
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If (Not Pruefzaehler.getPruefpunkte Is Nothing) Then
comport = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If comport <> 0 Then
Set objSensusInterface = New SensusIF2.Interface
objSensusInterface.CommPortNr = comport
NOWA_STOP = objSensusInterface.PortInit
If NOWA_STOP = 1 Then
lngAnzahlVersuche = 0
Do
NOWA_STOP = objSensusInterface.Do_NOWA_Stop
If NOWA_STOP = 1 Then
PrintStatus "NOWA_STOP an Einbauplatz " & Einbauplatz.getNr & " OK"
Else
lngAnzahlVersuche = lngAnzahlVersuche + 1
PrintStatus "Versuch " & lngAnzahlVersuche & "/" & MAXANZAHLVERSUCHE & "Fehler & " & NOWA_STOP & " bei NOWA_STOP an Einbauplatz " & Einbauplatz.getNr & ": " & objSensusInterface.GetErrorMessage(NOWA_STOP)
PrintStatus "letzte Frage war '" & text2hex(objSensusInterface.lastInput) & "'"
PrintStatus "letzte Antwort war '" & text2hex(objSensusInterface.lastOutput) & "'"
End If
Loop While NOWA_STOP <> 1 And lngAnzahlVersuche < MAXANZAHLVERSUCHE
Else
PrintStatus "Fehler & " & NOWA_STOP & " bei PortInit (NOWA_STOP) an Einbauplatz " & Einbauplatz.getNr & ": " & objSensusInterface.GetErrorMessage(NOWA_STOP)
End If
End If
End If 'pruefzaehler.getPruefpunkte Is Nothing
End If ' pruefzaehler Is Nothing
Next
End Function
Private Function NOWA_Read_Volume_Time(ByVal EinbauplatzNr As Integer, dbl_NOWA_Volume As Double, dbl_NOWA_time As Double) As Long
On Error GoTo Errorhandler
Dim comport As Integer
Dim objSensusInterface As SensusIF2.Interface
Dim udtEinheit As SENSUSIF_EINHEIT
Dim lngAnzahlVersuche As Long
Const MAXANZAHLVERSUCHE = 3
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
Set objSensusInterface = New SensusIF2.Interface
objSensusInterface.CommPortNr = comport
objSensusInterface.DebugWindowsIsVisible = False
NOWA_Read_Volume_Time = objSensusInterface.PortInit
If NOWA_Read_Volume_Time = 1 Then
NOWA_Read_Volume_Time = 0
lngAnzahlVersuche = 0
Do
NOWA_Read_Volume_Time = objSensusInterface.Do_Nowa_Read_Volume_Time(dbl_NOWA_Volume, udtEinheit, dbl_NOWA_time)
lngAnzahlVersuche = lngAnzahlVersuche + 1
If NOWA_Read_Volume_Time <> 1 Then
lngAnzahlVersuche = lngAnzahlVersuche + 1
PrintStatus "Versuch " & lngAnzahlVersuche & "/" & MAXANZAHLVERSUCHE & ": Fehler & " & NOWA_Read_Volume_Time & " bei Do_Nowa_Read_Volume_Time an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(NOWA_Read_Volume_Time)
PrintStatus "letze Frage war '" & objSensusInterface.lastInput & "'"
PrintStatus "letze Antwort war '" & objSensusInterface.lastOutput & "'"
End If
Loop While NOWA_Read_Volume_Time <> 1 And lngAnzahlVersuche < MAXANZAHLVERSUCHE
If NOWA_Read_Volume_Time = 1 Then
If udtEinheit <> SensusIF2.M3 Then
MsgBox "Bitte Turbo2e Einheit auf m³ stellen !"
End If
Else
PrintStatus "wiederholter Fehler " & NOWA_Read_Volume_Time & " in Nowa_Read an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(NOWA_Read_Volume_Time)
End If
Else
PrintStatus "Fehler " & NOWA_Read_Volume_Time & " in Nowa_Read(PortInit) an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(NOWA_Read_Volume_Time)
End If
Set objSensusInterface = Nothing
Exit Function
Errorhandler:
NOWA_Read_Volume_Time = Err.Number
PrintStatus "Fehler " & NOWA_Read_Volume_Time & " in Nowa_Read_Volume_Time/Errorhandler an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(NOWA_Read_Volume_Time)
End Function
Private Function SetFactoryCorrection(ByVal EinbauplatzNr As Integer, ByVal dbl_Correction As Double) As Long
On Error GoTo Errorhandler
Dim comport As Integer
Dim objSensusInterface As SensusIF2.Interface
Dim lngAnzahlVersuche As Long
Const MAXANZAHLVERSUCHE = 3
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
Set objSensusInterface = New SensusIF2.Interface
objSensusInterface.CommPortNr = comport
objSensusInterface.DebugWindowsIsVisible = False
SetFactoryCorrection = objSensusInterface.PortInit
lngAnzahlVersuche = 0
If SetFactoryCorrection = 1 Then
Do
SetFactoryCorrection = objSensusInterface.SetFactoryCorrection(dbl_Correction)
If SetFactoryCorrection <> 1 Then
lngAnzahlVersuche = lngAnzahlVersuche + 1
PrintStatus "Versuch " & lngAnzahlVersuche & "/" & MAXANZAHLVERSUCHE & "Fehler & " & SetFactoryCorrection & " bei SetFactoryCorrection an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(SetFactoryCorrection)
PrintStatus "letzte Frage war '" & text2hex(objSensusInterface.lastInput) & "'"
PrintStatus "letzte Antwort war '" & text2hex(objSensusInterface.lastOutput) & "'"
End If
Loop While SetFactoryCorrection <> 1 And lngAnzahlVersuche < MAXANZAHLVERSUCHE
End If
Exit Function
Errorhandler:
SetFactoryCorrection = Err.Number
PrintStatus "Fehler " & SetFactoryCorrection & " in SetFactoryCorrection an Einbauplatz " & EinbauplatzNr & ": " & objSensusInterface.GetErrorMessage(SetFactoryCorrection)
End Function
Public Sub LeseWinkel()
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim comport As Integer
Dim objSensusInterface As SensusIF2.Interface
Dim lngSuccess As Long
Dim lngWinkelMalZehn As Long
Dim rs As CRecordset
Dim dblWinkel As Double
Dim i As Integer
If m_blnDoWinkelmessung = False Then Exit Sub
If m_bKontinuierlich = False Then
MSFlexGrid1.col = 1
Else
m_DurchflussSollManuell = m_SPS.getQIst
End If
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If m_bKontinuierlich = False Then
MSFlexGrid1.col = 1
MSFlexGrid1.row = Einbauplatz.getNr
End If
If Not Pruefzaehler Is Nothing Then
comport = Val(g_App.Settings.getUSComPort(Einbauplatz.getNr))
If comport <> 0 Then
PrintStatus "Winkelmessung für Einbauplatz " & Einbauplatz.getNr
Set objSensusInterface = New SensusIF2.Interface
objSensusInterface.CommPortNr = comport
objSensusInterface.DebugWindowsIsVisible = False
lngSuccess = objSensusInterface.PortInit
If lngSuccess = 1 Then
For i = 1 To 10
If g_Abbruch = True Then
PrintStatus "Lese Winkel abgebrochen..."
Exit Sub
End If
lngSuccess = objSensusInterface.GetAngle(lngWinkelMalZehn, 3000)
If lngSuccess = 1 Then
dblWinkel = Round(lngWinkelMalZehn / 10, 1)
PrintStatus i & ". Winkel bei Einbauplatz " & Einbauplatz.getNr & " = " & dblWinkel & "°"
If m_bKontinuierlich = False Then
MSFlexGrid1.text = dblWinkel
End If
Else
If m_bKontinuierlich = False Then
MSFlexGrid1.text = "?"
End If
End If
Set rs = New CRecordset
rs.openRS "SELECT * from Turbo2Winkel where 1=0", False
rs.addNew
rs.setValue "FabNr", Pruefzaehler.getAuftragPositionSerienNr.getFabNr
rs.setValue "PruefgangNr", m_Pruefgang.PruefgangNr
rs.setValue "Winkel", dblWinkel
rs.setValue "Q", Round(m_DurchflussSollManuell, 5)
rs.update
Next
Else
If m_bKontinuierlich = False Then
MSFlexGrid1.text = "?"
End If
End If 'success = 1
End If ' comport <> 0
End If 'Pruefzaehler is nothing
Next Einbauplatz
Exit Sub
Errorhandler:
ErrorMsg "Fehler " & Err.Number & " in LeseWinkel:" & Err.Description
End Sub
''''''''''''''''''''''' Bemerkungen
Private Sub MSFlexGrid1_DblClick()
If g_blnVersuch = False Then Exit Sub
Dim row As Integer
Dim SerienNr As Long
Dim strText As String
row = MSFlexGrid1.row
SerienNr = Val(MSFlexGrid1.TextMatrix(row, 0))
If SerienNr > 0 Then
MSFlexGrid1.row = row
MSFlexGrid1.col = 1
txtBemerkung.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left + Frame2.Left
txtBemerkung.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top + Frame2.Top
txtBemerkung.Width = MSFlexGrid1.Width - MSFlexGrid1.CellLeft - 100
txtBemerkung.Visible = True
txtBemerkung.Enabled = True
txtBemerkung.Tag = SerienNr
'' Laden der Bemerkung
LoadPrueffehlerInfo m_Pruefgang.PruefgangNr, SerienNr, strText
txtBemerkung.text = strText
txtBemerkung.SetFocus
End If
End Sub
Private Sub txtBemerkung_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtBemerkung.Enabled = False
If txtBemerkung.Visible = True Then
SpeichereBemerkungUndSchliesseEingabe
End If
End If
End Sub
Private Sub txtBemerkung_LostFocus()
txtBemerkung.Enabled = False
If txtBemerkung.Visible = True Then
SpeichereBemerkungUndSchliesseEingabe
End If
End Sub
Private Sub SpeichereBemerkungUndSchliesseEingabe()
Dim SerienNr As Long
Dim strText As String
SerienNr = Val(txtBemerkung.Tag)
strText = txtBemerkung.text
SavePrueffehlerInfo m_Pruefgang.PruefgangNr, SerienNr, strText
txtBemerkung.Tag = ""
txtBemerkung.Visible = False
End Sub
Reference in New Issue View Git Blame Copy Permalink