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

4808 lines
159 KiB
Plaintext
Raw Blame History

VERSION 5.00
Begin VB.Form USPruefzaehlerPruefung
BackColor = &H8000000A&
BorderStyle = 0 'Kein
Caption = "Pruef2000"
ClientHeight = 11520
ClientLeft = 105
ClientTop = 105
ClientWidth = 15360
HelpContextID = 1
Icon = "USPruefzaehlerPruefung.frx":0000
LinkTopic = "Form1"
Moveable = 0 'False
ScaleHeight = 11520
ScaleWidth = 15360
ShowInTaskbar = 0 'False
StartUpPosition = 1 'Fenstermitte
WindowState = 2 'Maximiert
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 = 11475
Left = -30
TabIndex = 4
Top = -180
Width = 14655
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 10
Left = 5820
TabIndex = 148
Top = 10230
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 9
Left = 5790
TabIndex = 147
Top = 9240
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 8
Left = 5790
TabIndex = 146
Top = 8160
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 7
Left = 5790
TabIndex = 145
Top = 7170
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 6
Left = 5790
TabIndex = 144
Top = 6090
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 5
Left = 5790
TabIndex = 143
Top = 5070
Visible = 0 'False
Width = 825
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 4
Left = 5820
TabIndex = 142
Top = 4080
Visible = 0 'False
Width = 795
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 3
Left = 5820
TabIndex = 141
Top = 3060
Visible = 0 'False
Width = 795
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 2
Left = 5820
TabIndex = 140
Top = 2100
Visible = 0 'False
Width = 795
End
Begin VB.CommandButton cmdJustagewerte
Caption = "Justage"
Enabled = 0 'False
Height = 255
Index = 1
Left = 5820
TabIndex = 138
Top = 1050
Visible = 0 'False
Width = 795
End
Begin VB.Frame frmPruefprotokollDrucken
Caption = "Prüfprotokoll"
Height = 735
Left = 11400
TabIndex = 133
Top = 9300
Width = 2715
Begin VB.CheckBox chkProtokolldruck
Caption = "Protokoll drucken"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 180
TabIndex = 134
ToolTipText = "Aktivieren Sie diese Checkbox, um nach der Prüfung ein Protokoll zu drucken."
Top = 180
Width = 2355
End
End
Begin VB.Frame Frame6
Caption = "Seriennr.-Erkennung"
Height = 1845
Left = 6720
TabIndex = 96
Top = 930
Width = 4635
Begin VB.CommandButton cmdStopScan
Caption = "STOP SCAN"
Height = 255
Left = 3360
TabIndex = 136
Top = 1440
Width = 1095
End
Begin VB.Frame frmScanner
Caption = "Scanner Eingabe"
Height = 1095
Left = 210
TabIndex = 119
Top = 600
Width = 2985
Begin VB.TextBox txtScanner
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 120
MaxLength = 9
TabIndex = 120
Top = 600
Width = 1575
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 = 121
Top = 240
Width = 1575
End
End
Begin VB.CheckBox chkAuto
Caption = "Automatik"
Height = 225
Left = 3150
TabIndex = 102
Top = 270
Width = 1095
End
Begin VB.TextBox txtAnzahl
Alignment = 1 'Rechts
Height = 315
Left = 2520
MaxLength = 1
TabIndex = 97
Top = 240
Width = 435
End
Begin VB.Label lblScanStat
BackStyle = 0 'Transparent
Caption = "X"
Height = 285
Left = 3900
TabIndex = 101
Top = 1020
Width = 255
End
Begin VB.Shape Shape1
BackColor = &H000080FF&
BackStyle = 1 'Undurchsichtig
FillColor = &H00FFFFFF&
Height = 375
Left = 3660
Shape = 3 'Kreis
Top = 930
Width = 615
End
Begin VB.Label Label3
Alignment = 1 'Rechts
Caption = "Anzahl der eingebauten Zähler"
Enabled = 0 'False
Height = 315
Left = 120
TabIndex = 98
Top = 270
Width = 2325
End
End
Begin VB.CommandButton cmdOK
Caption = "Prüfung starten"
DownPicture = "USPruefzaehlerPruefung.frx":000C
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 = 12330
TabIndex = 88
Top = 10350
Width = 1785
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Zurück"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 9510
TabIndex = 87
Top = 10710
Width = 1785
End
Begin VB.CommandButton cmdSPSInfo
Caption = "Schaubild"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6870
TabIndex = 86
Top = 10680
Width = 1785
End
Begin VB.Timer Timer1
Left = 10020
Top = 2100
End
Begin VB.Frame Frame4
Caption = "Prüfgang Nr"
Height = 735
Left = 11400
TabIndex = 35
Top = 8460
Width = 2715
Begin VB.Label lblPruefgangNr
BorderStyle = 1 'Fest Einfach
Height = 285
Left = 810
TabIndex = 36
Top = 300
Width = 1635
End
End
Begin VB.Frame Frame2
Caption = "Regelart"
Height = 375
Left = 11400
TabIndex = 25
Top = 7980
Width = 2715
Begin VB.OptionButton OptRegelart
Caption = "Servo"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 240
TabIndex = 27
Top = 780
Visible = 0 'False
Width = 2355
End
Begin VB.OptionButton OptRegelart
Caption = "Frequenzumrichter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 240
TabIndex = 26
Top = 360
Visible = 0 'False
Width = 2355
End
End
Begin VB.Frame FrPruefer
Caption = "Prüfer:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 11430
TabIndex = 23
Top = 900
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 = 270
TabIndex = 24
Top = 300
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 = 6045
Left = 11400
TabIndex = 17
Top = 1770
Width = 2715
Begin VB.ComboBox cmbOrdnung
Height = 315
Left = 1800
TabIndex = 44
Text = "Combo1"
Top = 4800
Width = 615
End
Begin VB.ListBox lstVorpruefpunkte
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 = 240
TabIndex = 43
Top = 4800
Width = 1455
End
Begin VB.ComboBox cmbPruefpunkte
Height = 315
Left = 240
Style = 2 'Dropdown-Liste
TabIndex = 34
Top = 4020
Width = 1635
End
Begin VB.ListBox lstPruefpunkte
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2220
Left = 240
TabIndex = 18
Top = 1350
Width = 2265
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Ordnung"
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 = 1800
TabIndex = 46
Top = 4560
Width = 765
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Vorprüfung:"
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 = 240
TabIndex = 45
Top = 4560
Width = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Regulier-Prüfpunkt:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 33
Top = 3690
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 = 240
TabIndex = 22
Top = 480
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 = 240
TabIndex = 21
Top = 240
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 = 240
TabIndex = 20
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 = 240
TabIndex = 19
Top = 840
Width = 1995
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 1
Left = 480
TabIndex = 15
Top = 180
Width = 4185
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 1
Left = 2430
TabIndex = 137
Top = 780
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 = 1
Left = 120
TabIndex = 100
Top = 540
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 1
Left = 1920
TabIndex = 63
Top = 810
Width = 405
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 1920
TabIndex = 37
Top = 420
Width = 1455
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 315
Index = 1
Left = 120
TabIndex = 16
Top = 180
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 1
Left = 3630
Top = 600
Width = 480
End
End
Begin VB.Frame frame3
Caption = "Optionen"
Height = 7815
Left = 6840
TabIndex = 28
Top = 2820
Width = 4485
Begin VB.Frame frmPrfArt
Caption = "Prüfungsdurchführung"
Height = 3735
Left = 240
TabIndex = 53
Top = 3870
Width = 4155
Begin VB.CheckBox chkZeroFlowJustage
Caption = "Zeroflow Offset_Geber Justage"
Height = 255
Left = 210
TabIndex = 158
Top = 2190
Value = 1 'Aktiviert
Width = 3075
End
Begin VB.CheckBox chkVersuch
Caption = "Versuch-Prüfung"
Height = 285
Left = 180
TabIndex = 157
Top = 3390
Width = 1665
End
Begin VB.CheckBox chkHeissKaltSpreizungBerechnen
Caption = "Heiss-Kalt Spreizung berechnen"
Height = 255
Left = 540
TabIndex = 73
Top = 1170
Width = 2895
End
Begin VB.CheckBox chkZeroflow
Caption = "Zeroflow ST_Geber Justage"
Height = 255
Left = 540
TabIndex = 72
Top = 1860
Visible = 0 'False
Width = 2595
End
Begin VB.CheckBox chkFunktionsprüfung
Caption = "Funktionsprüfung "
Height = 285
Left = 180
TabIndex = 71
Top = 3090
Width = 2085
End
Begin VB.CheckBox chkNachjustage
Caption = "Nachjustage (Werte aus Zähler beibehalten)"
Height = 255
Left = 180
TabIndex = 70
Top = 240
Width = 3435
End
Begin VB.CheckBox chkBereichsjustage
Caption = "Bereichs Justage"
Height = 255
Left = 540
TabIndex = 69
Top = 1500
Width = 1755
End
Begin VB.CheckBox chkKontinuierlich
Caption = "Prüfung mit kontinuierlichem Durchfluß"
Height = 255
Left = 180
TabIndex = 56
Top = 2520
Width = 3075
End
Begin VB.CheckBox chkHauptpruefung
Caption = "Prüfzähler-Hauptprüfung "
Height = 285
Left = 180
TabIndex = 55
Top = 2820
Value = 1 'Aktiviert
Width = 2085
End
Begin VB.CheckBox chkVorpruefung
Caption = "Vorprüfung Justage (Qmax und Qmin)"
Height = 255
Left = 180
TabIndex = 54
Top = 840
Value = 1 'Aktiviert
Width = 3135
End
Begin VB.CheckBox chkVorjustage
Caption = "Vorjustage (auf < ± 10% bei Qmin)"
Height = 255
Left = 180
TabIndex = 135
Top = 540
Width = 2895
End
End
Begin VB.Frame Frame5
Caption = "Hauptprüfung mit"
Height = 1305
Left = 240
TabIndex = 50
Top = 2550
Width = 2415
Begin VB.OptionButton OptPrfArt
Caption = "Referenzzähler"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 240
TabIndex = 52
Top = 720
Width = 1965
End
Begin VB.OptionButton OptPrfArt
Caption = "Waage"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 0
Left = 240
TabIndex = 51
Top = 360
Width = 1905
End
End
Begin VB.Frame Frame1
Caption = "Vorprüfung mit"
Height = 1065
Left = 240
TabIndex = 47
Top = 1320
Width = 2415
Begin VB.OptionButton OptVorPrfArt
Caption = "Waage"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 240
TabIndex = 49
Top = 360
Width = 1575
End
Begin VB.OptionButton OptVorPrfArt
Caption = "Referenzzähler"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 240
TabIndex = 48
Top = 600
Width = 1935
End
End
Begin VB.TextBox txtAnzahlDauerPrf
Enabled = 0 'False
Height = 315
Left = 1890
TabIndex = 31
Text = "1"
Top = 630
Width = 495
End
Begin VB.CheckBox chkDauerpruefung
Caption = "Dauerprüfung"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 420
TabIndex = 30
Top = 240
Width = 1995
End
Begin VB.CheckBox chkPruefgangLang
Caption = "Prüfgang Lang"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 420
TabIndex = 29
Top = 930
Width = 1995
End
Begin VB.Shape shpLock
FillColor = &H000000FF&
FillStyle = 0 'Ausgefüllt
Height = 405
Index = 1
Left = 3450
Shape = 4 'Gerundetes Rechteck
Top = 2520
Visible = 0 'False
Width = 405
End
Begin VB.Label lblLock
Appearance = 0 '2D
BackColor = &H008080FF&
BorderStyle = 1 'Fest Einfach
Caption = "Zähler messen mit eigenem Fühler"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 825
Left = 2790
TabIndex = 122
ToolTipText = "Sicherstellen, dass der Vor- oder Rücklauffühler, je nach Einbau Hinweis, die aktuelle Wassertemperatur mißt."
Top = 3030
Visible = 0 'False
Width = 1575
End
Begin VB.Shape shpLock
FillColor = &H000000FF&
FillStyle = 0 'Ausgefüllt
Height = 1935
Index = 0
Left = 3450
Shape = 4 'Gerundetes Rechteck
Top = 480
Visible = 0 'False
Width = 405
End
Begin VB.Label lblDauer2
Caption = "Anzahl:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 32
Top = 660
Width = 915
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 2
Left = 480
TabIndex = 13
Top = 1200
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 2
Left = 2460
TabIndex = 139
Top = 750
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 = 2
Left = 120
TabIndex = 99
Top = 600
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 2
Left = 1950
TabIndex = 64
Top = 750
Width = 405
End
Begin VB.Label lblStatus
Caption = "Status"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 1890
TabIndex = 38
Top = 480
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 2
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 2
Left = 60
TabIndex = 14
Top = 180
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 3
Left = 480
TabIndex = 11
Top = 2220
Width = 4005
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 3
Left = 2400
TabIndex = 149
Top = 780
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 3
Left = 1920
TabIndex = 65
Top = 780
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 = 120
TabIndex = 0
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 3
Left = 1920
TabIndex = 39
Top = 540
Width = 1515
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 3
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 3
Left = 120
TabIndex = 12
Top = 180
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 4
Left = 480
TabIndex = 9
Top = 3240
Width = 4005
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 4
Left = 2430
TabIndex = 150
Top = 750
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 4
Left = 1920
TabIndex = 66
Top = 750
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 = 120
TabIndex = 1
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 4
Left = 1860
TabIndex = 40
Top = 480
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 4
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 255
Index = 4
Left = 180
TabIndex = 10
Top = 240
Width = 3735
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 5
Left = 480
TabIndex = 7
Top = 4260
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 5
Left = 2400
TabIndex = 151
Top = 780
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 5
Left = 1920
TabIndex = 67
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 5
Left = 60
TabIndex = 2
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 5
Left = 1860
TabIndex = 41
Top = 540
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 5
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 5
Left = 240
TabIndex = 8
Top = 360
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 6
Left = 480
TabIndex = 5
Top = 5280
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 6
Left = 2370
TabIndex = 152
Top = 780
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 6
Left = 1860
TabIndex = 68
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 6
Left = 60
TabIndex = 3
Top = 600
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 6
Left = 1860
TabIndex = 42
Top = 540
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 6
Left = 3480
Top = 540
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 6
Left = 240
TabIndex = 6
Top = 240
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 7
Left = 480
TabIndex = 74
Top = 6300
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 7
Left = 2400
TabIndex = 153
Top = 780
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 = 60
TabIndex = 76
Top = 600
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 7
Left = 1920
TabIndex = 75
Top = 810
Width = 405
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 7
Left = 3480
Top = 600
Width = 480
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 7
Left = 1890
TabIndex = 77
Top = 510
Width = 1455
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 7
Left = 120
TabIndex = 78
Top = 240
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 8
Left = 480
TabIndex = 79
Top = 7380
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 8
Left = 2430
TabIndex = 154
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 8
Left = 1980
TabIndex = 81
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 8
Left = 180
TabIndex = 80
Top = 540
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 8
Left = 1950
TabIndex = 83
Top = 570
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 8
Left = 3480
Top = 540
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 8
Left = 180
TabIndex = 82
Top = 270
Width = 3675
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 9
Left = 480
TabIndex = 89
Top = 8400
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 9
Left = 2490
TabIndex = 155
Top = 780
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 = 91
Top = 540
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 9
Left = 2040
TabIndex = 90
Top = 810
Width = 405
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 9
Left = 180
TabIndex = 93
Top = 180
Width = 3675
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 9
Left = 3480
Top = 540
Width = 480
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 9
Left = 2010
TabIndex = 92
Top = 540
Width = 1455
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 10
Left = 480
TabIndex = 103
Top = 9420
Width = 4000
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 225
Index = 10
Left = 2490
TabIndex = 156
Top = 780
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Enabled = 0 'False
Height = 195
Index = 10
Left = 2040
TabIndex = 105
Top = 810
Width = 405
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 10
Left = 240
TabIndex = 104
Top = 540
Width = 1695
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 10
Left = 2010
TabIndex = 107
Top = 540
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 10
Left = 3480
Top = 540
Width = 480
End
Begin VB.Label lblEinbau
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ123456789"
Height = 375
Index = 10
Left = 180
TabIndex = 106
Top = 180
Width = 3675
End
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 10
Left = 5820
TabIndex = 132
Top = 9960
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 9
Left = 5820
TabIndex = 131
Top = 8970
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 8
Left = 5820
TabIndex = 130
Top = 7890
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 7
Left = 5820
TabIndex = 129
Top = 6900
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 6
Left = 5820
TabIndex = 128
Top = 5820
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 5
Left = 5820
TabIndex = 127
Top = 4830
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 4
Left = 5820
TabIndex = 126
Top = 3810
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 3
Left = 5820
TabIndex = 125
Top = 2790
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 2
Left = 5820
TabIndex = 124
Top = 1830
Visible = 0 'False
Width = 735
End
Begin VB.Label lblFehler50
BorderStyle = 1 'Fest Einfach
Caption = "50°Qmin"
Height = 255
Index = 1
Left = 5820
TabIndex = 123
Top = 780
Visible = 0 'False
Width = 735
End
Begin VB.Label lblNrEbp
Caption = "10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 10
Left = 60
TabIndex = 118
Top = 9930
Width = 435
End
Begin VB.Label lblNrEbp
Caption = "9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 9
Left = 180
TabIndex = 117
Top = 8940
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 8
Left = 180
TabIndex = 116
Top = 7860
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 7
Left = 180
TabIndex = 115
Top = 6900
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 6
Left = 180
TabIndex = 114
Top = 5880
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 5
Left = 180
TabIndex = 113
Top = 4860
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 4
Left = 180
TabIndex = 112
Top = 3840
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 3
Left = 180
TabIndex = 111
Top = 2820
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 180
TabIndex = 110
Top = 1800
Width = 315
End
Begin VB.Label lblNrEbp
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 180
TabIndex = 109
Top = 780
Width = 315
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 10
Left = 5400
TabIndex = 108
Top = 9780
Width = 795
End
Begin VB.Image imgSchloss
Height = 405
Index = 10
Left = 5400
Top = 10080
Width = 375
End
Begin VB.Image imgZaehler
Height = 750
Index = 10
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 9780
Width = 615
End
Begin VB.Label lblTitle
Alignment = 2 'Zentriert
Caption = "Prüfvorbereitung der Ultraschall-Zähler Prüfung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 6270
TabIndex = 95
Top = 330
Width = 6915
End
Begin VB.Image imgZaehler
Height = 750
Index = 9
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 8670
Width = 615
End
Begin VB.Image imgSchloss
Height = 405
Index = 9
Left = 5400
Top = 8970
Width = 375
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 8
Left = 5400
TabIndex = 94
Top = 7740
Width = 795
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 9
Left = 5400
TabIndex = 85
Top = 8700
Width = 795
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 7
Left = 5430
TabIndex = 84
Top = 6720
Width = 795
End
Begin VB.Image imgSchloss
Height = 405
Index = 8
Left = 5400
Top = 7980
Width = 375
End
Begin VB.Image imgZaehler
Height = 750
Index = 8
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 7680
Width = 615
End
Begin VB.Image imgSchloss
Height = 405
Index = 7
Left = 5400
Top = 6990
Width = 375
End
Begin VB.Image imgZaehler
Height = 750
Index = 7
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 6660
Width = 615
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 6
Left = 5400
TabIndex = 62
Top = 5640
Width = 765
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 315
Index = 5
Left = 5460
TabIndex = 61
Top = 4560
Width = 735
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 4
Left = 5460
TabIndex = 60
Top = 3660
Width = 705
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 3
Left = 5460
TabIndex = 59
Top = 2640
Width = 735
End
Begin VB.Label lblTimeout
Caption = "0"
Height = 195
Index = 2
Left = 5460
TabIndex = 58
Top = 1620
Width = 795
End
Begin VB.Label lblTimeout
Caption = "123456"
Height = 195
Index = 1
Left = 5400
TabIndex = 57
Top = 570
Width = 675
End
Begin VB.Image imgSchloss
Height = 375
Index = 6
Left = 5400
Top = 5940
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 5
Left = 5400
Top = 4890
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 4
Left = 5400
Top = 3930
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 3
Left = 5400
Top = 2910
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 2
Left = 5400
Top = 1830
Width = 375
End
Begin VB.Image imgSchloss
Height = 375
Index = 1
Left = 5400
Top = 870
Width = 375
End
Begin VB.Image imgZaehler
Height = 750
Index = 1
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 480
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 2
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 1500
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 3
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 2550
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 4
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 3600
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 5
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 4560
Width = 615
End
Begin VB.Image imgZaehler
Height = 750
Index = 6
Left = 4740
MousePointer = 99 'Benutzerdefiniert
Top = 5580
Width = 615
End
Begin VB.Shape Shape2
BackColor = &H00FFC0C0&
BackStyle = 1 'Undurchsichtig
Height = 10815
Left = 4920
Top = 360
Width = 255
End
End
Begin VB.Timer timerBlink
Enabled = 0 'False
Left = 12240
Top = 240
End
End
Attribute VB_Name = "USPruefzaehlerPruefung"
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_colUniqueVorPP As CVorpruefpunktCol
Private m_nEinbauplatz As Integer
Private m_nSeriennummer As Long
Private m_Regelart As String
Private m_PruefungsArtWaage As Boolean
Private m_VorPruefungsArtWaage As Boolean
Private m_bDauerpruefung As Boolean
Private m_bPruefgangLang As Boolean
Private m_TimerOn As Boolean
Private m_Pruefgang As CPruefgang
Public m_SPS As CSPS
Private mblnAbbruch As Boolean
Private mlngRet As Long
Const const_keineSNText As String = "keine SNr"
Dim bTextChanged(10) As Boolean
Dim bBlinkend(10) As Boolean
Private Sub chkAuto_Click()
If chkAuto.value = vbChecked Then
txtAnzahl.Enabled = False
Call updateAnzahl
Else
txtAnzahl.Enabled = True
End If
End Sub
Private Sub chkDauerpruefung_click()
If chkDauerpruefung.value = 1 Then
m_bDauerpruefung = True
lblDauer2.Enabled = True
txtAnzahlDauerPrf.Enabled = True
txtAnzahlDauerPrf.SelStart = 1
txtAnzahlDauerPrf.SelLength = 3
Else
m_bDauerpruefung = False
lblDauer2.Enabled = False
txtAnzahlDauerPrf.Enabled = False
txtAnzahlDauerPrf.text = "1"
End If
End Sub
Private Sub chkHauptpruefung_Click()
If chkKontinuierlich.value = vbChecked Then
chkKontinuierlich.value = 0
End If
End Sub
Private Sub chkKontinuierlich_Click()
If chkHauptpruefung.value = vbChecked Then
chkHauptpruefung.value = 0
End If
End Sub
Private Sub chkProtokolldruck_Click()
If chkProtokolldruck.value = vbChecked Then
g_blnPruefprotokoll = True
Else
g_blnPruefprotokoll = False
End If
End Sub
'Private Sub chkKeineRegulierung_Click()
' If chkKeineRegulierung.Value = vbChecked Then
' chkRegulierung.Enabled = False
' Else
' chkRegulierung.Enabled = True
' End If
' Call chkRegulierung_Click
'End Sub
Private Sub chkPruefgangLang_click()
If chkPruefgangLang.value = 1 Then
m_bPruefgangLang = True
Else
m_bPruefgangLang = False
End If
End Sub
Private Function PruefpunkteZeitenVorhanden() As Boolean
Dim Pruefpunkt As CPruefpunkt
Dim Zeit As Double
For Each Pruefpunkt In m_colUniquePP.getCollection
Zeit = Pruefpunkt.GetTime
Debug.Print "Prüfpunkt " & Pruefpunkt.getQ & ", Zeit: " & Zeit
If Zeit = 0 Then
' Für einen Pruefpunkt ist keine Zeit definiert: sofort False zurückgeben
PruefpunkteZeitenVorhanden = False
Exit Function
End If
Next
' Alle Prüfpunkte haben Zeiten
PruefpunkteZeitenVorhanden = True
End Function
Private Sub OrdnungChanged()
Set m_colUniqueVorPP = calcVorpruefpunkte(m_colEinbauplatz)
updatePruefpunkte
End Sub
Private Sub chkVersuch_Click()
If chkVersuch.value = vbChecked Then
g_blnVersuch = True
Else
g_blnVersuch = False
End If
End Sub
Private Sub chkVorjustage_Click()
If chkVorjustage.value = vbChecked Then
chkNachjustage.Enabled = True
Else
If chkVorpruefung.value = vbUnchecked Then
chkNachjustage.Enabled = False
End If
End If
End Sub
Private Sub chkVorpruefung_Click()
If chkVorpruefung.value = vbUnchecked Then
chkBereichsjustage.Enabled = False
chkNachjustage.Enabled = False
chkZeroflow.Enabled = False
chkHeissKaltSpreizungBerechnen.Enabled = False
Else
chkBereichsjustage.Enabled = True
chkNachjustage.Enabled = True
chkZeroflow.Enabled = True
chkHeissKaltSpreizungBerechnen.Enabled = True
End If
cmbOrdnung_Click
End Sub
Private Sub cmbOrdnung_Click()
Debug.Print "cmbOrdnung_Click"
Call OrdnungChanged
If cmbOrdnung = 1 Then
chkBereichsjustage.Enabled = False
chkBereichsjustage.value = vbUnchecked
Else
chkBereichsjustage.Enabled = True
chkBereichsjustage.value = vbChecked
End If
End Sub
Private Sub cmdJustagewerte_Click(Index As Integer)
Dim formJustageWerte As frmJustagewerte
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim blnTimerwasOn As Boolean
blnTimerwasOn = Timer1.Enabled
StopScan
DoEvents
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set formJustageWerte = New frmJustagewerte
formJustageWerte.m_EinbauplatzNr = Index
Set formJustageWerte.m_Pruefzaehler = Pruefzaehler
Set formJustageWerte.m_Vorpruefpunkte = Pruefzaehler.getVorpruefpunkte
formJustageWerte.Show vbModal
If blnTimerwasOn Then
txtSerienNr(Index).SetFocus
'StartScan
End If
End Sub
Private Sub cmdOk_Click()
Dim EinbauplatzNr As Integer
g_Abbruch = False
If txtAnzahl.text = "" Then
chkAuto.value = vbChecked
Call chkAuto_Click
End If
If Not SindZaehlerAehnlich() Then
MsgBox ("Die Zähler sind zu unterschiedlich um zusammen geprüft zu werden")
Exit Sub
End If
If Not PruefpunkteZeitenVorhanden() Then
MsgBox ("Prüfpunktzeiten fehlen!" & vbCrLf & "Für alle Prüfpunkte müssen Zeiten definiert sein!")
Exit Sub
End If
Call Hauptpruefung
End Sub
Private Sub cmdRuecklaeuferanalyse_Click(Index As Integer)
Dim objForm As frmRuecklaeuferanalyse
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set objForm = New frmRuecklaeuferanalyse
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
objForm.m_EinbauplatzNr = Einbauplatz.getNr
Set objForm.m_Pruefzaehler = Einbauplatz.getPruefzaehler
Set objForm.m_Pruefgang = m_Pruefgang
objForm.Show vbModal, Me
End Sub
' Activiere die ProTool-Anwendung
Private Sub cmdSPSInfo_Click()
Call g_App.getSPS().ActivateProTool
End Sub
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
Private Sub cmdStopScan_Click()
If m_TimerOn = False Then
StartScan
Else
StopScan
End If
End Sub
Private Sub Form_Activate()
Call chkVorpruefung_Click
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
Set m_SPS = g_App.getSPS()
For i = 1 To 10
cmdRuecklaeuferanalyse(i).Enabled = False
If i > 1 Then
txtSerienNr(i).Left = txtSerienNr(1).Left
txtSerienNr(i).Top = txtSerienNr(1).Top
txtSerienNr(i).Width = txtSerienNr(1).Width
txtSerienNr(i).Height = txtSerienNr(1).Height
cmdSerNrAusw(i).Left = cmdSerNrAusw(1).Left
cmdSerNrAusw(i).Top = cmdSerNrAusw(1).Top
cmdSerNrAusw(i).Width = cmdSerNrAusw(1).Width
cmdSerNrAusw(i).Height = cmdSerNrAusw(1).Height
lblStatus(i).Left = lblStatus(1).Left
lblStatus(i).Top = lblStatus(1).Top
lblStatus(i).Width = lblStatus(1).Width
lblStatus(i).Height = lblStatus(1).Height
cmdJustagewerte(i).Left = cmdJustagewerte(1).Left
cmdJustagewerte(i).Top = cmdJustagewerte(1).Top
cmdJustagewerte(i).Width = cmdJustagewerte(1).Width
cmdJustagewerte(i).Height = cmdJustagewerte(1).Height
lblEinbau(i).Left = lblEinbau(1).Left
lblEinbau(i).Top = lblEinbau(1).Top
lblEinbau(i).Width = lblEinbau(1).Width
lblEinbau(i).Height = lblEinbau(1).Height
imgInfo(i).Left = imgInfo(1).Left
imgInfo(i).Top = imgInfo(1).Top
imgInfo(i).Width = imgInfo(1).Width
imgInfo(i).Height = imgInfo(1).Height
End If
imgZaehler(i).Picture = frmRes.imgZaehlerGrauLinks.Picture
txtSerienNr(i).MaxLength = 10
imgZaehler(i).Enabled = False
txtSerienNr(i).Enabled = False
cmdJustagewerte(i).Visible = False
If i <= g_App.Settings.EinbauplaetzeJeStrang Then
Else
lblNrEbp(i).Visible = False
frEinbau(i).Visible = False
imgZaehler(i).Visible = False
lblTimeout(i).Visible = False
cmdJustagewerte(i).Visible = False
End If
Next i
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
lblUniquePP = 0
lblMaxPP = g_App.Settings.getMaxPruefpunkte()
lblTitle = "Prüfvorbereitung Ultraschallzähler"
' Initialisierung der RadioButtons "PruefungsArt"
Select Case g_App.Settings.USPruefungsArt
Case "Waage"
OptPrfArt(0).value = True
OptPrfArt(1).value = False
m_PruefungsArtWaage = True
Case "Referenzzaehler"
OptPrfArt(0).value = False
OptPrfArt(1).value = True
m_PruefungsArtWaage = False
Case Else
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei für Prüfungsart"
exitInstance
End Select
' Initialisierung der CheckButtons "Funktionsprüfung"
Select Case g_App.Settings.USFunktionspruefung
Case "2" ' immer
chkFunktionsprüfung.Enabled = False
chkFunktionsprüfung.value = vbChecked
Case "1" ' ja vorgeschlagen
chkFunktionsprüfung.Enabled = True
chkFunktionsprüfung.value = vbChecked
Case "" ' nein vorgeschlagen
chkFunktionsprüfung.Enabled = True
chkFunktionsprüfung.value = vbUnchecked
Case "0" ' verhindert
chkFunktionsprüfung.value = vbUnchecked
chkFunktionsprüfung.Enabled = False
End Select
If g_blnVersuch = True Then
chkVersuch.value = vbChecked
chkVersuch.Visible = True
Else
Select Case g_App.Settings.Versuch
Case "0"
chkVersuch.value = vbUnchecked
chkVersuch.Visible = True
g_blnVersuch = False
Case "1"
chkVersuch.Visible = True
chkVersuch.value = vbChecked
g_blnVersuch = True
Case Else
' kein Ini Eintrag vorhanden
chkVersuch.value = vbUnchecked
chkVersuch.Visible = False
g_blnVersuch = False
End Select
End If
' Initialisierung der RadioButtons "Vorprüfung PruefungsArt"
Select Case g_App.Settings.USVorPruefungsArt
Case "Waage"
OptVorPrfArt(0).value = True
OptVorPrfArt(1).value = False
m_VorPruefungsArtWaage = True
Case "Referenzzaehler"
OptVorPrfArt(0).value = False
OptVorPrfArt(1).value = True
m_VorPruefungsArtWaage = False
Case Else
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei für USPrüfungsart"
exitInstance
End Select
cmdOK.Enabled = False
g_frmMain.Hide
Call initEinbauplaetze ' Erzeuge Einbauplaetze Collection
Call initRegelart
' Pruefgang Objekt erzeugen / Pruefgang starten
Set m_Pruefgang = New CPruefgang
' Ultraschallzaehler initialisieren
Call USinit
cmbOrdnung.AddItem 1
cmbOrdnung.AddItem 2
'cmbOrdnung.AddItem 3
'cmbOrdnung.AddItem 4
'cmbOrdnung.AddItem 5
cmbOrdnung.ListIndex = 0
Me.Visible = True
DoEvents
mblnAbbruch = False
'MsgBox ("Zum Aktivieren der eingebauten Zähler mind. 2 Sekunden Taste drücken!")
'Neu AP 23.03.2004
'Wenn in der INI-Datei der Wert auf 0 steht oder nicht vorhanden ist, dann Anzeige dieser Warnungen
If g_App.Settings.USTemperaturlock = 0 Then
' Zähler messen mit eigenem Füler
lblLock.Visible = True
shpLock(0).Visible = True
shpLock(1).Visible = True
ElseIf g_App.Settings.USTemperaturlock = 1 Then
' Zähler messen mit externem Fühler
lblLock.Visible = False
shpLock(0).Visible = False
shpLock(1).Visible = False
Else
MsgBox "falscher Wert in INI: [USTemperaturlock] VerwendungExternerFuehler '" & g_App.Settings.USTemperaturlock & "'"
End If
chkVorjustage.Visible = True
Select Case g_App.Settings.USVorjustage
Case "0"
chkVorjustage.Enabled = True
chkVorjustage.value = vbUnchecked
Case "1"
chkVorjustage.Enabled = True
chkVorjustage.value = vbChecked
chkVorjustage.Visible = True
Case "2"
chkVorjustage.Enabled = False
chkVorjustage.value = vbUnchecked
Case "3"
chkVorjustage.Enabled = False
chkVorjustage.value = vbChecked
chkVorjustage.Visible = True
End Select
Call chkVorpruefung_Click
chkProtokolldruck_Click
cmbOrdnung_Click
If g_blnVersuch = True Then
' Auf Wunsch von C.Nettemann:
chkVorjustage.value = vbUnchecked
chkVorpruefung.value = vbUnchecked
chkZeroFlowJustage.value = vbUnchecked
End If
StartScan
End Sub
' Einbauplätze initialisieren
'
Private Sub initEinbauplaetze()
Dim i As Integer
Dim Einbauplatz As CEinbauplatz
Set m_colEinbauplatz = New Collection
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
Set Einbauplatz = New CEinbauplatz
Call Einbauplatz.setNr(i)
m_colEinbauplatz.Add Einbauplatz, Str$(i)
Next i
End Sub
' Regelart initialisieren
Private Sub initRegelart()
' Todo: unter Q < 1 m^3 -> Servo verwenden -> für jeden PP individuell
' Vorbestzung aus INI Datei
Select Case g_App.Settings.Regelart
Case "FU"
OptRegelart(0).value = True
OptRegelart(1).value = False
m_Regelart = "FU"
Case "Servo"
OptRegelart(0).value = False
OptRegelart(1).value = True
m_Regelart = "Servo"
Case Else
OptRegelart(0).value = False
OptRegelart(1).value = False
End Select
End Sub
'------------------------------------------------------------------------------
' Private Funktionalität
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
g_frmMain.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
g_frmMain.Show
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
cmdCancel.Enabled = False
mblnAbbruch = True
Timer1.Enabled = True
End Sub
Private Sub Formularbeenden()
Dim Einbauplatz As CEinbauplatz
Dim lngRet As Long
Timer1.Enabled = False
cmdCancel.Enabled = True
Call StopScan
Debug.Print "Verlassen der US Prüfung"
Call endDialog(IDCANCEL)
End Sub
Private Sub imgSchloss_Click(Index As Integer)
If imgSchloss(Index).Picture = frmRes.ImgSchlossOff.Picture Then
' If MsgBox("Möchten Sie das Schloß schließen ?", vbYesNo, "Das Schloß ist Offen") = vbYes Then
' Call USSchlossSchliessen(Index)
' txtSerienNr(Index).Text = ""
' imgSchloss(Index).Picture = frmRes.ImgLeer
' Call ueberpruefe(Index)
' End If
Else
If MsgBox("Möchten Sie das Schloß öffnen?", vbYesNo, "Das Schloß ist Geschlossen") = vbYes Then
Call USSchlossOeffnen(Index)
txtSerienNr(Index).text = ""
imgSchloss(Index).Picture = frmRes.ImgLeer
Call ueberpruefe(Index)
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
Call dlg.setPruefzaehler(Einbauplatz.getPruefzaehler())
Call dlg.setEinbauplatz(Einbauplatz)
Set dlg.m_colEinbauplatz = m_colEinbauplatz
If doModal(dlg, True) = IDOK Then
Call updatePruefpunkte
If g_MetrologAktualisieren = True Then
AlleEinbauplaetzeDesGleichenAuftragesAktualisieren (Index)
Else
Call ueberpruefe(Index)
End If
End If
Me.MousePointer = vbDefault
End Sub
Private Sub lblFehler50_Click(Index As Integer)
' load frmoptimizeFlow_fp
' frmoptimizeFlow_fp.EinbauplatzNr = Index
' frmoptimizeFlow_fp.Show vbModal, Me
End Sub
Private Sub OptVorPrfArt_Click(Index As Integer)
Select Case Index
Case 0
m_VorPruefungsArtWaage = True
Case 1
m_VorPruefungsArtWaage = False
End Select
End Sub
Private Sub OptPrfArt_Click(Index As Integer)
Select Case Index
Case 0
m_PruefungsArtWaage = True
Case 1
m_PruefungsArtWaage = False
End Select
End Sub
Private Sub OptRegelart_Click(Index As Integer)
Select Case Index
Case 0
m_Regelart = "FU"
Case 1
m_Regelart = "Servo"
End Select
End Sub
Private Sub txtAnzahl_Click()
chkAuto.value = vbUnchecked
txtAnzahl.SelStart = 0
txtAnzahl.SelLength = Len(txtAnzahl.text)
End Sub
' Nur numerische Eingaben zulassen
Private Sub txtAnzahlDauerPrf_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
Else
If Len(txtAnzahlDauerPrf.text) > 2 Then KeyAscii = 0
End If
End Sub
Private Sub chkPruefgangLang_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
End If
End Sub
Private Sub txtAnzahlDauerPrf_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
chkDauerpruefung.value = 0
End If
End Sub
'----------------------------------------------------------------------------
' Event Handling für das Scanner Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtScanner_KeyPress(KeyAscii As Integer)
Dim nWert As Long
If KeyAscii = 13 Then
KeyAscii = 0 ' unterbinde Beep
If IsNumeric(txtScanner) Then
nWert = Val(txtScanner.text)
If nWert > 0 And nWert <= g_App.Settings.EinbauplaetzeJeStrang Then
m_nEinbauplatz = nWert
txtScanner.text = ""
lblScanner.caption = "Platz: " & Str(m_nEinbauplatz)
End If
If (nWert >= SERIENNR_MINWERT And nWert <= SERIENNR_MAXWERT) Then
m_nSeriennummer = nWert
txtScanner.text = ""
lblScanner.caption = "SN:" & Str(m_nSeriennummer)
End If
If m_nEinbauplatz > 0 And m_nSeriennummer > 0 Then
txtSerienNr(m_nEinbauplatz).text = FormatSerienNr(m_nSeriennummer)
lblScanner.caption = Str(m_nEinbauplatz) & " : " & Str(m_nSeriennummer)
Call ueberpruefe(m_nEinbauplatz)
m_nEinbauplatz = 0
m_nSeriennummer = 0
End If
Else
txtScanner = ""
beep
End If
End If
End Sub
'----------------------------------------------------------------------------
' Event Handling für das SerienNr Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtSerienNr_Change(Index As Integer)
bTextChanged(Index) = True
End Sub
Private Sub txtSerienNr_Click(Index As Integer)
StopScan
End Sub
'Eingefügt am 24.07.02 Pfeiffer
Private Sub cmdSerNrAusw_Click(Index As Integer)
StopScan
txtSerienNr_DblClick (Index)
End Sub
Private Sub txtSerienNr_DblClick(Index As Integer)
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
If IsNumeric(frmDialog.sSerienNr) Then
txtSerienNr(Index).text = frmDialog.sSerienNr
bTextChanged(Index) = True
txtSerienNr(Index).SetFocus
End If
End Sub
Private Sub txtSerienNr_GotFocus(Index As Integer)
m_sOldInput = txtSerienNr(Index).text
CursorAnEndeImSerienNrField (Index)
' selectSerienNrField (Index)
End Sub
Private Sub txtSerienNr_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
' Setzt Fokus ins darunterliegende Textfeld bei Cursor-Down
On Error Resume Next
txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).SetFocus
ueberpruefe (Index)
End If
If KeyCode = 38 Then
' Setzt Fokus ins darüberliegende Textfeld bei Cursor-Up
On Error Resume Next
txtSerienNr(IIf(Index > 1, Index - 1, g_App.Settings.EinbauplaetzeJeStrang)).SetFocus
ueberpruefe (Index)
End If
End Sub
Private Sub txtSerienNr_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).Enabled = True Then
txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).SetFocus
End If
ueberpruefe (Index)
StartScan
Else
StopScan
End If
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
' Komplettes Feld selektieren
'
Private Sub selectSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = 0
txtSerienNr(Index).SelLength = Len(txtSerienNr(Index))
End Sub
' Komplettes Feld selektieren
'
Private Sub CursorAnEndeImSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = Len(txtSerienNr(Index))
txtSerienNr(Index).SelLength = 0
End Sub
Private Sub txtSerienNr_LostFocus(Index As Integer)
Debug.Print "LostFocus"
If ActiveControl.Name <> "txtSerienNr" And txtSerienNr(Index) <> "" Then
'StopScan
End If
End Sub
' Validierung bei Fokus Wechsel in ein anderes Feld per Maus
Private Sub txtSerienNr_Validate(Index As Integer, Cancel As Boolean)
Debug.Print "Validate"
Call ueberpruefe(Index)
Cancel = False
End Sub
Private Sub ErstelleTestPruefzaehler(Index As Integer)
Dim oAuftragPositionSerienNummer As CAuftragPositionSerienNr
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Pruefpunkte As CPruefpunkte
lSerienNr = neueTestZaehlerSerienNr()
If lSerienNr = 0 Then
EntferneZaehlerAusEinbauplatz (Index)
Exit Sub
End If
txtSerienNr(Index).text = FormatSerienNr(lSerienNr)
Set oAuftragPositionSerienNummer = New CAuftragPositionSerienNr
oAuftragPositionSerienNummer.setAuftragNr 99999
oAuftragPositionSerienNummer.setPositionNr 1
oAuftragPositionSerienNummer.setEinbauplatzNr Index
oAuftragPositionSerienNummer.setNr lSerienNr
oAuftragPositionSerienNummer.save
Set Pruefzaehler = New CPruefzaehler
Pruefzaehler.setSerienNr lSerienNr
Set Einbauplatz = getEinbauplatz(Index)
Einbauplatz.setPruefzaehler Pruefzaehler
If Pruefzaehler.getPruefpunkte Is Nothing Then
Set Pruefpunkte = PruefpunkteDesErstenPZmitPP(m_colEinbauplatz)
Pruefzaehler.SetAuftragPositionSerienNr oAuftragPositionSerienNummer
Pruefzaehler.setPruefpunkte Pruefpunkte
If Pruefpunkte Is Nothing Then
DebugMsg "Pruefpunkte sind für diesen Zähler nicht definiert"
'If MsgBox("Dieser Zaehler enthält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then
' 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 If
End Sub
Private Function PruefpunkteDesErstenPZmitPP(ColEinbauplatz As Collection) As CPruefpunkte
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
For Each Einbauplatz In ColEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If Pruefzaehler.getPruefpunkte.getPruefpunkte.Count > 0 Then
Set PruefpunkteDesErstenPZmitPP = Pruefzaehler.getPruefpunkte
Exit Function
End If
End If
End If
Next
Set PruefpunkteDesErstenPZmitPP = Nothing
End Function
Private Sub ueberpruefe(Index As Integer)
If bTextChanged(Index) = True Then
bTextChanged(Index) = False
' Seriennummer wurde geändert
If txtSerienNr(Index).text = "0" Then
ErstelleTestPruefzaehler (Index)
ueberpruefe (Index)
Exit Sub
End If
If testSerienNrInput(Index) Then
If txtSerienNr(Index) <> "" Then
' Wenn SerienNr Feld nicht gelöscht und SerienNrInput
' gerade erfolgreich getestet wurde,
' dann überprüfen, ob Pruefpunkte vorhanden sind. Wenn nicht, manuell PP eingeben.
Call UeberpruefeAufPruefpunkte(Index)
End If
StartScan
Else
' SerienNr wurde nicht akzeptiert
txtSerienNr(Index).SetFocus
End If
Else
' nicht geändert
End If
If m_colUniquePP Is Nothing Then
cmdOK.Enabled = False
Else
If m_colUniquePP.Count > 0 Then
cmdOK.Enabled = True
Else
cmdOK.Enabled = False
End If
End If
Call updateAnzahl
End Sub
Private Sub updateAnzahl()
Dim iAnzahlPZ As Integer
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
iAnzahlPZ = iAnzahlPZ + 1
End If
If chkAuto.value = vbChecked Then
txtAnzahl.text = iAnzahlPZ
End If
Next
End Sub
Private Sub loescheFabNr(lngSerienNr As Long, lngFabNr As Long)
Dim rs As CRecordset
Set rs = New CRecordset
rs.openRS "UPDATE AuftragPositionSerienNr set FabNr = NULL WHERE SerienNr=" & lngSerienNr & " and FabNr=" & lngFabNr
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)
Set m_colUniqueVorPP = calcVorpruefpunkte(m_colEinbauplatz)
' Anzeige der eindeutigen Prüfpunkte aktualisieren
lblUniquePP = m_colUniquePP.Count
' Listboxen für Pruefpunkte aktualisieren
lstPruefpunkte.Clear
cmbPruefpunkte.Clear
m_colUniquePP.sortQ
For i = 1 To m_colUniquePP.Count()
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ & " (" & m_colUniquePP.Item(i).GetTime & " s = " & Format(m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6, "0") & " l)"
cmbPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
Next i
If m_colUniquePP.Count() > 0 Then
cmbPruefpunkte.ListIndex = 0
End If
lstVorpruefpunkte.Clear
m_colUniqueVorPP.sortQ
For i = 1 To m_colUniqueVorPP.Count
lstVorpruefpunkte.AddItem m_colUniqueVorPP.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) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim nTmpText As String
Dim Impulswertigkeit As Long
Set Einbauplatz = getEinbauplatz(Index)
' Eingabe ist Einbauplatz Nummer
If Val(txtSerienNr(Index)) > 0 And Val(txtSerienNr(Index)) <= g_App.Settings.EinbauplaetzeJeStrang Then
' Cursor laut Eingabe ins angewählte Feld setzen
If txtSerienNr(Val(txtSerienNr(Index))).Enabled = True Then
nTmpText = txtSerienNr(Index).text
txtSerienNr(Index).text = m_sOldInput
txtSerienNr(Val(nTmpText)).SetFocus
GoTo testSerienNrInputReturnOK
Else
GoTo testSerienNrInputReturnFalse
End If
End If
If Trim$(txtSerienNr(Index)) = "" Then
' Seriennummer wurde gelöscht
lSerienNr = -1
' Prüfen, ob noch irgendeine Seriennummer definiert ist
Dim bKeinPruefzaehler As Boolean
bKeinPruefzaehler = True
Dim i As Integer
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
If txtSerienNr(i) <> "" Then
bKeinPruefzaehler = False
End If
Next
Else
lSerienNr = Val(txtSerienNr(Index))
End If
' Setze im Einbauplatz Objekt die Seriennr. (laut DB)
If Not setEinbauplatzPruefzaehler(Einbauplatz, lSerienNr) Then
' Fehlgeschlagen:
GoTo testSerienNrInputReturnFalse
End If
'----------
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")
End If
End If
Call updatePruefpunkte
Call Show50GradFehlerBeiQmin(Index)
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
' Prüfpunkt ist noch nicht in der PPCollection vorhanden
Call Pruefpunkt.setUseCount(1)
Set KopiePruefpunkt = New CPruefpunkt
KopiePruefpunkt.copyFrom Pruefpunkt
colUniquePP.Add KopiePruefpunkt
Else
' Prüfpunkt ist vorhanden
' Nur UseCount erhöhen
Call colUniquePP.Item(nPos).incUseCount
End If
Next
End If
End If
End If
Next
Set calcPruefpunkte = colUniquePP
End Function
' Menge aller eindeutigen Vorprüfpunkte bilden
'
' @param Einbauplaetze Collection der Einbauplätze
'
' @return Collection mit allen eindeutigen CVorpruefpunkt-Objekten
''
' geändert am 26.1.2000 von RH: arbeitet jetzt mit KopiePruefpunkt
' geändert am 12.12.2001 von RH: Vorpruefpunkte übernommen aus Pruefpunkte
Private Function calcVorpruefpunkte(Einbauplaetze As Collection) As CVorpruefpunktCol
Dim Einbauplatz As CEinbauplatz
Dim Vorpruefpunkt As CVorpruefpunkt
Dim Vorpruefpunkte As CVorpruefpunkte
Dim colUniqueVorPP As New CVorpruefpunktCol
For Each Einbauplatz In Einbauplaetze
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
Set Vorpruefpunkte = Einbauplatz.getPruefzaehler().getVorpruefpunkte()
If Not Vorpruefpunkte Is Nothing Then
If Not Vorpruefpunkte.getPruefpunkte Is Nothing Then
For Each Vorpruefpunkt In Vorpruefpunkte.getPruefpunkte().getCollection()
Debug.Print "---"
Debug.Print "Q: " & Vorpruefpunkt.getQ
Debug.Print "n: " & Vorpruefpunkt.getOrdnung
Debug.Print "t: " & Vorpruefpunkt.GetTime
If Vorpruefpunkt.getOrdnung <= Val(cmbOrdnung.text) Then
Debug.Print "Ist dabei in Ordnung " & cmbOrdnung.text
colUniqueVorPP.Add Vorpruefpunkt
Else
Debug.Print "Ist NICHT dabei in Ordnung " & cmbOrdnung.text
End If
Next
Set calcVorpruefpunkte = colUniqueVorPP
Exit Function
End If
End If
End If
Next
Set calcVorpruefpunkte = colUniqueVorPP
End Function
' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts
' in der übergebenen Collection von Pruefpunkten enthalten ist.
'
Private Function getEquivPruefpunktIndexFromCollection(TestPruefpunkt As CPruefpunkt, colPruefpunkte As CPruefpunktCol) As Integer
Dim Pruefpunkt As CPruefpunkt
Dim i As Integer
For i = 1 To colPruefpunkte.Count
Set Pruefpunkt = colPruefpunkte.Item(i)
If Pruefpunkt.getQ() = TestPruefpunkt.getQ() Then
getEquivPruefpunktIndexFromCollection = i
Exit Function
End If
Next
End Function
' Prüfzähler-Objekt in dem angegebenen Einbauplatz löschen
' Der Einbauplatz ist danach wieder als "nicht in Verwendung" deklariert.
'
Private Sub clearEinbauplatzPruefzaehler(nEinbauplatz As Integer)
Dim Einbauplatz As CEinbauplatz
Set Einbauplatz = getEinbauplatz(nEinbauplatz)
If Not Einbauplatz Is Nothing Then
Call Einbauplatz.setPruefzaehler(Nothing)
End If
End Sub
' Einbauplatz auf Basis der übergebenen Serien-Nr. den
' zugehörigen Prüfzähler zuweisen.
'
' @param Einbauplatz Einbauplatz-Objekt
' @param lSerienNr Nr. des Zählers ( -1 = Leerung)
'
' @return true = Prüfzähler konnte dem Einbauplatz zugewiesen werden
' false = Serien-Nr. ist ungültig oder konnte nicht in der
' Datenbank gefunden werden
'
Private Function setEinbauplatzPruefzaehler(Einbauplatz As CEinbauplatz, lSerienNr As Long) As Boolean
Dim Pruefzaehler As CPruefzaehler
Dim EinbauplatzNr As Integer
setEinbauplatzPruefzaehler = False
If Einbauplatz Is Nothing Then
Call ErrorMsg("setEinbauplatzPruefzaehler: " + "Als Einbauplatz wurde nothing übergeben!")
Exit Function
End If
If lSerienNr < 0 Then
' Prüfzähler wurde ausgebaut
Call Einbauplatz.setPruefzaehler(Nothing)
setEinbauplatzPruefzaehler = True
ElseIf lSerienNr < SERIENNR_MINWERT Then
' Ungültige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
ElseIf lSerienNr > SERIENNR_MAXWERT Then
' Ungültige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
Else
' Seriennummer im gültigen Bereich
Call Einbauplatz.setPruefzaehler(Nothing)
Set Pruefzaehler = New CPruefzaehler
DebugMsg "Prüfzähler " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr
' Prüfen, ob eine Auftragsposition existiert
If Pruefzaehler.loadForSerienNr(lSerienNr) Then
' Prüfzähler vorhanden
DebugMsg "Prüfzähler mit SerienNr " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr
setEinbauplatzPruefzaehler = True
Else
' Todo: muss ein Prüfzähler Objekt wirklich erzeugt werden
' wenn Seriennummer nicht in der Datenbank steht ?
' nur wenn TEST-Pruefzaehler:
' Call Pruefzaehler.setSerienNr(lSerienNr)
End If
Call Einbauplatz.setPruefzaehler(Pruefzaehler)
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
On Error Resume Next
Dim blnOffsetJustagemoeglich As Boolean
Dim Einbauplatz As CEinbauplatz
Dim StatusFertigung As Integer
Dim JustageWerte As CJustagewerte
imgZaehler(Index).Enabled = True
Set Einbauplatz = getEinbauplatz(Index)
cmdRuecklaeuferanalyse(Index).Enabled = False
If Einbauplatz.getPruefzaehler() Is Nothing Then
' Leere Eingabe, kein Prüfzähler eingebaut
lblEinbau(Index).caption = ""
txtSerienNr(Index).BackColor = &HFFFFFF
imgZaehler(Index).Enabled = False
ElseIf hasDupes(Einbauplatz.getPruefzaehler()) Then
' Doppelte Serien-Nr.
lblEinbau(Index).caption = "Doppelte Serien-Nr."
txtSerienNr(Index).BackColor = &HC0C0FF ' IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
ElseIf Einbauplatz.getPruefzaehler().getAuftragPosition() Is Nothing Then
' Ungültige Serien-Nr.
lblEinbau(Index).caption = "keine Auftragsdaten!"
txtSerienNr(Index).BackColor = &HC0C0FF ' IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
Else
' Alles OK?
Dim Auftrag As CAuftrag
Dim AuftragPosition As CAuftragPosition
Dim Pruefzaehler As CPruefzaehler
Dim sMsg As String
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
Set Auftrag = Pruefzaehler.getAuftrag()
Set AuftragPosition = Pruefzaehler.getAuftragPosition()
cmdRuecklaeuferanalyse(Index).Enabled = True
sMsg = ""
If Auftrag Is Nothing Then
sMsg = sMsg & "(unbekannt)"
Else
sMsg = sMsg & Auftrag.getNr()
End If
sMsg = sMsg & "/"
If AuftragPosition Is Nothing Then
sMsg = sMsg & "(unbekannt)"
Else
sMsg = sMsg & AuftragPosition.getNr()
End If
sMsg = sMsg & " " & Trim(Pruefzaehler.getIdentNrObj.getTyp & _
" " & Pruefzaehler.getIdentNrObj.getTypzusatz)
sMsg = sMsg & " DN" & Pruefzaehler.getIdentNrObj.getNennweite
sMsg = sMsg & " " & Pruefzaehler.getIdentNrObj.GetTemperatur & "G"
sMsg = sMsg & "/PN" & Pruefzaehler.getIdentNrObj.getDruck
sMsg = sMsg & "(" & Pruefzaehler.getPruefklasseKZ & ")"
If Auftrag Is Nothing Or AuftragPosition Is Nothing Then
lblEinbau(Index).caption = sMsg
txtSerienNr(Index).BackColor = IIf(m_bBlink, &HC0C0FF, &HFFFFFF)
imgZaehler(Index).Enabled = False
Else
lblEinbau(Index).caption = sMsg
txtSerienNr(Index).BackColor = &HC0FFC0
imgZaehler(Index).Enabled = True
End If
StatusFertigung = Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung
If StatusFertigung < 25 Then
lblStatus(Index) = "neu"
End If
If StatusFertigung >= 25 And StatusFertigung < 30 Then
lblStatus(Index).caption = "Wdh"
End If
If StatusFertigung >= 30 Then
lblStatus(Index).caption = "keine Wdh erf."
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
Set JustageWerte = New CJustagewerte
If Not Pruefzaehler Is Nothing Then
JustageWerte.SerienNr = Pruefzaehler.getSerienNr
blnOffsetJustagemoeglich = HauptprfOffsetjustage(Pruefzaehler.getSerienNr, Pruefzaehler.getVorpruefpunkte, False)
If JustageWerte.load = True Then
If blnOffsetJustagemoeglich = True Then
cmdJustagewerte(Index).Visible = True
cmdJustagewerte(Index).Enabled = True
Else
cmdJustagewerte(Index).Visible = False
End If
Else
cmdJustagewerte(Index).Visible = False
End If
Else
cmdJustagewerte(Index).Visible = False
End If
'----------------------------------------------------
End Function
'------------------------------------------------------
'------------------------------------------
Private Sub UeberpruefeAufPruefpunkte(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Set Pruefzaehler = m_colEinbauplatz.Item(Index).getPruefzaehler
If Pruefzaehler Is Nothing Then
Exit Sub
End If
If Pruefzaehler.getPruefpunkte Is Nothing Then
Exit Sub
End If
If Pruefzaehler.getPruefpunkte.getPruefpunkteCount() = 0 Then
DebugMsg "Pruefpunkte sind für diesen Zähler nicht definiert"
If MsgBox("Dieser Zaehler enthält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then
Call imgZaehler_Click(Index)
Else
EntferneZaehlerAusEinbauplatz (Index)
Exit Sub
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
txtSerienNr(Index).SetFocus
End If
Else
If Pruefzaehler.getAuftragPositionSerienNr Is Nothing Then
MsgBox ("AuftragPosSNr unbekannt")
Else
CheckWriteSerienNr (Index)
End If
End If
End Sub
Public Sub Hauptpruefung()
Dim i As Integer
Dim dlgHauptPruefung As frmUSHauptprf
Dim blnPruefungDurchfuehren As Boolean
Dim Einbauplatz As CEinbauplatz
Set dlgHauptPruefung = New frmUSHauptprf
Set m_Pruefgang = New CPruefgang
Set dlgHauptPruefung.m_ParentForm = Me
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
Set dlgHauptPruefung.m_colUniqueVorPP = m_colUniqueVorPP
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
dlgHauptPruefung.m_AnzahlPZ = Val(txtAnzahl.text)
dlgHauptPruefung.mbln_Vorjustage = chkVorjustage.value
dlgHauptPruefung.mbln_Hauptpruefung = chkHauptpruefung.value
dlgHauptPruefung.mbln_Vorpruefung = chkVorpruefung.value
dlgHauptPruefung.mbln_Bereichsjustage = chkBereichsjustage.value
dlgHauptPruefung.mbln_nachjustage = chkNachjustage.value
dlgHauptPruefung.mbln_ZeroFlowMessung = chkZeroflow.value
dlgHauptPruefung.mbln_Funktionspruefung = chkFunktionsprüfung.value
dlgHauptPruefung.mbln_HeissKaltSpreizungBerechnen = chkHeissKaltSpreizungBerechnen.value
dlgHauptPruefung.mbln_ZeroFlowJustage = chkZeroFlowJustage.value
If g_Abbruch Then Exit Sub
' Flags
dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
dlgHauptPruefung.m_Regelart = m_Regelart
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
dlgHauptPruefung.m_VorPruefungsArtWaage = m_VorPruefungsArtWaage
dlgHauptPruefung.m_NurMesseinsaetze = 0
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
dlgHauptPruefung.m_bKontinuierlich = chkKontinuierlich.value
Timer1.Enabled = False
blnPruefungDurchfuehren = False
If chkNachjustage.value = vbChecked Then blnPruefungDurchfuehren = True
If chkVorjustage.value = vbChecked Then blnPruefungDurchfuehren = True
If chkVorpruefung.value = vbChecked Then blnPruefungDurchfuehren = True
If chkKontinuierlich.value = vbChecked Then blnPruefungDurchfuehren = True
If chkHauptpruefung.value = vbChecked Then blnPruefungDurchfuehren = True
If chkFunktionsprüfung.value = vbChecked Then blnPruefungDurchfuehren = True
If blnPruefungDurchfuehren = True Then
frmMeldung.Show vbNormal, Me
DoEvents
frmMeldung.lblMsg.caption = "Prüfungsinitialisierung für alle eingebauten Zähler"
frmMeldung.cmdIgnore.Enabled = False
frmMeldung.cmdExit.Enabled = False
frmMeldung.Visible = True
DoEvents
Call USPruefungInitialisierung
Unload frmMeldung
DoEvents
Me.Visible = False
dlgHauptPruefung.Show vbModal
Me.Visible = True
frmMeldung.Show vbNormal, Me
DoEvents
frmMeldung.lblMsg.caption = "Prüfungsabschluß für alle eingebauten Zähler"
frmMeldung.cmdIgnore.Enabled = False
frmMeldung.cmdExit.Enabled = False
frmMeldung.Visible = True
DoEvents
Call USPruefungAbschlussAlleZaehler
Unload frmMeldung
If dlgHauptPruefung.getExitCode = IDOK Then
'MsgBox ("Die Prüfung wurde beendet.")
Call PruefungFertigmeldenDialog("Die Prüfung ist beendet.", m_colEinbauplatz)
Else
MsgBox ("Die Prüfung wurde abgebrochen.")
End If
Else
' es fand keine Prüfung statt, da alle Checkbuttons ausgeschaltet sind
End If
DoEvents
If g_App.Settings.GetAuslieferung() <> "" Then
' Auslieferungsprogramm ist in der ini angegegben
If dlgHauptPruefung.getExitCode = IDOK Or blnPruefungDurchfuehren = False Then
' Wenn die Vor bzw. Hauptprüfung erfolgreich abgeschlossen wurde
' oder gar keine Prüfung durchgeführt wurde
' dann fragen, ob die Zähler abgeschlossen werden sollen
Dim objFrmAuslieferung As frmAuslieferung
Set objFrmAuslieferung = New frmAuslieferung
Set objFrmAuslieferung.m_colEinbauplatz = m_colEinbauplatz
objFrmAuslieferung.Show vbModal, Me
' Dim lngAusliefungAuswahl As Long
' lngAusliefungAuswahl = MsgBox("Möchten Sie jetzt das Programm 'Auslieferung'" & vbCrLf & "zum Verschließen für jeden Zähler jetzt starten?", vbYesNo Or vbDefaultButton2)
' If lngAusliefungAuswahl = vbYes Then
' For Each Einbauplatz In m_colEinbauplatz
' If Not Einbauplatz.getPruefzaehler Is Nothing Then
' Me.Visible = False
' Call StarteAuslieferung(Einbauplatz.getNr)
' Me.Visible = True
' End If
' Next
' End If
End If
End If
' Zähler entfernen, damit sie erneut eingelesen werden
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
txtSerienNr(i).text = ""
imgSchloss(i).Picture = frmRes.ImgLeer.Picture
ueberpruefe (i)
Next
If Not g_ohneSPS Then
' beide Behälter Ablassventile wieder schließen
m_SPS.WassserAblassen 0
End If
' Scannen wieder einschalten, damit sie erneut eingelesen werden
Timer1.Enabled = True
End Sub
Private Function SindZaehlerAehnlich() As Boolean
' Überprüfung ab alle Zähler gleich hinsichtlich:
' - Regulierwerte (Todo: Regulierwerte müssen aus Tabelle Sollwertregulierung bestimmt werden)
' - Nennweite
' - Zählertype
' - Anzeige (m^3) wenn Automatische Regulierung nicht gescheckt
' - Sollwert Regulierung (nur wenn Automatische Regulierung gecheckt)
' Todo: wie verfahren bei Mehrfacheinträgen z.B. m^3,RS,WI Wenn m^3 dann muß überall m^3 vorhanden sein, sonst muß gleich sein
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Dim colUniquePP As New CPruefpunktCol
Dim IdentNrObj As CIdentNr
Dim AuftragPosition As CAuftragPosition
Dim vergleich As String
Dim ersterZaehler As Boolean
Dim VergleichMuster As String
ersterZaehler = True
VergleichMuster = ""
vergleich = ""
SindZaehlerAehnlich = True
' Todo
Exit Function
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
Set IdentNrObj = Pruefzaehler.getIdentNrObj()
Set AuftragPosition = Pruefzaehler.getAuftragPosition()
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
If Not Pruefzaehler.getAuftrag.getNr = 99999 Then
vergleich = "Nennweite=" & IdentNrObj.getNennweite & ";"
vergleich = vergleich & "Type=" & IdentNrObj.getTyp & IdentNrObj.getTypzusatz & ";"
vergleich = vergleich & "Anzeige=" & Mid(AuftragPosition.getAnzeige, 1, 3) & "; "
' vergleich = vergleich & "Impulswertigkeit=" & Pruefzaehler.GetImpulseQM
Else
' Test-Pruefzaehler können nur mit anderen Test-Prüfzaehlern geprueft werden
vergleich = "PRUEFZAEHLER"
End If
' Alle weiteren Zaehler werden mit dem ersten verglichen
If ersterZaehler Then
VergleichMuster = vergleich
Else
' DebugMsg "Vergleich " & Einbauplatz.getNr & ": " & vergleich & " =?= " & VergleichMuster
' unterscheidet sich ein Zähler vom ersten, sind die Zaehler nicht ähnlich !
If VergleichMuster <> vergleich Then
SindZaehlerAehnlich = False
End If
End If
End If
ersterZaehler = False
Next
End Function
Private Sub Timer1_Timer()
Dim nIndex As Integer
Dim alteFabNr As String
Dim neueFabNr As String
Dim tmpFlag As Boolean
Dim lngRet As Long
Dim alteFarbe As Long
Dim blnSchlossOffen As Boolean
Dim Einbauplatz As CEinbauplatz
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Timer1.Enabled = False
If mblnAbbruch = True Then
Call Formularbeenden
Exit Sub
End If
If m_TimerOn = False Then Exit Sub
Shape1.BackColor = Shape1.BackColor Xor 255
For nIndex = 1 To g_App.Settings.EinbauplaetzeJeStrang
Set Einbauplatz = m_colEinbauplatz(nIndex)
If mblnAbbruch = True Then
Call Formularbeenden
Exit Sub
End If
alteFarbe = txtSerienNr(nIndex).BackColor
txtSerienNr(nIndex).BackColor = &HE0E0E0 ' am Scannen
DoEvents
lblScanStat.caption = nIndex
If USPing(nIndex) = 1 Then
'lblEinbau(nIndex).Caption = "US Zähler angeschlosssen!"
' Zähler antwortet
txtSerienNr(nIndex).Enabled = True
' eingefügt am 24.07.2002 Pfeiffer
cmdSerNrAusw(nIndex).Enabled = True
DoEvents
' FabNr lesen
neueFabNr = getUSFabNr(nIndex)
lblStatus(nIndex) = "FabNr: " & neueFabNr
lblTimeout(nIndex).caption = USgetOptoOffTimer(nIndex) & " min"
If Val(neueFabNr) <> Val(Einbauplatz.getZusatz) Or txtSerienNr(nIndex) = "" Then
' neuer Zähler wurde erkannt
Screen.MousePointer = vbHourglass
lngRet = USSetOptoOffTimerMax(Einbauplatz.getNr)
' Schloss prüfen
If Not USGetSchlossOffen(nIndex, blnSchlossOffen) Then
If blnSchlossOffen Then
imgSchloss(nIndex).Picture = frmRes.ImgSchlossOff
Else
imgSchloss(nIndex).Picture = frmRes.imgSchlossGes
End If
Else
' konnte Schloss nicht prüfen
End If
' Überprüfung auf Rechenwerksnennweite
Einbauplatz.intErkannteQp = Round(USGetFlowSimu(Einbauplatz.getNr) * 3600, 0)
Debug.Print "Rechenwerksnennweite (FlowSimu) : " & Einbauplatz.intErkannteQp
Einbauplatz.setZusatz neueFabNr
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
If Val(neueFabNr) > 0 Then
' FabNr ist vorhanden
If AuftragpositionSerienNr.loadFromFabNr(CLng(neueFabNr)) Then
'AuftragPositionSNr wurde gefunden, Zähler war schon mal hier
txtSerienNr(nIndex).text = FormatSerienNr(AuftragpositionSerienNr.getNr)
' Anzeigen der Auftragsdaten
bTextChanged(nIndex) = True
Call ueberpruefe(nIndex)
DoEvents
Call updatePruefpunkte
DoEvents
alteFarbe = txtSerienNr(nIndex).BackColor
Else
'AuftragPositionSNr wurde nicht gefunden, Zähler ist noch unbekannt
txtSerienNr(nIndex).text = const_keineSNText
End If
Else
'FabNr ist nicht vorhanden
End If
Screen.MousePointer = vbNormal
Else
' Zähler ist vorhanden aber wurde bereits vorher erkannt
bTextChanged(nIndex) = False
End If
Else
EntferneZaehlerAusEinbauplatz (nIndex)
Select Case g_lastPingFehler
Case -4
' keine Antowrt
Case -1
' kein Eintrag in Ini
lblEinbau(nIndex).caption = "kein Verbindung zu COM"
Case Else
lblEinbau(nIndex).caption = "Fehler " & g_lastPingFehler
End Select
' Zähler antwortet nicht, d.h.
' Zaehler wurde ausgebaut oder nicht wieder gescannt
' Einbauplatz.setZusatz ""
' txtSerienNr(nIndex).Text = ""
' Einbauplatz.setZusatz ""
' imgSchloss(nIndex).Picture = frmRes.ImgLeer.Picture
'
' txtSerienNr(nIndex).Enabled = False
'
' ' eingefügt am 24.07.2002 Pfeiffer
' cmdSerNrAusw(nIndex).Enabled = False
' lblStatus(nIndex) = ""
'
' ueberpruefe nIndex
' alteFarbe = vbWhite
End If ' ping
txtSerienNr(nIndex).BackColor = alteFarbe
DoEvents
Next
Timer1.Enabled = m_TimerOn
End Sub
' Prüft, ob Seriennr im Texteingabefeld von interner Seriennr abweicht
' fragt nach und schreibt eingegebene Seriennr in den Zähler
Private Sub CheckWriteSerienNr(Index As Integer)
Dim neueSernr As String
Dim geleseneFabNr As String
Dim Pruefzaehler As CPruefzaehler
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Dim Einbauplatz As CEinbauplatz
Dim comport As Integer
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
geleseneFabNr = Einbauplatz.getZusatz
If TestForQnIstOK(Einbauplatz) = False Then
EntferneZaehlerAusEinbauplatz (Index)
Exit Sub
End If
If AuftragpositionSerienNr.getFabNr <> geleseneFabNr Then
If MsgBox("Möchten Sie diese Seriennr ('" & FormatSerienNr(Pruefzaehler.getSerienNr) & ") für diesen US-Zähler (FabNr: '" & geleseneFabNr & "') zukünftig verwenden?", vbYesNo, "") = vbYes Then
If Not CheckAndCreateInSpeicherabbild(Einbauplatz.getNr, geleseneFabNr) Then
MsgBox ("Speicherabbild wurde nicht gesichert.")
Exit Sub
End If
comport = Val(g_App.Settings.getUSComPort(Index))
'modIECCOM.SetLiegenschaft COMport, CLng(Pruefzaehler.getSerienNr)
'geändert Pfeiffer 10.09.2002
'modIECCOM.SetIdentNo COMport, CLng(Pruefzaehler.getSerienNr)
AuftragpositionSerienNr.setFabNr CLng(geleseneFabNr)
AuftragpositionSerienNr.save
If UpdateInDruckpruefung(CLng(geleseneFabNr), Pruefzaehler.getSerienNr) = False Then
Call MsgBox("Für diesen Zähler (FabNr=" & geleseneFabNr & ") liegen keine Ergebnisse der Druckprüfung vor!", vbCritical)
LogIntoDB "Für diesen US Zähler (FabNr=" & geleseneFabNr & ") liegen keine Ergebnisse der Druckprüfung vor!", "Druckpruefung"
End If
Else
'geändert am 30.07.02 Pfeiffer
EntferneZaehlerAusEinbauplatz (Index)
End If
End If
End Sub
Private Sub StartScan()
cmdStopScan.caption = "Stop Scan"
Timer1.Interval = 1000
Timer1.Enabled = True
Shape1.BackColor = &H80FF&
m_TimerOn = True
End Sub
Private Sub StopScan()
cmdStopScan.caption = "Start Scan"
Timer1.Enabled = False
m_TimerOn = False
Shape1.BackColor = 0
End Sub
Private Sub USPruefungAbschlussAlleZaehler()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim EinbauplatzNr As Integer
Dim comport As Integer
Dim lngReturn As Long
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
lngReturn = USPruefungsAbschluss(Einbauplatz.getNr)
If lngReturn = 0 Then
Debug.Print "Prüfungsabschluss für Einbauplatz " & EinbauplatzNr & " OK"
Else
Debug.Print "Fehler " & lngReturn & " beim Prüfungsabschluss für Einbauplatz " & EinbauplatzNr
End If
' neu RH 8.12.2009
Dim AuftragPosition As CAuftragPosition
Set AuftragPosition = Einbauplatz.getPruefzaehler.getAuftragPosition
AuftragPosition.UpdateTLMenge_P
AuftragPosition.save Einbauplatz.getPruefzaehler.getAuftrag
End If
Next
End Sub
Private Sub USPruefungInitialisierung()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim EinbauplatzNr As Integer
Dim comport As Integer
Dim lngReturn As Long
m_colUniqueVorPP.sortQ
m_colUniquePP.sortQ
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
EinbauplatzNr = Einbauplatz.getNr
Set Pruefzaehler = Einbauplatz.getPruefzaehler
lngReturn = USZaehlerPruefungInitialisierung(Einbauplatz.getNr)
If lngReturn = 0 Then
DebugMsg "Prüfungsinitialisierung(" & EinbauplatzNr & ") OK"
Else
If lngReturn = -50 Then
ErrorMsg "Schloss konnte nicht geöffnet werden am Einbauplatz " & EinbauplatzNr & "." & vbCrLf & "Schloss ist immer noch geschlossen!"
Else
ErrorMsg "Fehler " & lngReturn & " bei der Prüfungsinitialisierung, Einbauplatz " & EinbauplatzNr
End If
End If
End If
Next
End Sub
'Private Function CheckAndCreateInSpeicherabbild(ByVal EinbauplatzNr As Integer, ByVal FabNr As Long) As Boolean
'Dim rs As CRecordset
'On Error GoTo CheckAndCreateInSpeicherabbildError
'
'TryAgain:
' Set rs = New CRecordset
'
' rs.openRS "SELECT * from Speicherabbild where FabNr = " & FabNr
' If rs.EOF Then
' rs.addNew
' Call rs.setValue("FabNr", FabNr)
' Call rs.setValue("Datum", Now())
' Call rs.setValue("MemoryContent", "")
'
' If Not rs.update Then
' GoTo CheckAndCreateInSpeicherabbildError
' End If
'
' Debug.Print "Datensatz mit der FabFabNr " & FabNr & " in der Tabelle Speicherabbild erzeugt."
' Else
' Debug.Print "Datensatz mit der FabFabNr " & FabNr & " ist in der Tabelle Speicherabbild vorhanden."
' End If
' Set rs = Nothing
' CheckAndCreateInSpeicherabbild = True
' Exit Function
'
'CheckAndCreateInSpeicherabbildError:
' Debug.Print "CheckAndCreateInSpeicherabbild: " & Err.Description
' If MsgBox("FabNr '" & FabNr & "' konnte nicht in Tabelle Speicherabbild erzeugt werden. Fehler " & Err.Number & vbCrLf & Err.Description, vbRetryCancel Or vbDefaultButton1) = vbRetry Then
' Set rs = Nothing
' Resume TryAgain
' Else
' Set rs = Nothing
' Debug.Print "CheckAndCreateInSpeicherabbild abgebrochen."
' CheckAndCreateInSpeicherabbild = False
' End If
'End Function
Private Function TestForQnIstOK(Einbauplatz As CEinbauplatz) As Boolean
On Error GoTo Errorhandler
Dim Pruefzaehler As CPruefzaehler
Set Pruefzaehler = Einbauplatz.getPruefzaehler
TestForQnIstOK = False
If Einbauplatz.intErkannteQp <> 0 Then
If Pruefzaehler.getVorpruefpunkte.load(Pruefzaehler.getIdentNr, Pruefzaehler.getPruefklasseKZ) = True Then
If Einbauplatz.intErkannteQp <> Pruefzaehler.getVorpruefpunkte.getQn Then
ErrorMsg "Die im Rechenwerk programmierte Rechenwerksnennweite (FP_Flow_Simu * 3600 = " & Einbauplatz.intErkannteQp & " m³/h) stimmt nicht mit in der Datenbank hinterlegten Qn=" & Pruefzaehler.getVorpruefpunkte.getQn & " m³/h aus der Tabelle Vorprüfpunkte überein!" & vbCrLf & "Der Zähler darf so nicht justiert und geprüft werden! Überprüfen Sie FP_Flow_Simu!"
Else
Debug.Print "OK: Die Rechenwerksnennweite " & Einbauplatz.intErkannteQp & " m³/h stimmt mit Qn aus der Tabelle Vorprüfpunkte überein!"
TestForQnIstOK = True
End If
Else
ErrorMsg "Die Vorprüfpunkte konnten nicht ermittelt werden für Prüfzähler SNr=" & FormatSerienNr(Pruefzaehler.getSerienNr)
Exit Function
End If
Else
ErrorMsg "Die Rechenwerksnennweite wurde nicht ermittelt"
End If
Exit Function
Errorhandler:
End Function
Private Sub EntferneZaehlerAusEinbauplatz(Index As Integer)
Dim Einbauplatz As CEinbauplatz
Set Einbauplatz = m_colEinbauplatz(Index)
Einbauplatz.setPruefzaehler Nothing
imgSchloss(Index).Picture = frmRes.ImgLeer.Picture
lblEinbau(Index).caption = ""
lblTimeout(Index).caption = ""
txtSerienNr(Index).BackColor = vbWhite
imgZaehler(Index).Enabled = False
txtSerienNr(Index).text = ""
Einbauplatz.setZusatz ""
cmdSerNrAusw(Index).Enabled = False
lblStatus(Index) = ""
txtSerienNr(Index).Enabled = True
If txtSerienNr(Index).Enabled = True And txtSerienNr(Index).Visible = True Then
On Error Resume Next
txtSerienNr(Index).SetFocus
On Error GoTo 0
End If
txtSerienNr(Index).Enabled = False
ueberpruefe Index
End Sub
Public Function HauptprfOffsetjustage2(ByVal lngSerienNr As Long, VorpruefpunkteCol As CVorpruefpunktCol, blnUsePruefstation As Boolean) As Boolean
' Justagedaten + Prüfpunkte einer Hauptprüf aktuellen Prüfstation in Qmin, Qmax oder QBereich
Dim strSQL As String
Dim rs As CRecordset
Dim intHPPCount As Integer
Set rs = New CRecordset
strSQL = "SELECT Pruefgang.*, * FROM Prueffehler INNER JOIN Pruefgang ON Prueffehler.PruefgangNr = Pruefgang.PruefgangNr Where Prueffehler.SerienNr = " & lngSerienNr & " "
If blnUsePruefstation Then
strSQL = strSQL & " and Pruefgang.PruefstationNr = " & g_App.PruefstationNr
End If
strSQL = strSQL & " ORDER BY Prueffehler.PruefDatum DESC"
Debug.Print strSQL
rs.openRS strSQL
Do While Not rs.EOF
For intHPPCount = 1 To 10
If rs.getDoubleValue("PP" & intHPPCount & "_Soll") <> 0 Then
If VorpruefpunkteCol.hasQ(rs.getDoubleValue("PP" & intHPPCount & "_Soll")) Then
Debug.Print "Übereinst: HPF-VP Q=" & rs.getDoubleValue("PP" & intHPPCount & "_Soll")
HauptprfOffsetjustage2 = True
Exit Function
End If
End If
Next
rs.MoveNext
Loop
End Function
Public Function HauptprfOffsetjustage(ByVal lngSerienNr As Long, Vorpruefpunkte As CVorpruefpunkte, blnUsePruefstation As Boolean) As Boolean
' Justagedaten + Prüfpunkte einer Hauptprüfung an dieser aktuellen Prüfstation in Qmin, Qmax oder QBereich
Dim strSQL As String
Dim rs As CRecordset
Dim intHPPCount As Integer
Dim intVPPCount As Integer
Dim blnQminVorhanden As Boolean
Dim blnQmaxVorhanden As Boolean
Dim dtmDatum As Date
Set rs = New CRecordset
strSQL = "SELECT * from USJustagewerte where SerienNr = " & lngSerienNr
rs.openRS strSQL
If Not rs.EOF Then
dtmDatum = rs.getDateValue("DatumVorpruefung")
'1 Minute anziehen, damit der Vergleich klappt
dtmDatum = DateAdd("n", -1, dtmDatum)
If Val(dtmDatum) = 0 Then
HauptprfOffsetjustage = False
Exit Function
End If
Else
Exit Function
End If
strSQL = "SELECT Pruefgang.*, Prueffehler.* FROM Prueffehler INNER JOIN Pruefgang ON Prueffehler.PruefgangNr = Pruefgang.PruefgangNr Where Prueffehler.SerienNr = " & lngSerienNr & " and Pruefgang.Datum >= CONVERT(smalldatetime, '" & Format(dtmDatum, "yyyy-mm-dd hh:mm:00") & "', 120)"
If blnUsePruefstation Then
strSQL = strSQL & " and Pruefgang.PruefstationNr = " & g_App.PruefstationNr
End If
strSQL = strSQL & " ORDER BY Prueffehler.PruefDatum DESC"
Debug.Print strSQL
rs.openRS strSQL
If Not rs.EOF Then
Debug.Print "Hauptprüfung am " & rs.getDateValue("Datum")
For intHPPCount = 1 To 10
If rs.getDoubleValue("PP" & intHPPCount & "_Soll") <> 0 Then
Debug.Print "teste HP =" & rs.getDoubleValue("PP" & intHPPCount & "_Soll")
For intVPPCount = 3 To 1 Step -1
Debug.Print intVPPCount & "; VP: " & Vorpruefpunkte.getPruefpunkt(intVPPCount).getQ & " =?= " & CSng(rs.getDoubleValue("PP" & intHPPCount & "_Soll"))
If CSng(Vorpruefpunkte.getPruefpunkt(intVPPCount).getQ) = CSng(rs.getDoubleValue("PP" & intHPPCount & "_Soll")) And Not rs.isFieldNull("PP" & intHPPCount & "_Fehler") Then
Select Case intVPPCount
Case 1 ' Qmax
Debug.Print "Qmax übereinstimmung"
blnQmaxVorhanden = True
Case 2 ' QBereich
Debug.Print "Qbereich übereinstimmung"
Case 3 ' Q min
Debug.Print "Qmin übereinstimmung"
blnQminVorhanden = True
End Select
End If
Next
End If
Next
Else
End If
If blnQmaxVorhanden And blnQminVorhanden Then
HauptprfOffsetjustage = True
Else
HauptprfOffsetjustage = False
End If
End Function
Sub AlleEinbauplaetzeDesGleichenAuftragesAktualisieren(Index As Integer)
Dim AuftragNr As Long
Dim PositionNr As Long
Dim PruefzaehlerAktuell As CPruefzaehler
Dim PruefzaehlerVergleich As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set PruefzaehlerAktuell = m_colEinbauplatz(Index).getPruefzaehler
AuftragNr = PruefzaehlerAktuell.getAuftrag.getNr
PositionNr = PruefzaehlerAktuell.getAuftragPosition.getNr
For Each Einbauplatz In m_colEinbauplatz
Set PruefzaehlerVergleich = Einbauplatz.getPruefzaehler
If Not PruefzaehlerVergleich Is Nothing Then
If PruefzaehlerAktuell.getAuftrag.getNr = PruefzaehlerVergleich.getAuftrag.getNr And PruefzaehlerAktuell.getAuftragPosition.getNr = PruefzaehlerVergleich.getAuftragPosition.getNr Then
bTextChanged(Einbauplatz.getNr) = True
Debug.Print "gleiche AuftragNr/PosNr in Einbauplatz " & Einbauplatz.getNr
Call updateEinbauplatz(Einbauplatz.getNr)
Call ueberpruefe(Einbauplatz.getNr)
End If
End If
Next
End Sub
Private Sub Show50GradFehlerBeiQmin(Index As Integer)
On Error GoTo Errorhandler
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim rs As CRecordset
Dim i As Integer
Dim Fehler As Double
Dim Vorpruefpunkte As CVorpruefpunkte
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Pruefzaehler Is Nothing Then
lblFehler50(Index).Visible = False
Else
Set Vorpruefpunkte = Pruefzaehler.getVorpruefpunkte
If Vorpruefpunkte Is Nothing Then
lblFehler50(Index).Visible = False
Else
If Vorpruefpunkte.LadeHeissesQMin(Pruefzaehler.getSerienNr, Pruefzaehler.getPruefpunkte.getPruefpunkt(Pruefzaehler.getPruefpunkte.getPruefpunkteCount).getQ, Fehler) Then
lblFehler50(Index).Visible = True
lblFehler50(Index).caption = Format(Fehler, "0.00")
' RH 12.08.2004 von 30% auf 10% heruntergesetzt
If Abs(Fehler) > 10 Then
lblFehler50(Index).BackColor = RGB(255, 160, 160) ' rot
lblFehler50(Index).ToolTipText = "Fehler bei Qmin 50°C an der P20 übersteigt 10%"
Else
lblFehler50(Index).BackColor = RGB(160, 255, 160) ' grün
lblFehler50(Index).ToolTipText = "Fehler bei Qmin 50°C an der P20"
End If
Else
lblFehler50(Index).caption = ""
lblFehler50(Index).BackColor = vbWhite
End If
End If
End If
Exit Sub
Errorhandler:
WriteToLog "Fehler " & Err.Number & " in Show50GradFehlerBeiQmin: " & Err.Description
End Sub
Private Sub StarteAuslieferung(EinbauplatzNr As Integer, Optional blnNacheinander As Boolean = True)
On Error GoTo Errorhandler
Dim strCOM As String
Dim strKommando As String
Dim lngHandle As Long
Dim blnTimer As Boolean
blnTimer = Timer1.Enabled
Timer1.Enabled = False
DoEvents
strCOM = CStr(Val(g_App.Settings.getUSComPort(EinbauplatzNr)))
strKommando = g_App.Settings.GetAuslieferung()
If strKommando <> "" Then
ExecuteAndWait strKommando, "/COM " & strCOM & " /EBP " & EinbauplatzNr & " /END", Me.hwnd, , blnNacheinander
End If
Timer1.Enabled = blnTimer
Exit Sub
Errorhandler:
ErrorMsg "Fehler " & Err.Number & " in StarteAuslieferung(): " & Err.Description
Timer1.Enabled = blnTimer
End Sub
Reference in New Issue View Git Blame Copy Permalink