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

4280 lines
142 KiB
Plaintext
Raw Blame History

VERSION 5.00
Begin VB.Form frmTurbo2PruefzaehlerPruefung
BackColor = &H8000000B&
BorderStyle = 0 'Kein
Caption = "Pruef2000"
ClientHeight = 11520
ClientLeft = 105
ClientTop = 105
ClientWidth = 15240
HelpContextID = 1
Icon = "Turbo2PruefzaehlerPruefung.frx":0000
LinkTopic = "Form1"
Moveable = 0 'False
ScaleHeight = 11520
ScaleWidth = 15240
ShowInTaskbar = 0 'False
StartUpPosition = 1 'Fenstermitte
Begin VB.Frame frMain
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 11445
Left = 0
TabIndex = 12
Top = 0
Width = 13275
Begin VB.Frame Frame6
Caption = "Impulswertigkeit"
Height = 795
Left = 5820
TabIndex = 104
Top = 9420
Width = 4035
End
Begin VB.Frame frmPruefprotokollDrucken
Caption = "Prüfprotokoll"
Height = 735
Left = 10380
TabIndex = 101
Top = 9450
Width = 2655
Begin VB.CheckBox chkProtokolldruck
Caption = "Protokoll drucken"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 300
TabIndex = 102
ToolTipText = "Aktivieren Sie diese Checkbox, um nach der Prüfung ein Protokoll zu drucken."
Top = 210
Width = 2055
End
End
Begin VB.Frame FrpruefPunkte
Caption = "Prüfpunkte"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4605
Left = 10380
TabIndex = 28
Top = 1500
Width = 2715
Begin VB.ComboBox cmbWinkelDurchfluss
Height = 315
Left = 420
TabIndex = 120
ToolTipText = "Auswahl des Durchflusses für die Winkelprüfung"
Top = 3900
Width = 1695
End
Begin VB.ComboBox cmbPruefpunkte
Height = 315
Left = 390
Style = 2 'Dropdown-Liste
TabIndex = 50
Top = 3120
Width = 1635
End
Begin VB.ListBox lstPruefpunkte
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1020
Left = 360
TabIndex = 29
Top = 1680
Width = 1695
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Winkelprüfpunkt:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 150
TabIndex = 121
Top = 3600
Width = 1470
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Regulier-Prüfpunkt:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 49
Top = 2820
Width = 1695
End
Begin VB.Label lblMaxPP
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Max. Prüfpunkte]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 300
TabIndex = 33
Top = 540
Width = 2115
End
Begin VB.Label lblMaxPPInfo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Max. Prüfpunkte:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 32
Top = 300
Width = 1455
End
Begin VB.Label lblUniquePP
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Anz. Prüfpunkte]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 300
TabIndex = 31
Top = 1080
Width = 2115
End
Begin VB.Label lblUniquePPInfo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Eindeutige Prüfpunkte:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 30
Top = 840
Width = 1995
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 1
Left = 570
TabIndex = 23
Top = 150
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 1
Left = 2460
TabIndex = 109
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 1
Left = 2010
TabIndex = 1
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Index = 1
Left = 210
TabIndex = 0
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 1
Left = 2010
TabIndex = 53
Top = 540
Width = 1935
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 375
Index = 1
Left = 240
TabIndex = 24
Top = 240
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 1
Left = 3480
Top = 600
Width = 480
End
End
Begin VB.Timer timer1
Enabled = 0 'False
Left = 5400
Top = 240
End
Begin VB.CommandButton cmdOK
Caption = "Prüfung starten"
DownPicture = "Turbo2PruefzaehlerPruefung.frx":000C
Enabled = 0 'False
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 = 11280
TabIndex = 62
Top = 10440
Width = 1875
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
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 = 8550
TabIndex = 61
Top = 10440
Width = 1845
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 = 5550
TabIndex = 60
Top = 10470
Width = 1935
End
Begin VB.Frame Frame4
Caption = "Prüfgang Nr"
Height = 735
Left = 10380
TabIndex = 51
Top = 8580
Width = 2715
Begin VB.Label lblPruefgangNr
BorderStyle = 1 'Fest Einfach
Height = 285
Left = 810
TabIndex = 52
Top = 300
Width = 1635
End
End
Begin VB.Frame Frame1
Caption = "Regulierung"
Height = 1095
Left = 5820
TabIndex = 43
Top = 2160
Width = 4035
Begin VB.ComboBox cmbSollFehler
Height = 315
Left = 1260
Style = 2 'Dropdown-Liste
TabIndex = 106
Top = 660
Width = 735
End
Begin VB.CheckBox chkRegulierungDurchfuehren
Caption = "automatische Regulierung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 450
TabIndex = 97
Top = 300
Value = 1 'Aktiviert
Width = 3375
End
Begin VB.Label Label5
Caption = "%"
Height = 255
Left = 2100
TabIndex = 107
Top = 720
Width = 255
End
Begin VB.Label Label4
Alignment = 1 'Rechts
Caption = "SollFehler"
Height = 255
Left = 300
TabIndex = 105
Top = 720
Width = 855
End
End
Begin VB.Frame frame3
Caption = "Optionen"
Height = 6015
Left = 5850
TabIndex = 39
Top = 3300
Width = 4035
Begin VB.CheckBox chkWinkelmessung
Caption = "Winkel messen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 122
Top = 3780
Width = 3375
End
Begin VB.CheckBox chkVersuch
Caption = "Versuch-Prüfung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 119
Top = 3420
Width = 3375
End
Begin VB.CheckBox chkEichpruefvorgabenIgnorieren
Caption = "Eichpruefvorgaben ignorieren"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 100
Top = 3000
Width = 3615
End
Begin VB.CheckBox chkKontinuierlichePrf
Caption = "nur Kontinuierliche Prüfung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 99
Top = 2580
Width = 3255
End
Begin VB.CheckBox chkRueckwaertsprf
Caption = "Rückwärtsprüfung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 98
Top = 2160
Width = 2415
End
Begin VB.CheckBox chkRegulierungVerwenden
Caption = "Reguliervorgabe = Fehlerwert"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 59
Top = 1710
Width = 3435
End
Begin VB.OptionButton OptPrfArt
Caption = "Referenzzähler"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 1
Left = 960
TabIndex = 47
Top = 4920
Width = 2685
End
Begin VB.OptionButton OptPrfArt
Caption = "Waage"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 960
TabIndex = 46
Top = 4590
Width = 2265
End
Begin VB.TextBox txtAnzahlDauerPrf
Enabled = 0 'False
Height = 315
Left = 1890
TabIndex = 44
Text = "1"
Top = 630
Width = 495
End
Begin VB.CheckBox chkNurMesseinsaetze
Caption = "Nur Meßeinsätze"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 300
TabIndex = 42
ToolTipText = "Meßeinsätze"
Top = 1500
Width = 2355
End
Begin VB.CheckBox chkDauerpruefung
Caption = "Dauerprüfung"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 300
TabIndex = 41
Top = 240
Width = 1995
End
Begin VB.CheckBox chkPruefgangLang
Caption = "Prüfgang Lang"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 300
TabIndex = 40
Top = 960
Width = 1995
End
Begin VB.Label lblPrfArt
Caption = "Prüfung mit:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 390
TabIndex = 48
Top = 4320
Width = 3255
End
Begin VB.Label lblDauer2
Caption = "Anzahl:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 45
Top = 660
Width = 915
End
End
Begin VB.Frame Frame2
Caption = "Regelart kommt raus"
Height = 1875
Left = 10380
TabIndex = 36
Top = 6540
Visible = 0 'False
Width = 2715
Begin VB.OptionButton OptRegelart
Caption = "Servo"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 240
TabIndex = 38
Top = 780
Width = 2355
End
Begin VB.OptionButton OptRegelart
Caption = "Frequenzumrichter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 240
TabIndex = 37
Top = 360
Width = 2355
End
End
Begin VB.Frame FrPruefer
Caption = "Prüfer:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 10380
TabIndex = 34
Top = 660
Width = 2715
Begin VB.Label lblPruefer
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Mitarbeiter Name]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 35
Top = 360
Width = 2115
End
End
Begin VB.Frame frmScanner
Caption = "Scanner Eingabe"
Height = 1455
Left = 5820
TabIndex = 25
Top = 540
Width = 1935
Begin VB.CommandButton cmdStopScan
Caption = "STOP SCAN"
Height = 315
Left = 120
TabIndex = 108
Top = 540
Width = 1215
End
Begin VB.TextBox txtScanner
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 120
MaxLength = 9
TabIndex = 26
Top = 960
Width = 1575
End
Begin VB.Label lblScanStat
BackStyle = 0 'Transparent
Caption = "x"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1500
TabIndex = 103
Top = 300
Width = 255
End
Begin VB.Shape Shape1
BorderColor = &H00000000&
BorderStyle = 2 'Strich
BorderWidth = 2
FillColor = &H000080FF&
FillStyle = 0 'Ausgefüllt
Height = 435
Left = 1260
Shape = 3 'Kreis
Top = 240
Width = 615
End
Begin VB.Label lblScanner
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 27
Top = 660
Width = 1575
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 2
Left = 570
TabIndex = 21
Top = 1140
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 2
Left = 2430
TabIndex = 110
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 2
Left = 1980
TabIndex = 3
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 2
Left = 210
TabIndex = 2
Top = 630
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 1980
TabIndex = 54
Top = 600
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 2
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 225
Index = 2
Left = 210
TabIndex = 22
Top = 270
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 3
Left = 570
TabIndex = 19
Top = 2130
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 3
Left = 2460
TabIndex = 111
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 3
Left = 1980
TabIndex = 5
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 3
Left = 270
TabIndex = 4
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 3
Left = 1980
TabIndex = 55
Top = 510
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 3
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 255
Index = 3
Left = 240
TabIndex = 20
Top = 240
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 4
Left = 570
TabIndex = 17
Top = 3120
Width = 3975
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 4
Left = 2430
TabIndex = 112
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 4
Left = 1980
TabIndex = 7
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 4
Left = 240
TabIndex = 6
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 4
Left = 1980
TabIndex = 56
Top = 600
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 4
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 4
Left = 240
TabIndex = 18
Top = 240
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 5
Left = 570
TabIndex = 15
Top = 4110
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 5
Left = 2430
TabIndex = 113
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 5
Left = 1980
TabIndex = 9
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 5
Left = 240
TabIndex = 8
Top = 660
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 5
Left = 1980
TabIndex = 57
Top = 600
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 5
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 375
Index = 5
Left = 120
TabIndex = 16
Top = 210
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 6
Left = 570
TabIndex = 13
Top = 5100
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 6
Left = 2460
TabIndex = 114
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 6
Left = 1980
TabIndex = 11
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 6
Left = 240
TabIndex = 10
Top = 600
Width = 1695
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 6
Left = 210
TabIndex = 14
Top = 240
Width = 3555
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 6
Left = 1980
TabIndex = 58
Top = 570
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 6
Left = 3480
Top = 600
Width = 480
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 7
Left = 570
TabIndex = 64
Top = 6090
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 7
Left = 2430
TabIndex = 115
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 7
Left = 1980
TabIndex = 66
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 7
Left = 240
TabIndex = 65
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 7
Left = 1980
TabIndex = 68
Top = 540
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 7
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 7
Left = 240
TabIndex = 67
Top = 210
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 8
Left = 570
TabIndex = 69
Top = 7080
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 8
Left = 2460
TabIndex = 116
Top = 840
Width = 945
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 8
Left = 240
TabIndex = 71
Top = 660
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 8
Left = 1980
TabIndex = 70
Top = 870
Width = 405
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 315
Index = 8
Left = 240
TabIndex = 73
Top = 210
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 8
Left = 3480
Top = 630
Width = 480
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 8
Left = 1980
TabIndex = 72
Top = 630
Width = 1935
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 9
Left = 570
TabIndex = 74
Top = 8130
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 9
Left = 2460
TabIndex = 117
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 9
Left = 1980
TabIndex = 76
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 9
Left = 240
TabIndex = 75
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 9
Left = 1980
TabIndex = 78
Top = 600
Width = 1935
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 9
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 9
Left = 270
TabIndex = 77
Top = 180
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 10
Left = 570
TabIndex = 89
Top = 9150
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 10
Left = 2430
TabIndex = 118
Top = 810
Width = 945
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 10
Left = 240
TabIndex = 91
Top = 600
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 10
Left = 1980
TabIndex = 90
Top = 810
Width = 405
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 10
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 10
Left = 2010
TabIndex = 92
Top = 570
Width = 1935
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 10
Left = 240
TabIndex = 93
Top = 210
Width = 3675
End
End
Begin VB.Frame Frame5
Caption = "Servo/FU Voreinstellwert"
Height = 1095
Left = 7800
TabIndex = 94
Top = 540
Width = 2055
Begin VB.ComboBox cmbAnzahlZaehler
Height = 315
Left = 1080
Style = 2 'Dropdown-Liste
TabIndex = 95
Top = 450
Width = 615
End
Begin VB.Label Label2
Caption = "Anzahl der Prüfzähler"
Height = 495
Left = 120
TabIndex = 96
Top = 360
Width = 915
End
End
Begin VB.Image imgSchloss
Height = 375
Index = 10
Left = 5280
Top = 9840
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 9
Left = 5280
Top = 8820
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 8
Left = 5280
Top = 7800
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 7
Left = 5280
Top = 6780
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 6
Left = 5280
Top = 5820
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 5
Left = 5280
Top = 4800
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 4
Left = 5280
Top = 3840
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 3
Left = 5280
Top = 2820
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 2
Left = 5280
Top = 1860
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 0
Left = 4980
Top = 240
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 1
Left = 5340
Top = 840
Width = 375
End
Begin VB.Image imgZaehler
Height = 630
Index = 10
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 9600
Width = 615
End
Begin VB.Label lblEbpNr
Caption = "10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 10
Left = 60
TabIndex = 88
Top = 9660
Width = 375
End
Begin VB.Label lblEbpNr
Caption = "9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 9
Left = 210
TabIndex = 87
Top = 8700
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 8
Left = 210
TabIndex = 86
Top = 7710
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 7
Left = 210
TabIndex = 85
Top = 6690
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 6
Left = 210
TabIndex = 84
Top = 5670
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 5
Left = 210
TabIndex = 83
Top = 4710
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 4
Left = 210
TabIndex = 82
Top = 3690
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 3
Left = 210
TabIndex = 81
Top = 2700
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 210
TabIndex = 80
Top = 1710
Width = 285
End
Begin VB.Label lblEbpNr
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 240
TabIndex = 79
Top = 720
Width = 285
End
Begin VB.Image imgZaehler
Height = 630
Index = 9
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 8580
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 8
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 7560
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 7
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 6540
Width = 615
End
Begin VB.Label lblTitle
Caption = "Prüfvorbereitung Turbo2e"
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 = 5760
TabIndex = 63
Top = 180
Width = 10695
End
Begin VB.Image imgZaehler
Height = 630
Index = 1
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 600
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 2
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 1620
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 3
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 2580
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 4
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 3570
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 5
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 4560
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 6
Left = 4650
MousePointer = 99 'Benutzerdefiniert
Top = 5520
Width = 615
End
End
End
Attribute VB_Name = "frmTurbo2PruefzaehlerPruefung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'==============================================================================
'
' File : Turbo2PruefzaehlerPruefung.frm
' Date : 24.03.1999
' Version: 1.00
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
'==============================================================================
'
' Einholen der Serien-Nr. für eine Prüfzählerprüfung
'
'==============================================================================
'
' History:
'
' Date : 24.03.1999
' Version: 1.00
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
' Erste dokumentierte Version.
'
'==============================================================================
Option Explicit
' Private Variablen
' -----------------
Private m_nRet As Integer
Private m_bInputChanged As Boolean
Private m_bBlink As Boolean
Private m_sOldInput As String
Private m_colEinbauplatz As Collection
Private m_colUniquePP As CPruefpunktCol
Private m_Regulierdaten As CRegulierdaten
Private m_nEinbauplatz As Integer
Private m_nSeriennummer As Long
Private m_Regelart As String
Private m_PruefungsArtWaage As Boolean
Private m_bDauerpruefung As Boolean
Private m_bPruefgangLang As Boolean
' neu eingefügt am 02.08.02 Pfeiffer
Private m_Zaehlerart As String
Private m_objSensusIFInterface As SensusIF2.Interface
Private m_blnIsInTimer As Boolean
Private m_blnIsInSensusIF As Boolean
Private m_blnDoStart As Boolean
Private m_Pruefgang As CPruefgang
Public m_SPS As CSPS
Dim bTextChanged(10) As Boolean
Dim bBlinkend(10) As Boolean
Dim mblnAbbruch As Boolean ' Abbruch beim Scannen
Dim m_TimerOn As Boolean ' bei DoEvents nicht 2 mal in Timer Routine springen
Const const_keineSNText As String = "keine SNr"
Const TEXTOHNEWINKELPP = "ohne"
Private Sub chkDauerpruefung_click()
If chkDauerpruefung.value = 1 Then
m_bDauerpruefung = True
lblDauer2.Enabled = True
txtAnzahlDauerPrf.Enabled = True
txtAnzahlDauerPrf.SelStart = 1
txtAnzahlDauerPrf.SelLength = 3
Else
m_bDauerpruefung = False
lblDauer2.Enabled = False
txtAnzahlDauerPrf.Enabled = False
txtAnzahlDauerPrf.text = "1"
End If
End Sub
Private Sub chkKontinuierlichePrf_Click()
If chkKontinuierlichePrf.value = vbChecked Then
OptPrfArt(1).value = True
OptPrfArt(0).value = False
OptPrfArt(0).Enabled = False
OptPrfArt(1).Enabled = False
chkRegulierungDurchfuehren.value = vbUnchecked
chkRegulierungDurchfuehren.Enabled = False
Else
chkRegulierungDurchfuehren.Enabled = True
OptPrfArt(0).Enabled = True
OptPrfArt(1).Enabled = True
End If
End Sub
Private Sub chkProtokolldruck_Click()
If chkProtokolldruck.value = vbChecked Then
g_blnPruefprotokoll = True
Else
g_blnPruefprotokoll = False
End If
End Sub
'Private Sub chkKeineRegulierung_Click()
' If chkKeineRegulierung.Value = vbChecked Then
' chkRegulierung.Enabled = False
' Else
' chkRegulierung.Enabled = True
' End If
' Call chkRegulierung_Click
'End Sub
Private Sub chkPruefgangLang_click()
If chkPruefgangLang.value = 1 Then
m_bPruefgangLang = True
Else
m_bPruefgangLang = False
End If
End Sub
'Private Sub chkRegulierung_Click()
''disable cmdRegulierdaten
' If chkRegulierung.Value = 1 And chkRegulierung.Enabled Then
' cmdVorgaben.Enabled = True
' Else
' cmdVorgaben.Enabled = False
' End If
'End Sub
Private Function PruefpunkteZeitenVorhanden() As Boolean
Dim Pruefpunkt As CPruefpunkt
Dim Zeit As Double
For Each Pruefpunkt In m_colUniquePP.getCollection
Zeit = Pruefpunkt.GetTime
Debug.Print "Prüfpunkt " & Pruefpunkt.getQ & ", Zeit: " & Zeit
If Zeit = 0 Then
' Für einen Pruefpunkt ist keine Zeit definiert: sofort False zurückgeben
PruefpunkteZeitenVorhanden = False
Exit Function
End If
Next
' Alle Prüfpunkte haben Zeiten
PruefpunkteZeitenVorhanden = True
End Function
Private Sub chkRegulierungDurchfuehren_Click()
If chkRegulierungDurchfuehren.value = vbChecked Then
cmbSollFehler.Enabled = True
Else
cmbSollFehler.Enabled = False
End If
End Sub
Private Sub chkVersuch_Click()
If chkVersuch.value = vbChecked Then
g_blnVersuch = True
Else
g_blnVersuch = False
End If
End Sub
Private Sub chkWinkelmessung_Click()
If chkWinkelmessung.value = vbChecked Then
cmbWinkelDurchfluss.Enabled = True
Else
cmbWinkelDurchfluss.Enabled = False
End If
End Sub
Private Sub cmbSollFehler_Click()
On Error GoTo Errorhandler
Dim Nennweite As Integer
Dim Regulierwert As Double
Regulierwert = CDbl(cmbSollFehler.text)
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
If Not m_colEinbauplatz Is Nothing Then
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
Nennweite = Einbauplatz.getPruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite
' speichern in ini
g_App.Settings.SetRegulierWertTurbo2e "Turbo2eRegulierWert" & CStr(Nennweite), CStr(Regulierwert)
End If
Next
End If
Errorhandler:
End Sub
Private Sub initCmbSollFehler(Nennweite As Long)
Dim dblRegulierwert As Double
Dim i As Integer
dblRegulierwert = g_App.Settings.GetRegulierWertTurbo2e("Turbo2eRegulierWert" & CStr(Nennweite))
For i = -120 To 120
Debug.Print i / 10
If CDbl(i / 10) = dblRegulierwert Then
cmbSollFehler.ListIndex = i + 120
End If
Next
End Sub
' Neu eingefügt am 02.08.02 Pfeiffer
Private Sub cmdSerNrAusw_Click(Index As Integer)
cmdSerNrAusw(Index).Enabled = False
txtSerienNr_DblClick (Index)
cmdSerNrAusw(Index).Enabled = True
End Sub
' Activiere die ProTool-Anwendung
Private Sub cmdSPSInfo_Click()
Call g_App.getSPS().ActivateProTool
End Sub
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
Private Sub Form_Load()
Dim i As Integer
Dim nLeft As Long
Dim nTop As Long
Call initEinbauplaetze ' Erzeuge Einbauplaetze Collection
Me.Width = Screen.Width
Me.Height = Screen.Height
Call centerFormInScreen(Me)
' Datenanzeigebereich zentrieren
' ------------------------------
nLeft = (Me.ScaleWidth - Me.frMain.Width) \ 2
nTop = (Me.ScaleHeight - Me.frMain.Height) \ 2
Me.frMain.BorderStyle = 0
Me.frMain.Left = nLeft
Me.frMain.Top = nTop
For i = -120 To 120
cmbSollFehler.AddItem i / 10
Next
cmbSollFehler.ListIndex = cmbSollFehler.ListCount / 2
Set m_SPS = g_App.getSPS()
Set m_Regulierdaten = New CRegulierdaten
For i = 1 To 10
lblEinbau(i).caption = ""
cmdRuecklaeuferanalyse(i).Enabled = False
'txtSerienNr(i).Left = txtSerienNr(1).Left
'txtSerienNr(i).Top = txtSerienNr(1).Top
'txtSerienNr(i).Width = txtSerienNr(1).Width
cmdSerNrAusw(i).Left = cmdSerNrAusw(1).Left
cmdSerNrAusw(i).Top = cmdSerNrAusw(1).Top
cmdSerNrAusw(i).Width = cmdSerNrAusw(1).Width
cmdSerNrAusw(i).Height = cmdSerNrAusw(1).Height
lblStatus(i).Left = lblStatus(1).Left
lblStatus(i).Top = lblStatus(1).Top
lblStatus(i).Width = lblStatus(1).Width
lblStatus(i).Height = lblStatus(1).Height
lblEinbau(i).Left = lblEinbau(1).Left
lblEinbau(i).Top = lblEinbau(1).Top
lblEinbau(i).Width = lblEinbau(1).Width
lblEinbau(i).Height = lblEinbau(1).Height
imgInfo(i).Left = imgInfo(1).Left
imgInfo(i).Top = imgInfo(1).Top
imgInfo(i).Width = imgInfo(1).Width
imgInfo(i).Height = imgInfo(1).Height
imgZaehler(i).Picture = frmRes.imgZaehlerGrauLinks.Picture
txtSerienNr(i).MaxLength = 10
imgZaehler(i).Enabled = False
If i <= g_App.Settings.EinbauplaetzeJeStrang Then
Else
frEinbau(i).Visible = False
imgZaehler(i).Visible = False
End If
Next i
If g_blnVersuch = True Then
chkVersuch.value = vbChecked
chkVersuch.Visible = True
Else
Select Case g_App.Settings.Versuch
Case "0"
chkVersuch.value = vbUnchecked
chkVersuch.Visible = True
g_blnVersuch = False
Case "1"
chkVersuch.Visible = True
chkVersuch.value = vbChecked
g_blnVersuch = True
Case Else
' kein Ini Eintrag vorhanden
chkVersuch.value = vbUnchecked
chkVersuch.Visible = False
g_blnVersuch = False
End Select
End If
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
lblUniquePP = 0
lblMaxPP = g_App.Settings.getMaxPruefpunkte()
lblTitle = "Prüfvorbereitung Turbo2e"
chkRegulierungVerwenden.value = g_App.Settings.RegulierungVerwenden
' neu RH 13.12.2004
If g_App.Settings.EichpruefvorgabenIgnorieren <> "0" And g_App.Settings.EichpruefvorgabenIgnorieren <> "1" Then
chkEichpruefvorgabenIgnorieren.Visible = False
Else
chkEichpruefvorgabenIgnorieren.Visible = True
If g_App.Settings.EichpruefvorgabenIgnorieren = "1" Then
chkEichpruefvorgabenIgnorieren.value = vbChecked
Else
chkEichpruefvorgabenIgnorieren.value = vbUnchecked
End If
End If
chkProtokolldruck_Click
' chkKeineRegulierung.Value = g_App.Settings.Ueberspringen
' Call chkKeineRegulierung_Click
' Initialisierung der RadioButtons "PruefungsArt"
Select Case g_App.Settings.PruefungsArt
Case "Waage"
OptPrfArt(0).value = True
OptPrfArt(1).value = False
m_PruefungsArtWaage = True
Case "Referenzzaehler"
OptPrfArt(0).value = False
OptPrfArt(1).value = True
m_PruefungsArtWaage = False
Case Else
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei für Prüfungsart"
exitInstance
End Select
'if g_App.
'cmdOK.Enabled = False
g_frmMain.Hide
Call initRegelart
' Pruefgang Objekt erzeugen / Pruefgang starten
Set m_Pruefgang = New CPruefgang
Call InitCmbAnzahlZaehler
If chkVersuch.value = vbChecked Then
chkRegulierungDurchfuehren.value = vbUnchecked
End If
chkWinkelmessung_Click
StartScan
End Sub
' Einbauplätze initialisieren
'
Private Sub initEinbauplaetze()
Dim i As Integer
Dim Einbauplatz As CEinbauplatz
Set m_colEinbauplatz = New Collection
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
Set Einbauplatz = New CEinbauplatz
Call Einbauplatz.setNr(i)
m_colEinbauplatz.Add Einbauplatz, Str$(i)
Next i
End Sub
' Regelart initialisieren
Private Sub initRegelart()
' Todo: unter Q < 1 m^3 -> Servo verwenden -> für jeden PP individuell
' Vorbestzung aus INI Datei
Select Case g_App.Settings.Regelart
Case "FU"
OptRegelart(0).value = True
OptRegelart(1).value = False
m_Regelart = "FU"
Case "Servo"
OptRegelart(0).value = False
OptRegelart(1).value = True
m_Regelart = "Servo"
Case Else
OptRegelart(0).value = False
OptRegelart(1).value = False
End Select
End Sub
'------------------------------------------------------------------------------
' Private Funktionalität
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
g_frmMain.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_objSensusIFInterface = Nothing
g_frmMain.Show
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
mblnAbbruch = True
If m_blnIsInSensusIF Then Exit Sub
If m_blnIsInTimer Then Exit Sub
Call endDialog(IDCANCEL)
End Sub
' Vorgabe der Prüfgangvorgaben
'
'Private Sub cmdVorgaben_Click()
' Dim dlg As frmPruefgangVorgaben
' Me.MousePointer = vbHourglass
' Set dlg = New frmPruefgangVorgaben
' Call dlg.setRegulierdaten(m_Regulierdaten)
' If doModal(dlg, True) = IDOK Then
' End If
' Me.MousePointer = vbDefault
'End Sub
' Dialog zur Änderung der Prüfpunkte
'
Private Sub imgZaehler_Click(Index As Integer)
Dim Einbauplatz As CEinbauplatz
Dim dlg As frmPruefvorgaben
Set Einbauplatz = getEinbauplatz(Index)
If Einbauplatz Is Nothing Then Exit Sub
Me.MousePointer = vbHourglass
Set dlg = New frmPruefvorgaben
Call dlg.setPruefzaehler(Einbauplatz.getPruefzaehler())
Call dlg.setEinbauplatz(Einbauplatz)
Set dlg.m_colEinbauplatz = m_colEinbauplatz
If doModal(dlg, True) = IDOK Then
' ZeigePruefpunkte (Index)
If g_MetrologAktualisieren = True Then
AlleEinbauplaetzeDesGleichenAuftragesAktualisieren (Index)
Else
Call ueberpruefe(Index)
End If
updatePruefpunkte
End If
Me.MousePointer = vbDefault
End Sub
Private Sub OptPrfArt_Click(Index As Integer)
Select Case Index
Case 0
m_PruefungsArtWaage = True
Case 1
m_PruefungsArtWaage = False
End Select
End Sub
Private Sub OptRegelart_Click(Index As Integer)
Select Case Index
Case 0
m_Regelart = "FU"
Case 1
m_Regelart = "Servo"
End Select
End Sub
' Nur numerische Eingaben zulassen
Private Sub txtAnzahlDauerPrf_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
Else
If Len(txtAnzahlDauerPrf.text) > 2 Then KeyAscii = 0
End If
End Sub
Private Sub chkPruefgangLang_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
End If
End Sub
Private Sub txtAnzahlDauerPrf_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
chkDauerpruefung.value = 0
End If
End Sub
'' Nur numerische Eingaben zulassen
'Private Sub txtImpulswertigkeitPZ_KeyPress(KeyAscii As Integer)
' If Not IsNumeric(Chr$(KeyAscii)) Then
' If KeyAscii <> 8 Then KeyAscii = 0
' End If
'End Sub
'----------------------------------------------------------------------------
' Event Handling für das Scanner Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtScanner_KeyPress(KeyAscii As Integer)
Dim nWert As Long
If KeyAscii = 13 Then
KeyAscii = 0 ' unterbinde Beep
If IsNumeric(txtScanner) Then
nWert = Val(txtScanner.text)
If nWert > 0 And nWert <= g_App.Settings.EinbauplaetzeJeStrang Then
m_nEinbauplatz = nWert
txtScanner.text = ""
lblScanner.caption = "Platz: " & Str(m_nEinbauplatz)
End If
If (nWert >= SERIENNR_MINWERT And nWert <= SERIENNR_MAXWERT) Then
m_nSeriennummer = nWert
txtScanner.text = ""
lblScanner.caption = "SN:" & Str(m_nSeriennummer)
End If
If m_nEinbauplatz > 0 And m_nSeriennummer > 0 Then
txtSerienNr(m_nEinbauplatz).text = FormatSerienNr(m_nSeriennummer)
lblScanner.caption = Str(m_nEinbauplatz) & " : " & Str(m_nSeriennummer)
Call ueberpruefe(m_nEinbauplatz)
m_nEinbauplatz = 0
m_nSeriennummer = 0
End If
Else
txtScanner = ""
beep
End If
End If
End Sub
'----------------------------------------------------------------------------
' Event Handling für das SerienNr Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtSerienNr_Change(Index As Integer)
bTextChanged(Index) = True
End Sub
Private Sub txtSerienNr_Click(Index As Integer)
selectSerienNrField (Index)
StopScan
End Sub
Private Sub txtSerienNr_DblClick(Index As Integer)
Dim frmDialog As frmSeriennrAuswahl
Dim i As Integer
If m_colEinbauplatz(Index).getZusatz <> "" Then
txtSerienNr(Index).Enabled = False
Set frmDialog = New frmSeriennrAuswahl
For i = 1 To 10
g_Seriennr(i) = txtSerienNr(i)
Next
If m_TimerOn = True Then
DisableEventsForSensusIF (Index)
frmDialog.Show vbModal, Me
EnableEventsForSensusIF (Index)
Else
frmDialog.Show vbModal, Me
End If
txtSerienNr(Index).Enabled = True
If IsNumeric(frmDialog.sSerienNr) Then
txtSerienNr(Index).text = frmDialog.sSerienNr
bTextChanged(Index) = True
txtSerienNr(Index).SetFocus
ueberpruefe (Index)
End If
End If
End Sub
Private Sub txtSerienNr_GotFocus(Index As Integer)
m_sOldInput = txtSerienNr(Index).text
CursorAnEndeImSerienNrField (Index)
' selectSerienNrField (Index)
End Sub
Private Sub txtSerienNr_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
' Setzt Fokus ins darunterliegende Textfeld bei Cursor-Down
If txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).Enabled = True Then
txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).SetFocus
End If
ueberpruefe (Index)
End If
If KeyCode = 38 Then
' Setzt Fokus ins darüberliegende Textfeld bei Cursor-Up
If txtSerienNr(IIf(Index > 1, Index - 1, g_App.Settings.EinbauplaetzeJeStrang)).Enabled = True Then
txtSerienNr(IIf(Index > 1, Index - 1, g_App.Settings.EinbauplaetzeJeStrang)).SetFocus
End If
ueberpruefe (Index)
End If
End Sub
Private Sub txtSerienNr_KeyPress(Index As Integer, KeyAscii As Integer)
'If KeyAscii = 13 Then
' txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).SetFocus
' ueberpruefe (Index)
'End If
If KeyAscii = 13 Then
ueberpruefe (Index)
StartScan
'Geändert am 10.08.02 Pfeiffer
If Index < g_App.Settings.EinbauplaetzeJeStrang Then
Index = Index + 1
Else
Index = 1
End If
If cmdSerNrAusw(Index).Enabled = True Then
cmdSerNrAusw(Index).SetFocus
End If
End If
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub ZeigePruefpunkte(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Set Pruefzaehler = m_colEinbauplatz(Index).getPruefzaehler
If Pruefzaehler Is Nothing Then
MsgBox ("Prüfzahler is nothing")
Else
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
If Pruefpunkte Is Nothing Then
MsgBox ("Pruefpunkte is nothing")
Else
For Each Pruefpunkt In Pruefpunkte.getPruefpunkte.getCollection
MsgBox Pruefpunkt.getQ
Next
End If
End If
End Sub
' Komplettes Feld selektieren
'
Private Sub selectSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = 0
txtSerienNr(Index).SelLength = Len(txtSerienNr(Index))
End Sub
' Komplettes Feld selektieren
'
Private Sub CursorAnEndeImSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = Len(txtSerienNr(Index))
txtSerienNr(Index).SelLength = 0
End Sub
' Validierung bei Fokus Wechsel in ein anderes Feld per Maus
Private Sub txtSerienNr_Validate(Index As Integer, Cancel As Boolean)
Call ueberpruefe(Index)
Cancel = False
End Sub
Private Sub ErstelleTestPruefzaehler(Index As Integer)
Dim oAuftragPositionSerienNummer As CAuftragPositionSerienNr
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Pruefpunkte As CPruefpunkte
lSerienNr = neueTestZaehlerSerienNr()
If lSerienNr = 0 Then
txtSerienNr(Index).text = ""
txtSerienNr(Index).SetFocus
Exit Sub
End If
txtSerienNr(Index).text = FormatSerienNr(lSerienNr)
Set oAuftragPositionSerienNummer = New CAuftragPositionSerienNr
oAuftragPositionSerienNummer.setAuftragNr 99999
oAuftragPositionSerienNummer.setPositionNr 1
oAuftragPositionSerienNummer.setEinbauplatzNr Index
oAuftragPositionSerienNummer.setNr lSerienNr
oAuftragPositionSerienNummer.save
Set Pruefzaehler = New CPruefzaehler
Pruefzaehler.setSerienNr lSerienNr
Set Einbauplatz = getEinbauplatz(Index)
Einbauplatz.setPruefzaehler Pruefzaehler
If Pruefzaehler.getPruefpunkte Is Nothing Then
Set Pruefpunkte = PruefpunkteDesErstenPZmitPP(m_colEinbauplatz)
Pruefzaehler.SetAuftragPositionSerienNr oAuftragPositionSerienNummer
Pruefzaehler.setPruefpunkte Pruefpunkte
If Pruefpunkte Is Nothing Then
DebugMsg "Pruefpunkte sind für diesen Zähler nicht definiert"
'If MsgBox("Dieser Zaehler enthält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then
' raise imgZaehler_Click(Index)
'Else
' txtSerienNr(Index).Text = ""
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
' txtSerienNr(Index).SetFocus
'End If
End If
End If
End Sub
Private Function PruefpunkteDesErstenPZmitPP(ColEinbauplatz As Collection) As CPruefpunkte
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
For Each Einbauplatz In ColEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If Pruefzaehler.getPruefpunkte.getPruefpunkteCount > 0 Then
Set PruefpunkteDesErstenPZmitPP = Pruefzaehler.getPruefpunkte
Exit Function
End If
End If
End If
Next
Set PruefpunkteDesErstenPZmitPP = Nothing
End Function
Private Sub ueberpruefe(Index As Integer)
DebugMsg "Überprüfe SerienNr " & txtSerienNr(Index)
If bTextChanged(Index) = True Then
bTextChanged(Index) = False
If txtSerienNr(Index).text = "0" Then
ErstelleTestPruefzaehler (Index)
ueberpruefe (Index)
Exit Sub
Else
End If
If testSerienNrInput(Index) Then
If txtSerienNr(Index) <> "" Then
' Wenn SerienNr Feld nicht gelöscht und SerienNrInput
' gerade erfolgreich getestet wurde,
' dann überprüfen, ob Pruefpunkte vorhanden sind. Wenn nicht, manuell PP eingeben.
Call UeberpruefeAufPruefpunkte(Index)
End If
Else
' SerienNr wurde nicht akzeptiert
If txtSerienNr(Index).Enabled = True Then
txtSerienNr(Index).SetFocus
End If
End If
Else
' nicht geändert
End If
If m_colUniquePP Is Nothing Then
cmdOK.Enabled = False
Else
If m_colUniquePP.Count > 0 Then
cmdOK.Enabled = True
Else
cmdOK.Enabled = False
End If
End If
End Sub
'---------------------------------------------------------------
' ermittelt neue Test-Prüfzähler Seriennummer
'
Private Function neueTestZaehlerSerienNr() As Long
Dim SQL As String
Dim SerienNr As Long
Dim rs As CRecordset
Dim NummernbandID As Long
Dim ueberlauf As Long
Set rs = New CRecordset
SQL = "select * from Nummernband where NummernbandID=" & g_App.Settings.NummernbandID & ";"
If rs.openRS(SQL) Then
If Not rs.EOF Then
SerienNr = rs.getLongValue("letzteNr")
ueberlauf = rs.getLongValue("bisSerienNr") - SerienNr
' Wenn wirklich Überlauf auftritt: Meldung !
If SerienNr >= rs.getLongValue("bisSerienNr") Then
ErrorMsg ("Überlauf im Nummernband für Testzähler")
Exit Function
End If
If ueberlauf < 1000 Then
MsgBox ("Überlauf nach " & ueberlauf & " Seriennummern bei " & rs.getLongValue("bisSerienNr") & ". Bitte Admin verständigen.....")
End If
SerienNr = SerienNr + 1
rs.setValue "letzteNr", SerienNr
rs.update
neueTestZaehlerSerienNr = SerienNr
Else
ErrorMsg ("Das Testzähler Nummernband ist in der Datenbank nicht definiert")
End If
End If
End Function
'----------------------------------------------------------------------------
' @param nNr Nr. eines Einbauplatzes
'
' @return Einbauplatz aus der Collection der Einbauplätze
' mit der angegebenen Nr. oder nothing, wenn es zu
' der Nr. keinen Einbauplatz gibt
'
Private Function getEinbauplatz(nNr As Integer) As CEinbauplatz
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
If Einbauplatz.getNr() = nNr Then
Set getEinbauplatz = Einbauplatz
Exit Function
End If
Next
End Function
' Menge der eindeutigen Prüfpunkte neu bilden und
' Summe neu anzeigen
'
' TODO: Komplettieren
'
Public Sub updatePruefpunkte()
Dim Einbauplatz As CEinbauplatz
Dim i As Integer
Set m_colUniquePP = calcPruefpunkte(m_colEinbauplatz)
' Anzeige der eindeutigen Prüfpunkte aktualisieren
lblUniquePP = m_colUniquePP.Count
' Listboxen für Pruefpunkte aktualisieren
lstPruefpunkte.Clear
cmbPruefpunkte.Clear
cmbWinkelDurchfluss.Clear
m_colUniquePP.sortQ
For i = 1 To m_colUniquePP.Count()
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
cmbPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
cmbWinkelDurchfluss.AddItem m_colUniquePP.Item(i).getQ
Next i
cmbPruefpunkte.AddItem "ohne"
cmbWinkelDurchfluss.AddItem TEXTOHNEWINKELPP
cmbWinkelDurchfluss.ListIndex = 0
If m_colUniquePP.Count() > 0 Then
cmbPruefpunkte.ListIndex = 0
End If
' PP-Warning-Flag für alle Einbauplätze auf FALSE setzen
For Each Einbauplatz In m_colEinbauplatz
Call Einbauplatz.setPPWarning(False)
Next
' Wenn die Menge der eindeutigen Prüfpunkte > dem Maximum in
' der INI-Datei ist, feststellen, welche Zähler das Problem sind.
If m_colUniquePP.Count <= g_App.Settings.getMaxPruefpunkte() Then
For Each Einbauplatz In m_colEinbauplatz
Call Einbauplatz.setPPWarning(False)
' TodoTodo
Call updateEinbauplatz(Einbauplatz.getNr())
Next
Exit Sub
End If
' Ausnahmezähler suchen und austragen, bis Maximum unterschritten ist
'
' Vorgehensweise:
' - Alle CPruefpunkt-Items in m_colUniquePP absteigend nach dem UseCount
' sortieren
' - Zaehler zu den Prüfpunkt(en) mit dem kleinsten UseCount feststellen
' und aus der Menge der Prüfzaehler ausklammern
Dim uniquePPcopy As CPruefpunktCol
' menge der eindeutigen Pruefpunkte erzeugen und
' absteigend nach dem "UseCount" sortieren
Set uniquePPcopy = New CPruefpunktCol
For i = 1 To m_colUniquePP.Count()
uniquePPcopy.Add m_colUniquePP.Item(i)
Next i
Call uniquePPcopy.sortUseCount
' welche(r) Zähler gehören zu dem an wenigsten benötigten Prüfpunkt?
Dim dQ As Double
dQ = uniquePPcopy.Item(1).getQ()
For Each Einbauplatz In m_colEinbauplatz
Dim Pruefpunkte As CPruefpunkte
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte()
If Not Pruefpunkte Is Nothing Then
If Pruefpunkte.hasQ(dQ) Then
Call Einbauplatz.setPPWarning(True)
End If
End If
End If
Call updateEinbauplatz(Einbauplatz.getNr())
Next
End Sub
' Neu eingegebene Serien-Nr. überprüfen
'
' @return true = Prüfzähler mit der übergebenen Serien-Nr. wurde dem
' Einbauplatz erfolgreich zugewiesen
'
Private Function testSerienNrInput(Index As Integer) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim nTmpText As String
Dim Impulswertigkeit As Long
Set Einbauplatz = getEinbauplatz(Index)
' Eingabe ist Einbauplatz Nummer
If Val(txtSerienNr(Index)) > 0 And Val(txtSerienNr(Index)) <= g_App.Settings.EinbauplaetzeJeStrang Then
' Cursor laut Eingabe ins angewählte Feld setzen
If txtSerienNr(Val(txtSerienNr(Index))).Enabled = True Then
nTmpText = txtSerienNr(Index).text
txtSerienNr(Index).text = m_sOldInput
txtSerienNr(Val(nTmpText)).SetFocus
GoTo testSerienNrInputReturnOK
Else
GoTo testSerienNrInputReturnFalse
End If
End If
If Trim$(txtSerienNr(Index)) = "" Then
' Seriennummer wurde gelöscht
lSerienNr = -1
' Prüfen, ob noch irgendeine Seriennummer definiert ist
Dim bKeinPruefzaehler As Boolean
bKeinPruefzaehler = True
Dim i As Integer
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
If txtSerienNr(i) <> "" Then
bKeinPruefzaehler = False
End If
Next
If bKeinPruefzaehler Then
' Keine Seriennummer mehr vorhanden:
' Feld für Impulswertigkeit löschen
' txtImpulswertigkeitPZ.text = ""
' Globale Regulierdaten werden gelöscht, wenn
' keine SerienNr mehr vorhanden ist
Set m_Regulierdaten = Nothing
End If
Else
lSerienNr = Val(txtSerienNr(Index))
End If
' Setze im Einbauplatz Objekt die Seriennr. (laut DB)
If Not setEinbauplatzPruefzaehler(Einbauplatz, lSerienNr) Then
' Fehlgeschlagen:
GoTo testSerienNrInputReturnFalse
End If
'---------- Textfeld Impulswertigkeit
Set Pruefzaehler = Einbauplatz.getPruefzaehler
testSerienNrInputReturnOK:
Call updateZaehlerImage(Index)
testSerienNrInput = True
If Not Pruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
' Todo: Verbesserung: Abweisen eines Zählers, wenn Regulierdaten
' des Zählers nicht gleich den globalen Regulierdaten sind.
If Pruefpunkte Is Nothing Then
ErrorMsg ("Es sind keine Prüfpunkte ermittelt worden")
Else
Set m_Regulierdaten = Pruefpunkte.getRegulierdaten
End If
End If
Call updatePruefpunkte
GoTo testSerienNrInputReturn
testSerienNrInputReturnFalse:
Call selectSerienNrField(Index)
Call updateZaehlerImage(Index)
If txtSerienNr(Index).Enabled = True Then
txtSerienNr(Index).SetFocus
End If
testSerienNrInput = False
testSerienNrInputReturn:
'On Error Resume Next
Call updateEinbauplatz(Index)
Exit Function
End Function
' Menge aller eindeutigen Prüfpunkte bilden
'
' @param Einbauplaetze Collection der Einbauplätze
'
' @return Collection mit allen eindeutigen CPruefpunkt-Objekten
'
' @see updatePruefpunkte
'
' geändert am 26.1.2000 von RH: arbeitet jetzt mit KopiePruefpunkt
'
Private Function calcPruefpunkte(Einbauplaetze As Collection) As CPruefpunktCol
Dim Einbauplatz As CEinbauplatz
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Dim colUniquePP As New CPruefpunktCol
Dim nPos As Integer
Dim i As Integer
Dim KopiePruefpunkt As CPruefpunkt
For Each Einbauplatz In Einbauplaetze
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte()
If Not Pruefpunkte Is Nothing Then
If Not Pruefpunkte.getPruefpunkte Is Nothing Then
For Each Pruefpunkt In Pruefpunkte.getPruefpunkte().getCollection()
nPos = getEquivPruefpunktIndexFromCollection(Pruefpunkt, colUniquePP)
If nPos = 0 Then
' Prüfpunkt ist noch nicht in der PPCollection vorhanden
Call Pruefpunkt.setUseCount(1)
Set KopiePruefpunkt = New CPruefpunkt
KopiePruefpunkt.copyFrom Pruefpunkt
colUniquePP.Add KopiePruefpunkt
Else
' Prüfpunkt ist vorhanden
' Nur UseCount erhöhen
Call colUniquePP.Item(nPos).incUseCount
End If
Next
End If
End If
End If
Next
Set calcPruefpunkte = colUniquePP
End Function
' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts
' in der übergebenen Collection von Pruefpunkten enthalten ist.
'
Private Function getEquivPruefpunktIndexFromCollection(TestPruefpunkt As CPruefpunkt, colPruefpunkte As CPruefpunktCol) As Integer
Dim Pruefpunkt As CPruefpunkt
Dim i As Integer
For i = 1 To colPruefpunkte.Count
Set Pruefpunkt = colPruefpunkte.Item(i)
If Pruefpunkt.getQ() = TestPruefpunkt.getQ() Then
getEquivPruefpunktIndexFromCollection = i
Exit Function
End If
Next
End Function
' Prüfzähler-Objekt in dem angegebenen Einbauplatz löschen
' Der Einbauplatz ist danach wieder als "nicht in Verwendung" deklariert.
'
Private Sub clearEinbauplatzPruefzaehler(nEinbauplatz As Integer)
Dim Einbauplatz As CEinbauplatz
Set Einbauplatz = getEinbauplatz(nEinbauplatz)
If Not Einbauplatz Is Nothing Then
Call Einbauplatz.setPruefzaehler(Nothing)
End If
End Sub
' Einbauplatz auf Basis der übergebenen Serien-Nr. den
' zugehörigen Prüfzähler zuweisen.
'
' @param Einbauplatz Einbauplatz-Objekt
' @param lSerienNr Nr. des Zählers ( -1 = Leerung)
'
' @return true = Prüfzähler konnte dem Einbauplatz zugewiesen werden
' false = Serien-Nr. ist ungültig oder konnte nicht in der
' Datenbank gefunden werden
'
Private Function setEinbauplatzPruefzaehler(Einbauplatz As CEinbauplatz, lSerienNr As Long) As Boolean
Dim Pruefzaehler As CPruefzaehler
Dim EinbauplatzNr As Integer
setEinbauplatzPruefzaehler = False
If Einbauplatz Is Nothing Then
Call ErrorMsg("setEinbauplatzPruefzaehler: " + "Als Einbauplatz wurde nothing übergeben!")
Exit Function
End If
If lSerienNr < 0 Then
' Prüfzähler wurde ausgebaut
Call Einbauplatz.setPruefzaehler(Nothing)
setEinbauplatzPruefzaehler = True
ElseIf lSerienNr < SERIENNR_MINWERT Then
' Ungültige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
ElseIf lSerienNr > SERIENNR_MAXWERT Then
' Ungültige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
Else
' Seriennummer im gültigen Bereich
Call Einbauplatz.setPruefzaehler(Nothing)
Set Pruefzaehler = New CPruefzaehler
' Prüfen, ob eine Auftragsposition existiert
If Pruefzaehler.loadForSerienNr(lSerienNr) Then
' Prüfzähler vorhanden
setEinbauplatzPruefzaehler = True
Else
' Todo: muss ein Prüfzähler Objekt wirklich erzeugt werden
' wenn Seriennummer nicht in der Datenbank steht ?
' nur wenn TEST-Pruefzaehler:
' Call Pruefzaehler.setSerienNr(lSerienNr)
End If
Call Einbauplatz.setPruefzaehler(Pruefzaehler)
DebugMsg "Prüfzähler mit SerienNr " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr
End If
End Function
' Taucht die Serien-Nr. des übergebenen Prüfzählers an verschiedenen
' Einbauplätzen auf?
'
' @param Pruefzaehler auf Eindeutigkeit zu überprüfender Prüfzähler
'
' Sonderfall: Prüfzähler mit der Serien-Nr. 0 dürfen mehrfach vorkommen
'
Private Function hasDupes(Pruefzaehler As CPruefzaehler) As Boolean
Dim Einbauplatz As CEinbauplatz
If Not Pruefzaehler Is Nothing Then
If Pruefzaehler.getSerienNr() <> 0 Then
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
If Not Einbauplatz.getPruefzaehler() Is Pruefzaehler Then
If Einbauplatz.getPruefzaehler().getSerienNr() = Pruefzaehler.getSerienNr() Then
hasDupes = True
Exit Function
End If
End If
End If
Next
End If
End If
End Function
' Zählerabbildung aktualisieren
'
Private Sub updateZaehlerImage(nIndex As Integer)
Dim Pruefzaehler As CPruefzaehler
If Not getEinbauplatz(nIndex) Is Nothing Then
Set Pruefzaehler = getEinbauplatz(nIndex).getPruefzaehler()
' Prüfzaehler an der Position eingebaut
If Pruefzaehler Is Nothing Then
imgZaehler(nIndex).Picture = frmRes.imgZaehlerGrauLinks.Picture
imgZaehler(nIndex).Enabled = False
ElseIf Pruefzaehler.isWarmwasserzaehler() Then
imgZaehler(nIndex).Enabled = True
imgZaehler(nIndex).Picture = frmRes.imgZaehlerRotLinks.Picture
Else
imgZaehler(nIndex).Enabled = True
imgZaehler(nIndex).Picture = frmRes.imgZaehlerBlauLinks.Picture
End If
Else
' Kein Prüfzaehler an der Position eingebaut
imgZaehler(nIndex).Picture = frmRes.imgZaehlerGrauLinks.Picture
imgZaehler(nIndex).Enabled = False
End If
End Sub
' Einbauplatzdaten neu anzeigen
' @return true = Keine Fehlerbedingung festgestellt
'
Private Function updateEinbauplatz(Index As Integer) As Boolean
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
Dim StatusFertigung As Integer
imgZaehler(Index).Enabled = True
Set Einbauplatz = getEinbauplatz(Index)
cmdRuecklaeuferanalyse(Index).Enabled = False
If Einbauplatz.getPruefzaehler() Is Nothing Then
' Leere Eingabe, kein Prüfzähler eingebaut
lblEinbau(Index).caption = ""
txtSerienNr(Index).BackColor = &HFFFFFF
imgZaehler(Index).Enabled = False
ElseIf hasDupes(Einbauplatz.getPruefzaehler()) Then
' Doppelte Serien-Nr.
lblEinbau(Index).caption = "Doppelte Serien-Nr."
txtSerienNr(Index).BackColor = &HC0C0FF ' IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
ElseIf Einbauplatz.getPruefzaehler().getAuftragPosition() Is Nothing Then
' Ungültige Serien-Nr.
lblEinbau(Index).caption = "keine Auftragsdaten!"
txtSerienNr(Index).BackColor = &HC0C0FF ' IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
Else
' Alles OK?
Dim Auftrag As CAuftrag
Dim AuftragPosition As CAuftragPosition
Dim Pruefzaehler As CPruefzaehler
Dim sMsg As String
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
Set Auftrag = Pruefzaehler.getAuftrag()
Set AuftragPosition = Pruefzaehler.getAuftragPosition()
cmdRuecklaeuferanalyse(Index).Enabled = True
sMsg = ""
If Auftrag Is Nothing Then
sMsg = sMsg & "(unbekannt)"
Else
sMsg = sMsg & Auftrag.getNr()
End If
sMsg = sMsg & "/"
If AuftragPosition Is Nothing Then
sMsg = sMsg & "(unbekannt)"
Else
sMsg = sMsg & AuftragPosition.getNr()
End If
'geändert am 14.02.2003 Pf, der letzte eigegebene Zähler bestimmt den Status "nur Messeinsätze" JA/NEIN
If Trim(Pruefzaehler.getIdentNrObj.GetKurzBezeichnung) <> "ME" Then
chkNurMesseinsaetze.value = 0
Else
chkNurMesseinsaetze.value = 1
End If
'RH 16.11.2005
Call initCmbSollFehler(Pruefzaehler.getIdentNrObj.getNennweite)
sMsg = sMsg & " " & Trim(Pruefzaehler.getIdentNrObj.getTyp & _
" " & Pruefzaehler.getIdentNrObj.getTypzusatz)
sMsg = sMsg & " DN" & Pruefzaehler.getIdentNrObj.getNennweite
sMsg = sMsg & " " & Pruefzaehler.getIdentNrObj.GetTemperatur & "G"
sMsg = sMsg & "/PN" & Pruefzaehler.getIdentNrObj.getDruck
sMsg = sMsg & "(" & Pruefzaehler.getPruefklasseKZ & ")"
If Auftrag Is Nothing Or AuftragPosition Is Nothing Then
lblEinbau(Index).caption = sMsg
txtSerienNr(Index).BackColor = IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
Else
lblEinbau(Index).caption = sMsg
txtSerienNr(Index).BackColor = &HC0FFC0
imgZaehler(Index).Enabled = True
End If
StatusFertigung = Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung
If StatusFertigung < 25 Then
'lblStatus(index) = ""
End If
If StatusFertigung >= 25 And StatusFertigung < 30 Then
lblStatus(Index).caption = "Wdh"
End If
If StatusFertigung >= 30 Then
lblStatus(Index).caption = "keine Wdh erf."
txtSerienNr(Index).BackColor = vbYellow
End If
End If
If Einbauplatz.getPPWarning() Then
imgInfo(Index).Picture = frmRes.imgWarning.Picture
imgInfo(Index).Visible = True
Else
imgInfo(Index).Visible = False
End If
End Function
'------------------------------------------------------
'------------------------------------------
Private Sub UeberpruefeAufPruefpunkte(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Set Pruefzaehler = m_colEinbauplatz.Item(Index).getPruefzaehler
If Pruefzaehler Is Nothing Then
Exit Sub
End If
If Pruefzaehler.getPruefpunkte Is Nothing Then
Exit Sub
End If
If Pruefzaehler.getPruefpunkte.getPruefpunkteCount() = 0 Then
DebugMsg "Pruefpunkte sind für diesen Zähler nicht definiert"
If MsgBox("Dieser Zaehler enthält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then
Call imgZaehler_Click(Index)
Else
EntferneZaehlerAusEinbauplatz (Index)
Exit Sub
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
txtSerienNr(Index).SetFocus
End If
Else
If Pruefzaehler.getAuftragPositionSerienNr Is Nothing Then
MsgBox ("AuftragPosSNr unbekannt")
Else
CheckWriteSerienNr (Index)
End If
End If
End Sub
Public Sub Hauptpruefung()
Set m_Pruefgang = New CPruefgang
Dim dlgHauptPruefung As frmTurbop2eHauptprf
Set dlgHauptPruefung = New frmTurbop2eHauptprf
Set dlgHauptPruefung.m_ParentForm = Me
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
Set dlgHauptPruefung.m_Regulierdaten = m_Regulierdaten
' dlgHauptPruefung.m_bKeineRegulierung = CBool(chkKeineRegulierung.Value)
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
If cmbWinkelDurchfluss.text <> TEXTOHNEWINKELPP Then
dlgHauptPruefung.m_dblWinkelQ = CDbl(cmbWinkelDurchfluss.text)
Else
dlgHauptPruefung.m_dblWinkelQ = 0
End If
Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
' Flags
dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
dlgHauptPruefung.m_Regelart = m_Regelart
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
dlgHauptPruefung.m_NurMesseinsaetze = (chkNurMesseinsaetze.value = 1)
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
dlgHauptPruefung.m_RegulierungVerwenden = CInt(chkRegulierungVerwenden.value = 1)
dlgHauptPruefung.m_bRegulierungDurchfuehren = CBool(chkRegulierungDurchfuehren.value = vbChecked)
dlgHauptPruefung.m_blnRueckwaertspruefung = CBool(chkRueckwaertsprf.value = vbChecked)
dlgHauptPruefung.m_bKontinuierlich = CBool(chkKontinuierlichePrf.value = vbChecked)
dlgHauptPruefung.m_bEichpruefvorgabenIgnorieren = CBool(chkEichpruefvorgabenIgnorieren.value = vbChecked)
dlgHauptPruefung.m_Regulierwert = CDbl(cmbSollFehler.text)
dlgHauptPruefung.m_blnDoWinkelmessung = CBool(chkWinkelmessung.value = vbChecked)
dlgHauptPruefung.Show vbModal
Set m_Pruefgang = dlgHauptPruefung.m_Pruefgang
If dlgHauptPruefung.getExitCode = IDOK Then
' Prüfung erfolgreich abgeschlossen
' MsgBox ("Pruefung beendet")
Else
If m_Pruefgang.PruefgangNr > 0 Then
If g_blnVersuch Then
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & " Abbruch"
m_Pruefgang.save
Else
m_Pruefgang.saveAbgebrochenen
m_Pruefgang.delete
Set m_Pruefgang = Nothing
LadeAuftragPositionSerienNrNeu m_colEinbauplatz
End If
' ' Hier könnte der Pruefgang gelöscht werden.
' If MsgBox("Sie haben die Pruefung abgebrochen." & vbCrLf & "Möchten Sie die Ergebnisse des abgebrochenen Pruefganges (PruefgangNr=" & m_Pruefgang.PruefgangNr & ") löschen?", vbYesNo Or vbDefaultButton2, "Pruefgang abgebrochen") = vbYes Then
' m_Pruefgang.saveAbgebrochenen
' m_Pruefgang.delete
' LadeAuftragPositionSerienNrNeu m_colEinbauplatz
' Else
' m_Pruefgang.save
' End If
Else
' hier gibt es keinen Prüfgang zum löschen
End If
End If
chkRueckwaertsprf.value = vbUnchecked
End Sub
Private Function SindZaehlerAehnlich() As Boolean
' Überprüfung ab alle Zähler gleich hinsichtlich:
' - Regulierwerte (Todo: Regulierwerte müssen aus Tabelle Sollwertregulierung bestimmt werden)
' - Nennweite
' - Zählertype
' - Anzeige (m^3) wenn Automatische Regulierung nicht gescheckt
' - Sollwert Regulierung (nur wenn Automatische Regulierung gecheckt)
' Todo: wie verfahren bei Mehrfacheinträgen z.B. m^3,RS,WI Wenn m^3 dann muß überall m^3 vorhanden sein, sonst muß gleich sein
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Dim colUniquePP As New CPruefpunktCol
Dim IdentNrObj As CIdentNr
Dim AuftragPosition As CAuftragPosition
Dim Regulierdaten As CRegulierdaten
Dim vergleich As String
Dim ersterZaehler As Boolean
Dim VergleichMuster As String
ersterZaehler = True
VergleichMuster = ""
vergleich = ""
SindZaehlerAehnlich = True
' Todo
Exit Function
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
Set IdentNrObj = Pruefzaehler.getIdentNrObj()
Set AuftragPosition = Pruefzaehler.getAuftragPosition()
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
Set Regulierdaten = New CRegulierdaten
Call Regulierdaten.load(IdentNrObj.getNr, Pruefpunkte.getPruefklasseKZ)
If Not Pruefzaehler.getAuftrag.getNr = 99999 Then
vergleich = "Nennweite=" & IdentNrObj.getNennweite & ";"
vergleich = vergleich & "Type=" & IdentNrObj.getTyp & IdentNrObj.getTypzusatz & ";"
' If chkRegulierung.Value = vbChecked Then
' vergleich = vergleich & "Anzeige=" & Mid(AuftragPosition.getAnzeige, 1, 3) & "; "
' Else
vergleich = vergleich & "Sollwert=" & Regulierdaten.getSPSSollwertRegulierung & ";"
' End If
' vergleich = vergleich & "Impulswertigkeit=" & Pruefzaehler.GetImpulseQM
Else
' Test-Pruefzaehler können nur mit anderen Test-Prüfzaehlern geprueft werden
vergleich = "PRUEFZAEHLER"
End If
' Alle weiteren Zaehler werden mit dem ersten verglichen
If ersterZaehler Then
VergleichMuster = vergleich
Else
DebugMsg "Vergleich " & Einbauplatz.getNr & ": " & vergleich & " =?= " & VergleichMuster
' unterscheidet sich ein Zähler vom ersten, sind die Zaehler nicht ähnlich !
If VergleichMuster <> vergleich Then
SindZaehlerAehnlich = False
End If
End If
End If
ersterZaehler = False
Next
End Function
Sub AlleEinbauplaetzeDesGleichenAuftragesAktualisieren(Index As Integer)
Dim AuftragNr As Long
Dim PositionNr As Long
Dim PruefzaehlerAktuell As CPruefzaehler
Dim PruefzaehlerVergleich As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set PruefzaehlerAktuell = m_colEinbauplatz(Index).getPruefzaehler
AuftragNr = PruefzaehlerAktuell.getAuftrag.getNr
PositionNr = PruefzaehlerAktuell.getAuftragPosition.getNr
For Each Einbauplatz In m_colEinbauplatz
Set PruefzaehlerVergleich = Einbauplatz.getPruefzaehler
If Not PruefzaehlerVergleich Is Nothing Then
If PruefzaehlerAktuell.getAuftrag.getNr = PruefzaehlerVergleich.getAuftrag.getNr And PruefzaehlerAktuell.getAuftragPosition.getNr = PruefzaehlerVergleich.getAuftragPosition.getNr Then
bTextChanged(Einbauplatz.getNr) = True
Debug.Print "gleiche AuftragNr/PosNr in Einbauplatz " & Einbauplatz.getNr
Call updateEinbauplatz(Einbauplatz.getNr)
Call ueberpruefe(Einbauplatz.getNr)
End If
End If
Next
End Sub
Private Sub InitCmbAnzahlZaehler()
Dim i As Integer
For i = 0 To 10
cmbAnzahlZaehler.AddItem CStr(i)
Next
cmbAnzahlZaehler.ListIndex = g_App.Settings.GetAnzahlFuerVoreinstellwert
End Sub
Private Sub cmbAnzahlZaehler_Click()
g_App.Settings.SetAnzahlFuerVoreinstellwert cmbAnzahlZaehler.ListIndex
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Formularbeenden()
Dim Einbauplatz As CEinbauplatz
Dim lngRet As Long
cmdCancel.Enabled = True
Call StopScan
Call endDialog(IDCANCEL)
End Sub
Private Sub StopScan()
Timer1.Enabled = False
m_TimerOn = False
Shape1.BackColor = 0
cmdStopScan.caption = "START SCAN"
End Sub
Private Sub Timer1_Timer()
Dim nIndex As Integer
Dim Einbauplatz As CEinbauplatz
Dim alteFarbe As Long
Dim comport As Integer
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Dim strAntwort As String
Dim lngSuccess As Long
Dim neueFabNr As String
Dim blnSchlossOffen As Boolean
If m_blnIsInTimer = True Then
' Timer Event wird bereits ausgeführt
m_blnIsInTimer = False
Exit Sub
End If
' Timer Events verhindern
If Timer1.Enabled = False Then
m_blnIsInTimer = False
Exit Sub
End If
If mblnAbbruch = True Then
' Abbruch wurde gedrückt
Call Formularbeenden
m_blnIsInTimer = False
Exit Sub
End If
If m_TimerOn = False Then
' Timer wurde angehalten aber Timer Event stand noch aus
m_blnIsInTimer = False
Exit Sub
End If
For nIndex = 1 To g_App.Settings.EinbauplaetzeJeStrang
' Beim Scannen blinkt der Kreis
Shape1.FillColor = Shape1.FillColor Xor 255
Set Einbauplatz = m_colEinbauplatz(nIndex)
If mblnAbbruch = True Then
Call Formularbeenden
m_blnIsInTimer = False
Exit Sub
End If
alteFarbe = txtSerienNr(nIndex).BackColor
txtSerienNr(nIndex).BackColor = &HE0E0E0 ' am Scannen
lblScanStat.caption = nIndex
comport = Val(g_App.Settings.getUSComPort(nIndex))
If comport = 0 Then
' Einbauplatz-COMPort ist nicht definiert
lblEinbau(nIndex).caption = "Err: no COM definded in ini"
cmdSerNrAusw(nIndex).Enabled = False
txtSerienNr(nIndex).Enabled = False
Else
' Einbauplatz-COMPort ist definiert
If m_blnDoStart = False Then
DisableEventsForSensusIF (nIndex)
'Dim lngCountVersuche As Long
'lngCountVersuche = 0
lblEinbau(nIndex).caption = "..."
DoEvents
Set m_objSensusIFInterface = New SensusIF2.Interface
m_objSensusIFInterface.CommPortNr = comport
m_objSensusIFInterface.DebugWindowsIsVisible = True
m_objSensusIFInterface.PortInit
lngSuccess = 0
'If mblnAbbruch = True Then Exit Do
'If m_blnDoStart = True Then Exit Do
'lngCountVersuche = lngCountVersuche + 1
lngSuccess = m_objSensusIFInterface.GetFactoryID(strAntwort)
If lngSuccess = 0 Then
Debug.Print "WDH"
End If
'Loop While lngSuccess = 0 And lngCountVersuche < g_CONSTTURBOVERSUCHE
If lngSuccess = 1 Then
If Left(lblEinbau(nIndex).caption, 3) = "Err" Then
lblEinbau(nIndex).caption = ""
End If
' Zähler antwortet
txtSerienNr(nIndex).Enabled = True
DoEvents
' FabNr lesen
neueFabNr = strAntwort
'cmdSerNrAusw(nIndex).Enabled = True
lblStatus(nIndex) = "FabNr: " & CStr(Val(neueFabNr))
If Val(neueFabNr) <> Val(Einbauplatz.getZusatz) Or txtSerienNr(nIndex) = "" Then
' es ist ein neuer Zähler
Screen.MousePointer = vbHourglass
'Schloss prüfen
'Set objSensusIFInterface = New SensusIF2.Interface
'objSensusIFInterface.CommPortNr = ComPort
'objSensusIFInterface.DebugWindowsIsVisible = False
'objSensusIFInterface.PortInit
If Not m_objSensusIFInterface.GetSealStatus(blnSchlossOffen) Then
If blnSchlossOffen Then
imgSchloss(nIndex).Picture = frmRes.ImgSchlossOff
Else
imgSchloss(nIndex).Picture = frmRes.imgSchlossGes
End If
Else
' konnte Schloss nicht prüfen
End If
'Set objSensusIFInterface = Nothing
' Überprüfung auf Rechenwerksnennweite
'Einbauplatz.intErkannteQp = Round(USGetFlowSimu(Einbauplatz.getNr) * 3600, 0)
'Debug.Print "Rechenwerksnennweite (FlowSimu) : " & Einbauplatz.intErkannteQp
Einbauplatz.setZusatz neueFabNr
If Val(neueFabNr) > 0 Then
' FabNr ist vorhanden
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
If AuftragpositionSerienNr.loadFromFabNr(CLng(neueFabNr)) Then
'AuftragPositionSNr wurde gefunden, Zähler war schon mal hier
txtSerienNr(nIndex).text = AuftragpositionSerienNr.getNr
' Anzeigen der Auftragsdaten
bTextChanged(nIndex) = True
Call ueberpruefe(nIndex)
DoEvents
Call updatePruefpunkte
DoEvents
alteFarbe = txtSerienNr(nIndex).BackColor
Else
'AuftragPositionSNr wurde nicht gefunden, Zähler ist noch unbekannt
txtSerienNr(nIndex).text = const_keineSNText
End If
Else
'FabNr ist nicht vorhanden
End If
Screen.MousePointer = vbNormal
Else
' Zähler ist vorhanden aber wurde bereits vorher erkannt
bTextChanged(nIndex) = False
End If
EnableEventsForSensusIF (nIndex)
Else
EnableEventsForSensusIF (nIndex)
' Set objSensusIFInterface = New SensusIF2.Interface
' objSensusIFInterface.CommPortNr = ComPort
' objSensusIFInterface.DebugWindowsIsVisible = False
' objSensusIFInterface.PortInit
' kein Pong nach Ping
' Zähler antwortet nicht, d.h.
' Zaehler wurde ausgebaut oder nicht wieder gescannt
EntferneZaehlerAusEinbauplatz (nIndex)
lblEinbau(nIndex).caption = m_objSensusIFInterface.GetErrorMessage(lngSuccess)
txtSerienNr(nIndex).Enabled = False
cmdSerNrAusw(nIndex).Enabled = False
lblStatus(nIndex) = ""
ueberpruefe nIndex
alteFarbe = vbWhite
End If
End If ' wenn nicht auf starten
End If ' COM definiert
txtSerienNr(nIndex).BackColor = alteFarbe
DoEvents
Next
m_blnIsInTimer = False
If m_blnDoStart Then
Timer1.Enabled = False
m_blnDoStart = False
DoStartHauptprüfung
End If
Timer1.Enabled = m_TimerOn 'Timer (wenn gewünscht) wieder einschalten
'StopScan
End Sub
Private Sub EntferneZaehlerAusEinbauplatz(Index As Integer)
' Dim Einbauplatz As CEinbauplatz
' Set Einbauplatz = m_colEinbauplatz(Index)
' Einbauplatz.setPruefzaehler Nothing
'
' imgSchloss(Index).Picture = frmRes.ImgLeer.Picture
m_colEinbauplatz(Index).setZusatz ""
txtSerienNr(Index).text = ""
imgSchloss(Index).Picture = frmRes.ImgLeer.Picture
txtSerienNr(Index).BackColor = vbWhite
lblEinbau(Index).caption = ""
' lblTimeout(Index).Caption = ""
imgZaehler(Index).Enabled = False
cmdSerNrAusw(Index).Enabled = False
lblStatus(Index) = ""
' txtSerienNr(Index).Enabled = True
'
' On Error Resume Next
' txtSerienNr(Index).SetFocus
' On Error GoTo 0
'
' txtSerienNr(Index).Enabled = False
'
' ueberpruefe Index
End Sub
Private Sub StartScan()
Timer1.Interval = 1000
Timer1.Enabled = True
Shape1.BackColor = &H80FF&
m_TimerOn = True
cmdStopScan.caption = "STOP SCAN"
End Sub
' Prüft, ob Seriennr im Texteingabefeld von interner Seriennr abweicht
' fragt nach und schreibt eingegebene Seriennr in den Zähler
Private Sub CheckWriteSerienNr(Index As Integer)
Dim neueSernr As String
Dim geleseneFabNr As String
Dim Pruefzaehler As CPruefzaehler
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Dim Einbauplatz As CEinbauplatz
Dim comport As Integer
Dim blnTimerOn As Boolean
Dim lngSuccess As Long
Dim blnFehler As Boolean
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
geleseneFabNr = Einbauplatz.getZusatz
' If TestForQnIstOK(Einbauplatz) = False Then
' EntferneZaehlerAusEinbauplatz (Index)
' Exit Sub
' End If
If AuftragpositionSerienNr.getFabNr <> geleseneFabNr Then
'If CStr(AuftragpositionSerienNr.getFabNr) <> geleseneFabNr Then
Dim strTemp As String
strTemp = "Möchten Sie diese Seriennr ('" & Pruefzaehler.getSerienNr & "') " & vbCrLf & "für diesen Turbo2e-Zähler" & vbCrLf & " (FabNr: '" & geleseneFabNr & "')" & vbCrLf & " zukünftig verwenden?"
If MsgBox(strTemp, vbYesNo Or vbQuestion, "neue Seriennr verwenden?") = vbYes Then
If geleseneFabNr <> "" Then
If Not CheckAndCreateInSpeicherabbild(Einbauplatz.getNr, geleseneFabNr) Then
MsgBox ("Speicherabbild wurde nicht gesichert.")
Exit Sub
End If
Else
MsgBox "Gelesene FabNr ist leer! Speicherabbild wurde nicht gesichert."
End If
comport = Val(g_App.Settings.getUSComPort(Index))
DisableEventsForSensusIF (Index)
If m_objSensusIFInterface Is Nothing Then Set m_objSensusIFInterface = New SensusIF2.Interface
m_objSensusIFInterface.CommPortNr = comport
m_objSensusIFInterface.PortInit
'lngSuccess = objSensusIFInterface.SetFactoryID(Pruefzaehler.getSerienNr)
blnFehler = True
'If lngSuccess = 1 Then
'lngSuccess = objSensusIFInterface.SetText(Pruefzaehler.getSerienNr)
'If lngSuccess = 1 Then
lngSuccess = m_objSensusIFInterface.SetMeterID(Pruefzaehler.getSerienNr)
If lngSuccess = 1 Then
blnFehler = False
Else
MsgBox ("Fehler " & lngSuccess & " beim Schreiben der MeterID: " & m_objSensusIFInterface.GetErrorMessage(lngSuccess))
End If
' Else
' MsgBox ("Fehler " & lngSuccess & " beim Schreiben des Meter-Textes: " & objSensusIFInterface.GetErrorMessage(lngSuccess))
' End If
' Else
' MsgBox ("Fehler " & lngSuccess & " beim Schreiben der FactoryID: " & objSensusIFInterface.GetErrorMessage(lngSuccess))
' End If
If blnFehler = False Then
' FactoryID, MeterID und Text wurden geschrieben!
Einbauplatz.setZusatz Pruefzaehler.getSerienNr
AuftragpositionSerienNr.setFabNr CLng(geleseneFabNr)
AuftragpositionSerienNr.save
If chkNurMesseinsaetze.value = vbUnchecked And chkVersuch.value = vbUnchecked Then
' kein Messeinsatz und kein Versuch
If UpdateInDruckpruefung(CLng(geleseneFabNr), Pruefzaehler.getSerienNr) = False Then
Call MsgBox("Für diesen Zähler (FabNr=" & geleseneFabNr & ") liegen keine Ergebnisse der Druckprüfung vor!", vbCritical)
LogIntoDB "Für diesen Turbo2 Zähler (FabNr=" & geleseneFabNr & ") liegen keine Ergebnisse der Druckprüfung vor!", "Druckpruefung"
End If
End If
Else
EntferneZaehlerAusEinbauplatz (Index)
End If
EnableEventsForSensusIF (Index)
Else
EntferneZaehlerAusEinbauplatz (Index)
End If
End If
End Sub
Private Function CheckAndCreateInSpeicherabbild(ByVal EinbauplatzNr As Integer, ByVal FabNr As Long) As Boolean
Dim rs As CRecordset
On Error GoTo CheckAndCreateInSpeicherabbildError
TryAgain:
Set rs = New CRecordset
rs.openRS "SELECT * from Speicherabbild where FabNr = " & FabNr
If rs.EOF Then
rs.addNew
Call rs.setValue("FabNr", FabNr)
Call rs.setValue("Datum", Now())
Call rs.setValue("MemoryContent", "")
If Not rs.update Then
GoTo CheckAndCreateInSpeicherabbildError
End If
Debug.Print "Datensatz mit der FabFabNr " & FabNr & " in der Tabelle Speicherabbild erzeugt."
Else
Debug.Print "Datensatz mit der FabFabNr " & FabNr & " ist in der Tabelle Speicherabbild vorhanden."
End If
Set rs = Nothing
CheckAndCreateInSpeicherabbild = True
Exit Function
CheckAndCreateInSpeicherabbildError:
Debug.Print "CheckAndCreateInSpeicherabbild: " & Err.Description
If MsgBox("FabNr '" & FabNr & "' konnte nicht in Tabelle Speicherabbild erzeugt werden. Fehler " & Err.Number & vbCrLf & Err.Description, vbRetryCancel Or vbDefaultButton1) = vbRetry Then
Set rs = Nothing
Resume TryAgain
Else
Set rs = Nothing
Debug.Print "CheckAndCreateInSpeicherabbild abgebrochen."
CheckAndCreateInSpeicherabbild = False
End If
End Function
Private Sub DisableEventsForSensusIF(Index As Integer)
' SensusIF Kommandos erlauben wähend des Wartens auf eine Antwort per DoEvents das Ausführen von anderen Events, wie
' z.B. das Vergeben von Seriennummern, das wiederum wieder SensusIF Kommandos benutzt.
' Deshalb müssen alle Events verhindert werden, solange auf eine SensusIF Antwort gewartet wird
txtSerienNr(Index).Enabled = False
cmdSerNrAusw(Index).Enabled = False
Timer1.Enabled = False
m_blnIsInSensusIF = True
Debug.Print "DisableEvents"
End Sub
Private Sub EnableEventsForSensusIF(Index As Integer)
txtSerienNr(Index).Enabled = True
cmdSerNrAusw(Index).Enabled = True
Timer1.Enabled = m_TimerOn
m_blnIsInSensusIF = False
Debug.Print "EnableEvents"
End Sub
Private Sub InitializeAllTurbo2e()
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
InitializeTurbo2e Einbauplatz.getNr
End If
Next
End Sub
Private Function InitializeTurbo2e(ByVal EinbauplatzNr As Integer) As Long
DisableEventsForSensusIF (EinbauplatzNr)
Dim comport As Integer
Dim blnError As Boolean
Dim lngCountVersuche As Long
Const MAXANZAHLVERSUCHE = 5
start:
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
'Dim objSensusIFInterface As SensusIF2.Interface
Set m_objSensusIFInterface = New SensusIF2.Interface
m_objSensusIFInterface.CommPortNr = comport
m_objSensusIFInterface.PortInit
m_objSensusIFInterface.DebugWindowsIsVisible = True
DebugMsg "Initialisierung des Turbo2e am Einbauplatz " & EinbauplatzNr & " ..."
lngCountVersuche = 0
Do
InitializeTurbo2e = m_objSensusIFInterface.SetIndexUnit(SENSUSIF_EINHEIT.M3)
If InitializeTurbo2e <> 1 Then
lngCountVersuche = lngCountVersuche + 1
Sleep 100, True
End If
Loop While InitializeTurbo2e <> 1 And lngCountVersuche < MAXANZAHLVERSUCHE
If InitializeTurbo2e <> 1 Then
ErrorMsg "Fehler " & InitializeTurbo2e & " bei SetIndexUnit(m³): " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e) & vbCrLf & "(" & lngCountVersuche & " mal wiederholt)"
blnError = True
End If
lngCountVersuche = 0
Do
InitializeTurbo2e = m_objSensusIFInterface.SetDisplayMode(5)
If InitializeTurbo2e <> 1 Then
lngCountVersuche = lngCountVersuche + 1
Sleep 100, True
End If
Loop While InitializeTurbo2e <> 1 And lngCountVersuche < MAXANZAHLVERSUCHE
If InitializeTurbo2e <> 1 Then
ErrorMsg "Fehler " & InitializeTurbo2e & " bei SetDisplayMode(5): " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e) & vbCrLf & "(" & lngCountVersuche & " mal wiederholt)"
blnError = True
End If
lngCountVersuche = 0
Do
InitializeTurbo2e = m_objSensusIFInterface.SetAMRdigits(Chr(8) & Chr(0))
If InitializeTurbo2e <> 1 Then
lngCountVersuche = lngCountVersuche + 1
Sleep 100, True
End If
Loop While InitializeTurbo2e <> 1 And lngCountVersuche < MAXANZAHLVERSUCHE
If InitializeTurbo2e <> 1 Then
ErrorMsg "Fehler " & InitializeTurbo2e & " bei SetAMRdigits(08 00) : " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e) & vbCrLf & "(" & lngCountVersuche & " mal wiederholt)"
blnError = True
End If
' InitializeTurbo2e = m_objSensusIFInterface.SetPulseOutput(7)
' If InitializeTurbo2e <> 1 Then
' MsgBox "Fehler " & InitializeTurbo2e & " bei SetPulseOutput: " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e)
' End If
lngCountVersuche = 0
Do
InitializeTurbo2e = m_objSensusIFInterface.SetFieldcorrection(0)
If InitializeTurbo2e <> 1 Then
lngCountVersuche = lngCountVersuche + 1
Sleep 100, True
End If
Loop While InitializeTurbo2e <> 1 And lngCountVersuche < MAXANZAHLVERSUCHE
If InitializeTurbo2e <> 1 Then
ErrorMsg "Fehler " & InitializeTurbo2e & " bei SetFieldcorrection(0): " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e) & vbCrLf & "(" & lngCountVersuche & " mal wiederholt)"
blnError = True
End If
' todo : abhängig von Nennweite, Auftrag etc
' InitializeTurbo2e = m_objSensusIFInterface.SetMetersizeVPRin(1, 9)
' If InitializeTurbo2e <> 1 Then
' MsgBox "Fehler " & InitializeTurbo2e & " bei SetMetersizeVPRin: " & m_objSensusIFInterface.GetErrorMessage(InitializeTurbo2e)
' End If
If blnError = True Then
If MsgBox("Initialisierung fehlgeschlagen. Soll die Initialisierung dieses Zählers wiederholt werden?", vbYesNo Or vbDefaultButton1) = vbYes Then
GoTo start
End If
End If
Set m_objSensusIFInterface = Nothing
EnableEventsForSensusIF (EinbauplatzNr)
End Function
Private Sub DoStartHauptprüfung()
Timer1.Enabled = False
Screen.MousePointer = vbHourglass
InitializeAllTurbo2e
Screen.MousePointer = vbNormal
Call Hauptpruefung
Timer1.Enabled = True
cmdOK.Enabled = True
End Sub
Private Sub cmdOk_Click()
If m_blnDoStart = True Then
MsgBox "es wird bereits gestartet"
Exit Sub
End If
If Not SindZaehlerAehnlich() Then
MsgBox ("Die Zähler sind zu unterschiedlich um zusammen geprüft zu werden")
Exit Sub
End If
If Not PruefpunkteZeitenVorhanden() Then
MsgBox ("Prüfpunktzeiten fehlen!" & vbCrLf & "Für alle Prüfpunkte müssen Zeiten definiert sein!")
Exit Sub
End If
' Vorraussetzungen sind erfüllt
Screen.MousePointer = vbHourglass
cmdOK.Enabled = False
m_blnDoStart = True
If Timer1.Enabled = True Then
Timer1.Enabled = False
m_blnDoStart = False
DoStartHauptprüfung
End If
End Sub
Private Sub cmdStopScan_Click()
If m_TimerOn = False Then
StartScan
Else
StopScan
End If
End Sub
Private Sub cmdRuecklaeuferanalyse_Click(Index As Integer)
Dim objForm As frmRuecklaeuferanalyse
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set objForm = New frmRuecklaeuferanalyse
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
objForm.m_EinbauplatzNr = Einbauplatz.getNr
Set objForm.m_Pruefzaehler = Einbauplatz.getPruefzaehler
Set objForm.m_Pruefgang = m_Pruefgang
objForm.Show vbModal, Me
End Sub
Reference in New Issue View Git Blame Copy Permalink