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

3392 lines
112 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Begin VB.Form frmPruefzaehlerPruefungManuell
BackColor = &H8000000B&
BorderStyle = 0 'Kein
Caption = "manuelle Prüfdaten Eingabe"
ClientHeight = 11520
ClientLeft = 105
ClientTop = 105
ClientWidth = 17220
Icon = "PruefzaehlerPruefungManuell.frx":0000
LinkTopic = "Form1"
Moveable = 0 'False
ScaleHeight = 11520
ScaleWidth = 17220
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 = 60
TabIndex = 20
Top = 0
Width = 15375
Begin VB.CommandButton cmdeRegisterZaehlerstand
Caption = "eRegister Service Funktionen"
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 = 9480
TabIndex = 100
Top = 7140
Width = 2715
End
Begin VB.CommandButton cmd_Vorbereitung_Ebeling
Caption = "eRegister Vorbereitung Ebeling&&Sohn"
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 = 9420
TabIndex = 99
Top = 6000
Width = 2775
End
Begin VB.CommandButton cmdSchotteinstellungen
Caption = "Schott Einstellungen ..."
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 = 12540
TabIndex = 98
Top = 360
Width = 2655
End
Begin VB.CommandButton cmd_eRegister_PruefungsAbschluss
Caption = "eRegister Prüfungs- Abschluss"
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 = 9420
TabIndex = 97
Top = 5220
Width = 2775
End
Begin VB.CommandButton cmd_eRegister_Pruefungsinitialisierung
Caption = "eRegister Prüfungs- Intialisierung"
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 = 9420
TabIndex = 96
Top = 4440
Width = 2775
End
Begin VB.CommandButton cmdDurchflussAnzeigen
Caption = "Durchfluss anzeigen"
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 = 10620
TabIndex = 95
Top = 8460
Width = 1410
End
Begin VB.Frame Frame1
Caption = "Optionen"
Height = 3135
Left = 9090
TabIndex = 90
Top = 1170
Width = 3375
Begin VB.CheckBox chkZulassung
Caption = "Zulassungsprüfung PTB/DKD"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 675
Left = 300
TabIndex = 94
Top = 2370
Width = 2925
End
Begin VB.CheckBox chkSimpleInput
Caption = "vereinfachte Eingabe"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 300
TabIndex = 93
Top = 1890
Width = 2985
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 = 92
Top = 270
Width = 2625
End
Begin VB.CheckBox chkAnzeigeKundeneigeneSerienNr
Caption = "Knd. eig. SerNr anzeigen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 300
TabIndex = 91
Top = 840
Width = 2985
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 = 1215
Index = 1
Left = 540
TabIndex = 31
Top = 150
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 1
Left = 2460
TabIndex = 80
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 1
Left = 1980
TabIndex = 1
Top = 930
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 = 1
Left = 240
TabIndex = 0
Top = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 1
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 1
Left = 240
TabIndex = 32
Top = 360
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 = 1215
Index = 2
Left = 570
TabIndex = 29
Top = 1260
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 2
Left = 2490
TabIndex = 81
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 2
Left = 1980
TabIndex = 3
Top = 930
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 = 240
TabIndex = 2
Top = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 2
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 2
Left = 240
TabIndex = 30
Top = 360
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 = 1215
Index = 3
Left = 540
TabIndex = 27
Top = 2310
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 3
Left = 2460
TabIndex = 82
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 3
Left = 1980
TabIndex = 5
Top = 930
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 = 240
TabIndex = 4
Top = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 3
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 3
Left = 240
TabIndex = 28
Top = 360
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 = 1215
Index = 4
Left = 540
TabIndex = 25
Top = 3390
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 4
Left = 2430
TabIndex = 83
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 4
Left = 1980
TabIndex = 7
Top = 930
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 = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 4
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 4
Left = 240
TabIndex = 26
Top = 360
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 = 1215
Index = 5
Left = 540
TabIndex = 23
Top = 4470
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 5
Left = 2430
TabIndex = 84
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 5
Left = 2010
TabIndex = 9
Top = 930
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 = 720
Width = 1695
End
Begin VB.Label lblEinbau
Height = 375
Index = 5
Left = 240
TabIndex = 24
Top = 360
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 5
Left = 3480
Top = 720
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 = 1215
Index = 6
Left = 540
TabIndex = 21
Top = 5580
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 6
Left = 2430
TabIndex = 85
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 6
Left = 1980
TabIndex = 11
Top = 930
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 = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 6
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 6
Left = 270
TabIndex = 22
Top = 360
Width = 3675
End
End
Begin VB.CommandButton cmdCancel
Caption = "Programm beenden"
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 = 12720
TabIndex = 59
Top = 10650
Width = 2475
End
Begin VB.CommandButton cmdOK
Caption = "Prüfdaten eingeben..."
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 = 9480
TabIndex = 58
Top = 10680
Width = 2535
End
Begin VB.CommandButton cmdPruefdatenergaenzen
Caption = "Prüfdaten ergänzen..."
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 = 9480
TabIndex = 57
Top = 9900
Width = 2535
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 = 1215
Index = 7
Left = 540
TabIndex = 54
Top = 6690
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 7
Left = 2430
TabIndex = 86
Top = 900
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 = 7
Left = 240
TabIndex = 12
Top = 690
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 7
Left = 1980
TabIndex = 13
Top = 930
Width = 405
End
Begin VB.Label lblEinbau
Height = 375
Index = 7
Left = 270
TabIndex = 55
Top = 360
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 7
Left = 3480
Top = 720
Width = 480
End
End
Begin VB.CommandButton Command1
Caption = "neuer Prüfgang "
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 = 9480
TabIndex = 53
Top = 9180
Width = 2535
End
Begin VB.CommandButton cmdAuftraege
Caption = "Auftragsdaten..."
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 = 12720
TabIndex = 52
Top = 9180
Width = 2475
End
Begin VB.Frame frame3
Caption = "Optionen"
Height = 1875
Left = 12600
TabIndex = 44
Top = 5220
Width = 2595
Begin VB.Label lblPruefgangNr
Caption = "PruefgangNr: nicht vergeben"
Height = 255
Left = 180
TabIndex = 45
Top = 300
Width = 2295
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 = 795
Left = 12540
TabIndex = 42
Top = 1140
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 = 43
Top = 360
Width = 2115
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 = 2955
Left = 12540
TabIndex = 36
Top = 2100
Width = 2715
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 = 37
Top = 1680
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 = 41
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 = 40
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 = 39
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 = 38
Top = 840
Width = 1995
End
End
Begin VB.Frame frmScanner
Caption = "Scanner Eingabe"
Height = 1095
Left = 12600
TabIndex = 33
Top = 7260
Width = 2595
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 = 480
Left = 120
MaxLength = 25
TabIndex = 34
Top = 480
Width = 2355
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 = 35
Top = 240
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 = 1215
Index = 8
Left = 540
TabIndex = 61
Top = 7800
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 8
Left = 2430
TabIndex = 87
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 8
Left = 1980
TabIndex = 15
Top = 930
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 = 8
Left = 240
TabIndex = 14
Top = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 8
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 8
Left = 270
TabIndex = 62
Top = 360
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 = 1215
Index = 9
Left = 540
TabIndex = 64
Top = 8940
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 9
Left = 2430
TabIndex = 88
Top = 900
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 = 9
Left = 240
TabIndex = 16
Top = 720
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 9
Left = 1980
TabIndex = 17
Top = 930
Width = 405
End
Begin VB.Label lblEinbau
Height = 375
Index = 9
Left = 270
TabIndex = 65
Top = 360
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 9
Left = 3480
Top = 720
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 = 1215
Index = 10
Left = 540
TabIndex = 67
Top = 10080
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 10
Left = 2430
TabIndex = 89
Top = 900
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 195
Index = 10
Left = 1980
TabIndex = 19
Top = 930
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 = 10
Left = 240
TabIndex = 18
Top = 720
Width = 1695
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 10
Left = 3480
Top = 720
Width = 480
End
Begin VB.Label lblEinbau
Height = 375
Index = 10
Left = 180
TabIndex = 68
Top = 240
Width = 3675
End
End
Begin VB.Label lblEbpNr
Caption = "10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 10
Left = 120
TabIndex = 79
Top = 10800
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 8
Left = 180
TabIndex = 78
Top = 8580
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 9
Left = 180
TabIndex = 77
Top = 9720
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 7
Left = 180
TabIndex = 76
Top = 7440
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 6
Left = 180
TabIndex = 75
Top = 6300
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 5
Left = 180
TabIndex = 74
Top = 5220
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 4
Left = 180
TabIndex = 73
Top = 4080
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 3
Left = 180
TabIndex = 72
Top = 2940
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 2
Left = 180
TabIndex = 71
Top = 1980
Width = 315
End
Begin VB.Label lblEbpNr
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Index = 1
Left = 180
TabIndex = 70
Top = 900
Width = 315
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 10
Left = 5460
TabIndex = 69
Top = 10560
Width = 3495
End
Begin VB.Image imgZaehler
Height = 750
Index = 10
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 10440
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 9
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 9330
Width = 615
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 9
Left = 5460
TabIndex = 66
Top = 9390
Width = 3495
End
Begin VB.Image imgZaehler
Height = 750
Index = 8
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 8250
Width = 615
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 8
Left = 5460
TabIndex = 63
Top = 8310
Width = 3500
End
Begin VB.Label lblTitle
BackStyle = 0 'Transparent
Caption = "Vorbereitung einer manuellen Prüfung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 5340
TabIndex = 60
Top = 150
Width = 9045
End
Begin VB.Image imgZaehler
Height = 750
Index = 7
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 7080
Width = 615
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 7
Left = 5460
TabIndex = 56
Top = 7140
Width = 3495
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 6
Left = 5400
TabIndex = 51
Top = 6060
Width = 3495
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 5
Left = 5400
TabIndex = 50
Top = 4980
Width = 3500
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 4
Left = 5400
TabIndex = 49
Top = 3840
Width = 3495
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 3
Left = 5340
TabIndex = 48
Top = 2730
Width = 3500
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 5400
TabIndex = 47
Top = 1650
Width = 3500
End
Begin VB.Label lblStatus
BackStyle = 0 'Transparent
BorderStyle = 1 'Fest Einfach
Caption = "[Status]"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 1
Left = 5400
TabIndex = 46
Top = 600
Width = 3500
End
Begin VB.Image imgZaehler
Height = 750
Index = 1
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 450
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 2
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 1650
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 3
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 2730
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 4
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 3810
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 5
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 4890
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 6
Left = 4680
MousePointer = 99 'Benutzerdefiniert
Top = 5970
Width = 615
End
End
End
Attribute VB_Name = "frmPruefzaehlerPruefungManuell"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'==============================================================================
'
' File : PruefzaehlerPruefung.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
Private m_blneRegisterInitialisierungDurchgefuehrt As Boolean
Private m_Pruefgang As CPruefgang
Public m_SPS As CSPS
Public mParentForm As Form
Dim bTextChanged(10) As Boolean
Private m_dlgManuellDetails As frmManuellDetails
Const SECTIONSIMPLEINPUT = "manuelle Pruefung"
Const KEYSIMPLEINPUT = "einfache Eingabe"
Private Sub chkAnzeigeKundeneigeneSerienNr_Click()
On Error GoTo Errorhandler
Dim i As Integer
If chkAnzeigeKundeneigeneSerienNr.value = vbChecked Then
g_blnKundeneigeneSerienNrAnzeigen = True
For i = 1 To 10
Call AnzeigeKundeneigeneSerienNr(i)
Next i
Else
g_blnKundeneigeneSerienNrAnzeigen = False
For i = 1 To 10
lblEinbau(i).FontSize = 8
lblEinbau(i).ForeColor = vbBlack
lblEinbau(i).FontBold = False
updateEinbauplatz (i)
Next i
End If
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in frmPruefzaehlerPruefungManuell.chkAnzeigeKundeneigeneSerienNr:" & Err.Description, "Softwarefehler"
End Sub
Private Sub AnzeigeKundeneigeneSerienNr(i As Integer)
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
lblEinbau(i).FontSize = 14
lblEinbau(i).ForeColor = &HC00000
lblEinbau(i).FontBold = True
Set Einbauplatz = m_colEinbauplatz.Item(i)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
lblEinbau(i).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
End If
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in chkAnzeigeKundeneigeneSerienNr:" & Err.Description, "Softwarefehler"
End Sub
Private Sub chkSimpleInput_Click()
If chkSimpleInput.Enabled = True Then
If chkSimpleInput.value = vbChecked Then
g_App.Settings.saveStringValue SECTIONSIMPLEINPUT, KEYSIMPLEINPUT, "1"
Else
g_App.Settings.saveStringValue SECTIONSIMPLEINPUT, KEYSIMPLEINPUT, "0"
End If
End If
End Sub
Private Sub cmdAuftraege_Click()
Dim dlg As frmAuftraege
Set dlg = New frmAuftraege
dlg.Show vbModal
End Sub
Private Sub cmdDurchflussAnzeigen_Click()
frmDurchflussanzeige.Show vbModal, Me
End Sub
Private Sub cmdeRegisterZaehlerstand_Click()
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.Visible = True
frmeRegisterPrf.Service
frmeRegisterPrf.Visible = False
End Sub
Private Sub cmdOk_Click()
Dim blnVersuch As Boolean
DoEvents
Set m_Pruefgang = New CPruefgang
blnVersuch = g_blnVersuch
g_blnVersuch = False
cmdOK.Enabled = False
Me.MousePointer = vbHourglass
If alleZaehlerHabenPP() Then
Call PruefdatenAufnehmen(, True)
Call PruefungFertigmeldenDialog("", m_colEinbauplatz)
End If
Me.MousePointer = vbNormal
cmdOK.Enabled = True
g_blnVersuch = blnVersuch
If AnzahlNeueMails() > 0 Then
If g_blnMitteilungengelesen = False Then
frmMitteilungen.Show vbModal
g_blnMitteilungengelesen = True
End If
End If
Call RefreshEinbauplaetze
End Sub
Private Sub RefreshEinbauplaetze()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
cmd_eRegister_Pruefungsinitialisierung.Enabled = False
cmd_eRegister_PruefungsAbschluss.Enabled = False
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
testSerienNrInput (Einbauplatz.getNr)
If Not Einbauplatz.eRegister Is Nothing Then
cmd_eRegister_Pruefungsinitialisierung.Enabled = True
If Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 25 Then
' nur geprüfte Zähler dürfen den Prüfungsabschluss durchlaufen, ansonsten bleibt der Button grau
cmd_eRegister_PruefungsAbschluss.Enabled = True
End If
End If
End If
Next
End Sub
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
Private Sub cmdPruefdatenergaenzen_Click()
Me.MousePointer = vbHourglass
cmdPruefdatenergaenzen.Enabled = False
Call PruefdatenErgaenzen
cmdPruefdatenergaenzen.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub PruefdatenErgaenzen()
Dim Index As Integer
Dim lngPruefgangNr As Long
Dim lngVergleichPruefgangNr As Long
Dim blnAlleImGleichemPruefgang As Boolean
Dim objPruefgang As CPruefgang
Dim Einbauplatz As CEinbauplatz
Set objPruefgang = New CPruefgang
blnAlleImGleichemPruefgang = True
If alleZaehlerHabenPP() Then
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
lngPruefgangNr = getLetztePruefgangNrForSerienNr(Einbauplatz.getPruefzaehler.getSerienNr)
Debug.Print "lngPruefgangNr=" & lngPruefgangNr & " für SerienNr=" & Einbauplatz.getPruefzaehler.getSerienNr
If lngPruefgangNr > 0 Then
' Prüfgangnummer konnte ermittelt werden
If lngVergleichPruefgangNr <> 0 Then
' Prüfgangnummer zum vergleichen liegt vor
If lngVergleichPruefgangNr <> lngPruefgangNr Then
' Prüfgangnummern sind ungleich
blnAlleImGleichemPruefgang = False
End If
Else ' lngVergleichPruefgangNr = 0
' Prüfgangnummer zum vergleichen liegt noch nicht vor
lngVergleichPruefgangNr = lngPruefgangNr
End If ' lngVergleichPruefgangNr <> 0
Else
' Prüfgangnummer konnte nicht ermittelt werden
blnAlleImGleichemPruefgang = False
End If 'lngPruefgangNr > 0
End If ' Pruefzähler ist eingebaut
Next
If blnAlleImGleichemPruefgang = False Then
ErrorMsg "Es wurde kein (gemeinsamer) Prüfgang für alle Zähler gefunden." & vbCrLf
Else
Set m_Pruefgang = New CPruefgang
If Not m_Pruefgang.load(lngVergleichPruefgangNr) Then
ErrorMsg "Die PrüfgangDaten für Prüfgang " & lngVergleichPruefgangNr & " konnten nicht geladen werden"
Else
PruefdatenAufnehmen True
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
Call PruefungFertigmeldenDialog("", m_colEinbauplatz)
End If
End If
End If
End Sub
Private Sub cmdSchotteinstellungen_Click()
SchotteinstellungenAendern
End Sub
Private Sub Command1_Click()
NeuerPruefgang
End Sub
Private Sub NeuerPruefgang()
Dim i As Integer
Set m_Pruefgang = Nothing
lblPruefgangNr.caption = "PruefgangNr: nicht vergeben"
For i = 1 To 10
txtSerienNr(i).text = ""
ueberpruefe (i)
Next
End Sub
Private Sub Form_Activate()
If g_App.PruefstationNr = 24 Then
' Scanner wird benutzt beim Notebook zum Vorbereiten der eRegister für Ebeling
txtScanner.SetFocus
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim nLeft As Long
Dim nTop As Long
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
cmdPruefdatenergaenzen.Top = cmdOK.Top - cmdOK.Height * 1.1
cmdPruefdatenergaenzen.Left = cmdOK.Left
cmdPruefdatenergaenzen.Height = cmdOK.Height
For i = 1 To 10
imgZaehler(i).Picture = frmRes.imgZaehlerGrauLinks.Picture
txtSerienNr(i).MaxLength = 10
imgZaehler(i).Enabled = False
lblStatus(i).caption = ""
If i > g_App.Settings.EinbauplaetzeJeStrang And g_App.PruefstationNr = 24 Then
' nicht benötigte Einbauplätze ausblenden beim Notebook zum Vorbereiten der eRegister für Ebeling
frEinbau(i).Visible = False
imgZaehler(i).Visible = False
lblEbpNr(i).Visible = False
End If
Next i
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
lblUniquePP = 0
lblMaxPP = g_App.Settings.getMaxPruefpunkte()
lblTitle = "Vorbereitung einer manuellen Prüfung Station: " & g_App.PruefstationNr
Me.caption = "manuelle Prüfdaten Eingabe für Prüfstation " & g_App.PruefstationNr
Call initEinbauplaetze ' Erzeuge Einbauplaetze Collection
chkSimpleInput.Enabled = False
If g_App.Settings.readStringValue(SECTIONSIMPLEINPUT, KEYSIMPLEINPUT, "0") = "1" Then
chkSimpleInput.value = vbChecked
Else
chkSimpleInput.value = vbUnchecked
End If
chkSimpleInput.Enabled = True
If g_blnVersuch Then
cmdCancel.caption = "Zurück"
End If
m_blneRegisterInitialisierungDurchgefuehrt = False
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 10
Set Einbauplatz = New CEinbauplatz
Call Einbauplatz.setNr(i)
m_colEinbauplatz.Add Einbauplatz, Str$(i)
Next i
End Sub
'------------------------------------------------------------------------------
' Private Funktionalität
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
'On Error Resume Next
'g_frmMain.Show
If Not g_blnVersuch Then
End
End If
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
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
Private Sub Form_Unload(Cancel As Integer)
If Not mParentForm Is Nothing Then
If mParentForm.Visible = False Then
mParentForm.Show
End If
End If
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
' Prüfzähler-Objekt zur Manipulation übergeben
Call dlg.setPruefzaehler(Einbauplatz.getPruefzaehler())
Call dlg.setEinbauplatz(Einbauplatz)
Set dlg.m_colEinbauplatz = m_colEinbauplatz
If doModal(dlg, True) = IDOK Then
Call updatePruefpunkte
Call ueberpruefe(Index)
End If
Me.MousePointer = vbDefault
End Sub
Private Sub txtScanner_GotFocus()
txtScanner.SelStart = 0
txtScanner.SelLength = Len(txtScanner.text)
End Sub
'----------------------------------------------------------------------------
' Event Handling für das Scanner Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtScanner_KeyPress(KeyAscii As Integer)
Dim nWert As Currency
Dim strEingabe As String
Dim strNachKomma As String
Dim strKundEigeneSerienNr As String
Dim Aps As CAuftragPositionSerienNr
Me.MousePointer = vbHourglass
DoEvents
txtScanner.BackColor = vbWhite
Select Case KeyAscii
Case 13
KeyAscii = 0 ' unterbinde Beep
strEingabe = txtScanner.text
' alles nach dem Komma ignorieren
If InStr(1, strEingabe, ",") > 0 Then
' mit Komma: (Kndeigene) SerienNr + komma + Funkadresse
' nur das vor dem Komma betrachten
strEingabe = Split(strEingabe, ",")(0)
End If
' EinbauplatzNr ?
If IsNumeric(strEingabe) And Len(strEingabe) <= 1 Then
' Eingabe ist numerisch
nWert = Val(strEingabe)
If nWert > 0 And nWert <= 10 Then
' ist eine Einbauplatz Nr
m_nEinbauplatz = nWert
txtScanner.text = ""
lblScanner.caption = "Platz: " & Str(m_nEinbauplatz)
GoTo SPRUNG_AUSWERTEN
End If
End If
' ggF Kundeneigene SNr in SNr wandeln
Set Aps = New CAuftragPositionSerienNr
If Aps.loadFromKndEigeneNr(strEingabe) Then
' ggF Kundeneigene SNr in SNr wandeln
nWert = Aps.getNr
chkAnzeigeKundeneigeneSerienNr.value = vbChecked
Else
' Eingabe ist keine Kundeneigene SerienNr
If IsNumeric(strEingabe) Then
nWert = Val(strEingabe)
chkAnzeigeKundeneigeneSerienNr.value = vbUnchecked
Else
txtScanner.BackColor = vbRed
txtScanner_GotFocus
End If
End If
If (nWert >= SERIENNR_MINWERT And nWert <= SERIENNR_MAXWERT) Then
' ist eine SerienNr
m_nSeriennummer = nWert
txtScanner.text = ""
lblScanner.caption = "SN:" & Str(m_nSeriennummer)
End If
Case Else
End Select
SPRUNG_AUSWERTEN:
If g_App.PruefstationNr = 24 And m_nEinbauplatz = 0 Then
' Default Einbauplatz für das Notebook zum Vorbereiten der eRegister für Ebeling
m_nEinbauplatz = 1
End If
If m_nEinbauplatz > 0 And m_nSeriennummer > 0 Then
txtSerienNr(m_nEinbauplatz).text = m_nSeriennummer
lblScanner.caption = Str(m_nEinbauplatz) & " : " & Str(m_nSeriennummer)
ueberpruefe (m_nEinbauplatz)
Dim Einbauplatz As CEinbauplatz
Set Einbauplatz = m_colEinbauplatz(m_nEinbauplatz)
m_nEinbauplatz = 0
m_nSeriennummer = 0
txtScanner.SetFocus
End If
' If KeyAscii = 13 Then
' KeyAscii = 0 ' unterbinde Beep
' If IsNumeric(txtScanner) Then
' nWert = Val(txtScanner.text)
' If nWert > 0 And nWert <= 10 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 = 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
Me.MousePointer = vbNormal
DoEvents
End Sub
'----------------------------------------------------------------------------
' Event Handling für das SerienNr Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtSerienNr_Change(Index As Integer)
bTextChanged(Index) = True
End Sub
Private Sub txtSerienNr_DblClick(Index As Integer)
If Val(txtSerienNr(Index).text) > 0 Then
' nach dieser SerienNr suchen
g_lngSerienNr = Val(txtSerienNr(Index).text)
End If
OeffeSerienNrAuswahl (Index)
g_lngSerienNr = 0
End Sub
' Neu eingefügt am 02.08.02 Pfeiffer
Private Sub cmdSerNrAusw_Click(Index As Integer)
' es soll nicht nach dieser SerienNr gesucht werden
g_lngSerienNr = 0
OeffeSerienNrAuswahl (Index)
End Sub
Private Sub OeffeSerienNrAuswahl(Index As Integer)
Dim lngColor As Long
lngColor = txtSerienNr(Index).BackColor
txtSerienNr(Index).BackColor = RGB(200, 200, 200)
Dim frmDialog As frmSeriennrAuswahl
Dim i As Integer
Set frmDialog = New frmSeriennrAuswahl
For i = 1 To 10
g_Seriennr(i) = txtSerienNr(i)
Next
frmDialog.Show vbModal, Me
txtSerienNr(Index).BackColor = lngColor
If IsNumeric(frmDialog.sSerienNr) Then
txtSerienNr(Index).text = Trim(frmDialog.sSerienNr)
bTextChanged(Index) = True
txtSerienNr(Index).SetFocus
Call ueberpruefe(Index, Val(frmDialog.lngAuftrag))
End If
End Sub
Private Sub txtSerienNr_GotFocus(Index As Integer)
m_sOldInput = txtSerienNr(Index).text
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
txtSerienNr(IIf(Index < 10, Index + 1, 1)).SetFocus
ueberpruefe (Index)
End If
If KeyCode = 38 Then
' Setzt Fokus ins darüberliegende Textfeld bei Cursor-Up
txtSerienNr(IIf(Index > 1, Index - 1, 10)).SetFocus
ueberpruefe (Index)
End If
End Sub
Private Sub txtSerienNr_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case KeyAscii
Case 13
ueberpruefe (Index)
'Geändert am 10.08.02 Pfeiffer
If Index < g_App.Settings.EinbauplaetzeJeStrang Then
Index = Index + 1
Else
Index = 1
End If
cmdSerNrAusw(Index).SetFocus
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
' Numerisch 0-9
Case 3, 22, 24, 8
' cut copy Paste Backspace
Case Else
Debug.Print "unterdrückt: " & KeyAscii
KeyAscii = 0
End Select
End Sub
' Komplettes Feld selektieren
'
Private Sub selectSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = 0
txtSerienNr(Index).SelLength = Len(txtSerienNr(Index))
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
lSerienNr = neueTestZaehlerSerienNr()
If lSerienNr = 0 Then
txtSerienNr(Index).text = ""
txtSerienNr(Index).SetFocus
Exit Sub
End If
txtSerienNr(Index).text = CStr(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
End Sub
Private Sub ueberpruefe(Index As Integer, Optional AuftragNr As Long)
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, AuftragNr) 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.
If g_App.PruefstationNr <> 24 Then
Call UeberpruefeAufPruefpunkte(Index)
End If
End If
Else
' SerienNr wurde nicht akzeptiert
txtSerienNr(Index).SetFocus
End If
Else
' nicht geändert
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
m_colUniquePP.sortQ
For i = 1 To m_colUniquePP.Count()
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
Next i
' 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, Optional AuftragNr As Long) 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)) <= 10 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 10
If txtSerienNr(i) <> "" Then
bKeinPruefzaehler = False
End If
Next
If bKeinPruefzaehler Then
' Keine Seriennummer mehr vorhanden:
' Globale Regulierdaten werden gelöscht, wenn
' keine SerienNr mehr vorhanden ist
Set m_Regulierdaten = Nothing
End If
Else
If IsNumeric(txtSerienNr(Index).text) Then
If CDbl(txtSerienNr(Index).text) <= SERIENNR_MAXWERT Then
lSerienNr = Val(txtSerienNr(Index))
Else
MsgBox "Diese SerienNr ist zu hoch. Die höchstmögliche SerienNr ist " & SERIENNR_MAXWERT
txtSerienNr(Index).text = ""
GoTo testSerienNrInputReturnFalse
End If
End If
End If
' Setze im Einbauplatz Objekt die Seriennr. (laut DB)
If Not setEinbauplatzPruefzaehler(Einbauplatz, lSerienNr, AuftragNr) Then
' Fehlgeschlagen:
GoTo testSerienNrInputReturnFalse
End If
'---------- Textfeld Impulswertigkeit
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' Bem: IdentNr muss vorhanden sein für .GetImpulseQM
'Impulswertigkeit = Pruefzaehler.GetImpulseQM
End If
'----------
testSerienNrInputReturnOK:
Call updateZaehlerImage(Index)
testSerienNrInput = True
If Not Pruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
If Teste_Aufe_Register(Index) Then
cmd_eRegister_Pruefungsinitialisierung.Enabled = True
cmd_eRegister_PruefungsAbschluss.Enabled = True
If Teste_Aufe_Nebenzaehler(Index) Then
cmd_Vorbereitung_Ebeling.Enabled = True
End If
End If
' Todo: Verbesserung: Abweisen eines Zählers, wenn Regulierdaten
' des Zählers nicht gleich den globalen Regulierdaten sind.
If Pruefpunkte Is Nothing Then
ErrorMsg ("Es konnten keine Prüfpunkte ermittelt werden.")
Else
Set m_Regulierdaten = Pruefpunkte.getRegulierdaten
End If
End If
Call updatePruefpunkte
Call CheckZulassungsPruefung
GoTo testSerienNrInputReturn
testSerienNrInputReturnFalse:
Call selectSerienNrField(Index)
Call updateZaehlerImage(Index)
txtSerienNr(Index).SetFocus
testSerienNrInput = False
testSerienNrInputReturn:
'On Error Resume Next
Call updateEinbauplatz(Index)
Exit Function
End Function
Private Function Teste_Aufe_Nebenzaehler(Index As Integer) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Left(Pruefzaehler.getIdentNrObj.GetVakoCode, 5) = "MTWNZ" Then
Teste_Aufe_Nebenzaehler = True
End If
End If
End Function
Private Function Teste_Aufe_Register(Index As Integer) As Boolean
Dim objIdentNr As CIdentNr
Dim objVakoCode As CVakoCode
Dim strVakoCode As String
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Bestellcode As CBestellcode
Dim strBestellcode As String
On Error GoTo Errorhandler
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set objIdentNr = Pruefzaehler.getIdentNrObj
strVakoCode = objIdentNr.GetVakoCode
If strVakoCode <> "" Then
Set objVakoCode = New CVakoCode
If objVakoCode.load(strVakoCode) Then
If InStr(1, objVakoCode.GetWert("Zählwerk"), "eRegister") > 0 Then
Teste_Aufe_Register = True
End If
End If
Else
If Pruefzaehler.getAuftragPosition.GetBestellcode <> "" Then
strBestellcode = Pruefzaehler.getAuftragPosition.GetBestellcode
Set Bestellcode = New CBestellcode
If Bestellcode.load(strBestellcode, Pruefzaehler.getAuftragPosition.getIdentNrObj.GetBestellgruppe) Then
If InStr(1, Bestellcode.GetWert("Zählwerk"), "eRegister") > 0 Then
Teste_Aufe_Register = True
End If
End If
End If
End If
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & "in Teste_Aufe_Register() " & Err.Description
Exit Function
Resume
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
Call Pruefpunkt.setUseCount(1)
Set KopiePruefpunkt = New CPruefpunkt
KopiePruefpunkt.copyFrom Pruefpunkt
colUniquePP.Add KopiePruefpunkt
Else
Call colUniquePP.Item(nPos).incUseCount
End If
Next
End If
Else
MsgBox ("Ein Pruefzaehler ohne PP")
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, Optional AuftragNr 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, AuftragNr) Then
' Prüfzähler vorhanden
setEinbauplatzPruefzaehler = True
DebugMsg "Prüfzähler mit SerienNr " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr
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)
m_colEinbauplatz.Item(Einbauplatz.getNr).setPruefzaehler Pruefzaehler
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
'
' '''todo:Diese Prozedur wird periodisch von dem Blink-Timer aufgerufen.
'
' @return true = Keine Fehlerbedingung festgestellt
'
Private Function updateEinbauplatz(Index As Integer) As Boolean
Dim StatusFertigung As Integer
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
imgZaehler(Index).Enabled = True
Set Einbauplatz = getEinbauplatz(Index)
If Einbauplatz.getPruefzaehler() Is Nothing Then
' Leere Eingabe, kein Prüfzähler eingebaut
lblEinbau(Index).caption = ""
lblStatus(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()
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
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 chkAnzeigeKundeneigeneSerienNr.value = vbChecked Then
' Kundeneigene SerienNr anzeigen
sMsg = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
End If
StatusFertigung = Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung
If StatusFertigung < 25 Then
lblStatus(Index) = ""
End If
If StatusFertigung >= 25 And StatusFertigung < 30 Then
lblStatus(Index).caption = "Wiederholung"
End If
If StatusFertigung >= 30 Then
lblStatus(Index).caption = "keine Wiederholung erforderlich"
End If
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
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.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
'txtSerienNr(Index).text = ""
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
'txtSerienNr(Index).SetFocus
End If
End If
End Sub
Public Sub PruefdatenAufnehmen(Optional blnOeffnenSchliessenErgaenzen As Boolean = False, Optional blnPruefgangLoeschenErlauben As Boolean = False)
Dim i As Integer
Set m_dlgManuellDetails = New frmManuellDetails
Set m_dlgManuellDetails.m_colEinbauplatz = m_colEinbauplatz
m_dlgManuellDetails.m_blnSimpleInput = CBool(chkSimpleInput.value = vbChecked)
m_dlgManuellDetails.m_blnRueckwaertspruefung = CBool(chkRueckwaertsprf.value = vbChecked)
Set m_dlgManuellDetails.m_Pruefgang = m_Pruefgang
m_dlgManuellDetails.mblnOeffnenSchliessenErgaenzen = blnOeffnenSchliessenErgaenzen
On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''
'm_dlgManuellDetails.Show vbModal, Me
'''''''''''''''''''''''''''''''''''''''''''''''''
'gefaktes Modale Formular
m_dlgManuellDetails.Show vbModeless, Me
Do
DoEvents
Loop While m_dlgManuellDetails.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''
Set m_Pruefgang = m_dlgManuellDetails.m_Pruefgang
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
If Err.Number <> 0 Then
LogIntoDB "Fehler " & Err.Number & " in PruefdatenAufnehmen: " & Err.Description, "PrüfungManuell"
End If
On Error GoTo 0
If m_dlgManuellDetails.getExitCode = vbOK Then
' For i = 1 To 10
'' txtSerienNr(i).text = ""
'' ueberpruefe (i)
' Next
Else
If m_Pruefgang.PruefgangNr > 0 And blnPruefgangLoeschenErlauben = True Then
If MsgBox("Sie haben die Eingabe der Prüfergebnisse abgebrochen." & vbCrLf & "Möchten Sie die die Daten des abgebrochenen Pruefganges (PruefgangNr=" & m_Pruefgang.PruefgangNr & ") löschen?", vbYesNo Or vbDefaultButton2, "Pruefgang abgebrochen") = vbYes Then
lblPruefgangNr.caption = ""
m_Pruefgang.saveAbgebrochenen
m_Pruefgang.delete
Set m_Pruefgang = Nothing
LadeAuftragPositionSerienNrNeu m_colEinbauplatz
Else
' nochmals speichern
m_Pruefgang.save
End If
Else
' hier gibt es keinen Prüfgang zum löschen
End If
End If
Set m_dlgManuellDetails = Nothing
End Sub
Function alleZaehlerHabenPP()
Dim Einbauplatz As CEinbauplatz
Dim Pruefpunkte As CPruefpunkte
Dim countZ As Integer
alleZaehlerHabenPP = True
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
' Prüfzählerobjekt vorhanden
Debug.Print "hat PZ"
Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte()
If Not Pruefpunkte Is Nothing Then
countZ = countZ + 1
If Not Pruefpunkte.getPruefpunkte Is Nothing Then
If Pruefpunkte.getPruefpunkteCount = 0 Then
alleZaehlerHabenPP = False
MsgBox ("Für einen Zaehler sind keine Pruefpunkte definiert." & vbCrLf & "Prüfdaten können daher nicht eingegeben werden.")
Exit Function
End If
Else
alleZaehlerHabenPP = False
MsgBox ("Für einen Zaehler sind keine Pruefpunkte definiert oder die Auftragsdaten unvollständig." & vbCrLf & "Prüfdaten können daher nicht eingegeben werden.")
Exit Function
End If
End If
End If
Next
If countZ = 0 Then
MsgBox ("Es sind keine Prüfzähler eingegeben. Daher können keine Prüfdaten eingegeben werden")
alleZaehlerHabenPP = False
End If
End Function
Public Function getLetztePruefgangNrForSerienNr(lngSerienNr As Long) As Long
Dim rs As CRecordset
Dim sSQL As String
Set rs = New CRecordset
sSQL = "SELECT TOP 1 Prueffehler.SerienNr, Max(AuftragPositionSerienNr.Wiederholungen) AS [Max von Wiederholungen], Pruefgang.PruefgangNr, Pruefgang.PP1_Soll, Pruefgang.PP2_Soll, Pruefgang.PP3_Soll, Pruefgang.PP4_Soll, Pruefgang.PP5_Soll, Pruefgang.PP6_Soll, Pruefgang.PP7_Soll, Pruefgang.PP8_Soll, Pruefgang.PP9_Soll, Pruefgang.PP10_Soll, Prueffehler.PP1_Fehler, Prueffehler.PP2_Fehler, Prueffehler.PP3_Fehler, Prueffehler.PP4_Fehler, Prueffehler.PP5_Fehler, Prueffehler.PP6_Fehler, Prueffehler.PP7_Fehler, Prueffehler.PP8_Fehler, Prueffehler.PP9_Fehler, Prueffehler.PP10_Fehler " _
& "FROM (Pruefgang INNER JOIN Prueffehler ON Pruefgang.PruefgangNr = Prueffehler.PruefgangNr) INNER JOIN AuftragPositionSerienNr ON (AuftragPositionSerienNr.SerienNr = Prueffehler.SerienNr) AND (Pruefgang.PruefgangNr = AuftragPositionSerienNr.Pruefgangnr) " _
& "GROUP BY Prueffehler.SerienNr, Pruefgang.PruefgangNr, Pruefgang.PP1_Soll, Pruefgang.PP2_Soll, Pruefgang.PP3_Soll, Pruefgang.PP4_Soll, Pruefgang.PP5_Soll, Pruefgang.PP6_Soll, Pruefgang.PP7_Soll, Pruefgang.PP8_Soll, Pruefgang.PP9_Soll, Pruefgang.PP10_Soll, Prueffehler.PP1_Fehler, Prueffehler.PP2_Fehler, Prueffehler.PP3_Fehler, Prueffehler.PP4_Fehler, Prueffehler.PP5_Fehler, Prueffehler.PP6_Fehler, Prueffehler.PP7_Fehler, Prueffehler.PP8_Fehler, Prueffehler.PP9_Fehler, Prueffehler.PP10_Fehler " _
& "Having ((Prueffehler.SerienNr) = " & lngSerienNr & ")" _
& " ORDER BY Max(AuftragPositionSerienNr.Wiederholungen) DESC;"
rs.openRS sSQL, True
If Not rs.EOF Then
getLetztePruefgangNrForSerienNr = rs.getLongValue("PruefgangNr")
Else
getLetztePruefgangNrForSerienNr = 0
End If
End Function
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
Private Sub chkRueckwaertsprf_Click()
Dim lngReturn As Long
If chkRueckwaertsprf.value = vbChecked Then
lngReturn = MsgBox("Sie haben 'Rückwärtsprüfung' ausgewählt. Sind sie sicher ?", vbYesNo Or vbDefaultButton2)
Select Case lngReturn
Case vbYes
chkRueckwaertsprf.value = vbChecked
Case vbNo
chkRueckwaertsprf.value = vbUnchecked
End Select
End If
End Sub
Private Sub ZeigePruefgangUmgebungForm()
' ggF. Luftdruck, LuftFeuchte und LuftTemp abfragen
Dim objForm As frmPruefgangUmgebung
Set objForm = New frmPruefgangUmgebung
objForm.Show vbModal, Me
End Sub
Private Sub chkZulassung_Click()
Dim strTemp As String
If chkZulassung.value = vbChecked Then
g_blnZulassungspruefung = True
If g_App.Settings.GetWetterstationURL <> "" Then
If GetWeatherData(g_dblLuftTemperatur, g_dblLuftFeuchte, g_dblLuftDruck, strTemp) = False Then
LogIntoDB strTemp, "Wetterstation"
' Es gab einen Fehler
ZeigePruefgangUmgebungForm
Else
If g_dblLuftTemperatur <> 0 And g_dblLuftFeuchte <> 0 And g_dblLuftDruck <> 0 Then
' alles OK
Exit Sub
Else
' Es müssen noch Werte eingetragen werden, weil sie 0 sind
ZeigePruefgangUmgebungForm
End If
End If
Else
' keine Wetterstatuin definiert
ZeigePruefgangUmgebungForm
End If
Else
' Zulassungsprüfung wurde abgeschaltet
g_blnZulassungspruefung = False
End If
End Sub
Private Sub CheckZulassungsPruefung()
' setzt ggF den Haken "Zulassungsprüfung" in Abhängigkeit des Zusatztextes
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strZulassungsschluesselwort As String
''''''''''''''''''' Zulassung '''''''''''''''''
Dim blnZulassungspruefung As Boolean
' hat der Prüfer evtl. vergessen, den Haken zu setzen?
If chkZulassung.value = vbUnchecked Then
' wird einer der eingebauten Zähler für eine Zulassung geprüft?
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If EinesDerWoerterVorhanden(Pruefzaehler.getAuftragPosition.getZusatztext, "Zulassung PTB|Zulassung DKD|DKD-Zertifikat|Zulassungsmuster|Zulassungsprüfung|Zulassungszähler|MID-Zulassung|DKD|NATA", strZulassungsschluesselwort) Then
blnZulassungspruefung = True
Exit For
End If
End If
Next
If blnZulassungspruefung = True Then
MsgBox "Die Option 'Zulassungsprüfung' wird ausgewählt," & vbCrLf & "weil der Auftragszusatztext entsprechende Schlüsselwörter " & vbCrLf & strZulassungsschluesselwort & " enthält:" & vbCrLf & Pruefzaehler.getAuftragPosition.getZusatztext
' Häkchen wird automatisch gesetzt
chkZulassung.value = vbChecked
End If
End If
Exit Sub
Errorhandler:
End Sub
Private Sub cmd_eRegister_Pruefungsinitialisierung_Click()
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.mblnVorbereitungEbeling = False
frmeRegisterPrf.mblnManuellePruefung = True
cmd_eRegister_Pruefungsinitialisierung.Enabled = False
DoEvents
frmeRegisterPrf.Show vbNormal, Me
If frmeRegisterPrf.PruefungInitialisierung_NeuerVako() Then
frmeRegisterPrf.Visible = False
m_blneRegisterInitialisierungDurchgefuehrt = True
MsgBox "Die PruefungInitialisierung wurde beendet."
cmd_eRegister_PruefungsAbschluss.Enabled = True
Else
frmeRegisterPrf.Visible = False
MsgBox "Die PruefungInitialisierung wurde abgebrochen."
m_blneRegisterInitialisierungDurchgefuehrt = False
End If
cmd_eRegister_Pruefungsinitialisierung.Enabled = True
frmeRegisterPrf.mblnManuellePruefung = False
End Sub
Private Sub cmd_eRegister_PruefungsAbschluss_Click()
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.mblnManuellePruefung = True
frmeRegisterPrf.mblnVorbereitungEbeling = False
frmeRegisterPrf.Show vbNormal, Me
cmd_eRegister_PruefungsAbschluss.Enabled = False
DoEvents
If frmeRegisterPrf.PruefungsAbschlussNeuerVako() = True Then
MsgBox "Der Pruefungsabschluss wurde durchgeführt."
Else
MsgBox "Der Pruefungsabschluss wurde vorzeitig abgebrochen oder wegen eines Fehler beendet."
End If
cmd_eRegister_PruefungsAbschluss.Enabled = True
Unload frmeRegisterPrf
End Sub
Private Sub cmd_Vorbereitung_Ebeling_Click()
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.mblnManuellePruefung = True
frmeRegisterPrf.mblnVorbereitungEbeling = True
frmeRegisterPrf.Show vbNormal, Me
cmd_Vorbereitung_Ebeling.Enabled = False
DoEvents
If frmeRegisterPrf.PruefungInitialisierung_NeuerVako() = True Then
If frmeRegisterPrf.PruefungsAbschlussNeuerVako() = True Then
MsgBox "Die Vorbereitung für die externe eRegister Prüfung (Ebeling) wurde durchgeführt."
Else
GoTo Abbruch
End If
Else
Abbruch:
MsgBox "Die Vorbereitung für die externe eRegister Prüfung (Ebeling) wurde abgebrochen."
End If
' Button wird erst durch erneutes Eingeben einer Seriennummer wieder aktiv
'cmd_Vorbereitung_Ebeling.Enabled = True
Unload frmeRegisterPrf
End Sub
Public Sub SchotteinstellungenAendern()
On Error GoTo Errorhandler
Unload frmSchottumdrehungen
Set frmSchottumdrehungen.m_colEinbauplatz = m_colEinbauplatz
frmSchottumdrehungen.setInfo "Bitte justieren Sie die Zähler mit den angezeigten Schotteinstellungen oder tragen Sie bekannte Schotteinstellungen ein."
frmSchottumdrehungen.Show vbModal, Me
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in SchotteinstellungenAendern(): " & Err.Description, "Softwarefehler"
End Sub
'Private Sub cmdeRegAbschluss_Click(Index As Integer)
' MsgBox ("eRegister Prüfungs Abschluss für Ebp " & Index)
'End Sub
'
'
'
'
'Private Sub cmdeRegister_Pfrinit_Click(Index As Integer)
'
' Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
'
' frmeRegisterPrf.Show vbNormal, Me
'
' If frmeRegisterPrf.PruefungInitialisierung_NeuerVako(True) Then
'
' End If
'
'End Sub
Reference in New Issue View Git Blame Copy Permalink