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

6338 lines
218 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Begin VB.Form frmPruefzaehlerPruefung
BackColor = &H8000000B&
BorderStyle = 0 'Kein
Caption = "Pruef2000"
ClientHeight = 12105
ClientLeft = 105
ClientTop = 105
ClientWidth = 13680
HelpContextID = 1
Icon = "PruefzaehlerPruefung.frx":0000
LinkTopic = "Form1"
Moveable = 0 'False
ScaleHeight = 12105
ScaleWidth = 13680
StartUpPosition = 1 'Fenstermitte
Begin VB.Frame frMain
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 11865
Left = -15
TabIndex = 20
Top = 60
Width = 13485
Begin VB.CommandButton cmdSchotteinstellungen
Caption = "Schott Einstellungen ..."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 10440
TabIndex = 163
Top = 300
Width = 2895
End
Begin VB.CommandButton cmdDurchflussAnzeigen
Caption = "Durchfluss anzeigen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 7875
TabIndex = 158
Top = 10695
Width = 1410
End
Begin VB.CheckBox chkOptionen
Caption = "Optionen anzeigen"
Height = 240
Left = 6195
TabIndex = 157
Top = 2835
Width = 3225
End
Begin VB.CommandButton cmdPruefpunkte
Caption = "Pr<50>fpunktkontrolle"
Height = 465
Left = 1620
TabIndex = 155
Top = 10350
Width = 945
End
Begin VB.CommandButton cmdCLR
Caption = "CLR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3090
TabIndex = 147
ToolTipText = "L<>scht alle Seriennummern aus den Eingabefeldern. "
Top = 10680
Width = 855
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 285
Left = 1650
TabIndex = 143
Top = 11400
Width = 11595
_ExtentX = 20452
_ExtentY = 503
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.Frame Frame7
Caption = "Impulswertigkeiten"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3000
Left = 6165
TabIndex = 136
Top = 7680
Width = 4125
Begin VB.CheckBox xbGenesis
Caption = "Genesis"
Height = 255
Left = 240
TabIndex = 166
Top = 2640
Value = 1 'Aktiviert
Width = 1335
End
Begin VB.CheckBox chkER56
Caption = "LWL && ER56"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 165
ToolTipText = "wenn aktiviert, werden PP2 und PP3 immer mit LWL gepr<70>ft"
Top = 1380
Width = 1515
End
Begin VB.CheckBox chkeRegisterPruefung
Caption = "eRegister Prf."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 162
ToolTipText = "Z<>hlwerke sind eRegsiter"
Top = 2160
Width = 1815
End
Begin VB.CheckBox chk_eReg_alle_PP
Caption = "LED Abgriff f. alle Pr<50>fpunkte"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2100
TabIndex = 161
ToolTipText = "Auszuw<75>hlen, wenn LWL Abgriff nicht m<>glich ist. Alle Pr<50>fpunkte werden per LED gemessen."
Top = 2100
Width = 1815
End
Begin VB.ComboBox cmbImpulswertigkeitPZ
Height = 315
Left = 690
TabIndex = 159
Top = 900
Visible = 0 'False
Width = 3315
End
Begin VB.CommandButton cmdLWLHelp
Caption = "?"
Height = 315
Left = 2160
TabIndex = 152
Top = 570
Width = 225
End
Begin VB.CheckBox chk_LWL_Encoder
Caption = "LWL Pr<50>fung f.a. Pr<50>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 = 375
Left = 180
TabIndex = 148
ToolTipText = "Bei dieser Option wird bei allen Durchfl<66>ssen das Relais auf den LWL Eingang geschaltet."
Top = 1680
Width = 3285
End
Begin VB.TextBox txtImpulswertigkeitPZ
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2400
TabIndex = 140
ToolTipText = "Eingabefeld f<>r die Impulswertigkeit f<>r Opto f<>r alle Einbaupl<70>tze"
Top = 1320
Width = 1005
End
Begin VB.CheckBox chkEinbauplatzImpulswertigkeit
Caption = "pro Einbauplatz individuell definieren"
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 = 150
TabIndex = 139
ToolTipText = "In einem neuen Fenster k<>nnen die Impulswertigkeiten f<>r Opto und LWL f<>r jeden Einbauplatz individuell gepfelgt werden."
Top = 270
Width = 3735
End
Begin VB.CheckBox chkFiberoptic
Caption = "Lichtwellenleiter"
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
Left = 150
TabIndex = 138
ToolTipText = "Wenn diese Option eingeschaltet ist, werden Pr<50>fpunkte mit 20 oder weniger Impulsen mit LWL gepr<70>ft."
Top = 540
Width = 2085
End
Begin VB.TextBox txtImpulswertigkeitLwl
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2400
TabIndex = 137
ToolTipText = "Eingabefeld f<>r die Impulswertigkeit f<>r LWL f<>r alle Einbaupl<70>tze"
Top = 540
Width = 1005
End
Begin VB.Label lblTXT_NZ
Alignment = 1 'Rechts
Caption = "NZ"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 150
TabIndex = 160
Top = 990
Width = 375
End
Begin VB.Label lblOpto
Alignment = 1 'Rechts
Caption = "Opto"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1830
TabIndex = 145
Top = 1380
Width = 525
End
Begin VB.Label Label6
Caption = "Imp/m<>"
Height = 255
Left = 3450
TabIndex = 142
Top = 600
Width = 525
End
Begin VB.Label Label7
Caption = "Imp/m<>"
Height = 255
Left = 3480
TabIndex = 141
Top = 1410
Width = 495
End
End
Begin VB.Frame frameDoppelimpulssperre
Height = 1125
Left = 10380
TabIndex = 120
Top = 8340
Width = 2715
Begin VB.CheckBox chkGanzeUmrundung
Caption = "ganze Fl<46>gelumrundung LWL"
Height = 345
Left = 90
TabIndex = 144
ToolTipText = "Ist diese Option gew<65>hlt, wird die Impulsanzahl des LWL auf ganze Palettenanzahl aufgerundet"
Top = 600
Width = 2505
End
Begin VB.TextBox txtDoppelimpulssperrzahl
Alignment = 1 'Rechts
Enabled = 0 'False
Height = 285
Left = 1800
MaxLength = 2
TabIndex = 123
Top = 210
Width = 465
End
Begin VB.Label Label5
Caption = "%"
Height = 285
Left = 2430
TabIndex = 122
Top = 210
Width = 195
End
Begin VB.Label Label4
Caption = "Doppelimpulssperre:"
Height = 285
Left = 180
TabIndex = 121
Top = 210
Width = 1485
End
End
Begin VB.CommandButton cmdAktualisiere
Caption = "Fertigungsstatus aktualisieren"
Height = 435
Left = 210
TabIndex = 119
Top = 10920
Width = 1335
End
Begin VB.CommandButton cmdFertigmeldenMAV
Caption = "nachtr<74>glich fertigmelden"
Height = 495
Left = 210
TabIndex = 117
Top = 10350
Width = 1335
End
Begin VB.CommandButton cmdNeuerPruefer
Caption = "Pr<50>fer <20>ndern"
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 = 4080
TabIndex = 116
Top = 10680
Width = 1815
End
Begin VB.Frame frmPruefprotokollDrucken
Caption = "Pr<50>fprotokoll"
Height = 735
Left = 10350
TabIndex = 103
Top = 9480
Width = 2745
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 = 195
TabIndex = 104
ToolTipText = "Aktivieren Sie diese Checkbox, um nach der Pr<50>fung ein Protokoll zu drucken."
Top = 240
Width = 2265
End
End
Begin VB.Frame FrpruefPunkte
Caption = "Pr<50>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 = 5055
Left = 10380
TabIndex = 36
Top = 1410
Width = 2985
Begin VB.CheckBox chkPPunsortiert
Caption = "Pr<50>fpunkt-Reihenfolge frei w<>hlbar"
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
Left = 120
TabIndex = 151
ToolTipText = "Ist diese Option gesetzt, kann die Reihenfolge der Durchfl<66>sse ge<67>ndert werden."
Top = 3030
Width = 2775
End
Begin VB.CommandButton cmdPP_Down
Caption = ">>"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 150
ToolTipText = "Pr<50>fpunkt zeitlich zum Ende verschieben"
Top = 2160
Width = 405
End
Begin VB.CommandButton cmdPP_Up
Caption = "<<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2160
TabIndex = 149
ToolTipText = "Pr<50>fpunkt zeitlich zum Anfang verschieben"
Top = 1695
Width = 405
End
Begin VB.CommandButton cmdPPUebernehmen
Caption = "Pr<50>fpunkte der letzen Pr<50>fung <20>bernehmen"
Height = 435
Left = 240
TabIndex = 124
Top = 3660
Width = 2025
End
Begin VB.ComboBox cmbPruefpunkte
Height = 315
Left = 555
Style = 2 'Dropdown-Liste
TabIndex = 60
Top = 4530
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 = 1500
Left = 210
TabIndex = 37
Top = 1440
Width = 1695
End
Begin VB.Label lblRegulierPP
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Regulier-Pr<50>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 = 540
TabIndex = 59
Top = 4230
Width = 1665
End
Begin VB.Label lblMaxPP
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Max. Pr<50>fpunkte]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 300
TabIndex = 41
Top = 540
Width = 2115
End
Begin VB.Label lblMaxPPInfo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Max. Pr<50>fpunkte:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 40
Top = 300
Width = 1455
End
Begin VB.Label lblUniquePP
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Anz. Pr<50>fpunkte]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 300
TabIndex = 39
Top = 1080
Width = 2115
End
Begin VB.Label lblUniquePPInfo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Eindeutige Pr<50>fpunkte:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 38
Top = 840
Width = 1995
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 1
Left = 570
TabIndex = 31
Top = 150
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 1
Left = 2520
TabIndex = 105
Top = 810
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 1
Left = 1950
TabIndex = 1
Top = 810
Width = 525
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 = 480
Index = 1
Left = 210
TabIndex = 0
Top = 570
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 1
Left = 3540
TabIndex = 126
ToolTipText = "Voreinstellwert"
Top = 750
Width = 465
End
Begin VB.Label lblStatus
Caption = "keine Wdh erf."
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 1
Left = 2010
TabIndex = 63
Top = 570
Width = 1485
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz1234abcdefghijklm"
Height = 345
Index = 1
Left = 150
TabIndex = 32
Top = 210
Width = 4305
WordWrap = -1 'True
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 1
Left = 4020
Top = 600
Width = 480
End
End
Begin VB.Timer timer_eRegister
Enabled = 0 'False
Left = 10020
Top = 2760
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Zur<75>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 = 9390
TabIndex = 71
Top = 10680
Width = 1845
End
Begin VB.CommandButton cmdSPSInfo
Caption = "Schaubild"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6000
TabIndex = 70
Top = 10680
Width = 1755
End
Begin VB.Frame Frame4
Caption = "Pr<50>fgang Nr"
Height = 765
Left = 10380
TabIndex = 61
Top = 7590
Width = 2715
Begin VB.Label lblPruefgangNr
BorderStyle = 1 'Fest Einfach
Height = 285
Left = 960
TabIndex = 62
Top = 270
Width = 1635
End
End
Begin VB.Frame FrameRegulierung
Caption = "Regulierung"
Height = 1485
Left = 6180
TabIndex = 51
Top = 1320
Width = 4095
Begin VB.CommandButton cmdRegulierungsformular
Caption = "*"
Height = 195
Left = 1380
TabIndex = 156
Top = 120
Width = 195
End
Begin VB.CheckBox chkQtRegulierung
Caption = "LWL Regulierung in Qt (MS Plus)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 154
Top = 1140
Width = 3825
End
Begin VB.CheckBox chkRegulierungDurchfuehren
Caption = "Regulierung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 99
Top = 300
Value = 1 'Aktiviert
Width = 3495
End
Begin VB.CommandButton cmdVorgaben
Caption = "Daten..."
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 750
TabIndex = 53
Top = 810
Width = 2025
End
Begin VB.CheckBox chkRegulierung
Caption = "automatische Regulierung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 52
Top = 540
Visible = 0 'False
Width = 3135
End
End
Begin VB.Frame frameOptionen
Caption = "Optionen"
Height = 4485
Left = 6180
TabIndex = 47
Top = 3120
Visible = 0 'False
Width = 4110
Begin VB.CheckBox chkAnzeigeKundeneigeneSerienNr
Caption = "Knd. eig. SerNr anzeigen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 300
TabIndex = 164
Top = 3660
Width = 3495
End
Begin VB.CheckBox chkNachpruefung
Caption = "Nachpr<70>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 = 2370
TabIndex = 153
ToolTipText = "Bei einer Nachpr<70>fung werden <20>berschreitung der Fehlergrenzen NICHT rot angezeigt."
Top = 840
Value = 1 'Aktiviert
Width = 1635
End
Begin VB.CommandButton cmdRZFehleranzeigen
Caption = "RZ Fehler anzeigen"
Height = 525
Left = 2715
TabIndex = 146
Top = 270
Width = 1125
End
Begin VB.CheckBox chkZulassung
Caption = "Zulassungspr<70>fung PTB/DKD"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 300
TabIndex = 125
Top = 3300
Width = 3585
End
Begin VB.CheckBox chkVersuch
Caption = "Versuch-Pr<50>fung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 300
TabIndex = 118
Top = 2940
Visible = 0 'False
Width = 2175
End
Begin VB.CheckBox chkMesseins<6E>tzeMerken
Caption = "WZ als ME pr<70>fen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 2100
TabIndex = 115
ToolTipText = "Me<4D>eins<6E>tze"
Top = 1470
Width = 2625
End
Begin VB.CheckBox chkKontinuierlichePrf
Caption = "nur Kontinuierliche Pr<50>fung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 300
TabIndex = 101
Top = 2340
Width = 3255
End
Begin VB.CheckBox chkRueckwaertsprf
Caption = "R<>ckw<6B>rtspr<70>fung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 300
TabIndex = 100
Top = 1980
Width = 2415
End
Begin VB.CheckBox chkRegulierungVerwenden
Caption = "Reguliervorgabe = Fehlerwert"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 300
TabIndex = 69
Top = 1590
Width = 3435
End
Begin VB.OptionButton OptPrfArt
Caption = "Referenzz<7A>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 = 2790
TabIndex = 57
Top = 3930
Width = 1245
End
Begin VB.OptionButton OptPrfArt
Caption = "Waage"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 1620
TabIndex = 56
Top = 3960
Width = 1095
End
Begin VB.TextBox txtAnzahlDauerPrf
Enabled = 0 'False
Height = 315
Left = 1470
TabIndex = 54
Text = "1"
Top = 600
Width = 495
End
Begin VB.CheckBox chkNurMesseinsaetze
Caption = "Nur Me<4D>eins<6E>tze"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 300
TabIndex = 50
ToolTipText = "Me<4D>eins<6E>tze"
Top = 1260
Width = 2235
End
Begin VB.CheckBox chkDauerpruefung
Caption = "Dauerpr<70>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 = 330
TabIndex = 49
ToolTipText = "Die komplette Pr<50>fung wird mehrmals wiederholt"
Top = 240
Width = 1995
End
Begin VB.CheckBox chkPruefgangLang
Caption = "Pr<50>fgang Lang"
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 300
TabIndex = 48
ToolTipText = "Qmin wird 2-3 mal gepr<70>ft und ein Mittelwert ohne Ausreisser wird berechnet. "
Top = 870
Width = 1995
End
Begin VB.CheckBox chkEichpruefvorgabenIgnorieren
Caption = "Eichpruefvorgaben ignorieren"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 300
TabIndex = 102
Top = 2730
Width = 3615
End
Begin VB.Label lblPrfArt
Caption = "Pr<50>fung mit:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 150
TabIndex = 58
Top = 4020
Width = 1335
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 = 630
TabIndex = 55
Top = 630
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "Regelart kommt raus"
Height = 1005
Left = 10380
TabIndex = 44
Top = 6540
Visible = 0 'False
Width = 2715
Begin VB.OptionButton OptRegelart
Caption = "Servo"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 240
TabIndex = 46
Top = 570
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 = 45
Top = 210
Width = 2355
End
End
Begin VB.Frame FrPruefer
Caption = "Pr<50>fer:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 10380
TabIndex = 42
Top = 660
Width = 2985
Begin VB.Label lblPruefer
BackColor = &H00000000&
BackStyle = 0 'Transparent
Caption = "[Mitarbeiter Name]"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 43
Top = 360
Width = 2115
End
End
Begin VB.Frame frmScanner
Caption = "Scanner Eingabe"
Height = 825
Left = 6180
TabIndex = 33
Top = 450
Width = 1875
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 = 34
Top = 270
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 = 35
Top = 240
Width = 1575
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 2
Left = 570
TabIndex = 29
Top = 1140
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 2
Left = 2520
TabIndex = 106
Top = 810
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 2
Left = 1950
TabIndex = 3
Top = 780
Width = 525
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 = 180
TabIndex = 2
Top = 570
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 2
Left = 3570
TabIndex = 127
ToolTipText = "Voreinstellwert"
Top = 810
Width = 435
End
Begin VB.Label lblStatus
Caption = "Status"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 2
Left = 1950
TabIndex = 64
Top = 570
Width = 1995
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 2
Left = 4020
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
ForeColor = &H00000000&
Height = 285
Index = 2
Left = 180
TabIndex = 30
Top = 210
Width = 4275
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 3
Left = 570
TabIndex = 27
Top = 2130
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 3
Left = 2490
TabIndex = 107
Top = 810
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 3
Left = 1950
TabIndex = 5
Top = 810
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 3
Left = 240
TabIndex = 4
Top = 600
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 3
Left = 3540
TabIndex = 128
ToolTipText = "Voreinstellwert"
Top = 780
Width = 435
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 = 225
Index = 3
Left = 1980
TabIndex = 65
Top = 570
Width = 1905
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 3
Left = 4020
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 255
Index = 3
Left = 240
TabIndex = 28
Top = 240
Width = 4215
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 4
Left = 570
TabIndex = 25
Top = 3120
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 4
Left = 2520
TabIndex = 108
Top = 780
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 4
Left = 1980
TabIndex = 7
Top = 780
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 4
Left = 240
TabIndex = 6
Top = 600
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 4
Left = 3570
TabIndex = 129
ToolTipText = "Voreinstellwert"
Top = 750
Width = 435
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 4
Left = 1980
TabIndex = 66
Top = 600
Width = 1965
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 4
Left = 4020
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 4
Left = 240
TabIndex = 26
Top = 240
Width = 4215
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 5
Left = 570
TabIndex = 23
Top = 4110
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 5
Left = 2520
TabIndex = 109
Top = 810
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 5
Left = 1980
TabIndex = 9
Top = 810
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 5
Left = 240
TabIndex = 8
Top = 660
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 5
Left = 3570
TabIndex = 130
ToolTipText = "Voreinstellwert"
Top = 780
Width = 435
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 = 1980
TabIndex = 67
Top = 600
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 5
Left = 4050
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 375
Index = 5
Left = 120
TabIndex = 24
Top = 210
Width = 4335
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 6
Left = 570
TabIndex = 21
Top = 5100
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 6
Left = 2490
TabIndex = 110
Top = 780
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 6
Left = 1950
TabIndex = 11
Top = 780
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 6
Left = 240
TabIndex = 10
Top = 600
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 6
Left = 3600
TabIndex = 131
ToolTipText = "Voreinstellwert"
Top = 720
Width = 435
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 6
Left = 210
TabIndex = 22
Top = 240
Width = 4215
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 = 405
Index = 6
Left = 1980
TabIndex = 68
Top = 570
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 6
Left = 4050
Top = 600
Width = 480
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 7
Left = 570
TabIndex = 74
Top = 6090
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 7
Left = 2490
TabIndex = 111
Top = 780
Width = 1005
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 7
Left = 1950
TabIndex = 13
Top = 780
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 7
Left = 240
TabIndex = 12
Top = 600
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 7
Left = 3600
TabIndex = 132
ToolTipText = "Voreinstellwert"
Top = 780
Width = 435
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 = 7
Left = 1980
TabIndex = 76
Top = 540
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 7
Left = 4050
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 7
Left = 240
TabIndex = 75
Top = 210
Width = 4215
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1155
Index = 8
Left = 570
TabIndex = 77
Top = 7080
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 8
Left = 2520
TabIndex = 112
Top = 840
Width = 1005
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 8
Left = 240
TabIndex = 14
Top = 660
Width = 1695
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 8
Left = 1950
TabIndex = 15
Top = 840
Width = 525
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 8
Left = 3570
TabIndex = 133
ToolTipText = "Voreinstellwert"
Top = 810
Width = 435
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 375
Index = 8
Left = 240
TabIndex = 79
Top = 210
Width = 4155
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 8
Left = 4050
Top = 630
Width = 480
End
Begin VB.Label lblStatus
Caption = "Status:"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 8
Left = 1980
TabIndex = 78
Top = 630
Width = 1455
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 9
Left = 570
TabIndex = 80
Top = 8130
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 9
Left = 2550
TabIndex = 113
Top = 780
Width = 945
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 9
Left = 1980
TabIndex = 17
Top = 780
Width = 525
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 9
Left = 240
TabIndex = 16
Top = 600
Width = 1695
End
Begin VB.Label lblVoreinstellwert
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 9
Left = 3570
TabIndex = 134
ToolTipText = "Voreinstellwert"
Top = 750
Width = 435
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 = 82
Top = 570
Width = 1455
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 9
Left = 4050
Top = 600
Width = 480
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 9
Left = 270
TabIndex = 81
Top = 180
Width = 4155
End
End
Begin VB.Frame frEinbau
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1125
Index = 10
Left = 570
TabIndex = 93
Top = 9150
Width = 4605
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "R<>ckl<6B>ufer"
Height = 225
Index = 10
Left = 2550
TabIndex = 114
Top = 780
Width = 1005
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Index = 10
Left = 240
TabIndex = 18
Top = 600
Width = 1725
End
Begin VB.CommandButton cmdSerNrAusw
Caption = "Snr."
Height = 225
Index = 10
Left = 2010
TabIndex = 19
Top = 780
Width = 525
End
Begin VB.Label lblVoreinstellwert
BorderStyle = 1 'Fest Einfach
Caption = "+0.5"
Height = 255
Index = 10
Left = 3600
TabIndex = 135
ToolTipText = "Voreinstellwert"
Top = 780
Width = 435
End
Begin VB.Image imgInfo
Appearance = 0 '2D
Height = 480
Index = 10
Left = 4050
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 = 435
Index = 10
Left = 2010
TabIndex = 94
Top = 570
Width = 1455
End
Begin VB.Label lblEinbau
Caption = "1234abcdefghijklmnopqrstuvwxyz"
Height = 285
Index = 10
Left = 240
TabIndex = 95
Top = 210
Width = 4215
End
End
Begin VB.Frame Frame5
Caption = "Servo/FU Voreinstellwert"
Height = 825
Left = 8190
TabIndex = 96
Top = 450
Visible = 0 'False
Width = 2085
Begin VB.ComboBox cmbAnzahlZaehler
Height = 315
Left = 1080
Style = 2 'Dropdown-Liste
TabIndex = 97
Top = 300
Width = 615
End
Begin VB.Label Label2
Caption = "Anzahl der Pr<50>fz<66>hler"
Height = 495
Left = 120
TabIndex = 98
Top = 270
Width = 915
End
End
Begin VB.CommandButton cmdOK
Caption = "Pr<50>fung starten"
DownPicture = "PruefzaehlerPruefung.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 = 11340
TabIndex = 72
Top = 10680
Width = 1875
End
Begin VB.Image imgZaehler
Height = 630
Index = 10
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 9450
Width = 615
End
Begin VB.Label lblEbpNr
Caption = "10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 10
Left = 30
TabIndex = 92
Top = 9660
Width = 555
End
Begin VB.Label lblEbpNr
Caption = "9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 9
Left = 90
TabIndex = 91
Top = 8700
Width = 405
End
Begin VB.Label lblEbpNr
Caption = "8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 8
Left = 90
TabIndex = 90
Top = 7710
Width = 405
End
Begin VB.Label lblEbpNr
Caption = "7"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 7
Left = 90
TabIndex = 89
Top = 6690
Width = 405
End
Begin VB.Label lblEbpNr
Caption = "6"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 6
Left = 120
TabIndex = 88
Top = 5670
Width = 375
End
Begin VB.Label lblEbpNr
Caption = "5"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 5
Left = 90
TabIndex = 87
Top = 4710
Width = 405
End
Begin VB.Label lblEbpNr
Caption = "4"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 4
Left = 90
TabIndex = 86
Top = 3690
Width = 405
End
Begin VB.Label lblEbpNr
Caption = "3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 3
Left = 120
TabIndex = 85
Top = 2670
Width = 375
End
Begin VB.Label lblEbpNr
Caption = "2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 2
Left = 90
TabIndex = 84
Top = 1710
Width = 375
End
Begin VB.Label lblEbpNr
Caption = "1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Index = 1
Left = 120
TabIndex = 83
Top = 720
Width = 405
End
Begin VB.Image imgZaehler
Height = 630
Index = 9
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 8430
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 8
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 7410
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 7
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 6390
Width = 615
End
Begin VB.Label lblTitle
Caption = "Pr<50>fvorbereitung"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 6210
TabIndex = 73
Top = 180
Width = 7215
End
Begin VB.Image imgZaehler
Height = 630
Index = 1
Left = 5400
MousePointer = 99 'Benutzerdefiniert
Top = 450
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 2
Left = 5400
MousePointer = 99 'Benutzerdefiniert
Top = 1470
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 3
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 2430
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 4
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 3420
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 5
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 4410
Width = 615
End
Begin VB.Image imgZaehler
Height = 630
Index = 6
Left = 5370
MousePointer = 99 'Benutzerdefiniert
Top = 5370
Width = 615
End
End
End
Attribute VB_Name = "frmPruefzaehlerPruefung"
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<50>fz<66>hlerpr<70>fung
'
'==============================================================================
'
' History:
'
' Date : 24.03.1999
' Version: 1.00
' Author : Reinhard Henning, Andreas Schmidt, lindner&partner
'
' Erste dokumentierte Version.
'
'==============================================================================
Option Explicit
' Private Variablen
' -----------------
Private m_nRet As Integer
Private m_bInputChanged As Boolean
Private m_bBlink As Boolean
Private m_sOldInput As String
Private m_colEinbauplatz As Collection
Private m_colUniquePP As CPruefpunktCol
Private m_Regulierdaten As CRegulierdaten
Private m_nEinbauplatz As Integer
Private m_nSeriennummer As Long
Private m_Regelart As String
Private m_PruefungsArtWaage As Boolean
Private m_bDauerpruefung As Boolean
Private m_bPruefgangLang As Boolean
' neu eingef<65>gt am 02.08.02 Pfeiffer
Private m_Zaehlerart As String
Private m_Pruefgang As CPruefgang
Private m_ersterEingebauterPruefzaehler As CPruefzaehler
Private m_ersterEingebauterPruefzaehlerDerLetztenPruefung As CPruefzaehler
Public m_SPS As CSPS
Dim bTextChanged(10) As Boolean
Dim bBlinkend(10) As Boolean
Private Sub chk_eReg_alle_PP_Click()
If chkeRegisterPruefung.value = vbUnchecked Then Exit Sub
If chk_eReg_alle_PP.value = vbChecked Then
If chkQtRegulierung.value = vbUnchecked Then
chkFiberoptic.value = vbUnchecked
End If
If chkeRegisterPruefung.value = vbChecked Then
txtImpulswertigkeitPZ.Enabled = False
'txtImpulswertigkeitPZ.text = ""
lblOpto.Enabled = False
End If
Else
chkFiberoptic.value = vbChecked
chk_LWL_Encoder.value = vbChecked
End If
End Sub
Private Sub chk_LWL_Encoder_Click()
WriteToLog "Option 'LWL Encoder f.a. Pr<50>fpunkte' wurde auf '" & chk_LWL_Encoder.value & "' gesetzt."
If chk_LWL_Encoder.value = vbChecked Then
' LWL Encoder f<>r alle Pr<50>fpunkte ist ausgew<65>hlt
' damit automatisch LWL anw<6E>hlen
chkFiberoptic.value = vbChecked
If Not chkEinbauplatzImpulswertigkeit.value = vbChecked Then
' nur wenn keine individuelle Impulswertigkeit festgelegt ist, dann Eingabefeld f<>r alle LWL Impulswerttigkeiten enablen
txtImpulswertigkeitLwl.Enabled = True
End If
' Opto Impuslwertigkeit disablen
lblOpto.Enabled = False
txtImpulswertigkeitPZ.Enabled = False
' entweder alle Pr<50>fpunkte oder nur die beiden letzten
chkER56.value = vbUnchecked
g_blnLWLfuerallePruefpunkte = True
Else
g_blnLWLfuerallePruefpunkte = False
' Opto Impuslwertigkeit enablen
If Not chkEinbauplatzImpulswertigkeit.value = vbChecked Then
' nur wenn keine individuelle Impulswertigkeit festgelegt ist, dann Eingabefeld f<>r alle LWL Impulswerttigkeiten enablen
lblOpto.Enabled = True
txtImpulswertigkeitPZ.Enabled = True
End If
End If
End Sub
Private Sub chkAnzeigeKundeneigeneSerienNr_Click()
On Error GoTo Errorhandler
Dim i As Integer
If chkAnzeigeKundeneigeneSerienNr.value = vbChecked Then
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
Call AnzeigeKundeneigeneSerienNr(i)
Next i
Else
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
lblEinbau(i).FontSize = 8
lblEinbau(i).ForeColor = vbBlack
lblEinbau(i).FontBold = False
updateEinbauplatz (i)
Next i
End If
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in frmPruefzaehlerPruefung.chkAnzeigeKundeneigeneSerienNr:" & Err.Description, "Softwarefehler"
End Sub
Private Sub AnzeigeKundeneigeneSerienNr(i As Integer)
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim rs_eRegister As CRecordset
lblEinbau(i).FontSize = 14
lblEinbau(i).ForeColor = &HC00000
lblEinbau(i).FontBold = True
Set Einbauplatz = m_colEinbauplatz.Item(i)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
lblEinbau(i).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
If chkeRegisterPruefung.value = vbChecked Then
If Get_eRegister_Recordset(Pruefzaehler.getSerienNr, rs_eRegister) Then
lblEinbau(i).caption = lblEinbau(i).caption & " " & rs_eRegister.getStringValue("Adresse")
End If
End If
End If
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in chkAnzeigeKundeneigeneSerienNr:" & Err.Description, "Softwarefehler"
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 chkEinbauplatzImpulswertigkeit_Click()
WriteToLog "Option 'pro Einbauplatz individuell definieren' wurde auf '" & chkEinbauplatzImpulswertigkeit.value & "' gesetzt."
If chkEinbauplatzImpulswertigkeit.value = vbChecked Then
txtImpulswertigkeitPZ.Enabled = False
txtImpulswertigkeitLwl.Enabled = False
lblOpto.Enabled = False
Dim objForm As frmImpulswertigkeitEinbauplatz
Set objForm = New frmImpulswertigkeitEinbauplatz
Set objForm.m_colEinbauplatz = m_colEinbauplatz
objForm.Show vbModal
Else
lblOpto.Enabled = True
txtImpulswertigkeitPZ.Enabled = True
If chkFiberoptic.value = vbChecked Then
txtImpulswertigkeitLwl.Enabled = True
End If
End If
End Sub
Private Sub chkER56_Click()
If chkER56.value = vbChecked Then
chkFiberoptic.value = vbChecked
chk_LWL_Encoder.value = vbUnchecked
g_blnPrfMitER56 = True
Else
g_blnPrfMitER56 = False
End If
End Sub
Private Sub chkeRegisterPruefung_Click()
If chkeRegisterPruefung.value = vbChecked Then
' eRegister Pr<50>fung
g_blneRegisterPruefung = True
Call Ausblenden_Wenn_eRegistrer
' erst mal keine automastische Regulierung
' chkRegulierungDurchfuehren.value = vbUnchecked
' LWL statt Opto
chkFiberoptic.value = vbChecked
chk_LWL_Encoder.value = vbChecked
chk_eReg_alle_PP.Enabled = True
cmdRegulierungsformular.Visible = False
'chkFiberoptic.Enabled = False
'chk_LWL_Encoder.Enabled = False
chkRegulierungDurchfuehren.caption = "eRegister Regulierung"
'neu 2016-07-21 Arno: kein Regulierung bei eRegistern
If g_App.PruefstationNr = 2006 And m_ersterEingebauterPruefzaehler.getIdentNrObj.getNennweite >= 200 Then
chkRegulierungDurchfuehren.value = vbChecked
Else
chkRegulierungDurchfuehren.value = vbUnchecked
End If
If g_blnVersuch = False Then
If m_ersterEingebauterPruefzaehler.getIdentNrObj.getNennweite < 200 Then
chkRegulierungDurchfuehren.Enabled = False
chkQtRegulierung.Enabled = False
End If
End If
Else
' keine eRegister
chkFiberoptic.Enabled = True
chk_LWL_Encoder.Enabled = True
chkRegulierungDurchfuehren.caption = "Regulierung durchf<68>hren"
g_blneRegisterPruefung = False
chk_eReg_alle_PP.Enabled = False
chk_eReg_alle_PP.value = vbUnchecked
End If
End Sub
Private Sub chkFiberoptic_Click()
Dim Impulswertigkeit As Double
WriteToLog "Option 'Lichtwellenleiter' wurde auf '" & chkFiberoptic.value & "' gesetzt."
If chkFiberoptic.value = vbUnchecked And chkQtRegulierung.value = vbChecked And chk_eReg_alle_PP.value = vbUnchecked Then
MsgBox "Die Option 'Regulierung in Qt' wird nun ausgeschaltet, da LWL ausgeschaltet wurde. Es ist daher keine Regulierung ausgew<65>hlt."
chkQtRegulierung.value = vbUnchecked
End If
If chkeRegisterPruefung.value = vbChecked Then
' bei der ERegister Pr<50>fung gibt es keine Opto messungen, nur LWL!
chk_LWL_Encoder.value = vbChecked
' Opto messungen d<>rfen auch nicht eingeschaltet werden
chk_LWL_Encoder.Enabled = False
Else
chk_LWL_Encoder.Enabled = True
End If
' If chkFiberoptic.Value = vbUnchecked And chk_LWL_Encoder = vbChecked Then
' chk_LWL_Encoder.Value = vbUnchecked
'
' Exit Sub
' End If
If chkFiberoptic.value = vbChecked Then
chkGanzeUmrundung.Enabled = True
g_blnPrfMitLWL = True
chk_eReg_alle_PP.value = vbUnchecked
If chkEinbauplatzImpulswertigkeit.value = vbChecked Then
txtImpulswertigkeitLwl.Enabled = False
Else
txtImpulswertigkeitLwl.Enabled = True
End If
UpdateLWLImpulswertigkeit
If Not m_ersterEingebauterPruefzaehler Is Nothing Then
AllePruefzaehlerNeuEinlesen
If chkeRegisterPruefung.value = vbUnchecked Then
chkQtRegulierung_Click
End If
End If
Else
g_blnPrfMitLWL = False
chkER56.value = vbUnchecked
chkGanzeUmrundung.Enabled = False
txtImpulswertigkeitLwl.Enabled = False
UpdateLWLImpulswertigkeit
chk_LWL_Encoder.value = vbUnchecked
End If
End Sub
Private Sub AllePruefzaehlerNeuEinlesen()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strSerienNr As String
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set Einbauplatz.eRegister = Nothing
End If
Next
End Sub
Private Sub chkGanzeUmrundung_Click()
If chkGanzeUmrundung.value = vbChecked Then
g_blnganzeFluegelumrundung = True
Else
g_blnganzeFluegelumrundung = False
End If
End Sub
Private Sub chkKontinuierlichePrf_Click()
If chkKontinuierlichePrf.value = vbChecked Then
OptPrfArt(1).value = True
OptPrfArt(0).value = False
OptPrfArt(0).Enabled = False
OptPrfArt(1).Enabled = False
chkRegulierungDurchfuehren.value = vbUnchecked
chkRegulierungDurchfuehren.Enabled = False
Else
chkRegulierungDurchfuehren.Enabled = True
OptPrfArt(0).Enabled = True
OptPrfArt(1).Enabled = True
End If
End Sub
Private Sub chkMesseins<6E>tzeMerken_Click()
' RH 12.9.2006 mit AB: Verbesserungsvorschlag vom 7.9.2006
If chkMesseins<6E>tzeMerken.value = vbChecked Then
' Option wird beibehalten
chkNurMesseinsaetze.value = vbChecked
chkNurMesseinsaetze.Enabled = False
Else
chkNurMesseinsaetze.Enabled = True
End If
End Sub
Private Sub chkNachpruefung_Click()
If chkNachpruefung.value = vbChecked Then
Call g_App.Settings.saveStringValue("Vorbelegung", "Nachpruefung", "1")
Else
Call g_App.Settings.saveStringValue("Vorbelegung", "Nachpruefung", "0")
End If
End Sub
Private Sub chkOptionen_Click()
If chkOptionen.value = vbChecked Then
frameOptionen.Visible = True
Else
frameOptionen.Visible = False
End If
End Sub
Private Sub chkPPunsortiert_Click()
If chkPPunsortiert.value = vbChecked Then
g_blnPruefpunkteUnsortiert = True
cmdPP_Up.Enabled = True
cmdPP_Down.Enabled = True
Else
g_blnPruefpunkteUnsortiert = False
cmdPP_Up.Enabled = False
cmdPP_Down.Enabled = False
' hier sind die PP sortiert
If Not m_colUniquePP Is Nothing Then
m_colUniquePP.sortQ
UpdateLstPruefpunkte
End If
End If
End Sub
Private Sub chkProtokolldruck_Click()
If chkProtokolldruck.value = vbChecked Then
g_blnPruefprotokoll = True
Else
g_blnPruefprotokoll = False
End If
End Sub
'Private Sub chkKeineRegulierung_Click()
' If chkKeineRegulierung.Value = vbChecked Then
' chkRegulierung.Enabled = False
' Else
' chkRegulierung.Enabled = True
' End If
' Call chkRegulierung_Click
'End Sub
Private Sub chkPruefgangLang_click()
If chkPruefgangLang.value = 1 Then
m_bPruefgangLang = True
Else
m_bPruefgangLang = False
End If
End Sub
Private Sub chkQtRegulierung_Click()
If chkQtRegulierung.value = vbChecked Then
' eingeschaltet:
If chkRegulierungDurchfuehren.value = vbChecked Then
' MsgBox "Sie haben 'LWL Regulierung in Qt' eingeschaltet. Die 'normale' Regulierung wird daher ausgeschaltet."
chkRegulierungDurchfuehren.value = vbUnchecked
DoEvents
End If
If chkFiberoptic.value = vbUnchecked Then
' F<>r eine Regulierung in Qt muss die Option 'Lichtwellenleiter' ausgew<65>hlt sein. Diese Option wird jetzt aktiviert.
chkFiberoptic.value = vbChecked
DoEvents
End If
cmbPruefpunkte.Enabled = True
If cmbPruefpunkte.ListCount > 1 Then
If cmbPruefpunkte.ListIndex <> 1 Then
' Qmax oder nichts ist ausgew<65>hlt. K<>nnte falsch sein. Also Pr<50>fer fragen:
'If MsgBox("M<>chten Sie " & cmbPruefpunkte.List(1) & " m<>/h als Regulierpr<70>fpunkt Qt ausw<73>hlen?", vbYesNo) = vbYes Then
cmbPruefpunkte.ListIndex = 1
'End If
End If
End If
If Val(txtImpulswertigkeitLwl.text) = 0 And chkFiberoptic.value = vbUnchecked Then
'txtImpulswertigkeitLwl.text = InputBox("Bitte geben Sie die Impulswertigkeit f<>r LWL ein", "'Lichtwellenleiter' ist ausgew<65>hlt aber Impulswertigkeit LWL ist leer!")
MsgBox "Bitte w<>hlen Sie m<>glichst die Option 'Lichtwellenleiter', bevor sie Seriennummern eingeben. Bitte geben Sie auch die Impulswertigkeit f<>r LWL ein.", vbInformation
On Error Resume Next
txtImpulswertigkeitLwl.SetFocus
End If
Else
End If
End Sub
Private Sub chkRegulierung_Click()
'disable cmdRegulierdaten
If chkRegulierung.value = 1 And chkRegulierung.Enabled Then
cmdVorgaben.Enabled = True
Else
cmdVorgaben.Enabled = False
End If
End Sub
Private Function PruefpunkteZeitenVorhanden() As Boolean
Dim Pruefpunkt As CPruefpunkt
Dim Zeit As Double
For Each Pruefpunkt In m_colUniquePP.getCollection
Zeit = Pruefpunkt.GetTime
Debug.Print "Pr<50>fpunkt " & Pruefpunkt.getQ & ", Zeit: " & Zeit
If Zeit = 0 Then
' F<>r einen Pruefpunkt ist keine Zeit definiert: sofort False zur<75>ckgeben
PruefpunkteZeitenVorhanden = False
Exit Function
End If
Next
' Alle Pr<50>fpunkte haben Zeiten
PruefpunkteZeitenVorhanden = True
End Function
Private Sub chkRegulierungDurchfuehren_Click()
If chkRegulierungDurchfuehren.value = vbChecked Then
'chkRegulierung.Enabled = True
cmbPruefpunkte.Enabled = True
If chkQtRegulierung.value = vbChecked Then
chkQtRegulierung.value = vbUnchecked
DoEvents
End If
If cmbPruefpunkte.ListCount > 0 Then
If cmbPruefpunkte.ListIndex <> 0 Then
' Qmax ist nicht ausgew<65>hlt. K<>nnte falsch sein. Also Pr<50>fer fragen:
If MsgBox("M<>chten Sie " & cmbPruefpunkte.List(0) & " m<>/h als Regulierpr<70>fpunkt Qmax ausw<73>hlen?", vbYesNo) = vbYes Then
cmbPruefpunkte.ListIndex = 0
End If
End If
End If
Else
chkRegulierung.Enabled = False
cmbPruefpunkte.Enabled = False
End If
End Sub
Private Sub chkRueckwaertsprf_Click()
Dim lngReturn As Long
If chkRueckwaertsprf.Enabled = False Then Exit Sub
If chkRueckwaertsprf.value = vbChecked Then
lngReturn = MsgBox("Sie haben 'R<>ckw<6B>rtspr<70>fung' ausgew<65>hlt. Sind sie sicher ?", vbYesNo Or vbDefaultButton2)
Select Case lngReturn
Case vbYes
chkRueckwaertsprf.value = vbChecked
DebugMsg "Es wurde R<>ckw<6B>rtspr<70>fung ausgew<65>hlt."
Case vbNo
chkRueckwaertsprf.value = vbUnchecked
DebugMsg "Es wurde Vorw<72>rtspr<70>fung ausgew<65>hlt."
End Select
End If
End Sub
Private Sub chkVersuch_Click()
If chkVersuch.value = vbChecked Then
g_blnVersuch = True
Else
g_blnVersuch = False
End If
FuerVersuchAusblendenOderVorbesetzten
End Sub
Private Sub chkZulassung_Click()
Dim strTemp As String
If chkZulassung.value = vbChecked Then
g_blnZulassungspruefung = True
If g_App.Settings.GetWetterstationURL <> "" Then
If GetWeatherData(g_dblLuftTemperatur, g_dblLuftFeuchte, g_dblLuftDruck, strTemp) = False Then
LogIntoDB strTemp, "Wetterstation"
' Es gab einen Fehler
ZeigePruefgangUmgebungForm
Else
If g_dblLuftTemperatur <> 0 And g_dblLuftFeuchte <> 0 And g_dblLuftDruck <> 0 Then
' alles OK
Exit Sub
Else
' Es m<>ssen noch Werte eingetragen werden, weil sie 0 sind
ZeigePruefgangUmgebungForm
End If
End If
Else
' keine Wetterstatuin definiert
ZeigePruefgangUmgebungForm
End If
Else
' Zulassungspr<70>fung wurde abgeschaltet
g_blnZulassungspruefung = False
End If
End Sub
Private Sub ZeigePruefgangUmgebungForm()
' ggF. Luftdruck, LuftFeuchte und LuftTemp abfragen
Dim objForm As frmPruefgangUmgebung
Set objForm = New frmPruefgangUmgebung
objForm.Show vbModal, Me
End Sub
Private Sub cmbImpulswertigkeitPZ_Change()
cmbImpulswertigkeitPZ_Click
End Sub
Private Sub cmbImpulswertigkeitPZ_Click()
Dim strText As String
strText = Trim(Split(cmbImpulswertigkeitPZ.text & " ", " ")(0))
txtImpulswertigkeitPZ.text = Val(strText)
If Val(txtImpulswertigkeitPZ.text) > 0 Then
txtImpulswertigkeitPZ.text = Val(txtImpulswertigkeitPZ.text)
Else
txtImpulswertigkeitPZ.text = ""
End If
End Sub
Private Sub cmd_eRegister_Click()
If g_App.Settings.readStringValue("eRegister", "ThamesWater", "") = "" Then
If MsgBox("M<>chten Sie Thameswater Auftr<74>ge mit den Werten aus der Tabelle eRegister_Auftragposition pr<70>fen? Sie k<>nnen das auch in der ini Datei mit: [eRegister]ThamesWater=alt(neu) <20>ndern.", vbYesNo) = vbYes Then
g_App.Settings.saveStringValue "eRegister", "ThamesWater", "neu"
Else
g_App.Settings.saveStringValue "eRegister", "ThamesWater", "alt"
End If
End If
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.Show vbNormal, Me
frmeRegisterPrf.frameTest.Visible = True
End Sub
Private Sub cmdAktualisiere_Click()
Call AktualisiereEinbauplatzInfos
End Sub
Private Sub cmdCLR_Click()
Dim i As Integer
txtImpulswertigkeitLwl.text = ""
txtImpulswertigkeitPZ.text = ""
chkER56.value = vbUnchecked
For i = 1 To 10
txtSerienNr(i).text = ""
ueberpruefe (i)
Next
End Sub
Private Sub cmdDurchflussAnzeigen_Click()
frmDurchflussanzeige.Show vbNormal, Me
End Sub
Private Sub cmdFertigmeldenMAV_Click()
Call PruefungFertigmeldenDialog("Nachtr<74>glich fertigmelden", m_colEinbauplatz)
End Sub
Private Sub cmdLWLHelp_Click()
Dim oForm As frmMeldung
Dim strText As String
Set oForm = New frmMeldung
oForm.lblMsg.FontName = "Courier New"
strText = ""
Dim strSQL As String
Dim rs As CRecordset
strSQL = "SELECT * from LWL_Impulswertigkeit "
strText = strText & "Typ Nennweiten Impulswertigkeit f<>r LWL" & vbCrLf
strText = strText & "-------------------------------------------------------" & vbCrLf
Set rs = New CRecordset
rs.openRS strSQL, True
Do While Not rs.EOF
If rs.getLongValue("ImpulswertigkeitLWL") > 0 Then
strText = strText & rs.getStringValue("Typ") & " " & rs.getStringValue("Typzusatz") & " " & rs.getStringValue("Nennweite") & " " & rs.getLongValue("ImpulswertigkeitLWL") & vbCrLf
End If
rs.MoveNext
Loop
oForm.lblMsg.Alignment = 0
oForm.lblMsg = strText
oForm.cmdExit.Visible = False
oForm.cmdIgnore.caption = "OK"
oForm.Show vbModal
End Sub
Private Sub cmdNeuerPruefer_Click()
Dim dlgLogin As frmLogin
Set dlgLogin = New frmLogin
Do While dlgLogin.getMitarbeiter() Is Nothing
dlgLogin.cmbPruefstation.Enabled = False
dlgLogin.Show vbModal, Me
If dlgLogin.getMitarbeiter() Is Nothing Then
If MsgBox("Anwendung beenden?", vbYesNo Or vbDefaultButton2) = vbYes Then
Unload Me
End
End If
End If
g_App.Mitarbeiter = dlgLogin.getMitarbeiter()
Loop
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
If Not m_Pruefgang Is Nothing Then
m_Pruefgang.PrueferNr = g_App.Mitarbeiter.getNr
End If
ShowBegruessungsRitual
If GibtEsEinNeuesUpdate() Then
If MsgBox("Es gibt ein Update dieser Software. M<>chten Sie die Software aktualisieren ? Alle Eingaben gehen dabei verloren.", vbYesNo Or vbDefaultButton2) = vbYes Then
PruefeAufUpdate
End If
End If
MsgBox "Neuer Pr<50>fer ist: " & g_App.Mitarbeiter.getVorname & " " & g_App.Mitarbeiter.getName & " (" & g_App.Mitarbeiter.getNr & ")"
If g_App.Mitarbeiter.GetPruefstellenleiter() = True Then
txtDoppelimpulssperrzahl.Enabled = True
Else
txtDoppelimpulssperrzahl.Enabled = False
End If
End Sub
Private Sub cmdOk_Click()
ShowStatus "Pr<50>fung wird gestartet..."
Me.MousePointer = vbHourglass
cmdOK.Enabled = False
Call OkIsClicked
If m_colUniquePP.Count > 0 Then
cmdOK.Enabled = True
ShowStatus "Bereit"
Else
cmdOK.Enabled = False
ShowStatus ""
End If
Me.MousePointer = vbNormal
End Sub
Private Sub OkIsClicked()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
If m_colUniquePP.Count >= 11 Then
Me.MousePointer = vbNormal
MsgBox "Es k<>nnen nur max 10 Pr<50>fpunkte zusammen gepr<70>ft werden. Verringern Sie die Anzahl der Pr<50>fpunkte!"
cmdOK.Enabled = False
Exit Sub
End If
If g_blnVersuch = False Then
If TestPPForRZFehler() = False Then
LogIntoDB "Keine oder alte RZ Fehler. Pr<50>fung verhindert.", "RZ Fehler"
Exit Sub
End If
End If
If chkVersuch.value = vbUnchecked And chkEichpruefvorgabenIgnorieren.value = vbUnchecked Then
If Not SindAlleZaehlerTemperaturAehnlich() Then
Me.MousePointer = vbNormal
Call MsgBox("Die gemeinsame Pr<50>fung von Kalt- und Heisswasserz<72>hlern ist nicht zul<75>ssig!", vbCritical)
Exit Sub
End If
End If
If chkFiberoptic.value = vbChecked And chkEinbauplatzImpulswertigkeit.value = vbUnchecked And txtImpulswertigkeitLwl.Enabled = True And Val(txtImpulswertigkeitLwl.text) = 0 Then
MsgBox "Sie m<>ssen die LWL-Impulswertigkeit angeben, wenn Sie LWL-Pr<50>fung ausgew<65>hlt haben.", vbOKOnly, "Das Eingabefeld LWL-Impulswertigkeit ist 0 oder leer."
Me.MousePointer = vbNormal
txtImpulswertigkeitLwl.SetFocus
txtImpulswertigkeitLwl.SelStart = 0
txtImpulswertigkeitLwl.SelLength = Len(txtImpulswertigkeitLwl.text)
Exit Sub
End If
If Val(txtImpulswertigkeitPZ.text) = 0 And txtImpulswertigkeitPZ.Enabled = True And chkEinbauplatzImpulswertigkeit.value = vbUnchecked And chkFiberoptic.value = vbUnchecked Then
Me.MousePointer = vbNormal
If txtImpulswertigkeitPZ.Enabled Then
MsgBox "Sie m<>ssen die Opto-Impulswertigkeit angeben, wenn Sie Opto-Pr<50>fung ausgew<65>hlt haben.", vbOKOnly, "Das Eingabefeld Impulswertigkeit ist 0 oder leer."
txtImpulswertigkeitPZ.SetFocus
txtImpulswertigkeitPZ.SelStart = 0
txtImpulswertigkeitPZ.SelLength = Len(txtImpulswertigkeitPZ.text)
Exit Sub
End If
End If
If Not PruefpunkteZeitenVorhanden() Then
Me.MousePointer = vbNormal
MsgBox ("Pr<50>fpunktzeiten fehlen!" & vbCrLf & "F<>r alle Pr<50>fpunkte m<>ssen Zeiten definiert sein!")
Exit Sub
End If
Dim strEinbaulageNichtVorhanden As String
strEinbaulageNichtVorhanden = ""
If chkZulassung.value = vbChecked Then
' <20>berpr<70>fen ob die Einbaulage vergessen wurde
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Einbauplatz.m_strEinbaulage = "" Then
'Einbaulage vergessen!
strEinbaulageNichtVorhanden = strEinbaulageNichtVorhanden & Einbauplatz.getNr & " "
End If
End If
Next
If strEinbaulageNichtVorhanden <> "" Then
'mind. eine Einbaulage wurde vergessen
MsgBox "F<>r eine Zulassungspr<70>fung m<>ssen noch die Einbaulagen aller Z<>hler im Pr<50>fvorgaben-Formular angegeben werden." & vbCrLf & "Bitte klicken Sie auf die Z<>hlersymbole den Einbaupl<70>tzen " & Trim(strEinbaulageNichtVorhanden) & "."
Exit Sub
End If
End If
Me.MousePointer = vbHourglass
If xbGenesis.value = vbChecked Then
Call Hauptpruefung_Genesis
Else
If chkeRegisterPruefung.value = vbChecked Then
Call Hauptpruefung_eRegister
Else
Call Hauptpruefung
End If
End If
CheckForRuecklaeufer
' ggf wurden manche eRegister Z<>hler aufgrund eines Funk-Timeouts entfernt, also Z<>hler wieder einbauen
AllePruefzaehlerNeuEinlesen
End Sub
Private Sub CheckForRuecklaeufer()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim blnRuecklaeufervorhanden As Boolean
Dim strEinbauplaetze As String
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Pruefzaehler.IstRueckl<6B>ufer Then
blnRuecklaeufervorhanden = True
strEinbauplaetze = strEinbauplaetze & Einbauplatz.getNr & " "
End If
End If
Next
If blnRuecklaeufervorhanden Then
MsgBox "An den Einbaupl<70>tzen " & strEinbauplaetze & " sind R<>ckl<6B>ufer." & vbCrLf & "Bitte bewerten Sie die Reparaturmassnahmen!"
End If
End Sub
Private Sub CheckZulassungsPruefung()
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim strZulassungsschluesselwort As String
''''''''''''''''''' Zulassung '''''''''''''''''
' RH 16.4.2008
Dim blnZulassungspruefung As Boolean
' hat der Pr<50>fer evtl. vergessen, den Haken zu setzen?
If chkZulassung.value = vbUnchecked Then
' wird einer der eingebauten Z<>hler f<>r eine Zulassung gepr<70>ft?
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If EinesDerWoerterVorhanden(Pruefzaehler.getAuftragPosition.getZusatztext, "Zulassung PTB|Zulassung DKD|DKD-Zertifikat|Zulassungsmuster|Zulassungspr<70>fung|Zulassungsz<73>hler|MID-Zulassung|DKD|NATA", strZulassungsschluesselwort) Then
blnZulassungspruefung = True
Exit For
End If
End If
Next
If blnZulassungspruefung = True Then
MsgBox "Die Option 'Zulassungspr<70>fung' wird ausgew<65>hlt," & vbCrLf & "weil der Auftragszusatztext entsprechende Schl<68>sselw<6C>rter " & vbCrLf & strZulassungsschluesselwort & " enth<74>lt:" & vbCrLf & Pruefzaehler.getAuftragPosition.getZusatztext
' H<>kchen wird automatisch gesetzt
chkZulassung.value = vbChecked
End If
End If
Exit Sub
Errorhandler:
End Sub
Private Sub cmdPPUebernehmen_Click()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkt As CPruefpunkt
Dim PruefpunktCol As CPruefpunktCol
Dim Pruefpunkte As CPruefpunkte
Dim i As Integer
i = 0
For Each Einbauplatz In m_colEinbauplatz
i = i + 1
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' Pr<50>fz<66>hler ist eingebaut
If Not Pruefzaehler Is m_ersterEingebauterPruefzaehlerDerLetztenPruefung Then
' Es handelt sich nicht um den selben Pr<50>fz<66>hler
Pruefzaehler.setPruefpunkte m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getPruefpunkte.GetPruefpunkteKopie
Pruefzaehler.getPruefpunkte.setInfo "Kopiert von " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr
' Set PruefpunktCol = New CPruefpunktCol
' For Each Pruefpunkt In m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getPruefpunkte.getPruefpunkte.getCollection
' PruefpunktCol.Add Pruefpunkt
' Next
'
' Set Pruefpunkte = New CPruefpunkte
' Pruefpunkte.setPruefpunkte PruefpunktCol
' Pruefzaehler.setPruefpunkte Pruefpunkte
End If
End If
updatePruefpunkte
Next
MsgBox "Alle eingebauten Pr<50>fz<66>hler haben nun die gleichen Pr<50>fpunkte."
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
Private Sub cmdRZFehleranzeigen_Click()
'frmRZFehler.Show vbModal, Me
frmRefZFehler.Show vbNormal, Me
End Sub
Private Sub cmdSchotteinstellungen_Click()
SchotteinstellungenAendern
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 Function TestPPForRZFehler() As Boolean
Dim Pruefpunkt As CPruefpunkt
Dim Referenzzaehler As CRefzaehler
Dim Temperatur As Double
Dim letzterFehler As Double
Dim Durchfluss As Double
Dim letzteSerienNr As Long
Dim Vergleichsdatum As Date
Dim frmFG As frmFlexgrid
Dim blnFehler As Boolean
Dim strQFehlerhaft As String
Const SPALTE_NW = 0
Const SPALTE_SN = 1
Const SPALTE_Q = 2
Const SPALTE_F = 3
Const SPALTE_DAT = 4
On Error Resume Next
Temperatur = 21
If Not g_ohneSPS Then
Temperatur = m_SPS.GetEinlaufTemperatur
End If
Set frmFG = New frmFlexgrid
frmFG.chkIgnore.caption = "Ignorieren und mit der Pr<50>fung fortfahren"
frmFG.MSFlexGrid1.FormatString = "NW|RZ SerienNr|Durchfluss|RZ-Fehler|Datum RZ-Pr<50>fpunkt"
For Each Pruefpunkt In m_colUniquePP.getCollection
Set Referenzzaehler = New CRefzaehler
Durchfluss = Pruefpunkt.getQ
Referenzzaehler.loadForDurchfluss Durchfluss, g_App.Settings.getMIDGruppe
If Referenzzaehler.SerienNr <> 0 Then
Vergleichsdatum = Referenzzaehler.letztePruefung
letzterFehler = Referenzzaehler.letzterFehler(Durchfluss, Temperatur)
End If
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_NW) = Referenzzaehler.Nennweite
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_SN) = Referenzzaehler.SerienNr
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_Q) = FormatDurchfluss(Durchfluss)
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_F) = Round(letzterFehler, 2)
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_DAT) = Format(Referenzzaehler.DatumDesFehlers, "dd.mm.yyyy hh:mm")
If Referenzzaehler.DatumDesFehlers = 0 Or Referenzzaehler.SerienNr = 0 Then
' keine Fehlerwerte f<>r diesen Durchfluss vorhanden
frmFG.MSFlexGrid1.row = frmFG.MSFlexGrid1.Rows - 1
frmFG.MSFlexGrid1.col = SPALTE_F
frmFG.MSFlexGrid1.CellBackColor = RGB(200, 100, 100)
frmFG.MSFlexGrid1.col = SPALTE_DAT
frmFG.MSFlexGrid1.CellBackColor = RGB(200, 100, 100)
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_F) = " - "
frmFG.MSFlexGrid1.TextMatrix(frmFG.MSFlexGrid1.Rows - 1, SPALTE_DAT) = " - "
blnFehler = True
strQFehlerhaft = strQFehlerhaft & Replace(FormatDurchfluss(Durchfluss), ",", ".") & " (nicht vorhanden); "
ElseIf Vergleichsdatum <> Referenzzaehler.DatumDesFehlers Then
' Fehlerwerte wurden nicht bei der letzten Pr<50>fung des Referenzz<7A>hlers
' f<>r diesen Durchfluss ermittelt
frmFG.MSFlexGrid1.col = SPALTE_DAT
frmFG.MSFlexGrid1.row = frmFG.MSFlexGrid1.Rows - 1
frmFG.MSFlexGrid1.CellBackColor = RGB(200, 100, 100)
blnFehler = True
strQFehlerhaft = strQFehlerhaft & Replace(FormatDurchfluss(Durchfluss), ",", ".") & "; "
Else
frmFG.MSFlexGrid1.col = SPALTE_DAT
frmFG.MSFlexGrid1.row = frmFG.MSFlexGrid1.Rows - 1
frmFG.MSFlexGrid1.CellBackColor = RGB(100, 200, 100)
End If
frmFG.MSFlexGrid1.AddItem ""
Next
frmFG.MSFlexGrid1.RemoveItem frmFG.MSFlexGrid1.Rows - 1
If blnFehler = True Then
frmFG.caption = "Warnung: fehlende Referenzz<7A>hler Pr<50>fpunkte bei der letzten RZ Pr<50>fung!"
frmFG.lblText.caption = "F<>r folgende Durchfl<66>sse liegen keine interpolierbaren Referenzz<7A>hler-Fehler aus der jeweils letzen Pr<50>fung des Referenzz<7A>hlers vor:" & vbCrLf
frmFG.lblText.caption = frmFG.lblText.caption & strQFehlerhaft & vbCrLf
frmFG.lblText.caption = frmFG.lblText.caption & "Es darf nur gepr<70>ft werden, wenn f<>r alle Durchfl<66>sse aktuelle Referenzz<7A>hler-Fehlerwerte bei der letzten RZ-Pr<50>fung ermittelt worden sind!" & vbCrLf
frmFG.lblText.caption = frmFG.lblText.caption & "Entfernen Sie ggF. Pr<50>fpunkte f<>r diese Pr<50>fung oder f<>hren zuerst eine umfangreichere Referenzz<7A>hlerpr<70>fung durch."
frmFG.chkIgnore.ToolTipText = "Warnung ignorieren und Pr<50>fz<66>hler-Pr<50>fung trotzdem starten."
frmFG.Show vbModal, Me
If frmFG.mblnCheckIgnore = True Then
LogIntoDB "keine oder alte RZ Fehler. Ignorieren wurde ausgew<65>hlt.", "RZ Fehler"
TestPPForRZFehler = True
End If
Else
Set frmFG = Nothing
TestPPForRZFehler = True
End If
End Function
Private Sub Form_Load()
Dim i As Integer
Dim nLeft As Long
Dim nTop As Long
g_blneRegisterPruefung = False
g_blnPrfMitER56 = False
Select Case g_App.Settings.LICHTWELLENLEITER
Case "0"
' per Default ohne Haken
chkFiberoptic.value = vbUnchecked
chkFiberoptic.Visible = True
Case "1"
' per Default mit Haken
chkFiberoptic.value = vbChecked
chkFiberoptic.Visible = True
Case -1
' per Default ausgeblendet
chkFiberoptic.value = vbUnchecked
chkFiberoptic.Visible = False
Case Else
' Ini Wert (ausgeblendet) neu anlegen
g_App.Settings.LICHTWELLENLEITER = -1
chkFiberoptic.value = vbUnchecked
chkFiberoptic.Visible = False
End Select
If g_blnVersuch = True Then
' war schon mal angeklickt oder steht so in INI
chkVersuch.value = vbChecked
chkVersuch.Visible = True
frameOptionen.Visible = True
chkOptionen.value = vbChecked
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
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()
Set m_Regulierdaten = New CRegulierdaten
For i = 1 To 10
lblEinbau(i).caption = ""
cmdRuecklaeuferanalyse(i).Enabled = False
frEinbau(i).Left = frEinbau(1).Left
frEinbau(i).Width = frEinbau(1).Width
frEinbau(i).Height = frEinbau(1).Height
txtSerienNr(i).Left = txtSerienNr(1).Left
txtSerienNr(i).Top = txtSerienNr(1).Top
txtSerienNr(i).Width = txtSerienNr(1).Width
txtSerienNr(i).Height = txtSerienNr(1).Height
txtSerienNr(i).FontSize = txtSerienNr(1).FontSize
cmdSerNrAusw(i).Left = cmdSerNrAusw(1).Left
cmdSerNrAusw(i).Top = cmdSerNrAusw(1).Top
cmdSerNrAusw(i).Width = cmdSerNrAusw(1).Width
cmdSerNrAusw(i).Height = cmdSerNrAusw(1).Height
lblVoreinstellwert(i).Left = lblVoreinstellwert(1).Left
lblVoreinstellwert(i).Top = lblVoreinstellwert(1).Top
lblVoreinstellwert(i).Width = lblVoreinstellwert(1).Width
lblVoreinstellwert(i).Height = lblVoreinstellwert(1).Height
lblVoreinstellwert(i).caption = ""
lblVoreinstellwert(i).Visible = False
lblVoreinstellwert(i).ToolTipText = "Sollwert Regulierung"
lblStatus(i).Left = lblStatus(1).Left
lblStatus(i).Top = lblStatus(1).Top
lblStatus(i).Width = lblStatus(1).Width
lblStatus(i).Height = lblStatus(1).Height
lblEinbau(i).Left = lblEinbau(1).Left
lblEinbau(i).Top = lblEinbau(1).Top
lblEinbau(i).Width = lblEinbau(1).Width
lblEinbau(i).Height = lblEinbau(1).Height
imgInfo(i).Left = imgInfo(1).Left
imgInfo(i).Top = imgInfo(1).Top
imgInfo(i).Width = imgInfo(1).Width
imgInfo(i).Height = imgInfo(1).Height
cmdRuecklaeuferanalyse(i).Left = cmdRuecklaeuferanalyse(1).Left
cmdRuecklaeuferanalyse(i).Top = cmdRuecklaeuferanalyse(1).Top
cmdRuecklaeuferanalyse(i).Width = cmdRuecklaeuferanalyse(1).Width
cmdRuecklaeuferanalyse(i).Height = cmdRuecklaeuferanalyse(1).Height
imgZaehler(i).Picture = frmRes.imgZaehlerGrauLinks.Picture
txtSerienNr(i).MaxLength = 15
imgZaehler(i).Enabled = False
If i <= g_App.Settings.EinbauplaetzeJeStrang Then
Else
frEinbau(i).Visible = False
imgZaehler(i).Visible = False
End If
Next i
If g_App.Settings.GetOrSetIniWert("Vorbelegung", "Nachpruefung", "1") = "1" Then
chkNachpruefung.value = vbChecked
Else
chkNachpruefung.value = vbUnchecked
End If
lblPruefer = g_App.Mitarbeiter().getVorname() & " " & g_App.Mitarbeiter().getName()
lblUniquePP = 0
lblMaxPP = g_App.Settings.getMaxPruefpunkte()
lblTitle = "Pr<50>fvorbereitung"
Call FuerVersuchAusblendenOderVorbesetzten
chkRegulierung.value = g_App.Settings.AutomatischeRegulierung
chkRegulierungVerwenden.value = g_App.Settings.RegulierungVerwenden
' neu RH 13.12.2004
If g_App.Settings.EichpruefvorgabenIgnorieren <> "0" And g_App.Settings.EichpruefvorgabenIgnorieren <> "1" Then
chkEichpruefvorgabenIgnorieren.Visible = False
Else
chkEichpruefvorgabenIgnorieren.Visible = True
If g_App.Settings.EichpruefvorgabenIgnorieren = "1" Then
chkEichpruefvorgabenIgnorieren.value = vbChecked
Else
chkEichpruefvorgabenIgnorieren.value = vbUnchecked
End If
End If
' neu RH 20.5.2010
If g_App.Settings.PruefpunkteUnsortiert = "0" Then
chkPPunsortiert.Visible = True
chkPPunsortiert.value = vbUnchecked
End If
If g_App.Settings.PruefpunkteUnsortiert = "1" Then
chkPPunsortiert.Visible = True
chkPPunsortiert.value = vbChecked
End If
Call chkPPunsortiert_Click
' ' neu RH 19.1.2007
' If g_App.Settings.PruefpunkteUnsortiert <> "0" And g_App.Settings.PruefpunkteUnsortiert <> "1" Then
' chkPPunsortiert.Value = vbUnchecked
' chkPPunsortiert.Visible = False
' cmdPP_Up.Enabled = True
' cmdPP_Down.Enabled = True
' Else
' cmdPP_Up.Enabled = False
' cmdPP_Down.Enabled = False
' chkPPunsortiert.Visible = True
' If g_App.Settings.PruefpunkteUnsortiert = "1" Then
' chkPPunsortiert.Value = vbChecked
' Else
' chkPPunsortiert.Value = vbUnchecked
' End If
' End If
' neu RH 29.1.2007: Protokolldruck immer aus
chkProtokolldruck.value = vbUnchecked
Call chkProtokolldruck_Click
Call chk_LWL_Encoder_Click
' chkKeineRegulierung.Value = g_App.Settings.Ueberspringen
' Call chkKeineRegulierung_Click
' Initialisierung der RadioButtons "PruefungsArt"
Select Case g_App.Settings.PruefungsArt
Case "Waage"
OptPrfArt(0).value = True
OptPrfArt(1).value = False
m_PruefungsArtWaage = True
Case "Referenzzaehler"
OptPrfArt(0).value = False
OptPrfArt(1).value = True
m_PruefungsArtWaage = False
Case Else
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei f<>r Pr<50>fungsart"
exitInstance
End Select
cmdOK.Enabled = False
g_frmMain.Hide
Call initEinbauplaetze ' Erzeuge Einbauplaetze Collection
Call initRegelart
Call chkFiberoptic_Click
' Pruefgang Objekt erzeugen / Pruefgang starten
Set m_Pruefgang = New CPruefgang
Call InitCmbAnzahlZaehler
Me.Visible = True
setzeFocusBeimStart
cmdPPUebernehmen.Enabled = False
If g_App.Mitarbeiter.GetPruefstellenleiter() = True Or g_blnVersuch Then
txtDoppelimpulssperrzahl.Enabled = True
Else
txtDoppelimpulssperrzahl.Enabled = False
End If
If g_bMeitwinMID_Sonderpruefung Then
chkRegulierungDurchfuehren.value = vbUnchecked
lblTitle = "Pr<50>fvorbereitung Meitwin MID"
fillcmbImpulswertigkeiten cmbImpulswertigkeitPZ
lblTXT_NZ.Visible = True
cmbImpulswertigkeitPZ.Visible = True
Else
cmbImpulswertigkeitPZ.Visible = False
lblTXT_NZ.Visible = False
End If
End Sub
Private Sub setzeFocusBeimStart()
Dim i As Integer
For i = 1 To 10
If cmdSerNrAusw(i).Visible = True Then
cmdSerNrAusw(i).SetFocus
Exit For
End If
Next
End Sub
' Einbaupl<70>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<69>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_blneRegisterPruefung = False
g_blnPrfMitER56 = False
g_frmMain.Show
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
Call endDialog(IDCANCEL)
End Sub
' Vorgabe der Pr<50>fgangvorgaben
'
Private Sub cmdVorgaben_Click()
Dim dlg As frmPruefgangVorgaben
Me.MousePointer = vbHourglass
Set dlg = New frmPruefgangVorgaben
Call dlg.setRegulierdaten(m_Regulierdaten)
If doModal(dlg, True) = IDOK Then
End If
Me.MousePointer = vbDefault
End Sub
' Dialog zur <20>nderung der Pr<50>fpunkte
'
Private Sub imgZaehler_Click(Index As Integer)
Dim Einbauplatz As CEinbauplatz
Dim dlg As frmPruefvorgaben
Set Einbauplatz = getEinbauplatz(Index)
If Einbauplatz Is Nothing Then Exit Sub
Me.MousePointer = vbHourglass
Set dlg = New frmPruefvorgaben
Call dlg.setPruefzaehler(Einbauplatz.getPruefzaehler())
Call dlg.setEinbauplatz(Einbauplatz)
Set dlg.m_colEinbauplatz = m_colEinbauplatz
If doModal(dlg, True) = IDOK Then
' ZeigePruefpunkte (Index)
If g_MetrologAktualisieren = True Then
AlleEinbauplaetzeDesGleichenAuftragesAktualisieren (Index)
Else
Call ueberpruefe(Index)
End If
updatePruefpunkte
If m_colUniquePP.Count > 0 Then
cmdOK.Enabled = True
Else
cmdOK.Enabled = False
End If
End If
Me.MousePointer = vbDefault
End Sub
Private Sub OptPrfArt_Click(Index As Integer)
Select Case Index
Case 0
m_PruefungsArtWaage = True
Case 1
m_PruefungsArtWaage = False
End Select
End Sub
Private Sub OptRegelart_Click(Index As Integer)
Select Case Index
Case 0
m_Regelart = "FU"
Case 1
m_Regelart = "Servo"
End Select
End Sub
' Nur numerische Eingaben zulassen
Private Sub txtAnzahlDauerPrf_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
Else
If Len(txtAnzahlDauerPrf.text) > 2 Then KeyAscii = 0
End If
End Sub
Private Sub chkPruefgangLang_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
End If
End Sub
Private Sub txtAnzahlDauerPrf_Validate(Cancel As Boolean)
If Val(txtAnzahlDauerPrf.text) < 2 Or Val(txtAnzahlDauerPrf.text) > 9999 Then
txtAnzahlDauerPrf.text = "1"
chkDauerpruefung.value = 0
End If
End Sub
Private Sub txtDoppelimpulssperrzahl_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
Select Case KeyAscii
Case 8, 32
Exit Sub
Case Else
KeyAscii = 0
End Select
Else
End If
End Sub
Private Sub txtDoppelimpulssperrzahl_Validate(Cancel As Boolean)
txtDoppelimpulssperrzahl.text = Val(txtDoppelimpulssperrzahl.text)
End Sub
Private Sub txtImpulswertigkeitLwl_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
' Nur numerische Eingaben zulassen
Private Sub txtImpulswertigkeitPZ_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
'----------------------------------------------------------------------------
' Event Handling f<>r das Scanner Eingabefeld
'----------------------------------------------------------------------------
Private Sub txtScanner_KeyPress(KeyAscii As Integer)
Dim nWert As Long
If KeyAscii = 13 Then
KeyAscii = 0 ' unterbinde Beep
If IsNumeric(txtScanner) Then
nWert = Val(txtScanner.text)
If nWert > 0 And nWert <= g_App.Settings.EinbauplaetzeJeStrang Then
m_nEinbauplatz = nWert
txtScanner.text = ""
lblScanner.caption = "Platz: " & Str(m_nEinbauplatz)
End If
If (nWert >= SERIENNR_MINWERT And nWert <= SERIENNR_MAXWERT) Then
m_nSeriennummer = nWert
txtScanner.text = ""
lblScanner.caption = "SN:" & Str(m_nSeriennummer)
End If
If m_nEinbauplatz > 0 And m_nSeriennummer > 0 Then
txtSerienNr(m_nEinbauplatz).text = 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_DblClick(Index As Integer)
If Val(txtSerienNr(Index).text) > 0 Then
' nach dieser SerienNr suchen
g_lngSerienNr = Val(txtSerienNr(Index).text)
End If
OeffneSerienNrAuswahl (Index)
g_lngSerienNr = 0
End Sub
' Neu eingef<65>gt am 02.08.02 Pfeiffer
Private Sub cmdSerNrAusw_Click(Index As Integer)
' es soll nicht nach dieser SerienNr gesucht werden
g_lngSerienNr = 0
OeffneSerienNrAuswahl (Index)
End Sub
Private Sub OeffneSerienNrAuswahl(Index As Integer)
Dim lngColor As Long
lngColor = txtSerienNr(Index).BackColor
txtSerienNr(Index).BackColor = RGB(200, 200, 200)
Dim frmDialog As frmSeriennrAuswahl
Dim i As Integer
Set frmDialog = New frmSeriennrAuswahl
For i = 1 To 10
g_Seriennr(i) = txtSerienNr(i)
Next
frmDialog.Show vbModal, Me
txtSerienNr(Index).BackColor = lngColor
If IsNumeric(frmDialog.sSerienNr) Then
txtSerienNr(Index).text = Trim(frmDialog.sSerienNr)
bTextChanged(Index) = True
txtSerienNr(Index).SetFocus
Call ueberpruefe(Index, Val(frmDialog.lngAuftrag))
End If
End Sub
Private Sub txtSerienNr_GotFocus(Index As Integer)
m_sOldInput = txtSerienNr(Index).text
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
txtSerienNr(IIf(Index < g_App.Settings.EinbauplaetzeJeStrang, Index + 1, 1)).SetFocus
ueberpruefe (Index)
End If
If KeyCode = 38 Then
' Setzt Fokus ins dar<61>berliegende Textfeld bei Cursor-Up
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)
Debug.Print "KeyAscii=" & KeyAscii
Select Case KeyAscii
Case 3, 22, 24, 8
' Cut, Copy , Paste, Backspace
Debug.Print "KeyAscii=" & KeyAscii
Exit Sub
Case 13
ueberpruefe (Index)
'Ge<47>ndert am 10.08.02 Pfeiffer
If Index < g_App.Settings.EinbauplaetzeJeStrang Then
Index = Index + 1
Else
Index = 1
End If
cmdSerNrAusw(Index).SetFocus
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
'Numerisch
Case Else
Debug.Print "KeyAscii=" & KeyAscii
'KeyAscii = 0
End Select
End Sub
Private Sub ZeigePruefpunkte(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Set Pruefzaehler = m_colEinbauplatz(Index).getPruefzaehler
If Pruefzaehler Is Nothing Then
MsgBox ("Pr<50>fzahler is nothing")
Else
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
If Pruefpunkte Is Nothing Then
MsgBox ("Pruefpunkte is nothing")
Else
For Each Pruefpunkt In Pruefpunkte.getPruefpunkte.getCollection
MsgBox Pruefpunkt.getQ
Next
End If
End If
End Sub
' Komplettes Feld selektieren
'
Private Sub selectSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = 0
txtSerienNr(Index).SelLength = Len(txtSerienNr(Index))
End Sub
' Komplettes Feld selektieren
'
Private Sub CursorAnEndeImSerienNrField(Index As Integer)
txtSerienNr(Index).SelStart = Len(txtSerienNr(Index))
txtSerienNr(Index).SelLength = 0
End Sub
' Validierung bei Fokus Wechsel in ein anderes Feld per Maus
Private Sub txtSerienNr_Validate(Index As Integer, Cancel As Boolean)
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Val(Pruefzaehler.getSerienNr) = Val(txtSerienNr(Index).text) And Val(txtSerienNr(Index).text) <> 0 Then
' SerienNr wurde nicht ge<67>ndert und ist nicht leer
Exit Sub
End If
Else
' es war kein Pruefzaehler eingebaut
If txtSerienNr(Index).text = "" Then
' SerienNr ist leer
Exit Sub
End If
End If
Call ueberpruefe(Index)
Cancel = False
End Sub
Private Sub ErstelleTestPruefzaehler(Index As Integer)
Dim oAuftragPositionSerienNummer As CAuftragPositionSerienNr
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Pruefpunkte As CPruefpunkte
lSerienNr = neueTestZaehlerSerienNr()
If lSerienNr = 0 Then
txtSerienNr(Index).text = ""
txtSerienNr(Index).SetFocus
Exit Sub
End If
txtSerienNr(Index).text = CStr(lSerienNr)
Set oAuftragPositionSerienNummer = New CAuftragPositionSerienNr
oAuftragPositionSerienNummer.setAuftragNr 99999
oAuftragPositionSerienNummer.setPositionNr 1
oAuftragPositionSerienNummer.setEinbauplatzNr Index
oAuftragPositionSerienNummer.setNr lSerienNr
oAuftragPositionSerienNummer.save
Set Pruefzaehler = New CPruefzaehler
Pruefzaehler.setSerienNr lSerienNr
Set Einbauplatz = getEinbauplatz(Index)
Einbauplatz.setPruefzaehler Pruefzaehler
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<74>lt keine Pr<50>fpunktdaten in der Datenbank. M<>chten Sie jetzt Pr<50>fpunkte eingeben?", vbYesNo) = vbYes Then
' raise imgZaehler_Click(Index)
'Else
' txtSerienNr(Index).Text = ""
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
' txtSerienNr(Index).SetFocus
'End If
End If
End If
End Sub
Private Function PruefpunkteDesErstenPZmitPP(ColEinbauplatz As Collection) As CPruefpunkte
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
For Each Einbauplatz In ColEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If Pruefzaehler.getPruefpunkte.getPruefpunkteCount > 0 Then
Set PruefpunkteDesErstenPZmitPP = Pruefzaehler.getPruefpunkte
Exit Function
End If
End If
End If
Next
Set PruefpunkteDesErstenPZmitPP = Nothing
End Function
Private Sub ueberpruefe(Index As Integer, Optional lngAuftragNr As Long = 0)
DebugMsg "<22>berpr<70>fe SerienNr " & txtSerienNr(Index)
beep
If bTextChanged(Index) = True Then
bTextChanged(Index) = False
If txtSerienNr(Index).text = "0" Then
ErstelleTestPruefzaehler (Index)
ueberpruefe (Index)
Exit Sub
Else
End If
If testSerienNrInput(Index, lngAuftragNr) Then
If txtSerienNr(Index) <> "" Then
' Wenn SerienNr Feld nicht gel<65>scht und SerienNrInput
' gerade erfolgreich getestet wurde,
' dann <20>berpr<70>fen, ob Pruefpunkte vorhanden sind. Wenn nicht, manuell PP eingeben.
Call UeberpruefeAufPruefpunkte(Index)
Call uberpruefe_Auf_eRegister(Index)
Call uberpruefe_Auf_ER56(Index)
End If
Else
cmdRuecklaeuferanalyse(Index).Enabled = False
' SerienNr wurde nicht akzeptiert
txtSerienNr(Index).SetFocus
End If
Else
' nicht ge<67>ndert
End If
Check_If_Sonderversion_PP_Ubernehmen_Erlaubt
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
UpdateDoppelimpulsperre
ueberpruefeAufMID
End Sub
Private Function Get_eRegister_Recordset(lngSerienNr As Long, ByRef rs_eRegister As CRecordset)
Dim strSQL As String
Set rs_eRegister = New CRecordset
On Error GoTo Errorhandler
strSQL = "SELECT * from eRegister where Seriennummer = " & lngSerienNr
rs_eRegister.openRS strSQL
If Not rs_eRegister.EOF Then
Get_eRegister_Recordset = True
End If
Exit Function
Errorhandler:
MsgBox "Fehler " & Err.Number & " in Get_eRegister_Recordset(" & lngSerienNr & "): " & Err.Description
End Function
' Falls LWL angehakt ist
' wird aus dem bisher erstem Pr<50>fz<66>hler (von oben) die Impulswertigkeit aktualisiert
Private Sub UpdateLWLImpulswertigkeit()
Dim tmpPruefzaehler As CPruefzaehler
If chkFiberoptic.value = vbChecked Then
If Val(txtImpulswertigkeitLwl.text) = 0 Then
If Not m_ersterEingebauterPruefzaehler Is Nothing Then
Set tmpPruefzaehler = New CPruefzaehler
tmpPruefzaehler.loadForSerienNr m_ersterEingebauterPruefzaehler.getSerienNr
txtImpulswertigkeitLwl.text = tmpPruefzaehler.m_lng_LWLImpulswertigkeit
End If
End If
End If
End Sub
Private Sub uberpruefe_Auf_ER56(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Bestellcode As CBestellcode
Dim Zaehlwerk As String
Dim VakoCode As CVakoCode
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set VakoCode = New CVakoCode
If VakoCode.load(Pruefzaehler.getAuftragPosition.getIdentNrObj.GetVakoCode) Then
Zaehlwerk = VakoCode.GetWert("Z<>hlwerk")
Else
' kein Vako
Exit Sub
End If
If InStr(1, LCase(Zaehlwerk), "encoder") > 0 Then
If g_blnPrfMitER56 = False Then
chkER56.value = vbChecked
MsgBox "Option 'LWL & ER56' (Pr<50>fung mit LWL & ER56 Encoder) wurde aktiviert, weil im Auftrag/Vako Z<>hlwerk = Encoder steht." & vbCrLf & "PP2 und PP3 werden mit LWL gepr<70>ft."
End If
End If
Exit Sub
End Sub
Private Sub uberpruefe_Auf_eRegister(Index As Integer)
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Bestellcode As CBestellcode
Dim Zaehlwerk As String
Dim VakoCode As CVakoCode
Set Einbauplatz = m_colEinbauplatz(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set Bestellcode = New CBestellcode
If Bestellcode.load(Pruefzaehler.getAuftragPosition.GetBestellcode, Pruefzaehler.getIdentNrObj.GetBestellgruppe) Then
Zaehlwerk = Bestellcode.GetWert("Z<>hlwerk")
Else
Debug.Print "kein Bestellcode"
Set VakoCode = New CVakoCode
If VakoCode.load(Pruefzaehler.getAuftragPosition.getIdentNrObj.GetVakoCode) Then
Zaehlwerk = VakoCode.GetWert("Z<>hlwerk")
Else
' Weder Vako noch Bestellcode
Exit Sub
End If
End If
If InStr(1, Zaehlwerk, "eRegister") > 0 Then
If g_blneRegisterPruefung = False Then
' es handelt sich um den ersten Z<>hler mit eRegister
g_blneRegisterPruefung = True
chkeRegisterPruefung.Visible = True
chkeRegisterPruefung.value = vbChecked
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Alle Z<>hler ausser dem Meistream Plus DN 50 werden ohne LWL gepr<70>ft und reguliert (A.P. email am 15.9.15 18:01)
' Alle MS Plus ausser NW 40 werden auch mit LWL gepr<70>ft. Nur 40er nur mit eRegister (Arno Schramm am 20.4.2016)
' Alle MS und MS Plus DN 40 DN 200 werden ohne LWL gepr<70>ft (12.7.2016 TQ)
Select Case Pruefzaehler.getAuftragPosition.getIdentNrObj.getTyp
Case "MS", "MMS"
Select Case Pruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite
Case 40, 200
' TQ am 2016-07-12
' MMS MS DN40 und DN200 k<>nnen nicht mit LWL gepr<70>ft werden, Alle Pr<50>fpunkte werden per eRegister LED gepr<70>ft
chk_eReg_alle_PP.value = vbChecked
Case 50
Select Case Pruefzaehler.getAuftragPosition.getIdentNrObj.getBaulaenge
'fehlende Absprache mit TQ, Roland: Baul<75>nge 270 beim eregister auch <20>ber LWL pr<70>fen- Aussage vom Eddy Slatosch am 2017-07-04
Case 270
' TQ am 2016-07-12
' MS MSS DN 50 Baul<75>nge 270 k<>nnen nicht mit LWL gepr<70>ft werden, Alle Pr<50>fpunkte werden per eRegister LED gepr<70>ft
chk_eReg_alle_PP.value = vbChecked
Case Else
' anderen Nennweiten, andere Baul<75>ngen
chkFiberoptic.value = vbChecked
UpdateLWLImpulswertigkeit
GoTo weiter_LWL
End Select
Case Else
' anderen Nennweiten, andere Baul<75>ngen
chkFiberoptic.value = vbChecked
UpdateLWLImpulswertigkeit
GoTo weiter_LWL
End Select
Case Else
' andere Typen
End Select
weiter_LWL:
' alle eregister werden reguliert, entweder mit LWL oder per eRegister messung
'chkRegulierungDurchfuehren.Value = vbChecked
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
' es handelt sich weitere Z<>hler mit eRegister
End If
Else
If g_blneRegisterPruefung = True Then
MsgBox "Sie haben eine eRegister Pr<50>fung ausgew<65>hlt. Dieser Z<>hler ist kein eRegister und kann nicht gepr<70>ft werden. Klicken Sie auf 'zur<75>ck' um einen neue Pr<50>fung zu beginnen."
txtSerienNr(Index).text = ""
ueberpruefe (Index)
End If
End If
End If
End Sub
Private Sub ueberpruefeAufMID()
On Error GoTo Errorhandler
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
StatusBar1.SimpleText = ""
g_bln_Pruefung_nach_MID = False
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If Pruefzaehler.getPruefpunkte.m_bPruefung_nach_MID Then
g_bln_Pruefung_nach_MID = True
StatusBar1.SimpleText = "Pr<50>fung nach MID!"
End If
End If
End If
Next
Errorhandler:
End Sub
'---------------------------------------------------------------
' ermittelt neue Test-Pr<50>fz<66>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 <20>berlauf auftritt: Meldung !
If SerienNr >= rs.getLongValue("bisSerienNr") Then
ErrorMsg ("<22>berlauf im Nummernband f<>r Testz<74>hler")
Exit Function
End If
If ueberlauf < 1000 Then
MsgBox ("<22>berlauf nach " & ueberlauf & " Seriennummern bei " & rs.getLongValue("bisSerienNr") & ". Bitte Admin verst<73>ndigen.....")
End If
SerienNr = SerienNr + 1
rs.setValue "letzteNr", SerienNr
rs.update
neueTestZaehlerSerienNr = SerienNr
Else
ErrorMsg ("Das Testz<74>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<70>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<50>fpunkte neu bilden und
' Summe neu anzeigen
'
' TODO: Komplettieren
'
Public Sub updatePruefpunkte()
Dim Einbauplatz As CEinbauplatz
Dim i As Integer
Dim strAlterRegulierpruefpunkt As String
Set m_colUniquePP = calcPruefpunkte(m_colEinbauplatz)
' Anzeige der eindeutigen Pr<50>fpunkte aktualisieren
lblUniquePP.caption = m_colUniquePP.Count
' Listboxen f<>r Pruefpunkte aktualisieren
lstPruefpunkte.Clear
strAlterRegulierpruefpunkt = cmbPruefpunkte.text
cmbPruefpunkte.Clear
m_colUniquePP.sortQ
For i = 1 To m_colUniquePP.Count()
lstPruefpunkte.AddItem FormatDurchfluss(m_colUniquePP.Item(i).getQ)
cmbPruefpunkte.AddItem FormatDurchfluss(m_colUniquePP.Item(i).getQ)
If cmbPruefpunkte.List(cmbPruefpunkte.ListCount - 1) = strAlterRegulierpruefpunkt Then
cmbPruefpunkte.ListIndex = cmbPruefpunkte.ListCount - 1
End If
Debug.Print m_colUniquePP.Item(i).getQ
Next i
If m_colUniquePP.Count() > 0 And cmbPruefpunkte.ListIndex = -1 Then
If chkQtRegulierung.value = vbChecked Then
chkQtRegulierung_Click
Else
cmbPruefpunkte.ListIndex = 0
End If
End If
' PP-Warning-Flag f<>r alle Einbaupl<70>tze auf FALSE setzen
For Each Einbauplatz In m_colEinbauplatz
Call Einbauplatz.setPPWarning(False)
Next
' Wenn die Menge der eindeutigen Pr<50>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())
If Not Einbauplatz.getPruefzaehler Is Nothing And chkQtRegulierung.value = vbUnchecked Then
' Pr<50>fz<66>hler ist eingebaut und chkQtRegulierung ist nicht aktiviert
''RH TQ 2016-07-12: MS Plus werden nicht mehr in Qt reguliert
''' If Einbauplatz.getPruefzaehler.getAuftragPosition.getIdentNrObj.getTypzusatz = "Plus" And Einbauplatz.getPruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite = 50 Then
''' ' AP 2015-05-11: nur MS Plus DN50 soll reguliert werden
''' If chkQtRegulierung.Tag = "" Then
''' ' QT Regulierung wurde bisher noch nicht ausgew<65>hlt
''' ' QT Regulierung ausw<73>hlen
'''' chkRegulierung.value = vbUnchecked
'''' chkQtRegulierung.value = vbChecked
''' End If
''' 'chkQtRegulierung.Tag = "checked"
''' Else
''' chkQtRegulierung.value = vbUnchecked
''' End If
End If
Next
Exit Sub
End If
' Ausnahmez<65>hler suchen und austragen, bis Maximum unterschritten ist
'
' Vorgehensweise:
' - Alle CPruefpunkt-Items in m_colUniquePP absteigend nach dem UseCount
' sortieren
' - Zaehler zu den Pr<50>fpunkt(en) mit dem kleinsten UseCount feststellen
' und aus der Menge der Pr<50>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<65>ren zu dem an wenigsten ben<65>tigten Pr<50>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. <20>berpr<70>fen
'
' @return true = Pr<50>fz<66>hler mit der <20>bergebenen Serien-Nr. wurde dem
' Einbauplatz erfolgreich zugewiesen
'
Private Function testSerienNrInput(Index As Integer, Optional AuftragNr As Long) As Boolean
Dim Einbauplatz As CEinbauplatz
Dim lSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim nTmpText As String
Dim Impulswertigkeit As Long
Set Einbauplatz = getEinbauplatz(Index)
' Eingabe ist Einbauplatz Nummer
If Val(txtSerienNr(Index)) > 0 And Val(txtSerienNr(Index)) <= g_App.Settings.EinbauplaetzeJeStrang Then
' Cursor laut Eingabe ins angew<65>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<65>scht
lSerienNr = -1
' Pr<50>fen, ob noch irgendeine Seriennummer definiert ist
Dim bKeinPruefzaehler As Boolean
bKeinPruefzaehler = True
Dim i As Integer
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
If txtSerienNr(i) <> "" Then
bKeinPruefzaehler = False
End If
Next
If bKeinPruefzaehler Then
' Keine Seriennummer mehr vorhanden:
' Feld f<>r Impulswertigkeit l<>schen
txtImpulswertigkeitPZ.text = ""
' Globale Regulierdaten werden gel<65>scht, wenn
' keine SerienNr mehr vorhanden ist
Einbauplatz.m_strEinbaulage = ""
Set m_Regulierdaten = Nothing
End If
Else
' If IsNumeric(txtSerienNr(Index).Text) Then
' If CDbl(txtSerienNr(Index).Text) <= SERIENNR_MAXWERT Then
' lSerienNr = Val(txtSerienNr(Index))
' Else
' MsgBox "Diese SerienNr ist zu hoch. Die h<>chstm<74>gliche SerienNr ist " & SERIENNR_MAXWERT
' txtSerienNr(Index).Text = ""
' GoTo testSerienNrInputReturnFalse
' End If
' Else
' nicht numerisch, z.B. KundeneigeneSerienNr
If SucheSerienNrZuNichtnumerischerSerienNr(txtSerienNr(Index).text, lSerienNr, Index) Then
txtSerienNr(Index).text = lSerienNr
Else
ErrorMsg "Es konnten keine Auftragsdaten zu dieser SerienNr gefunden werden!"
Einbauplatz.setPruefzaehler Nothing
GoTo testSerienNrInputReturnFalse
End If
' End If
End If
' Setze im Einbauplatz Objekt die Seriennr. (laut DB)
If Not setEinbauplatzPruefzaehler(Einbauplatz, lSerienNr, AuftragNr) Then
' Fehlgeschlagen:
GoTo testSerienNrInputReturnFalse
End If
'---------- Textfeld Impulswertigkeit
'If Val(txtImpulswertigkeitPZ.text) = 0 Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If g_bMeitwinMID_Sonderpruefung Then
'txtImpulswertigkeitPZ.text = "90510"
'Einbauplatz.m_ImpulseQM = 90510
Else
' Bem: IdentNr muss vorhanden sein f<>r .GetImpulseQM
Impulswertigkeit = Pruefzaehler.GetImpulseQM
If CStr(Impulswertigkeit) <> "0" Then
txtImpulswertigkeitPZ.text = CStr(Impulswertigkeit)
If Einbauplatz.m_ImpulseQM = 0 Then
'nur wenn Impulswertigkeit noch nicht definiert wurde
Einbauplatz.m_ImpulseQM = Impulswertigkeit
End If
End If
End If
If chkFiberoptic.value = vbChecked Then
' nur wenn Lichtwellenleiter
Impulswertigkeit = Pruefzaehler.GetImpulseLwl
If CStr(Impulswertigkeit) <> "0" Then
txtImpulswertigkeitLwl.text = CStr(Impulswertigkeit)
If Einbauplatz.m_ImpulseLwl = 0 Then
'nur wenn Lwlw Impulswertigkeit noch nicht definiert wurde
Einbauplatz.m_ImpulseLwl = Impulswertigkeit
End If
End If
End If
End If
'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
If Pruefzaehler.getAuftragPosition.getMetrolog = "SONDERV." And Pruefzaehler.getAuftragPosition.getKZP = 10 Then
MsgBox "Es sind keine Pr<50>fpunkte ermittelt worden. " & vbCrLf & "F<>r KZP=10 und Metrolog='SONDERV.' m<>ssen die Pr<50>fpunkte manuell eingegeben werden."
Else
ErrorMsg "Es sind keine Pr<50>fpunkte ermittelt worden.", True
End If
Else
Set m_Regulierdaten = Pruefpunkte.getRegulierdaten
End If
End If
Call updatePruefpunkte
Call CheckZulassungsPruefung
GoTo testSerienNrInputReturn
testSerienNrInputReturnFalse:
Call selectSerienNrField(Index)
Call updateZaehlerImage(Index)
txtSerienNr(Index).SetFocus
testSerienNrInput = False
testSerienNrInputReturn:
'On Error Resume Next
Call updateEinbauplatz(Index)
Exit Function
End Function
Private Function SucheSerienNrZuNichtnumerischerSerienNr(ByVal strSerienNr As String, ByRef lSerienNr As Long, Index As Integer)
Dim strSQL As String
Dim rs As CRecordset
strSerienNr = Trim(strSerienNr)
Set rs = New CRecordset
' Phase I: SerienNr suchen
If IsNumeric(strSerienNr) And Val(strSerienNr) < SERIENNR_MAXWERT And Val(strSerienNr) > SERIENNR_MINWERT Then
' SerienNr kann in eine numerische SerienNr gewandelt werden
lSerienNr = Val(strSerienNr)
strSQL = "SELECT * from AuftragPositionSerienNr where SerienNr = " & Val(strSerienNr)
rs.openRS strSQL, True
If Not rs.EOF Then
SucheSerienNrZuNichtnumerischerSerienNr = True
Exit Function
End If
End If
' SerienNr numerisch nicht gefunden = > Phase II: als KundeneigeneSerienNr suchen
strSQL = "SELECT distinct SerienNr from AuftragPositionSerienNr where replace(KundeneigeneSerienNr,' ','') like '" & Replace(strSerienNr, " ", "") & "%" & "'"
Debug.Print strSQL
rs.openRS strSQL, True
If rs.EOF Then
' Weder als SerienNr noch als Kundeneigene SerienNr gefunden
SucheSerienNrZuNichtnumerischerSerienNr = False
Exit Function
Else
If rs.RecordCount = 1 Then
lSerienNr = rs.getLongValue("SerienNr")
SucheSerienNrZuNichtnumerischerSerienNr = True
Else
MsgBox "Die Kundeneigene SerienNr ist nicht eindeutig (Anzahl " & rs.RecordCount & "). Bitte geben Sie mehr Stellen an!"
SucheSerienNrZuNichtnumerischerSerienNr = False
txtSerienNr(Index).SetFocus
End If
End If
End Function
' Menge aller eindeutigen Pr<50>fpunkte bilden
'
' @param Einbauplaetze Collection der Einbaupl<70>tze
'
' @return Collection mit allen eindeutigen CPruefpunkt-Objekten
'
' @see updatePruefpunkte
'
' ge<67>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<50>fpunkt ist noch nicht in der PPCollection vorhanden
Call Pruefpunkt.setUseCount(1)
Set KopiePruefpunkt = New CPruefpunkt
KopiePruefpunkt.copyFrom Pruefpunkt
colUniquePP.Add KopiePruefpunkt
Else
' Pr<50>fpunkt ist vorhanden
' Nur UseCount erh<72>hen
Call colUniquePP.Item(nPos).incUseCount
End If
Next
End If
End If
End If
Next
Set calcPruefpunkte = colUniquePP
End Function
' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts
' in der <20>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<50>fz<66>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 <20>bergebenen Serien-Nr. den
' zugeh<65>rigen Pr<50>fz<66>hler zuweisen.
'
' @param Einbauplatz Einbauplatz-Objekt
' @param lSerienNr Nr. des Z<>hlers ( -1 = Leerung)
'
' @return true = Pr<50>fz<66>hler konnte dem Einbauplatz zugewiesen werden
' false = Serien-Nr. ist ung<6E>ltig oder konnte nicht in der
' Datenbank gefunden werden
'
Private Function setEinbauplatzPruefzaehler(Einbauplatz As CEinbauplatz, lSerienNr As Long, Optional AuftragNr As Long) As Boolean
Dim Pruefzaehler As CPruefzaehler
Dim EinbauplatzNr As Integer
setEinbauplatzPruefzaehler = False
If Einbauplatz Is Nothing Then
Call ErrorMsg("setEinbauplatzPruefzaehler: " + "Als Einbauplatz wurde nothing <20>bergeben!")
Exit Function
End If
If lSerienNr < 0 Then
' Pr<50>fz<66>hler wurde ausgebaut
Call Einbauplatz.setPruefzaehler(Nothing)
setEinbauplatzPruefzaehler = True
ElseIf lSerienNr < SERIENNR_MINWERT Then
' Ung<6E>ltige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
ElseIf lSerienNr > SERIENNR_MAXWERT Then
' Ung<6E>ltige Serien-Nr.
Call Einbauplatz.setPruefzaehler(Nothing)
Else
' Seriennummer im g<>ltigen Bereich
Call Einbauplatz.setPruefzaehler(Nothing)
Set Pruefzaehler = New CPruefzaehler
' Pr<50>fen, ob eine Auftragsposition existiert
If Pruefzaehler.loadForSerienNr(lSerienNr, AuftragNr) Then
'If Pruefzaehler.loadForSerienNr_neu(lSerienNr, AuftragNr) Then
' Pr<50>fz<66>hler vorhanden
setEinbauplatzPruefzaehler = True
If Pruefzaehler.m_lng_LWLImpulswertigkeit > 0 Then
txtImpulswertigkeitLwl.text = Pruefzaehler.m_lng_LWLImpulswertigkeit
End If
' Herausgenommen am 30.09.2014 au Wunsch Peter Buch
' If Pruefzaehler.m_blnIsEncoder And chkFiberoptic.value = vbChecked Then
' If chk_LWL_Encoder.value <> vbChecked Then
' If MsgBox("Pr<50>fz<66>hler wurde als Encoder identifiziert. 'LWL Encoder f.a. Pr<50>fpunkte' wird nun vorausgew<65>hlt!", vbQuestion, vbOKCancel) = vbOK Then
' chk_LWL_Encoder.value = vbChecked
' End If
' End If
' End If
DebugMsg "Pr<50>fz<66>hler mit SerienNr " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr
Else
' Todo: muss ein Pr<50>fz<66>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 <20>bergebenen Pr<50>fz<66>hlers an verschiedenen
' Einbaupl<70>tzen auf?
'
' @param Pruefzaehler auf Eindeutigkeit zu <20>berpr<70>fender Pr<50>fz<66>hler
'
' Sonderfall: Pr<50>fz<66>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<50>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<50>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 Einbauplatz As CEinbauplatz
Dim StatusFertigung As Integer
imgZaehler(Index).Enabled = True
Set Einbauplatz = getEinbauplatz(Index)
cmdRuecklaeuferanalyse(Index).Enabled = False
lblStatus(Index).BackColor = &H8000000B
txtSerienNr(Index).FontSize = 14
If Einbauplatz.getPruefzaehler() Is Nothing Then
' Leere Eingabe, kein Pr<50>fz<66>hler eingebaut
lblEinbau(Index).caption = ""
txtSerienNr(Index).BackColor = &HFFFFFF
imgZaehler(Index).Enabled = False
lblStatus(Index).caption = ""
txtDoppelimpulssperrzahl.text = ""
lblVoreinstellwert(Index).caption = ""
lblVoreinstellwert(Index).ToolTipText = "Sollwert Regulierung"
lblVoreinstellwert(Index).Visible = 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<6E>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
If chkMesseins<6E>tzeMerken.value = vbUnchecked Then
'ge<67>ndert am 14.02.2003 Pf, der letzte eigegebene Z<>hler bestimmt den Status "nur Messeins<6E>tze" JA/NEIN
If Trim(Pruefzaehler.getIdentNrObj.GetKurzBezeichnung) <> "ME" Then
chkNurMesseinsaetze.value = 0
Else
chkNurMesseinsaetze.value = 1
End If
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
Dim rs_eRegister As CRecordset
If chkeRegisterPruefung.value = vbChecked Then
If Get_eRegister_Recordset(Pruefzaehler.getSerienNr, rs_eRegister) Then
lblEinbau(Index).caption = lblEinbau(Index).caption & " " & rs_eRegister.getStringValue("Adresse")
End If
End If
'RH 2.7.2007
' Pruefzaehler.getAuftragPositionSerienNr.load Pruefzaehler.getSerienNr
' StatusFertigung = Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung
'
' If StatusFertigung < 25 Then
' lblStatus(index).Caption = ""
' End If
'
' If StatusFertigung >= 25 And StatusFertigung < 30 Then
' lblStatus(index).Caption = "Wdh"
' lblStatus(index).BackColor = RGB(255, 255, 128)
' End If
'
' If StatusFertigung >= 30 Then
' lblStatus(index).Caption = "keine Wdh erf."
' txtSerienNr(index).BackColor = vbYellow
' lblStatus(index).BackColor = RGB(255, 128, 128)
' End If
UpdateStatusFertigung Index
End If
Call updateSollwertRegulierung(Pruefzaehler, Index)
If Einbauplatz.getPPWarning() Then
imgInfo(Index).Picture = frmRes.imgWarning.Picture
imgInfo(Index).Visible = True
Else
imgInfo(Index).Visible = False
End If
SetzeErstenEingabautenPruefzaehler
If chkAnzeigeKundeneigeneSerienNr.value = vbChecked Then
Call AnzeigeKundeneigeneSerienNr(Index)
End If
End Function
Private Sub updateSollwertRegulierung(Pruefzaehler As CPruefzaehler, Index)
Dim lngGruppe As Long
Dim dblSollwert As Double
Dim strPruefer As String
Dim datDatum As Date
Dim strBemerkung As String
On Error GoTo Errorhandler
If Not Pruefzaehler Is Nothing Then
If Not Pruefzaehler.getPruefpunkte Is Nothing Then
If Pruefzaehler.getIdentNrObj.GetVakoCode <> "" Then
'VakoCode
'
Else
If GetLetzteAenderungSollwertFromMetrologIdentNr(Pruefzaehler.getPruefpunkte.getPruefklasseKZ, Pruefzaehler.getIdentNr, dblSollwert, strPruefer, datDatum, strBemerkung) Then
lblVoreinstellwert(Index).caption = Format(dblSollwert, "0.0")
lblVoreinstellwert(Index).ToolTipText = "Sollwert Regulierung: " & Format(dblSollwert, "0.0") & "% "
lblVoreinstellwert(Index).ToolTipText = lblVoreinstellwert(Index).ToolTipText & "ge<67>ndert von Pr<50>fer " & strPruefer & " "
lblVoreinstellwert(Index).ToolTipText = lblVoreinstellwert(Index).ToolTipText & "am " & Format(datDatum, "dd.mm.yyyy") & " "
lblVoreinstellwert(Index).ToolTipText = lblVoreinstellwert(Index).ToolTipText & strBemerkung
lblVoreinstellwert(Index).Visible = True
Else
Dim Regulierdaten As CRegulierdaten
Set Regulierdaten = New CRegulierdaten
Call Regulierdaten.load(Pruefzaehler.getIdentNrObj.getNr, Pruefzaehler.getPruefpunkte.getPruefklasseKZ)
lblVoreinstellwert(Index).caption = Regulierdaten.getSPSSollwertRegulierung
lblVoreinstellwert(Index).ToolTipText = "Sollwert Regulierung: Originalwert aus DB=" & Regulierdaten.getSPSSollwertRegulierung & "%"
lblVoreinstellwert(Index).Visible = True
End If
End If
End If
End If
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in frmPruefzaehlerpruefung.updateSollwertRegulierung() " & Err.Description
End Sub
'------------------------------------------------------
'------------------------------------------
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
g_bln_Pruefung_nach_MID = False
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 (IdentNr=" & Pruefzaehler.getIdentNr & ", Metrolog='" & Pruefzaehler.getPruefklasseKZ & "') enth<74>lt keine Pr<50>fpunktdaten in der Datenbank. M<>chten Sie jetzt Pr<50>fpunkte eingeben?", vbYesNo) = vbYes Then
Call imgZaehler_Click(Index)
Else
txtSerienNr(Index).text = ""
' Alternativ:
'txtSerienNr(Index).BackColor = vbRed
' Fokus setzen, um ein Validate Event zu bekommen:
txtSerienNr(Index).SetFocus
End If
End If
End Sub
Public Sub Hauptpruefung()
Dim dlgHauptPruefung As frmHauptprf
' hier beginnt auf jeden Fall ein neuer Pr<50>fgang
Set m_Pruefgang = Nothing
Set m_Pruefgang = New CPruefgang
Set dlgHauptPruefung = New frmHauptprf
Set dlgHauptPruefung.m_ParentForm = Me
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
Set dlgHauptPruefung.m_Regulierdaten = m_Regulierdaten
' dlgHauptPruefung.m_bKeineRegulierung = CBool(chkKeineRegulierung.Value)
' <20>bergabe der Obejkt-Referenz auf den Pr<50>fgang
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
If chkEinbauplatzImpulswertigkeit.value = vbUnchecked Then
If Val(txtImpulswertigkeitPZ.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitPZ = CLng(txtImpulswertigkeitPZ.text)
End If
If Val(txtImpulswertigkeitLwl.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitLwl = CLng(txtImpulswertigkeitLwl.text)
Else
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
Else
dlgHauptPruefung.m_ImpulswertigkeitPZ = 0
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
' neu RH 10.07.2007
m_colUniquePP.sortQ
'
Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
' Flags
dlgHauptPruefung.m_bAutomatik = chkRegulierung.value
dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
dlgHauptPruefung.m_Regelart = m_Regelart
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
dlgHauptPruefung.m_NurMesseinsaetze = (chkNurMesseinsaetze.value = 1)
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
dlgHauptPruefung.m_RegulierungVerwenden = CInt(chkRegulierungVerwenden.value = 1)
dlgHauptPruefung.m_bRegulierungDurchfuehren = CBool(chkRegulierungDurchfuehren.value = vbChecked)
dlgHauptPruefung.m_blnRueckwaertspruefung = CBool(chkRueckwaertsprf.value = vbChecked)
dlgHauptPruefung.m_bKontinuierlich = CBool(chkKontinuierlichePrf.value = vbChecked)
dlgHauptPruefung.m_bEichpruefvorgabenIgnorieren = CBool(chkEichpruefvorgabenIgnorieren.value = vbChecked)
dlgHauptPruefung.m_bLichtwellenleiter = CBool(chkFiberoptic.value = vbChecked And chkFiberoptic.Visible = True)
dlgHauptPruefung.m_blnKundeneigeneSerienNrAnzeigen = CBool(chkAnzeigeKundeneigeneSerienNr.value = vbChecked)
dlgHauptPruefung.m_bRegulierungInQtDurchfehhren = CBool(chkQtRegulierung.value = vbChecked)
dlgHauptPruefung.m_bytDoppelimpulssperrzahl = CByte(Val(txtDoppelimpulssperrzahl.text))
Set m_ersterEingebauterPruefzaehlerDerLetztenPruefung = m_ersterEingebauterPruefzaehler
cmdPPUebernehmen.ToolTipText = "Hiermit <20>bernehmen Sie die Pr<50>fpunkte des letzten Pr<50>fganges von Pr<50>fz<66>hler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " f<>r alle eingebauten Pr<50>fz<66>hler."
cmdPPUebernehmen.Enabled = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dlgHauptPruefung.Show vbModal, Me
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set m_Pruefgang = dlgHauptPruefung.m_Pruefgang
Call chkProtokolldruck_Click
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
If dlgHauptPruefung.getExitCode = IDOK Then
' Pr<50>fung erfolgreich abgeschlossen
If g_bMeitwinMID_Sonderpruefung Then
If g_blnVersuch And (g_App.PruefstationNr = 2010 Or g_App.PruefstationNr = 2009) Then
MsgBox "Pr<50>fergebnisse werden NICHT gel<65>scht (da Versuchspr<70>fer an der P2009/P2010)."
Else
m_Pruefgang.delete
Set m_Pruefgang = Nothing
End If
End If
Else
If m_Pruefgang.PruefgangNr > 0 Then
If g_blnVersuch Then
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & ". Abbruch!"
m_Pruefgang.save
Else
MsgBox "Sie haben den Pr<50>fgang abgebrochen. Die Pr<50>fergebnisse dieses Pr<50>fganges werden vollst<73>ndig gel<65>scht!", , "Pruef2000"
Dim i As Integer
Dim strSerienNr As String
strSerienNr = ""
For i = 1 To 10
strSerienNr = Trim(strSerienNr & " " & txtSerienNr(i).text)
Next
LogIntoDB "gel<65>schter Pr<50>fgang f<>r SerienNr: " & strSerienNr, "Abbr<62>che"
m_Pruefgang.mstrSerienNrListe = strSerienNr
m_Pruefgang.saveAbgebrochenen
ShowStatus "Daten des abgebrochenen Pr<50>fgangs werden gel<65>scht (Dauer max 2 Minuten)..."
m_Pruefgang.delete
ShowStatus ""
Set m_Pruefgang = Nothing
lblPruefgangNr.caption = ""
LadeAuftragPositionSerienNrNeu m_colEinbauplatz
End If
Else
' hier gibt es keinen Pr<50>fgang zum l<>schen
End If
End If
chkRueckwaertsprf.Enabled = False
chkRueckwaertsprf.value = vbUnchecked
chkRueckwaertsprf.Enabled = True
'''''''''''''''''''
' Fertigungstatus aktualisieren
Call AktualisiereEinbauplatzInfos
'''''''''''''''''''
setzeFocusBeimStart
'******************
PruefeAufUpdate
If AnzahlNeueMails() > 0 Then
If g_blnMitteilungengelesen = False Then
frmMitteilungen.Show vbModal
g_blnMitteilungengelesen = True
End If
End If
'**************
End Sub
Public Sub Hauptpruefung_eRegister()
Dim dlgHauptPruefung As frmHauptprf_ereg
Dim PPNr As Integer
' hier beginnt auf jeden Fall ein neuer Pr<50>fgang
Set m_Pruefgang = Nothing
Set m_Pruefgang = New CPruefgang
Set dlgHauptPruefung = New frmHauptprf_ereg
Set dlgHauptPruefung.m_ParentForm = Me
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
Set dlgHauptPruefung.m_Regulierdaten = m_Regulierdaten
' <20>bergabe der Obejkt-Referenz auf den Pr<50>fgang
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
If chkEinbauplatzImpulswertigkeit.value = vbUnchecked Then
If Val(txtImpulswertigkeitPZ.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitPZ = CLng(txtImpulswertigkeitPZ.text)
End If
If Val(txtImpulswertigkeitLwl.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitLwl = CLng(txtImpulswertigkeitLwl.text)
Else
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
Else
dlgHauptPruefung.m_ImpulswertigkeitPZ = 0
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
If chkPPunsortiert.value = vbUnchecked Then
' neu RH 10.07.2007
m_colUniquePP.sortQ
End If
' der erste PP wird normalerweise mit einer eRegister-Messung gepr<70>ft
m_colUniquePP.Item(1).m_bln_eRegisterPruefung = True
If chk_eReg_alle_PP.value = vbChecked Then
dlgHauptPruefung.m_bln_Alle_PP_mit_eRegister = True
' alle Pr<50>fpunkte werden mit eRegister-Messung gepr<70>ft
For PPNr = 1 To m_colUniquePP.Count
m_colUniquePP.Item(PPNr).m_bln_eRegisterPruefung = True
Next
Else
dlgHauptPruefung.m_bln_Alle_PP_mit_eRegister = False
End If
If cmbPruefpunkte.text <> "" Then
Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
End If
' Flags
dlgHauptPruefung.m_bAutomatik = chkRegulierung.value
dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
dlgHauptPruefung.m_Regelart = m_Regelart
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
dlgHauptPruefung.m_NurMesseinsaetze = (chkNurMesseinsaetze.value = 1)
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
dlgHauptPruefung.m_RegulierungVerwenden = CInt(chkRegulierungVerwenden.value = vbChecked)
dlgHauptPruefung.m_bRegulierungDurchfuehren = CBool(chkRegulierungDurchfuehren.value = vbChecked)
dlgHauptPruefung.m_blnRueckwaertspruefung = CBool(chkRueckwaertsprf.value = vbChecked)
dlgHauptPruefung.m_bKontinuierlich = CBool(chkKontinuierlichePrf.value = vbChecked)
dlgHauptPruefung.m_bEichpruefvorgabenIgnorieren = CBool(chkEichpruefvorgabenIgnorieren.value = vbChecked)
dlgHauptPruefung.m_bLichtwellenleiter = CBool(chkFiberoptic.value = vbChecked And chkFiberoptic.Visible = True)
dlgHauptPruefung.m_blnKundeneigeneSerienNrAnzeigen = CBool(chkAnzeigeKundeneigeneSerienNr.value = vbChecked)
dlgHauptPruefung.m_bRegulierungInQtDurchfehhren = CBool(chkQtRegulierung.value = vbChecked)
dlgHauptPruefung.m_bytDoppelimpulssperrzahl = CByte(Val(txtDoppelimpulssperrzahl.text))
Set m_ersterEingebauterPruefzaehlerDerLetztenPruefung = m_ersterEingebauterPruefzaehler
cmdPPUebernehmen.ToolTipText = "Hiermit <20>bernehmen Sie die Pr<50>fpunkte des letzten Pr<50>fganges von Pr<50>fz<66>hler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " f<>r alle eingebauten Pr<50>fz<66>hler."
cmdPPUebernehmen.Enabled = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dlgHauptPruefung.Show vbModeless, Me
' aufrufen des Ablaufs,
dlgHauptPruefung.Hauptpruefung
If False Then
Unload dlgHauptPruefung
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set m_Pruefgang = dlgHauptPruefung.m_Pruefgang
Call chkProtokolldruck_Click
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
If dlgHauptPruefung.getExitCode = IDOK Then
' Pr<50>fung erfolgreich abgeschlossen
If g_bMeitwinMID_Sonderpruefung Then
m_Pruefgang.delete
Set m_Pruefgang = Nothing
Else
m_Pruefgang.save
End If
Else
If m_Pruefgang.PruefgangNr > 0 Then
If g_blnVersuch Then
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & ". Abbruch!"
m_Pruefgang.save
Else
If MsgBox("Sie haben den Pr<50>fgang abgebrochen. M<>chten Sie die Pr<50>fergebnisse dieses Pr<50>fganges vollst<73>ndig l<>schen?", vbYesNo Or vbDefaultButton2, "Pruef2000") = vbYes Then
Dim i As Integer
Dim strSerienNr As String
For i = 1 To 10
strSerienNr = Trim(strSerienNr & " " & txtSerienNr(i).text)
Next
LogIntoDB "gel<65>schter Pr<50>fgang f<>r SerienNr: " & strSerienNr, "Abbr<62>che"
m_Pruefgang.saveAbgebrochenen
ShowStatus "Daten des abgebrochenen Pr<50>fgangs werden gel<65>scht (Dauer max 2 Minuten)..."
m_Pruefgang.delete
ShowStatus ""
Set m_Pruefgang = Nothing
lblPruefgangNr.caption = ""
LadeAuftragPositionSerienNrNeu m_colEinbauplatz
Else
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & ". Abbruch. Ergebnisse beibehalten."
m_Pruefgang.save
End If
End If
Else
' hier gibt es keinen Pr<50>fgang zum l<>schen
End If
End If
chkRueckwaertsprf.Enabled = False
chkRueckwaertsprf.value = vbUnchecked
chkRueckwaertsprf.Enabled = True
'''''''''''''''''''
' Fertigungstatus aktualisieren
Call AktualisiereEinbauplatzInfos
'''''''''''''''''''
setzeFocusBeimStart
'******************
PruefeAufUpdate
If AnzahlNeueMails() > 0 Then
If g_blnMitteilungengelesen = False Then
frmMitteilungen.Show vbModal
g_blnMitteilungengelesen = True
End If
End If
'**************
End Sub
Public Sub Hauptpruefung_Genesis()
Dim dlgHauptPruefung As frmHauptprf_genesis
Dim PPNr As Integer
' hier beginnt auf jeden Fall ein neuer Pr<50>fgang
Set m_Pruefgang = Nothing
Set m_Pruefgang = New CPruefgang
Set dlgHauptPruefung = New frmHauptprf_genesis
Set dlgHauptPruefung.m_ParentForm = Me
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
Set dlgHauptPruefung.m_Regulierdaten = m_Regulierdaten
' <20>bergabe der Obejkt-Referenz auf den Pr<50>fgang
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
If chkEinbauplatzImpulswertigkeit.value = vbUnchecked Then
If Val(txtImpulswertigkeitPZ.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitPZ = CLng(txtImpulswertigkeitPZ.text)
End If
If Val(txtImpulswertigkeitLwl.text) > 0 Then
dlgHauptPruefung.m_ImpulswertigkeitLwl = CLng(txtImpulswertigkeitLwl.text)
Else
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
Else
dlgHauptPruefung.m_ImpulswertigkeitPZ = 0
dlgHauptPruefung.m_ImpulswertigkeitLwl = 0
End If
If chkPPunsortiert.value = vbUnchecked Then
' neu RH 10.07.2007
m_colUniquePP.sortQ
End If
' der erste PP wird normalerweise mit einer eRegister-Messung gepr<70>ft
m_colUniquePP.Item(1).m_bln_eRegisterPruefung = True
If chk_eReg_alle_PP.value = vbChecked Then
dlgHauptPruefung.m_bln_Alle_PP_mit_eRegister = True
' alle Pr<50>fpunkte werden mit eRegister-Messung gepr<70>ft
For PPNr = 1 To m_colUniquePP.Count
m_colUniquePP.Item(PPNr).m_bln_eRegisterPruefung = True
Next
Else
dlgHauptPruefung.m_bln_Alle_PP_mit_eRegister = False
End If
If cmbPruefpunkte.text <> "" Then
Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
End If
' Flags
dlgHauptPruefung.m_bAutomatik = chkRegulierung.value
dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
dlgHauptPruefung.m_Regelart = m_Regelart
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
dlgHauptPruefung.m_NurMesseinsaetze = (chkNurMesseinsaetze.value = 1)
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
dlgHauptPruefung.m_RegulierungVerwenden = CInt(chkRegulierungVerwenden.value = vbChecked)
dlgHauptPruefung.m_bRegulierungDurchfuehren = CBool(chkRegulierungDurchfuehren.value = vbChecked)
dlgHauptPruefung.m_blnRueckwaertspruefung = CBool(chkRueckwaertsprf.value = vbChecked)
dlgHauptPruefung.m_bKontinuierlich = CBool(chkKontinuierlichePrf.value = vbChecked)
dlgHauptPruefung.m_bEichpruefvorgabenIgnorieren = CBool(chkEichpruefvorgabenIgnorieren.value = vbChecked)
dlgHauptPruefung.m_bLichtwellenleiter = CBool(chkFiberoptic.value = vbChecked And chkFiberoptic.Visible = True)
dlgHauptPruefung.m_blnKundeneigeneSerienNrAnzeigen = CBool(chkAnzeigeKundeneigeneSerienNr.value = vbChecked)
dlgHauptPruefung.m_bRegulierungInQtDurchfehhren = CBool(chkQtRegulierung.value = vbChecked)
dlgHauptPruefung.m_bytDoppelimpulssperrzahl = CByte(Val(txtDoppelimpulssperrzahl.text))
Set m_ersterEingebauterPruefzaehlerDerLetztenPruefung = m_ersterEingebauterPruefzaehler
cmdPPUebernehmen.ToolTipText = "Hiermit <20>bernehmen Sie die Pr<50>fpunkte des letzten Pr<50>fganges von Pr<50>fz<66>hler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " f<>r alle eingebauten Pr<50>fz<66>hler."
cmdPPUebernehmen.Enabled = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dlgHauptPruefung.Show vbModeless, Me
' aufrufen des Ablaufs,
dlgHauptPruefung.Hauptpruefung
If False Then
Unload dlgHauptPruefung
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set m_Pruefgang = dlgHauptPruefung.m_Pruefgang
Call chkProtokolldruck_Click
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
If dlgHauptPruefung.getExitCode = IDOK Then
' Pr<50>fung erfolgreich abgeschlossen
If g_bMeitwinMID_Sonderpruefung Then
m_Pruefgang.delete
Set m_Pruefgang = Nothing
Else
m_Pruefgang.save
End If
Else
If m_Pruefgang.PruefgangNr > 0 Then
If g_blnVersuch Then
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & ". Abbruch!"
m_Pruefgang.save
Else
If MsgBox("Sie haben den Pr<50>fgang abgebrochen. M<>chten Sie die Pr<50>fergebnisse dieses Pr<50>fganges vollst<73>ndig l<>schen?", vbYesNo Or vbDefaultButton2, "Pruef2000") = vbYes Then
Dim i As Integer
Dim strSerienNr As String
For i = 1 To 10
strSerienNr = Trim(strSerienNr & " " & txtSerienNr(i).text)
Next
LogIntoDB "gel<65>schter Pr<50>fgang f<>r SerienNr: " & strSerienNr, "Abbr<62>che"
m_Pruefgang.saveAbgebrochenen
ShowStatus "Daten des abgebrochenen Pr<50>fgangs werden gel<65>scht (Dauer max 2 Minuten)..."
m_Pruefgang.delete
ShowStatus ""
Set m_Pruefgang = Nothing
lblPruefgangNr.caption = ""
LadeAuftragPositionSerienNrNeu m_colEinbauplatz
Else
m_Pruefgang.Bemerkung = m_Pruefgang.Bemerkung & ". Abbruch. Ergebnisse beibehalten."
m_Pruefgang.save
End If
End If
Else
' hier gibt es keinen Pr<50>fgang zum l<>schen
End If
End If
chkRueckwaertsprf.Enabled = False
chkRueckwaertsprf.value = vbUnchecked
chkRueckwaertsprf.Enabled = True
'''''''''''''''''''
' Fertigungstatus aktualisieren
Call AktualisiereEinbauplatzInfos
'''''''''''''''''''
setzeFocusBeimStart
'******************
'**************
End Sub
Private Function SindAlleZaehlerTemperaturAehnlich() As Boolean
Dim ErsterPruefzaehler As CPruefzaehler
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set ErsterPruefzaehler = Nothing
SindAlleZaehlerTemperaturAehnlich = True
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
If ErsterPruefzaehler Is Nothing Then
Set ErsterPruefzaehler = Einbauplatz.getPruefzaehler
Else
If (ErsterPruefzaehler.getIdentNrObj.GetTemperatur >= 70) <> (Pruefzaehler.getIdentNrObj.GetTemperatur >= 70) Then
SindAlleZaehlerTemperaturAehnlich = False
Exit For
End If
End If
End If
Next
End Function
Private Function SindZaehlerAehnlich() As Boolean
' <20>berpr<70>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<74>gen z.B. m^3,RS,WI Wenn m^3 dann mu<6D> <20>berall m^3 vorhanden sein, sonst mu<6D> gleich sein
On Error Resume Next
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim Pruefpunkt As CPruefpunkt
Dim colUniquePP As New CPruefpunktCol
Dim IdentNrObj As CIdentNr
Dim AuftragPosition As CAuftragPosition
Dim Regulierdaten As CRegulierdaten
Dim vergleich As String
Dim ersterZaehler As Boolean
Dim VergleichMuster As String
ersterZaehler = True
VergleichMuster = ""
vergleich = ""
SindZaehlerAehnlich = True
' Todo
Exit Function
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
Set IdentNrObj = Pruefzaehler.getIdentNrObj()
Set AuftragPosition = Pruefzaehler.getAuftragPosition()
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
Set Regulierdaten = New CRegulierdaten
Call Regulierdaten.load(IdentNrObj.getNr, Pruefpunkte.getPruefklasseKZ)
If Not Pruefzaehler.getAuftrag.getNr = 99999 Then
vergleich = "Nennweite=" & IdentNrObj.getNennweite & ";"
vergleich = vergleich & "Type=" & IdentNrObj.getTyp & IdentNrObj.getTypzusatz & ";"
If chkRegulierung.value = vbChecked Then
vergleich = vergleich & "Anzeige=" & Mid(AuftragPosition.getAnzeige, 1, 3) & "; "
Else
vergleich = vergleich & "Sollwert=" & Regulierdaten.getSPSSollwertRegulierung & ";"
End If
' vergleich = vergleich & "Impulswertigkeit=" & Pruefzaehler.GetImpulseQM
Else
' Test-Pruefzaehler k<>nnen nur mit anderen Test-Pr<50>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 <20>hnlich !
If VergleichMuster <> vergleich Then
SindZaehlerAehnlich = False
End If
End If
End If
ersterZaehler = False
Next
End Function
Sub AlleEinbauplaetzeDesGleichenAuftragesAktualisieren(Index As Integer)
Dim AuftragNr As Long
Dim PositionNr As Long
Dim PruefzaehlerAktuell As CPruefzaehler
Dim PruefzaehlerVergleich As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Set PruefzaehlerAktuell = m_colEinbauplatz(Index).getPruefzaehler
AuftragNr = PruefzaehlerAktuell.getAuftrag.getNr
PositionNr = PruefzaehlerAktuell.getAuftragPosition.getNr
For Each Einbauplatz In m_colEinbauplatz
Set PruefzaehlerVergleich = Einbauplatz.getPruefzaehler
If Not PruefzaehlerVergleich Is Nothing Then
If PruefzaehlerAktuell.getAuftrag.getNr = PruefzaehlerVergleich.getAuftrag.getNr And PruefzaehlerAktuell.getAuftragPosition.getNr = PruefzaehlerVergleich.getAuftragPosition.getNr Then
bTextChanged(Einbauplatz.getNr) = True
Debug.Print "gleiche AuftragNr/PosNr in Einbauplatz " & Einbauplatz.getNr
Call updateEinbauplatz(Einbauplatz.getNr)
Call ueberpruefe(Einbauplatz.getNr)
End If
End If
Next
End Sub
Private Sub InitCmbAnzahlZaehler()
Dim i As Integer
For i = 0 To 10
cmbAnzahlZaehler.AddItem CStr(i)
Next
cmbAnzahlZaehler.ListIndex = g_App.Settings.GetAnzahlFuerVoreinstellwert
End Sub
Private Sub cmbAnzahlZaehler_Click()
g_App.Settings.SetAnzahlFuerVoreinstellwert cmbAnzahlZaehler.ListIndex
End Sub
Sub AktualisiereEinbauplatzInfos()
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim AuftragPosition As CAuftragPosition
Dim strSerienNr As String
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
UpdateStatusFertigung Einbauplatz.getNr
' neu RH 8.12.2009
Set AuftragPosition = Einbauplatz.getPruefzaehler.getAuftragPosition
AuftragPosition.UpdateTLMenge_P
AuftragPosition.save Einbauplatz.getPruefzaehler.getAuftrag
End If
Next
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in AktualisiereEinbauplatzInfos():" & Err.Description, "unbekannt"
End Sub
Sub UpdateStatusFertigung(Index As Integer)
Dim StatusFertigung As Integer
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
lblStatus(Index).caption = ""
lblStatus(Index).BackColor = &H8000000F
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
AuftragpositionSerienNr.load Pruefzaehler.getSerienNr, Pruefzaehler.getAuftrag.getNr
Pruefzaehler.SetAuftragPositionSerienNr AuftragpositionSerienNr
StatusFertigung = AuftragpositionSerienNr.getStatusFertigung
If StatusFertigung < 25 Then
' ungepr<70>ft
lblStatus(Index).caption = ""
lblStatus(Index).BackColor = &H8000000F ' hellgrau
End If
If StatusFertigung >= 25 And StatusFertigung < 30 Then
' ausserhalb der Fehlergrenzen: Wiederholung
lblStatus(Index).caption = "Wdh"
lblStatus(Index).BackColor = RGB(255, 255, 128) ' gelb
End If
If StatusFertigung >= 30 Then
' innerhalb der Fehlergrenzen
lblStatus(Index).caption = "keine Wdh erf."
lblStatus(Index).BackColor = RGB(128, 255, 128) ' gr<67>n
End If
Else
LogIntoDB "Fehler in UpdateStatusFertigung(): falscher Index ", "Programmfehler"
End If
End Sub
Private Sub Check_If_Sonderversion_PP_Ubernehmen_Erlaubt()
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
'
' If Val(lblPruefgangNr.Caption) = 0 Then
' cmdPPUebernehmen.Enabled = False
' Exit Sub
' End If
'
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' If Pruefzaehler.getPruefklasseKZ <> "SONDERV." Then
' cmdPPUebernehmen.Enabled = False
' Exit Sub
' End If
' End If
' Next
' cmdPPUebernehmen.Enabled = True
End Sub
Private Sub SetzeErstenEingabautenPruefzaehler()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim i As Integer
For i = 1 To lblEbpNr.Count - 1
lblEbpNr(i).caption = i
lblEbpNr(i).ToolTipText = ""
Next
i = 0
For Each Einbauplatz In m_colEinbauplatz
i = i + 1
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set m_ersterEingebauterPruefzaehler = Pruefzaehler
lblEbpNr(i).caption = i & "*"
lblEbpNr(i).ToolTipText = "Der erster eingebaute Pr<50>fz<66>hler bestimmt Pr<50>fgang Parameter (Doppelimpulsserre usw.)"
Exit For
End If
Next
End Sub
Private Sub UpdateDoppelimpulsperre()
Dim ErsterPruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
If txtDoppelimpulssperrzahl.text = "" Then
Set ErsterPruefzaehler = Nothing
For Each Einbauplatz In m_colEinbauplatz
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
If Not Pruefzaehler Is Nothing Then
If ErsterPruefzaehler Is Nothing Then
Set ErsterPruefzaehler = Einbauplatz.getPruefzaehler
If Not g_blnVersuch And Not ErsterPruefzaehler.getIdentNrObj Is Nothing Then
txtDoppelimpulssperrzahl.text = ErsterPruefzaehler.getIdentNrObj.GetDoppelimpulssperrzahl
If txtDoppelimpulssperrzahl.text <> 0 Then
txtDoppelimpulssperrzahl.BackColor = RGB(255, 128, 128)
End If
Else
txtDoppelimpulssperrzahl.text = "0"
End If
End If
End If
Next
End If
End Sub
Public Sub ShowStatus(strMessage As String)
StatusBar1.SimpleText = strMessage
DoEvents
End Sub
Private Sub FuerVersuchAusblendenOderVorbesetzten()
If Not g_blneRegisterPruefung Then
chkRegulierungDurchfuehren.value = IIf(g_blnVersuch, vbUnchecked, vbChecked)
End If
chkPruefgangLang.Enabled = IIf(g_blnVersuch, vbChecked, vbUnchecked)
chk_LWL_Encoder.value = IIf(g_blnVersuch, vbUnchecked, chk_LWL_Encoder.value)
'chk_LWL_Encoder.Enabled = Not g_blnVersuch
If g_App.Mitarbeiter.GetPruefstellenleiter() = True Or g_blnVersuch Then
txtDoppelimpulssperrzahl.Enabled = True
chkeRegisterPruefung.Enabled = True
Else
txtDoppelimpulssperrzahl.Enabled = False
chkeRegisterPruefung.Enabled = False
End If
End Sub
''''''''''''''''''''''''''''''''''
Private Sub cmdPP_Down_Click()
Dim Index As Integer
If lstPruefpunkte.ListIndex < 0 Then Exit Sub
Index = lstPruefpunkte.ListIndex + 1
If Index < m_colUniquePP.Count Then
m_colUniquePP.Vertausche Index, Index + 1
End If
UpdateLstPruefpunkte
End Sub
Private Sub cmdPP_Up_Click()
Dim Index As Integer
If lstPruefpunkte.ListIndex < 0 Then Exit Sub
Index = lstPruefpunkte.ListIndex + 1
If Index - 1 >= 1 Then
m_colUniquePP.Vertausche Index, Index - 1
End If
UpdateLstPruefpunkte
End Sub
Private Sub UpdateLstPruefpunkte()
Dim i As Integer
Dim strQ As String
If m_colUniquePP Is Nothing Then Exit Sub
If m_colUniquePP.Count = 0 Then Exit Sub
If lstPruefpunkte.ListIndex > -1 Then
strQ = lstPruefpunkte.List(lstPruefpunkte.ListIndex)
End If
lstPruefpunkte.Clear
For i = 1 To m_colUniquePP.Count
Debug.Print i & ": " & m_colUniquePP.Item(i).getQ
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
If CStr(m_colUniquePP.Item(i).getQ) = strQ And strQ <> "" Then
lstPruefpunkte.ListIndex = i - 1
End If
Next
End Sub
Private Sub cmdPruefpunkte_Click()
Pruefpunktkontrolle m_colEinbauplatz, m_colUniquePP
' Dim objForm As frmFlexgrid
' Set objForm = New frmFlexgrid
' objForm.MSFlexGrid1.Clear
'
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
' Dim Pruefpunktcol As Collection
' Dim Pruefpunkt As CPruefpunkt
' Dim PPNr As Integer
'
' objForm.Caption = "Pruef2000 Pr<50>fpunkt Kontrolle"
' objForm.lblText = "Pr<50>fpunkt Kontrolle"
' objForm.MSFlexGrid1.Cols = 11
' objForm.MSFlexGrid1.Rows = 11
' objForm.Width = 6960
' objForm.chkIgnore.Visible = False
' ' F<>r alle Einbaupl<70>tze
' For Each Einbauplatz In m_colEinbauplatz
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
' If Not Pruefzaehler Is Nothing Then
' ' f<>r jeden Pr<50>fz<66>hler
' objForm.MSFlexGrid1.TextMatrix(Einbauplatz.getNr, 0) = " " & Pruefzaehler.getSerienNr & " "
'
' PPNr = 0
' For Each Pruefpunkt In m_colUniquePP.getCollection
' PPNr = PPNr + 1
' If objForm.MSFlexGrid1.TextMatrix(0, PPNr) = "" Then
' objForm.MSFlexGrid1.TextMatrix(0, PPNr) = Pruefpunkt.getQ
' Else
' If Not objForm.MSFlexGrid1.TextMatrix(0, PPNr) = Pruefpunkt.getQ Then
' Debug.Print objForm.MSFlexGrid1.TextMatrix(0, PPNr) & " <> " & Pruefpunkt.getQ
' End If
' End If
'
' objForm.MSFlexGrid1.row = Einbauplatz.getNr
' objForm.MSFlexGrid1.Col = PPNr
'
' If Pruefzaehler.getPruefpunkte.hasQ(Pruefpunkt.getQ) Then
' objForm.MSFlexGrid1.CellBackColor = vbGreen
' Else
' objForm.MSFlexGrid1.CellBackColor = vbRed
' End If
' Next
' End If
' Next
'
'
'
' objForm.Show vbModal
End Sub
Private Sub cmdRegulierungsformular_Click()
Dim frmReg As frmRegulierung
Set frmReg = New frmRegulierung
Set frmReg.m_colEinbauplatz = m_colEinbauplatz
Set frmReg.m_colUniquePP = m_colUniquePP
Set frmReg.m_Regulierdaten = m_Regulierdaten
frmReg.Show
End Sub
Private Sub Ausblenden_Wenn_eRegistrer()
' Laut Thomas Quedenbaum am 29.8.2016 sollen alle Optionen ausgeblendet werden,
' die f<>r eine eRegister Pr<50>fung nicht relevant sind
If g_blnVersuch Then Exit Sub
If g_blneRegisterPruefung = False Then Exit Sub
If Not m_ersterEingebauterPruefzaehler Is Nothing Then
If m_ersterEingebauterPruefzaehler.getIdentNrObj.getNennweite >= 200 Then
FrameRegulierung.Visible = True
chkRegulierungDurchfuehren.Enabled = True
chkRegulierung.Enabled = True
chkQtRegulierung.Enabled = True
Else
FrameRegulierung.Visible = False
chkRegulierungDurchfuehren.value = vbUnchecked
chkRegulierung.value = vbUnchecked
chkQtRegulierung.value = vbUnchecked
End If
Else
Exit Sub
End If
frmScanner.Visible = False
chk_LWL_Encoder.Visible = False
lblOpto.Visible = False
txtImpulswertigkeitPZ.Visible = False
Label7.Visible = False
chkEinbauplatzImpulswertigkeit.value = vbUnchecked
chkEinbauplatzImpulswertigkeit.Visible = False
frameDoppelimpulssperre.Visible = False
chkPPunsortiert.Visible = False
cmdPPUebernehmen.Visible = False
lblRegulierPP.Visible = False
cmbPruefpunkte.Visible = False
End Sub
Public Sub SchotteinstellungenAendern()
On Error GoTo Errorhandler
Unload frmSchottumdrehungen
Set frmSchottumdrehungen.m_colEinbauplatz = m_colEinbauplatz
frmSchottumdrehungen.setInfo "Bitte justieren Sie die Z<>hler mit den angezeigten Schotteinstellungen oder tragen Sie bekannte Schotteinstellungen ein."
frmSchottumdrehungen.Show vbModal, Me
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in SchotteinstellungenAendern(): " & Err.Description, "Softwarefehler"
End Sub
Reference in New Issue View Git Blame Copy Permalink