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ü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ü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ü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ählen, wenn LWL Abgriff nicht möglich ist. Alle Prü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üfung f.a. Prüfpunkte" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 180 TabIndex = 148 ToolTipText = "Bei dieser Option wird bei allen Durchflü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ä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üfpunkte mit 20 oder weniger Impulsen mit LWL geprü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ä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ügelumrundung LWL" Height = 345 Left = 90 TabIndex = 144 ToolTipText = "Ist diese Option gewä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äglich fertigmelden" Height = 495 Left = 210 TabIndex = 117 Top = 10350 Width = 1335 End Begin VB.CommandButton cmdNeuerPruefer Caption = "Prüfer ä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ü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üfung ein Protokoll zu drucken." Top = 240 Width = 2265 End End Begin VB.Frame FrpruefPunkte Caption = "Prüfpunkte" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 5055 Left = 10380 TabIndex = 36 Top = 1410 Width = 2985 Begin VB.CheckBox chkPPunsortiert Caption = "Prü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üsse geä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ü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üfpunkt zeitlich zum Anfang verschieben" Top = 1695 Width = 405 End Begin VB.CommandButton cmdPPUebernehmen Caption = "Prüfpunkte der letzen Prüfung ü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ü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üfpunkte]" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 300 TabIndex = 41 Top = 540 Width = 2115 End Begin VB.Label lblMaxPPInfo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Max. Prüfpunkte:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 120 TabIndex = 40 Top = 300 Width = 1455 End Begin VB.Label lblUniquePP BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "[Anz. Prüfpunkte]" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 300 TabIndex = 39 Top = 1080 Width = 2115 End Begin VB.Label lblUniquePPInfo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Eindeutige Prüfpunkte:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 120 TabIndex = 38 Top = 840 Width = 1995 End End Begin VB.Frame 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ä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ü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ü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ü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üfung werden Ü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ü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ü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ätzeMerken Caption = "WZ als ME prü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ßeinsätze" Top = 1470 Width = 2625 End Begin VB.CheckBox chkKontinuierlichePrf Caption = "nur Kontinuierliche Prüfung" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 345 Left = 300 TabIndex = 101 Top = 2340 Width = 3255 End Begin VB.CheckBox chkRueckwaertsprf Caption = "Rückwärtsprüfung" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 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ä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ßeinsätze" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 300 TabIndex = 50 ToolTipText = "Meßeinsätze" Top = 1260 Width = 2235 End Begin VB.CheckBox chkDauerpruefung Caption = "Dauerprüfung" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 330 TabIndex = 49 ToolTipText = "Die komplette Prüfung wird mehrmals wiederholt" Top = 240 Width = 1995 End Begin VB.CheckBox chkPruefgangLang Caption = "Prü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ü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ü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ü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ä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ä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ä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ä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ä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ä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ä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ä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ä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üfzähler" Height = 495 Left = 120 TabIndex = 98 Top = 270 Width = 915 End End Begin VB.CommandButton cmdOK Caption = "Prü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ü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üfzählerprüfung ' '============================================================================== ' ' History: ' ' Date : 24.03.1999 ' Version: 1.00 ' Author : Reinhard Henning, Andreas Schmidt, lindner&partner ' ' Erste dokumentierte Version. ' '============================================================================== Option Explicit ' Private Variablen ' ----------------- Private m_nRet As Integer Private m_bInputChanged As Boolean Private m_bBlink As Boolean Private m_sOldInput As String Private m_colEinbauplatz As Collection Private m_colUniquePP As CPruefpunktCol Private m_Regulierdaten As CRegulierdaten Private m_nEinbauplatz As Integer Private m_nSeriennummer As Long Private m_Regelart As String Private m_PruefungsArtWaage As Boolean Private m_bDauerpruefung As Boolean Private m_bPruefgangLang As Boolean ' neu eingefügt am 02.08.02 Pfeiffer Private m_Zaehlerart As String Private m_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üfpunkte' wurde auf '" & chk_LWL_Encoder.value & "' gesetzt." If chk_LWL_Encoder.value = vbChecked Then ' LWL Encoder für alle Prüfpunkte ist ausgewählt ' damit automatisch LWL anwä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ü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ü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ü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ählt." chkQtRegulierung.value = vbUnchecked End If If chkeRegisterPruefung.value = vbChecked Then ' bei der ERegister Prü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ätzeMerken_Click() ' RH 12.9.2006 mit AB: Verbesserungsvorschlag vom 7.9.2006 If chkMesseinsä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ä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ählt. Könnte falsch sein. Also Prüfer fragen: 'If MsgBox("Möchten Sie " & cmbPruefpunkte.List(1) & " m³/h als Regulierprüfpunkt Qt auswä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ä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üfpunkt " & Pruefpunkt.getQ & ", Zeit: " & Zeit If Zeit = 0 Then ' Für einen Pruefpunkt ist keine Zeit definiert: sofort False zurückgeben PruefpunkteZeitenVorhanden = False Exit Function End If Next ' Alle Prüfpunkte haben Zeiten PruefpunkteZeitenVorhanden = True End Function Private Sub chkRegulierungDurchfuehren_Click() If chkRegulierungDurchfuehren.value = vbChecked Then '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ählt. Könnte falsch sein. Also Prüfer fragen: If MsgBox("Möchten Sie " & cmbPruefpunkte.List(0) & " m³/h als Regulierprüfpunkt Qmax auswä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ärtsprüfung' ausgewählt. Sind sie sicher ?", vbYesNo Or vbDefaultButton2) Select Case lngReturn Case vbYes chkRueckwaertsprf.value = vbChecked DebugMsg "Es wurde Rückwärtsprüfung ausgewählt." Case vbNo chkRueckwaertsprf.value = vbUnchecked DebugMsg "Es wurde Vorwärtsprüfung ausgewä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ü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äge mit den Werten aus der Tabelle eRegister_Auftragposition prüfen? Sie können das auch in der ini Datei mit: [eRegister]ThamesWater=alt(neu) ä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ä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ü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ü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üfpunkte zusammen geprüft werden. Verringern Sie die Anzahl der Prüfpunkte!" cmdOK.Enabled = False Exit Sub End If If g_blnVersuch = False Then If TestPPForRZFehler() = False Then LogIntoDB "Keine oder alte RZ Fehler. Prü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üfung von Kalt- und Heisswasserzählern ist nicht zulä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üfung ausgewä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üfung ausgewä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üfpunktzeiten fehlen!" & vbCrLf & "Für alle Prüfpunkte müssen Zeiten definiert sein!") Exit Sub End If Dim strEinbaulageNichtVorhanden As String strEinbaulageNichtVorhanden = "" If chkZulassung.value = vbChecked Then ' überprü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üfung müssen noch die Einbaulagen aller Zähler im Prüfvorgaben-Formular angegeben werden." & vbCrLf & "Bitte klicken Sie auf die Zählersymbole den Einbauplä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äufer Then blnRuecklaeufervorhanden = True strEinbauplaetze = strEinbauplaetze & Einbauplatz.getNr & " " End If End If Next If blnRuecklaeufervorhanden Then MsgBox "An den Einbauplätzen " & strEinbauplaetze & " sind Rücklä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üfer evtl. vergessen, den Haken zu setzen? If chkZulassung.value = vbUnchecked Then ' wird einer der eingebauten Zähler für eine Zulassung geprüft? For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler Is Nothing Then If EinesDerWoerterVorhanden(Pruefzaehler.getAuftragPosition.getZusatztext, "Zulassung PTB|Zulassung DKD|DKD-Zertifikat|Zulassungsmuster|Zulassungsprüfung|Zulassungszähler|MID-Zulassung|DKD|NATA", strZulassungsschluesselwort) Then blnZulassungspruefung = True Exit For End If End If Next If blnZulassungspruefung = True Then MsgBox "Die Option 'Zulassungsprüfung' wird ausgewählt," & vbCrLf & "weil der Auftragszusatztext entsprechende Schlüsselwörter " & vbCrLf & strZulassungsschluesselwort & " enthält:" & vbCrLf & Pruefzaehler.getAuftragPosition.getZusatztext ' Häkchen wird automatisch gesetzt chkZulassung.value = vbChecked End If End If Exit Sub Errorhandler: End Sub Private Sub 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üfzähler ist eingebaut If Not Pruefzaehler Is m_ersterEingebauterPruefzaehlerDerLetztenPruefung Then ' Es handelt sich nicht um den selben Prüfzä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üfzähler haben nun die gleichen Prü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üfung fortfahren" frmFG.MSFlexGrid1.FormatString = "NW|RZ SerienNr|Durchfluss|RZ-Fehler|Datum RZ-Prü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üfung des Referenzzä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ähler Prüfpunkte bei der letzten RZ Prüfung!" frmFG.lblText.caption = "Für folgende Durchflüsse liegen keine interpolierbaren Referenzzähler-Fehler aus der jeweils letzen Prüfung des Referenzzählers vor:" & vbCrLf frmFG.lblText.caption = frmFG.lblText.caption & strQFehlerhaft & vbCrLf frmFG.lblText.caption = frmFG.lblText.caption & "Es darf nur geprüft werden, wenn für alle Durchflüsse aktuelle Referenzzähler-Fehlerwerte bei der letzten RZ-Prüfung ermittelt worden sind!" & vbCrLf frmFG.lblText.caption = frmFG.lblText.caption & "Entfernen Sie ggF. Prüfpunkte für diese Prüfung oder führen zuerst eine umfangreichere Referenzzählerprüfung durch." frmFG.chkIgnore.ToolTipText = "Warnung ignorieren und Prüfzähler-Prüfung trotzdem starten." frmFG.Show vbModal, Me If frmFG.mblnCheckIgnore = True Then LogIntoDB "keine oder alte RZ Fehler. Ignorieren wurde ausgewä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ü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ü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ü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ätze initialisieren ' Private Sub initEinbauplaetze() Dim i As Integer Dim Einbauplatz As CEinbauplatz Set m_colEinbauplatz = New Collection For i = 1 To g_App.Settings.EinbauplaetzeJeStrang Set Einbauplatz = New CEinbauplatz Call Einbauplatz.setNr(i) m_colEinbauplatz.Add Einbauplatz, Str$(i) Next i End Sub ' Regelart initialisieren Private Sub initRegelart() ' Todo: unter Q < 1 m^3 -> Servo verwenden -> für jeden PP individuell ' Vorbestzung aus INI Datei Select Case g_App.Settings.Regelart Case "FU" OptRegelart(0).value = True OptRegelart(1).value = False m_Regelart = "FU" Case "Servo" OptRegelart(0).value = False OptRegelart(1).value = True m_Regelart = "Servo" Case Else OptRegelart(0).value = False OptRegelart(1).value = False End Select End Sub '------------------------------------------------------------------------------ ' Private Funktionalität '------------------------------------------------------------------------------ ' Dialog beenden ' ' @param nRet Returncode des Dialogs ' Private Sub endDialog(nRet As Integer) m_nRet = nRet Unload Me g_frmMain.Show End Sub Private Sub Form_Unload(Cancel As Integer) g_blneRegisterPruefung = False g_blnPrfMitER56 = False g_frmMain.Show End Sub '------------------------------------------------------------------------------ ' Event-Handling '------------------------------------------------------------------------------ Private Sub cmdCancel_Click() Call endDialog(IDCANCEL) End Sub ' Vorgabe der Prüfgangvorgaben ' Private Sub cmdVorgaben_Click() Dim dlg As frmPruefgangVorgaben Me.MousePointer = vbHourglass Set dlg = New frmPruefgangVorgaben Call dlg.setRegulierdaten(m_Regulierdaten) If doModal(dlg, True) = IDOK Then End If Me.MousePointer = vbDefault End Sub ' Dialog zur Änderung der Prüfpunkte ' Private Sub imgZaehler_Click(Index As Integer) Dim Einbauplatz As CEinbauplatz Dim dlg As frmPruefvorgaben Set Einbauplatz = getEinbauplatz(Index) If Einbauplatz Is Nothing Then Exit Sub Me.MousePointer = vbHourglass Set dlg = New frmPruefvorgaben 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ü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ü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ä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ü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ä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ält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then ' raise imgZaehler_Click(Index) 'Else ' txtSerienNr(Index).Text = "" ' Alternativ: 'txtSerienNr(Index).BackColor = vbRed ' Fokus setzen, um ein Validate Event zu bekommen: ' txtSerienNr(Index).SetFocus 'End If End If End If End Sub Private Function PruefpunkteDesErstenPZmitPP(ColEinbauplatz As Collection) As CPruefpunkte Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim Pruefpunkte As CPruefpunkte For Each Einbauplatz In ColEinbauplatz If Not Einbauplatz.getPruefzaehler Is Nothing Then Set Pruefzaehler = Einbauplatz.getPruefzaehler If Not Pruefzaehler.getPruefpunkte Is Nothing Then If Pruefzaehler.getPruefpunkte.getPruefpunkteCount > 0 Then Set PruefpunkteDesErstenPZmitPP = Pruefzaehler.getPruefpunkte Exit Function End If End If End If Next Set PruefpunkteDesErstenPZmitPP = Nothing End Function Private Sub ueberpruefe(Index As Integer, Optional lngAuftragNr As Long = 0) DebugMsg "Überprü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öscht und SerienNrInput ' gerade erfolgreich getestet wurde, ' dann überprü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ä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üfzä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üfung mit LWL & ER56 Encoder) wurde aktiviert, weil im Auftrag/Vako Zählwerk = Encoder steht." & vbCrLf & "PP2 und PP3 werden mit LWL geprü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üft und reguliert (A.P. email am 15.9.15 18:01) ' Alle MS Plus ausser NW 40 werden auch mit LWL geprü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ü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üft werden, Alle Prüfpunkte werden per eRegister LED geprüft chk_eReg_alle_PP.value = vbChecked Case 50 Select Case Pruefzaehler.getAuftragPosition.getIdentNrObj.getBaulaenge 'fehlende Absprache mit TQ, Roland: Baulänge 270 beim eregister auch über LWL prüfen- Aussage vom Eddy Slatosch am 2017-07-04 Case 270 ' TQ am 2016-07-12 ' MS MSS DN 50 Baulänge 270 können nicht mit LWL geprüft werden, Alle Prüfpunkte werden per eRegister LED geprüft chk_eReg_alle_PP.value = vbChecked Case Else ' anderen Nennweiten, andere Baulängen chkFiberoptic.value = vbChecked UpdateLWLImpulswertigkeit GoTo weiter_LWL End Select Case Else ' anderen Nennweiten, andere Baulä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üfung ausgewählt. Dieser Zähler ist kein eRegister und kann nicht geprüft werden. Klicken Sie auf 'zurück' um einen neue Prü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üfung nach MID!" End If End If End If Next Errorhandler: End Sub '--------------------------------------------------------------- ' ermittelt neue Test-Prüfzähler Seriennummer ' Private Function neueTestZaehlerSerienNr() As Long Dim SQL As String Dim SerienNr As Long Dim rs As CRecordset Dim NummernbandID As Long Dim ueberlauf As Long Set rs = New CRecordset SQL = "select * from Nummernband where NummernbandID=" & g_App.Settings.NummernbandID & ";" If rs.openRS(SQL) Then If Not rs.EOF Then SerienNr = rs.getLongValue("letzteNr") ueberlauf = rs.getLongValue("bisSerienNr") - SerienNr ' Wenn wirklich Überlauf auftritt: Meldung ! If SerienNr >= rs.getLongValue("bisSerienNr") Then ErrorMsg ("Überlauf im Nummernband für Testzähler") Exit Function End If If ueberlauf < 1000 Then MsgBox ("Überlauf nach " & ueberlauf & " Seriennummern bei " & rs.getLongValue("bisSerienNr") & ". Bitte Admin verständigen.....") End If SerienNr = SerienNr + 1 rs.setValue "letzteNr", SerienNr rs.update neueTestZaehlerSerienNr = SerienNr Else ErrorMsg ("Das Testzähler Nummernband ist in der Datenbank nicht definiert") End If End If End Function '---------------------------------------------------------------------------- ' @param nNr Nr. eines Einbauplatzes ' ' @return Einbauplatz aus der Collection der Einbauplätze ' mit der angegebenen Nr. oder nothing, wenn es zu ' der Nr. keinen Einbauplatz gibt ' Private Function getEinbauplatz(nNr As Integer) As CEinbauplatz Dim Einbauplatz As CEinbauplatz For Each Einbauplatz In m_colEinbauplatz If Einbauplatz.getNr() = nNr Then Set getEinbauplatz = Einbauplatz Exit Function End If Next End Function ' Menge der eindeutigen Prüfpunkte neu bilden und ' Summe neu anzeigen ' ' TODO: Komplettieren ' Public Sub updatePruefpunkte() Dim Einbauplatz As CEinbauplatz Dim i As Integer Dim strAlterRegulierpruefpunkt As String Set m_colUniquePP = calcPruefpunkte(m_colEinbauplatz) ' Anzeige der eindeutigen Prü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ätze auf FALSE setzen For Each Einbauplatz In m_colEinbauplatz Call Einbauplatz.setPPWarning(False) Next ' Wenn die Menge der eindeutigen Prüfpunkte > dem Maximum in ' der INI-Datei ist, feststellen, welche Zähler das Problem sind. If m_colUniquePP.Count <= g_App.Settings.getMaxPruefpunkte() Then For Each Einbauplatz In m_colEinbauplatz Call Einbauplatz.setPPWarning(False) ' TodoTodo Call updateEinbauplatz(Einbauplatz.getNr()) If Not Einbauplatz.getPruefzaehler Is Nothing And chkQtRegulierung.value = vbUnchecked Then ' Prüfzä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ählt ''' ' QT Regulierung auswä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ähler suchen und austragen, bis Maximum unterschritten ist ' ' Vorgehensweise: ' - Alle CPruefpunkt-Items in m_colUniquePP absteigend nach dem UseCount ' sortieren ' - Zaehler zu den Prüfpunkt(en) mit dem kleinsten UseCount feststellen ' und aus der Menge der Prüfzaehler ausklammern Dim uniquePPcopy As CPruefpunktCol ' menge der eindeutigen Pruefpunkte erzeugen und ' absteigend nach dem "UseCount" sortieren Set uniquePPcopy = New CPruefpunktCol For i = 1 To m_colUniquePP.Count() uniquePPcopy.Add m_colUniquePP.Item(i) Next i Call uniquePPcopy.sortUseCount ' welche(r) Zähler gehören zu dem an wenigsten benötigten Prüfpunkt? Dim dQ As Double dQ = uniquePPcopy.Item(1).getQ() For Each Einbauplatz In m_colEinbauplatz Dim Pruefpunkte As CPruefpunkte If Not Einbauplatz.getPruefzaehler() Is Nothing Then Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte() If Not Pruefpunkte Is Nothing Then If Pruefpunkte.hasQ(dQ) Then Call Einbauplatz.setPPWarning(True) End If End If End If Call updateEinbauplatz(Einbauplatz.getNr()) Next End Sub ' Neu eingegebene Serien-Nr. überprüfen ' ' @return true = Prüfzähler mit der übergebenen Serien-Nr. wurde dem ' Einbauplatz erfolgreich zugewiesen ' Private Function testSerienNrInput(Index As Integer, Optional AuftragNr As Long) As Boolean Dim Einbauplatz As CEinbauplatz Dim lSerienNr As Long Dim Pruefzaehler As CPruefzaehler Dim Pruefpunkte As CPruefpunkte Dim nTmpText As String Dim Impulswertigkeit As Long Set Einbauplatz = getEinbauplatz(Index) ' Eingabe ist Einbauplatz Nummer If Val(txtSerienNr(Index)) > 0 And Val(txtSerienNr(Index)) <= g_App.Settings.EinbauplaetzeJeStrang Then ' Cursor laut Eingabe ins angewählte Feld setzen If txtSerienNr(Val(txtSerienNr(Index))).Enabled = True Then nTmpText = txtSerienNr(Index).text txtSerienNr(Index).text = m_sOldInput txtSerienNr(Val(nTmpText)).SetFocus GoTo testSerienNrInputReturnOK Else GoTo testSerienNrInputReturnFalse End If End If If Trim$(txtSerienNr(Index)) = "" Then ' Seriennummer wurde gelöscht lSerienNr = -1 ' Prüfen, ob noch irgendeine Seriennummer definiert ist Dim bKeinPruefzaehler As Boolean bKeinPruefzaehler = True Dim i As Integer For i = 1 To g_App.Settings.EinbauplaetzeJeStrang If txtSerienNr(i) <> "" Then bKeinPruefzaehler = False End If Next If bKeinPruefzaehler Then ' Keine Seriennummer mehr vorhanden: ' Feld für Impulswertigkeit löschen txtImpulswertigkeitPZ.text = "" ' Globale Regulierdaten werden gelöscht, wenn ' keine SerienNr mehr vorhanden ist 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ö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üfpunkte ermittelt worden. " & vbCrLf & "Für KZP=10 und Metrolog='SONDERV.' müssen die Prüfpunkte manuell eingegeben werden." Else ErrorMsg "Es sind keine Prü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üfpunkte bilden ' ' @param Einbauplaetze Collection der Einbauplätze ' ' @return Collection mit allen eindeutigen CPruefpunkt-Objekten ' ' @see updatePruefpunkte ' ' geändert am 26.1.2000 von RH: arbeitet jetzt mit KopiePruefpunkt ' Private Function calcPruefpunkte(Einbauplaetze As Collection) As CPruefpunktCol Dim Einbauplatz As CEinbauplatz Dim Pruefpunkte As CPruefpunkte Dim Pruefpunkt As CPruefpunkt Dim colUniquePP As New CPruefpunktCol Dim nPos As Integer Dim i As Integer Dim KopiePruefpunkt As CPruefpunkt For Each Einbauplatz In Einbauplaetze If Not Einbauplatz.getPruefzaehler() Is Nothing Then Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte() If Not Pruefpunkte Is Nothing Then If Not Pruefpunkte.getPruefpunkte Is Nothing Then For Each Pruefpunkt In Pruefpunkte.getPruefpunkte().getCollection() nPos = getEquivPruefpunktIndexFromCollection(Pruefpunkt, colUniquePP) If nPos = 0 Then ' Prüfpunkt ist noch nicht in der PPCollection vorhanden Call Pruefpunkt.setUseCount(1) Set KopiePruefpunkt = New CPruefpunkt KopiePruefpunkt.copyFrom Pruefpunkt colUniquePP.Add KopiePruefpunkt Else ' Prüfpunkt ist vorhanden ' Nur UseCount erhöhen Call colUniquePP.Item(nPos).incUseCount End If Next End If End If End If Next Set calcPruefpunkte = colUniquePP End Function ' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts ' in der übergebenen Collection von Pruefpunkten enthalten ist. ' Private Function getEquivPruefpunktIndexFromCollection(TestPruefpunkt As CPruefpunkt, colPruefpunkte As CPruefpunktCol) As Integer Dim Pruefpunkt As CPruefpunkt Dim i As Integer For i = 1 To colPruefpunkte.Count Set Pruefpunkt = colPruefpunkte.Item(i) If Pruefpunkt.getQ() = TestPruefpunkt.getQ() Then getEquivPruefpunktIndexFromCollection = i Exit Function End If Next End Function ' Prüfzähler-Objekt in dem angegebenen Einbauplatz löschen ' Der Einbauplatz ist danach wieder als "nicht in Verwendung" deklariert. ' Private Sub clearEinbauplatzPruefzaehler(nEinbauplatz As Integer) Dim Einbauplatz As CEinbauplatz Set Einbauplatz = getEinbauplatz(nEinbauplatz) If Not Einbauplatz Is Nothing Then Call Einbauplatz.setPruefzaehler(Nothing) End If End Sub ' Einbauplatz auf Basis der übergebenen Serien-Nr. den ' zugehörigen Prüfzähler zuweisen. ' ' @param Einbauplatz Einbauplatz-Objekt ' @param lSerienNr Nr. des Zählers ( -1 = Leerung) ' ' @return true = Prüfzähler konnte dem Einbauplatz zugewiesen werden ' false = Serien-Nr. ist ungültig oder konnte nicht in der ' Datenbank gefunden werden ' Private Function setEinbauplatzPruefzaehler(Einbauplatz As CEinbauplatz, lSerienNr As Long, Optional AuftragNr As Long) As Boolean Dim Pruefzaehler As CPruefzaehler Dim EinbauplatzNr As Integer setEinbauplatzPruefzaehler = False If Einbauplatz Is Nothing Then Call ErrorMsg("setEinbauplatzPruefzaehler: " + "Als Einbauplatz wurde nothing übergeben!") Exit Function End If If lSerienNr < 0 Then ' Prüfzähler wurde ausgebaut Call Einbauplatz.setPruefzaehler(Nothing) setEinbauplatzPruefzaehler = True ElseIf lSerienNr < SERIENNR_MINWERT Then ' Ungültige Serien-Nr. Call Einbauplatz.setPruefzaehler(Nothing) ElseIf lSerienNr > SERIENNR_MAXWERT Then ' Ungültige Serien-Nr. Call Einbauplatz.setPruefzaehler(Nothing) Else ' Seriennummer im gültigen Bereich Call Einbauplatz.setPruefzaehler(Nothing) Set Pruefzaehler = New CPruefzaehler ' Prüfen, ob eine Auftragsposition existiert If Pruefzaehler.loadForSerienNr(lSerienNr, AuftragNr) Then 'If Pruefzaehler.loadForSerienNr_neu(lSerienNr, AuftragNr) Then ' Prüfzä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üfzähler wurde als Encoder identifiziert. 'LWL Encoder f.a. Prüfpunkte' wird nun vorausgewählt!", vbQuestion, vbOKCancel) = vbOK Then ' chk_LWL_Encoder.value = vbChecked ' End If ' End If ' End If DebugMsg "Prüfzähler mit SerienNr " & lSerienNr & " am Einbauplatz " & Einbauplatz.getNr Else ' Todo: muss ein Prüfzähler Objekt wirklich erzeugt werden ' wenn Seriennummer nicht in der Datenbank steht ? ' nur wenn TEST-Pruefzaehler: ' Call Pruefzaehler.setSerienNr(lSerienNr) End If Call Einbauplatz.setPruefzaehler(Pruefzaehler) End If End Function ' Taucht die Serien-Nr. des übergebenen Prüfzählers an verschiedenen ' Einbauplätzen auf? ' ' @param Pruefzaehler auf Eindeutigkeit zu überprüfender Prüfzähler ' ' Sonderfall: Prüfzähler mit der Serien-Nr. 0 dürfen mehrfach vorkommen ' Private Function hasDupes(Pruefzaehler As CPruefzaehler) As Boolean Dim Einbauplatz As CEinbauplatz If Not Pruefzaehler Is Nothing Then If Pruefzaehler.getSerienNr() <> 0 Then For Each Einbauplatz In m_colEinbauplatz If Not Einbauplatz.getPruefzaehler() Is Nothing Then If Not Einbauplatz.getPruefzaehler() Is Pruefzaehler Then If Einbauplatz.getPruefzaehler().getSerienNr() = Pruefzaehler.getSerienNr() Then hasDupes = True Exit Function End If End If End If Next End If End If End Function ' Zählerabbildung aktualisieren ' Private Sub updateZaehlerImage(nIndex As Integer) Dim Pruefzaehler As CPruefzaehler If Not getEinbauplatz(nIndex) Is Nothing Then Set Pruefzaehler = getEinbauplatz(nIndex).getPruefzaehler() ' Prüfzaehler an der Position eingebaut If Pruefzaehler Is Nothing Then imgZaehler(nIndex).Picture = frmRes.imgZaehlerGrauLinks.Picture imgZaehler(nIndex).Enabled = False ElseIf Pruefzaehler.isWarmwasserzaehler() Then imgZaehler(nIndex).Enabled = True imgZaehler(nIndex).Picture = frmRes.imgZaehlerRotLinks.Picture Else imgZaehler(nIndex).Enabled = True imgZaehler(nIndex).Picture = frmRes.imgZaehlerBlauLinks.Picture End If Else ' Kein Prüfzaehler an der Position eingebaut imgZaehler(nIndex).Picture = frmRes.imgZaehlerGrauLinks.Picture imgZaehler(nIndex).Enabled = False End If End Sub ' Einbauplatzdaten neu anzeigen ' ' '''todo:Diese Prozedur wird periodisch von dem Blink-Timer aufgerufen. ' ' @return true = Keine Fehlerbedingung festgestellt ' Private Function updateEinbauplatz(Index As Integer) As Boolean On Error Resume Next Dim 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üfzä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ü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ätzeMerken.value = vbUnchecked Then 'geändert am 14.02.2003 Pf, der letzte eigegebene Zähler bestimmt den Status "nur Messeinsätze" JA/NEIN If Trim(Pruefzaehler.getIdentNrObj.GetKurzBezeichnung) <> "ME" Then chkNurMesseinsaetze.value = 0 Else chkNurMesseinsaetze.value = 1 End If 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ändert von Prü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ält keine Prüfpunktdaten in der Datenbank. Möchten Sie jetzt Prüfpunkte eingeben?", vbYesNo) = vbYes Then Call imgZaehler_Click(Index) Else txtSerienNr(Index).text = "" ' Alternativ: 'txtSerienNr(Index).BackColor = vbRed ' Fokus setzen, um ein Validate Event zu bekommen: txtSerienNr(Index).SetFocus End If End If End Sub Public Sub Hauptpruefung() Dim dlgHauptPruefung As frmHauptprf ' hier beginnt auf jeden Fall ein neuer Prü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) ' Übergabe der Obejkt-Referenz auf den Prü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 übernehmen Sie die Prüfpunkte des letzten Prüfganges von Prüfzähler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " für alle eingebauten Prüfzä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üfung erfolgreich abgeschlossen If g_bMeitwinMID_Sonderpruefung Then If g_blnVersuch And (g_App.PruefstationNr = 2010 Or g_App.PruefstationNr = 2009) Then MsgBox "Prüfergebnisse werden NICHT gelöscht (da Versuchsprü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üfgang abgebrochen. Die Prüfergebnisse dieses Prüfganges werden vollständig gelö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öschter Prüfgang für SerienNr: " & strSerienNr, "Abbrüche" m_Pruefgang.mstrSerienNrListe = strSerienNr m_Pruefgang.saveAbgebrochenen ShowStatus "Daten des abgebrochenen Prüfgangs werden gelö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ü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ü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 ' Übergabe der Obejkt-Referenz auf den Prü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ü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üfpunkte werden mit eRegister-Messung geprü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 übernehmen Sie die Prüfpunkte des letzten Prüfganges von Prüfzähler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " für alle eingebauten Prüfzä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ü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üfgang abgebrochen. Möchten Sie die Prüfergebnisse dieses Prüfganges vollstä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öschter Prüfgang für SerienNr: " & strSerienNr, "Abbrüche" m_Pruefgang.saveAbgebrochenen ShowStatus "Daten des abgebrochenen Prüfgangs werden gelö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ü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ü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 ' Übergabe der Obejkt-Referenz auf den Prü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ü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üfpunkte werden mit eRegister-Messung geprü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 übernehmen Sie die Prüfpunkte des letzten Prüfganges von Prüfzähler " & m_ersterEingebauterPruefzaehlerDerLetztenPruefung.getSerienNr & " für alle eingebauten Prüfzä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ü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üfgang abgebrochen. Möchten Sie die Prüfergebnisse dieses Prüfganges vollstä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öschter Prüfgang für SerienNr: " & strSerienNr, "Abbrüche" m_Pruefgang.saveAbgebrochenen ShowStatus "Daten des abgebrochenen Prüfgangs werden gelö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ü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 ' Überprüfung ab alle Zähler gleich hinsichtlich: ' - Regulierwerte (Todo: Regulierwerte müssen aus Tabelle Sollwertregulierung bestimmt werden) ' - Nennweite ' - Zählertype ' - Anzeige (m^3) wenn Automatische Regulierung nicht gescheckt ' - Sollwert Regulierung (nur wenn Automatische Regulierung gecheckt) ' Todo: wie verfahren bei Mehrfacheinträgen z.B. m^3,RS,WI Wenn m^3 dann muß überall m^3 vorhanden sein, sonst muß gleich sein On Error Resume Next Dim Einbauplatz As CEinbauplatz Dim Pruefzaehler As CPruefzaehler Dim Pruefpunkte As CPruefpunkte Dim Pruefpunkt As CPruefpunkt Dim colUniquePP As New CPruefpunktCol Dim IdentNrObj As CIdentNr Dim AuftragPosition As CAuftragPosition Dim Regulierdaten As CRegulierdaten Dim vergleich As String Dim ersterZaehler As Boolean Dim VergleichMuster As String ersterZaehler = True VergleichMuster = "" vergleich = "" SindZaehlerAehnlich = True ' Todo Exit Function For Each Einbauplatz In m_colEinbauplatz Set Pruefzaehler = Einbauplatz.getPruefzaehler() If Not Pruefzaehler Is Nothing Then Set IdentNrObj = Pruefzaehler.getIdentNrObj() Set AuftragPosition = Pruefzaehler.getAuftragPosition() Set Pruefpunkte = Pruefzaehler.getPruefpunkte Set Regulierdaten = New CRegulierdaten Call Regulierdaten.load(IdentNrObj.getNr, Pruefpunkte.getPruefklasseKZ) If Not Pruefzaehler.getAuftrag.getNr = 99999 Then vergleich = "Nennweite=" & IdentNrObj.getNennweite & ";" vergleich = vergleich & "Type=" & IdentNrObj.getTyp & IdentNrObj.getTypzusatz & ";" If chkRegulierung.value = vbChecked Then vergleich = vergleich & "Anzeige=" & Mid(AuftragPosition.getAnzeige, 1, 3) & "; " Else vergleich = vergleich & "Sollwert=" & Regulierdaten.getSPSSollwertRegulierung & ";" End If ' vergleich = vergleich & "Impulswertigkeit=" & Pruefzaehler.GetImpulseQM Else ' Test-Pruefzaehler können nur mit anderen Test-Prüfzaehlern geprueft werden vergleich = "PRUEFZAEHLER" End If ' Alle weiteren Zaehler werden mit dem ersten verglichen If ersterZaehler Then VergleichMuster = vergleich Else DebugMsg "Vergleich " & Einbauplatz.getNr & ": " & vergleich & " =?= " & VergleichMuster ' unterscheidet sich ein Zähler vom ersten, sind die Zaehler nicht ähnlich ! If VergleichMuster <> vergleich Then SindZaehlerAehnlich = False End If End If End If ersterZaehler = False Next End Function Sub AlleEinbauplaetzeDesGleichenAuftragesAktualisieren(Index As Integer) Dim AuftragNr As Long Dim PositionNr As Long Dim PruefzaehlerAktuell As CPruefzaehler Dim PruefzaehlerVergleich As CPruefzaehler Dim Einbauplatz As CEinbauplatz Set PruefzaehlerAktuell = m_colEinbauplatz(Index).getPruefzaehler AuftragNr = PruefzaehlerAktuell.getAuftrag.getNr PositionNr = PruefzaehlerAktuell.getAuftragPosition.getNr For Each Einbauplatz In m_colEinbauplatz Set PruefzaehlerVergleich = Einbauplatz.getPruefzaehler If Not PruefzaehlerVergleich Is Nothing Then If PruefzaehlerAktuell.getAuftrag.getNr = PruefzaehlerVergleich.getAuftrag.getNr And PruefzaehlerAktuell.getAuftragPosition.getNr = PruefzaehlerVergleich.getAuftragPosition.getNr Then bTextChanged(Einbauplatz.getNr) = True Debug.Print "gleiche AuftragNr/PosNr in Einbauplatz " & Einbauplatz.getNr Call updateEinbauplatz(Einbauplatz.getNr) Call ueberpruefe(Einbauplatz.getNr) End If End If Next End Sub Private Sub InitCmbAnzahlZaehler() Dim i As Integer For i = 0 To 10 cmbAnzahlZaehler.AddItem CStr(i) Next cmbAnzahlZaehler.ListIndex = g_App.Settings.GetAnzahlFuerVoreinstellwert End Sub Private Sub cmbAnzahlZaehler_Click() g_App.Settings.SetAnzahlFuerVoreinstellwert cmbAnzahlZaehler.ListIndex End Sub 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ü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ü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üfzähler bestimmt Prü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üfpunkt Kontrolle" ' objForm.lblText = "Prüfpunkt Kontrolle" ' objForm.MSFlexGrid1.Cols = 11 ' objForm.MSFlexGrid1.Rows = 11 ' objForm.Width = 6960 ' objForm.chkIgnore.Visible = False ' ' Für alle Einbauplätze ' For Each Einbauplatz In m_colEinbauplatz ' Set Pruefzaehler = Einbauplatz.getPruefzaehler ' If Not Pruefzaehler Is Nothing Then ' ' für jeden Prüfzä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ü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