2220 lines
74 KiB
Plaintext
2220 lines
74 KiB
Plaintext
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmVerbundzaehlerEingabe
|
|
Caption = "Verbundzähler Prüfung"
|
|
ClientHeight = 10620
|
|
ClientLeft = 60
|
|
ClientTop = 420
|
|
ClientWidth = 14400
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 10620
|
|
ScaleWidth = 14400
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.Frame frMain
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 9855
|
|
Left = 0
|
|
TabIndex = 6
|
|
Top = 60
|
|
Width = 13275
|
|
Begin VB.Frame frEinbau
|
|
Caption = "Einbauplatz B"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 2175
|
|
Index = 2
|
|
Left = 480
|
|
TabIndex = 30
|
|
Top = 3000
|
|
Width = 9465
|
|
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 = 1320
|
|
TabIndex = 37
|
|
Top = 720
|
|
Width = 1695
|
|
End
|
|
Begin VB.CommandButton cmdSerNrAusw
|
|
Caption = "Snr."
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 2
|
|
Left = 3060
|
|
TabIndex = 36
|
|
Top = 720
|
|
Width = 465
|
|
End
|
|
Begin VB.CommandButton cmdRuecklaeuferanalyse
|
|
Caption = "Rückläufer"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 2
|
|
Left = 3570
|
|
TabIndex = 35
|
|
Top = 720
|
|
Width = 1005
|
|
End
|
|
Begin VB.TextBox txtSerienNrNZ
|
|
Enabled = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 390
|
|
HideSelection = 0 'False
|
|
Index = 2
|
|
Left = 150
|
|
TabIndex = 34
|
|
Top = 1590
|
|
Width = 1695
|
|
End
|
|
Begin VB.CheckBox chkPruefNZ
|
|
Alignment = 1 'Rechts ausgerichtet
|
|
Caption = "Prüfnebenzähler"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 225
|
|
Index = 2
|
|
Left = 4680
|
|
TabIndex = 33
|
|
Top = 1680
|
|
Width = 1665
|
|
End
|
|
Begin VB.ComboBox cmb2KundeneigeneSNr
|
|
Enabled = 0 'False
|
|
Height = 360
|
|
Index = 2
|
|
Left = 2130
|
|
TabIndex = 32
|
|
Top = 1590
|
|
Width = 2295
|
|
End
|
|
Begin VB.TextBox txtFabNr
|
|
Height = 360
|
|
Index = 2
|
|
Left = 7410
|
|
TabIndex = 31
|
|
Top = 1680
|
|
Width = 1695
|
|
End
|
|
Begin VB.Label lblEinbau
|
|
BorderStyle = 1 'Fest Einfach
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 315
|
|
Index = 2
|
|
Left = 1350
|
|
TabIndex = 43
|
|
Top = 330
|
|
Width = 7875
|
|
End
|
|
Begin VB.Image imgInfo
|
|
Appearance = 0 '2D
|
|
Height = 480
|
|
Index = 2
|
|
Left = 4650
|
|
Top = 720
|
|
Width = 480
|
|
End
|
|
Begin VB.Label lblStatus
|
|
BackStyle = 0 'Transparent
|
|
Caption = "[Status]................................................"
|
|
BeginProperty Font
|
|
Name = "Arial"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 585
|
|
Index = 2
|
|
Left = 6090
|
|
TabIndex = 42
|
|
Top = 720
|
|
Width = 3105
|
|
End
|
|
Begin VB.Image imgZaehler
|
|
Height = 690
|
|
Index = 2
|
|
Left = 5340
|
|
MousePointer = 99 'Benutzerdefiniert
|
|
Top = 720
|
|
Width = 705
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Hauptzähler"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 2
|
|
Left = 180
|
|
TabIndex = 41
|
|
Top = 780
|
|
Width = 1035
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Nebenzaehler SNr"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 2
|
|
Left = 180
|
|
TabIndex = 40
|
|
Top = 1350
|
|
Width = 1455
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Kundeneig. SNr NZ"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 2
|
|
Left = 2160
|
|
TabIndex = 39
|
|
Top = 1320
|
|
Width = 1875
|
|
End
|
|
Begin VB.Label Label5
|
|
Caption = "FabNr"
|
|
Height = 195
|
|
Index = 2
|
|
Left = 7500
|
|
TabIndex = 38
|
|
Top = 1320
|
|
Width = 675
|
|
End
|
|
End
|
|
Begin VB.CheckBox chkSimulation
|
|
Caption = "Simulation"
|
|
Height = 495
|
|
Left = 10410
|
|
TabIndex = 27
|
|
Top = 8400
|
|
Width = 2535
|
|
End
|
|
Begin VB.Frame Frame1
|
|
Caption = "Optionen"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 3135
|
|
Left = 450
|
|
TabIndex = 19
|
|
Top = 5250
|
|
Width = 9465
|
|
Begin VB.ComboBox cmbImpulswertigkeit_NZ
|
|
Height = 360
|
|
Left = 6000
|
|
TabIndex = 44
|
|
Text = "Combo1"
|
|
Top = 690
|
|
Width = 3045
|
|
End
|
|
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 = 180
|
|
TabIndex = 21
|
|
Top = 840
|
|
Width = 2325
|
|
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 = 180
|
|
TabIndex = 20
|
|
Top = 300
|
|
Width = 1905
|
|
End
|
|
Begin VB.Label Label4
|
|
Caption = "Impulswertigkeit NZ"
|
|
Height = 315
|
|
Left = 4020
|
|
TabIndex = 26
|
|
Top = 750
|
|
Width = 1875
|
|
End
|
|
End
|
|
Begin VB.CommandButton cmdOK
|
|
Caption = "Prüfung starten"
|
|
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 = 10440
|
|
TabIndex = 18
|
|
Top = 8940
|
|
Width = 2535
|
|
End
|
|
Begin VB.CommandButton cmdCancel
|
|
Caption = "zurück"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 615
|
|
Left = 7320
|
|
TabIndex = 17
|
|
Top = 8940
|
|
Width = 2535
|
|
End
|
|
Begin VB.Frame frEinbau
|
|
Caption = "Einbauplatz A"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 2175
|
|
Index = 1
|
|
Left = 540
|
|
TabIndex = 13
|
|
Top = 840
|
|
Width = 9465
|
|
Begin VB.TextBox txtFabNr
|
|
Height = 360
|
|
Index = 1
|
|
Left = 7440
|
|
TabIndex = 28
|
|
Top = 1560
|
|
Width = 1695
|
|
End
|
|
Begin VB.ComboBox cmb2KundeneigeneSNr
|
|
Enabled = 0 'False
|
|
Height = 360
|
|
Index = 1
|
|
Left = 2130
|
|
TabIndex = 5
|
|
Top = 1590
|
|
Width = 2295
|
|
End
|
|
Begin VB.CheckBox chkPruefNZ
|
|
Alignment = 1 'Rechts ausgerichtet
|
|
Caption = "Prüfnebenzähler"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 225
|
|
Index = 1
|
|
Left = 4680
|
|
TabIndex = 4
|
|
Top = 1680
|
|
Width = 1665
|
|
End
|
|
Begin VB.TextBox txtSerienNrNZ
|
|
Enabled = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 390
|
|
Index = 1
|
|
Left = 150
|
|
TabIndex = 3
|
|
Top = 1560
|
|
Width = 1695
|
|
End
|
|
Begin VB.CommandButton cmdRuecklaeuferanalyse
|
|
Caption = "Rückläufer"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 1
|
|
Left = 3570
|
|
TabIndex = 2
|
|
Top = 720
|
|
Width = 1005
|
|
End
|
|
Begin VB.CommandButton cmdSerNrAusw
|
|
Caption = "Snr."
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 1
|
|
Left = 3060
|
|
TabIndex = 1
|
|
Top = 720
|
|
Width = 465
|
|
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 = 1320
|
|
TabIndex = 0
|
|
Top = 720
|
|
Width = 1695
|
|
End
|
|
Begin VB.Label Label5
|
|
Caption = "FabNr"
|
|
Height = 195
|
|
Index = 1
|
|
Left = 7500
|
|
TabIndex = 29
|
|
Top = 1320
|
|
Width = 675
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Kundeneig. SNr NZ"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 1
|
|
Left = 2160
|
|
TabIndex = 25
|
|
Top = 1320
|
|
Width = 1875
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Nebenzaehler SNr"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 1
|
|
Left = 180
|
|
TabIndex = 24
|
|
Top = 1320
|
|
Width = 1455
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Hauptzähler"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Index = 1
|
|
Left = 180
|
|
TabIndex = 23
|
|
Top = 780
|
|
Width = 1035
|
|
End
|
|
Begin VB.Image imgZaehler
|
|
Height = 690
|
|
Index = 1
|
|
Left = 5340
|
|
MousePointer = 99 'Benutzerdefiniert
|
|
Top = 720
|
|
Width = 705
|
|
End
|
|
Begin VB.Label lblStatus
|
|
BackStyle = 0 'Transparent
|
|
Caption = "[Status]................................................"
|
|
BeginProperty Font
|
|
Name = "Arial"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 585
|
|
Index = 1
|
|
Left = 6120
|
|
TabIndex = 22
|
|
Top = 720
|
|
Width = 3105
|
|
End
|
|
Begin VB.Image imgInfo
|
|
Appearance = 0 '2D
|
|
Height = 480
|
|
Index = 1
|
|
Left = 4650
|
|
Top = 720
|
|
Width = 480
|
|
End
|
|
Begin VB.Label lblEinbau
|
|
BorderStyle = 1 'Fest Einfach
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 285
|
|
Index = 1
|
|
Left = 1350
|
|
TabIndex = 14
|
|
Top = 360
|
|
Width = 7785
|
|
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 = 10170
|
|
TabIndex = 11
|
|
Top = 870
|
|
Width = 2595
|
|
Begin VB.Label lblPruefer
|
|
BackColor = &H00000000&
|
|
BackStyle = 0 'Transparent
|
|
Caption = "[Mitarbeiter Name]"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 12
|
|
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 = 3195
|
|
Left = 10170
|
|
TabIndex = 7
|
|
Top = 1830
|
|
Width = 2595
|
|
Begin VB.ListBox lstPruefpunkte
|
|
Height = 1020
|
|
Left = 480
|
|
TabIndex = 8
|
|
Top = 1440
|
|
Width = 1695
|
|
End
|
|
Begin VB.Label lblUniquePP
|
|
BackColor = &H00000000&
|
|
BackStyle = 0 'Transparent
|
|
Caption = "[Anz. Prüfpunkte]"
|
|
Height = 255
|
|
Left = 480
|
|
TabIndex = 10
|
|
Top = 660
|
|
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 = 300
|
|
TabIndex = 9
|
|
Top = 420
|
|
Width = 1995
|
|
End
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 15
|
|
Top = 10365
|
|
Width = 14400
|
|
_ExtentX = 25400
|
|
_ExtentY = 661
|
|
Style = 1
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin VB.Label lblTitle
|
|
BackStyle = 0 'Transparent
|
|
Caption = "Vorbereitung einer Verbundzähler 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 = 3840
|
|
TabIndex = 16
|
|
Top = 240
|
|
Width = 9045
|
|
End
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmVerbundzaehlerEingabe"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
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_Pruefgang As CPruefgang
|
|
Public m_SPS As CSPS
|
|
|
|
Private mbln_eRegister As Boolean ' es handelt sich um eRegister Werke
|
|
|
|
|
|
Dim bTextChanged(10) As Boolean
|
|
Private m_dlgManuellDetails As frmManuellDetails
|
|
|
|
|
|
Private Sub chkAnzeigeKundeneigeneSerienNr_Click()
|
|
On Error GoTo Errorhandler
|
|
Dim i As Integer
|
|
If chkAnzeigeKundeneigeneSerienNr.value = vbChecked Then
|
|
g_blnKundeneigeneSerienNrAnzeigen = True
|
|
For i = 1 To 2
|
|
Call AnzeigeKundeneigeneSerienNr(i)
|
|
Next i
|
|
Else
|
|
g_blnKundeneigeneSerienNrAnzeigen = False
|
|
For i = 1 To 2
|
|
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 cmbImpulswertigkeit_NZ_Change()
|
|
CheckForPruefbereitschaft
|
|
End Sub
|
|
|
|
|
|
Private Sub cmbImpulswertigkeit_NZ_Click()
|
|
CheckForPruefbereitschaft
|
|
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 cmdOk_Click()
|
|
|
|
Set m_Pruefgang = New CPruefgang
|
|
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
' Verheiratung
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
|
|
If Pruefzaehler.m_Verbundzaehler Is Nothing Then
|
|
Set Pruefzaehler.m_Verbundzaehler = New CVerbundzaehler
|
|
End If
|
|
|
|
If txtSerienNrNZ(Einbauplatz.getNr).text <> "" Then
|
|
Pruefzaehler.m_Verbundzaehler.lngSerienNrNZ = txtSerienNrNZ(Einbauplatz.getNr).text
|
|
End If
|
|
|
|
If cmb2KundeneigeneSNr(Einbauplatz.getNr).text <> "" Then
|
|
Pruefzaehler.m_Verbundzaehler.strKundeneigeneSerienNrNZ = cmb2KundeneigeneSNr(Einbauplatz.getNr).text
|
|
End If
|
|
|
|
If chkPruefNZ(Einbauplatz.getNr).value = vbChecked Then
|
|
Pruefzaehler.m_Verbundzaehler.blnIstPruefnebenzaehler = True
|
|
End If
|
|
|
|
End If
|
|
Next
|
|
|
|
|
|
cmdOK.Enabled = False
|
|
Me.MousePointer = vbHourglass
|
|
|
|
If alleZaehlerHabenPP() Then
|
|
Me.Visible = False
|
|
|
|
Dim frmForm As frmVerbundzaehlerHauptpruefung
|
|
Set frmForm = New frmVerbundzaehlerHauptpruefung
|
|
|
|
Set frmForm.m_colUniquePP = m_colUniquePP
|
|
Set frmForm.m_colEinbauplatz = m_colEinbauplatz
|
|
frmForm.m_blnSimulation = (chkSimulation.value = vbChecked)
|
|
frmForm.m_lngImpulswertigkeit_NZ = Val(Split(cmbImpulswertigkeit_NZ.text, " ")(0))
|
|
|
|
frmForm.mbln_eRegister = mbln_eRegister
|
|
frmForm.Show vbModal, Me
|
|
|
|
Set m_Pruefgang = frmForm.m_Pruefgang
|
|
|
|
Me.Visible = True
|
|
|
|
Call PruefungFertigmeldenDialog("", m_colEinbauplatz)
|
|
End If
|
|
Me.MousePointer = vbNormal
|
|
cmdOK.Enabled = True
|
|
|
|
End Sub
|
|
|
|
' @return Code, mit dem endDialog aufgerufen wurde
|
|
'
|
|
Public Function getExitCode() As Integer
|
|
getExitCode = m_nRet
|
|
End Function
|
|
|
|
|
|
Private Function CheckForPruefbereitschaft() As Boolean
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
Dim blnOK As Boolean
|
|
Dim blnDeny As Boolean
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
If Pruefzaehler.getSerienNr <> 0 Then
|
|
If Pruefzaehler.IstVerbundZaehler Then
|
|
' Ein Verbundzähler ist eingebaut
|
|
blnOK = True
|
|
Else
|
|
' Ein NICHT-Verbundzähler ist eingebaut
|
|
blnDeny = True
|
|
End If
|
|
Else
|
|
blnDeny = True
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
|
|
If Val(cmbImpulswertigkeit_NZ.text) = 0 And cmbImpulswertigkeit_NZ.Enabled = True Then
|
|
blnDeny = True
|
|
End If
|
|
|
|
If blnDeny = False And blnOK = True Then
|
|
CheckForPruefbereitschaft = True
|
|
cmdOK.Enabled = True
|
|
Else
|
|
CheckForPruefbereitschaft = False
|
|
cmdOK.Enabled = False
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Private Sub Form_Load()
|
|
Dim i As Integer
|
|
Dim nLeft As Long
|
|
Dim nTop As Long
|
|
|
|
mbln_eRegister = False
|
|
|
|
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 = 1 To 2
|
|
imgZaehler(i).Picture = frmRes.imgZaehlerGrauLinks.Picture
|
|
txtSerienNr(i).MaxLength = 10
|
|
imgZaehler(i).Enabled = False
|
|
lblStatus(i).caption = ""
|
|
Next i
|
|
|
|
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
|
|
lblUniquePP = 0
|
|
''lblMaxPP = g_App.Settings.getMaxPruefpunkte()
|
|
|
|
lblTitle.caption = "Vorbereitung einer Verbundzähler-Prüfung Station: " & g_App.PruefstationNr
|
|
Me.caption = lblTitle.caption
|
|
|
|
Call initEinbauplaetze ' Erzeuge Einbauplaetze Collection
|
|
|
|
ModMain.fillcmbImpulswertigkeiten cmbImpulswertigkeit_NZ
|
|
cmdOK.Enabled = 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 2
|
|
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
|
|
|
|
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
|
|
|
|
|
|
' 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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
'----------------------------------------------------------------------------
|
|
' 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 2
|
|
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 < 2 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
|
|
|
|
' Komplettes Feld selektieren
|
|
Private Sub selectNZSerienNrField(Index As Integer)
|
|
txtSerienNrNZ(Index).SelStart = 0
|
|
txtSerienNrNZ(Index).SelLength = Len(txtSerienNrNZ(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)
|
|
CheckForPruefbereitschaft
|
|
Exit Sub
|
|
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.
|
|
Call UeberpruefeAufPruefpunkte(Index)
|
|
Else
|
|
Debug.Print "heraus"
|
|
txtSerienNrNZ(Index).text = ""
|
|
cmb2KundeneigeneSNr(Index).Clear
|
|
End If
|
|
Else
|
|
' SerienNr wurde nicht akzeptiert
|
|
txtSerienNr(Index).SetFocus
|
|
End If
|
|
Else
|
|
' nicht geändert
|
|
End If
|
|
CheckForPruefbereitschaft
|
|
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 2
|
|
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
|
|
|
|
' 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
|
|
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
|
|
|
|
|
|
' 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
|
|
|
|
|
|
Dim Einbaulatz As CEinbauplatz
|
|
Set Einbaulatz = m_colEinbauplatz.Item(Einbauplatz.getNr)
|
|
Debug.Print Pruefzaehler.getSerienNr & " am Ebp " & Einbauplatz.getNr
|
|
Einbaulatz.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
|
|
cmb2KundeneigeneSNr(Index).Clear
|
|
|
|
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()
|
|
|
|
If Not Pruefzaehler.IstVerbundZaehler Then
|
|
lblEinbau(Index).caption = "kein Verbundzaehler!"
|
|
txtSerienNr(Index).BackColor = &HC0C0FF
|
|
imgZaehler(Index).Enabled = False
|
|
Exit Function
|
|
Else
|
|
|
|
Dim Verbundzaehler As CVerbundzaehler
|
|
Set Verbundzaehler = New CVerbundzaehler
|
|
If Verbundzaehler.LoadForHauptzaehler(Pruefzaehler.getSerienNr) Then
|
|
' Hier sind HZ und NZ bereits über die Tabelle Verbundzähler verbunden
|
|
Set Pruefzaehler.m_Verbundzaehler = Verbundzaehler
|
|
If Verbundzaehler.lngSerienNrHZ <> 0 Then
|
|
txtSerienNrNZ(Index).text = Verbundzaehler.lngSerienNrNZ
|
|
txtSerienNrNZ(Index).Enabled = False
|
|
Else
|
|
txtSerienNrNZ(Index).Enabled = True
|
|
End If
|
|
|
|
If Verbundzaehler.strKundeneigeneSerienNrNZ <> "" Then
|
|
cmb2KundeneigeneSNr(Index).text = Verbundzaehler.strKundeneigeneSerienNrNZ
|
|
cmb2KundeneigeneSNr(Index).Enabled = False
|
|
Else
|
|
cmb2KundeneigeneSNr(Index).Enabled = True
|
|
End If
|
|
Else
|
|
' Hier sind HZ und NZ noch nicht über die Tabelle Verbundzähler verbunden
|
|
|
|
txtSerienNrNZ(Index).Enabled = True
|
|
cmb2KundeneigeneSNr(Index).Enabled = True
|
|
|
|
Dim lngSerienNrNZ As Long
|
|
lngSerienNrNZ = getNZSerienNrFromAuftragsnetz(Index)
|
|
|
|
If lngSerienNrNZ > 0 Then
|
|
txtSerienNrNZ(Index).text = CStr(lngSerienNrNZ)
|
|
txtSerienNr_Validate Index, False
|
|
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
|
|
If AuftragpositionSerienNr.load(lngSerienNrNZ) Then
|
|
If AuftragpositionSerienNr.getKundeneigeneSerienNr <> "" Then
|
|
cmb2KundeneigeneSNr(Index).text = AuftragpositionSerienNr.getKundeneigeneSerienNr
|
|
Else
|
|
cmb2KundeneigeneSNr(Index).text = ""
|
|
cmb2KundeneigeneSNr(Index).Enabled = False
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
|
|
Call Fillcmb2KundeneigeneSNr(Pruefzaehler.getAuftragPosition.GetFertigungsauftragNr, Index)
|
|
End If
|
|
End If
|
|
|
|
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 & ")"
|
|
|
|
Update_eRegister (Index)
|
|
|
|
|
|
If Not Einbauplatz.eRegister Is Nothing Then
|
|
sMsg = sMsg & " " & Einbauplatz.eRegister.m_sRadioAdressFinal
|
|
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 Update_eRegister(Index As Integer)
|
|
Dim Einbaulatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
Set Einbaulatz = m_colEinbauplatz.Item(Index)
|
|
Set Pruefzaehler = Einbaulatz.getPruefzaehler
|
|
|
|
Set Einbaulatz.eRegister = New CeRegister
|
|
If Einbaulatz.eRegister.loadForSerienNr(Pruefzaehler.getSerienNr) = True Then
|
|
' HZ ist eRegister
|
|
mbln_eRegister = True
|
|
chkPruefNZ(1).Enabled = False
|
|
chkPruefNZ(2).Enabled = False
|
|
cmbImpulswertigkeit_NZ.Enabled = False
|
|
txtFabNr(1).Enabled = False
|
|
txtFabNr(2).Enabled = False
|
|
Else
|
|
Set Einbaulatz.eRegister = Nothing
|
|
End If
|
|
End Sub
|
|
|
|
|
|
'------------------------------------------------------
|
|
'------------------------------------------
|
|
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
|
|
|
|
|
|
|
|
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 Function getNZSerienNrFromAuftragsnetz(Index As Integer) As Long
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim Einbauplatz As CEinbauplatz
|
|
|
|
Dim AuftragspositionHZ As CAuftragPosition
|
|
Dim AuftragspositionNZ As CAuftragPosition
|
|
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
Dim ersteSerienNr As Long
|
|
Dim Number As Long
|
|
|
|
Dim Aps As CAuftragPositionSerienNr
|
|
|
|
Set Einbauplatz = m_colEinbauplatz.Item(Index)
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
|
|
If Not Pruefzaehler Is Nothing Then
|
|
Set AuftragspositionHZ = Pruefzaehler.getAuftragPosition
|
|
Number = Pruefzaehler.getSerienNr - AuftragspositionHZ.getSerienNummerVon + 1
|
|
If Number >= 1 And Number <= AuftragspositionHZ.getMenge Then
|
|
Debug.Print AuftragspositionHZ.m_lLead_AuftragNr
|
|
Set AuftragspositionNZ = New CAuftragPosition
|
|
|
|
strSQL = "SELECT * from AlleAuftragPositionen "
|
|
strSQL = strSQL & " INNER JOIN IdentNr on AlleAuftragPositionen.IdentNr = IdentNr.IdentNr "
|
|
strSQL = strSQL & " where Lead_AufNr = " & AuftragspositionHZ.m_lLead_AuftragNr
|
|
''''strSQL = strSQL & " and IdentNr.KurzBez = 'NZ' "
|
|
strSQL = strSQL & " and IdentNr.VakoCode like 'MTWNZ%'"
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print strSQL
|
|
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
AuftragspositionNZ.load rs.getLongValue("AuftragNr"), rs.getIntValue("PositionNr")
|
|
getNZSerienNrFromAuftragsnetz = AuftragspositionNZ.getSerienNummerVon + Number - 1
|
|
End If
|
|
|
|
Else
|
|
' Fehler
|
|
MsgBox "NZ SerienNr kann aus den Auftragsdaten nicht erzeugt werden."
|
|
End If
|
|
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Private Function Fillcmb2KundeneigeneSNr(lngFANr As Long, Index As Integer) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
Set rs = New CRecordset
|
|
|
|
strSQL = "SELECT DISTINCT KundeneigeneSerNrNbZ From Verbundzaehler Where Info_FertigungsauftragNr = " & lngFANr & " order by KundeneigeneSerNrNbZ"
|
|
|
|
rs.openRS strSQL, True
|
|
|
|
Do While Not rs.EOF
|
|
If rs.getStringValue("KundeneigeneSerNrNbZ") <> "" Then
|
|
cmb2KundeneigeneSNr(Index).AddItem rs.getStringValue("KundeneigeneSerNrNbZ")
|
|
rs.MoveNext
|
|
Fillcmb2KundeneigeneSNr = True
|
|
Else
|
|
Debug.Print ""
|
|
Fillcmb2KundeneigeneSNr = False
|
|
Exit Function
|
|
End If
|
|
'cmb2KundeneigeneSNr(Index).Style = fmStyleDropDownList
|
|
Loop
|
|
|
|
End Function
|
|
|
|
|
|
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 Function IstPruefnebenzaehler(lngSerienNrNebenzaehler As Long) As Boolean
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = "SELECT * From Pruefnebenzaehler WHERE SerienNr = " & lngSerienNrNebenzaehler
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
|
|
If Not rs.EOF Then
|
|
IstPruefnebenzaehler = True
|
|
End If
|
|
End Function
|
|
|
|
|
|
Private Sub txtSerienNrNZ_GotFocus(Index As Integer)
|
|
' selectNZSerienNrField Index
|
|
End Sub
|
|
|
|
''Info:
|
|
''
|
|
''Wenn der Nebenzähler eine (Sensus-) Serien-Nr hat, muss diese immer eingetragen
|
|
''werden!
|
|
''Das Eingabefeld 'Nebenzähler' darf nur dann leer gelassen werden, wenn der
|
|
''Nebenzähler keine (Sensus-) Serien-Nr sondern nur eine kundeneigene Serien-Nr hat.
|
|
Private Sub txtSerienNrNZ_Validate(Index As Integer, Cancel As Boolean)
|
|
If txtSerienNrNZ(Index).Enabled = True Then
|
|
If Val(txtSerienNrNZ(Index).text) > 0 And Val(txtSerienNrNZ(Index).text) = Val(txtSerienNr(Index).text) Then
|
|
MsgBox "Nebenzähler-SerienNr darf nicht gleich der Hauptzähler-SerienNr sein!"
|
|
' diese Zeile schein irgendwie nicht zu funktionieren:
|
|
txtSerienNrNZ(Index).SetFocus
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
TesteAufPruefNZ Index
|
|
End Sub
|
|
Private Sub chkPruefNZ_Click(Index As Integer)
|
|
TesteAufPruefNZ Index
|
|
End Sub
|
|
|
|
Private Sub TesteAufPruefNZ(Index As Integer)
|
|
Dim lngSerienNrNZ As Long
|
|
lngSerienNrNZ = Val(txtSerienNrNZ(Index).text)
|
|
If lngSerienNrNZ > 0 And chkPruefNZ(Index).value = vbChecked Then
|
|
If Not IstPruefnebenzaehler(lngSerienNrNZ) Then
|
|
MsgBox lngSerienNrNZ & " ist keine Prüf-Nebenzähler."
|
|
chkPruefNZ(Index).value = vbUnchecked
|
|
Else
|
|
txtSerienNrNZ(Index).Enabled = True
|
|
txtSerienNrNZ(Index).text = ""
|
|
cmb2KundeneigeneSNr(Index).text = ""
|
|
If txtSerienNrNZ(Index).Enabled Then
|
|
txtSerienNrNZ(Index).SetFocus
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
|