Files
laatzen/Pruef2000/source/frmManuellDetails.frm
T
2021-10-01 11:11:04 +02:00

3425 lines
122 KiB
Plaintext

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmManuellDetails
ClientHeight = 9510
ClientLeft = 60
ClientTop = 345
ClientWidth = 18030
LinkTopic = "Form1"
ScaleHeight = 9510
ScaleWidth = 18030
StartUpPosition = 3 'Windows-Standard
WindowState = 2 'Maximiert
Begin VB.Frame frameERegister
Caption = "eRegister"
Height = 1395
Left = 60
TabIndex = 50
Top = 5820
Width = 1515
Begin VB.ComboBox cmbeRegisterPP
Height = 315
Left = 480
Style = 2 'Dropdown-Liste
TabIndex = 52
Top = 900
Width = 795
End
Begin VB.CommandButton cmdeRegisterpruefpunkt
Caption = "Messung"
Height = 375
Left = 180
TabIndex = 51
Top = 300
Width = 1215
End
Begin VB.Label Label4
Caption = "PP"
Height = 255
Left = 60
TabIndex = 53
Top = 960
Width = 375
End
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 1395
Left = 690
TabIndex = 49
Top = 7950
Visible = 0 'False
Width = 6435
_ExtentX = 11351
_ExtentY = 2461
_Version = 393216
End
Begin VB.TextBox txtInfoVerbundzaehler
Alignment = 2 'Zentriert
BackColor = &H00C0FFFF&
Height = 1485
Left = 1740
MultiLine = -1 'True
TabIndex = 47
Text = "frmManuellDetails.frx":0000
Top = 7950
Width = 6315
End
Begin VB.TextBox txtWasserVorlaufTemperatur
Alignment = 1 'Rechts
Height = 345
Left = 240
TabIndex = 43
Top = 5370
Width = 735
End
Begin VB.CommandButton cmdRuecklaeuferanalyse
Caption = "Rückläufer"
Height = 255
Left = 240
TabIndex = 41
Top = 4530
Width = 1155
End
Begin VB.Frame Frame1
Caption = "PrüfgangNr"
Height = 495
Left = 120
TabIndex = 38
Top = 3960
Width = 1395
Begin VB.Label lblPruefgangNr
Height = 195
Left = 60
TabIndex = 39
Top = 240
Width = 1275
End
End
Begin VB.Frame frameTab
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6495
Index = 0
Left = 1800
TabIndex = 10
Top = 780
Width = 14565
Begin VB.CommandButton cmdNZInfo
Caption = "NZ Prüfergebnisse aus LU anzeigen"
Height = 525
Index = 0
Left = 120
TabIndex = 48
Top = 3660
Width = 1575
End
Begin VB.TextBox txtFabNr
Alignment = 1 'Rechts
Height = 285
Index = 0
Left = 120
TabIndex = 0
Top = 1710
Width = 1485
End
Begin VB.CheckBox chkPruefNZ
Alignment = 1 'Rechts ausgerichtet
Caption = "Prüfnebenzähler"
Height = 255
Index = 0
Left = 240
TabIndex = 2
Top = 2925
Width = 1455
End
Begin VB.TextBox txtSerienNrNZ
Alignment = 1 'Rechts
Height = 285
Index = 0
Left = 150
TabIndex = 1
ToolTipText = "Um die NZ Seriennummer ändern zu können, klicken Sie doppelt in dieses Feld"
Top = 2625
Width = 1575
End
Begin VB.TextBox txtQ
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 0
Left = 3000
TabIndex = 3
Top = 540
Width = 1035
End
Begin VB.TextBox txtBehVol
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3000
TabIndex = 8
Top = 4440
Width = 1035
End
Begin VB.TextBox txtNZStop
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Index = 0
Left = 3000
TabIndex = 7
Top = 2940
Width = 1035
End
Begin VB.TextBox txtNZStart
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3000
TabIndex = 6
Top = 2520
Width = 1035
End
Begin VB.TextBox txtHZStop
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 0
Left = 3000
TabIndex = 5
Top = 1440
Width = 1035
End
Begin VB.TextBox txtHZStart
Alignment = 1 'Rechts
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 0
Left = 3000
TabIndex = 4
Top = 1020
Width = 1035
End
Begin MSForms.ComboBox cmb2KundeneigeneSNr
Height = 315
Index = 0
Left = 120
TabIndex = 46
Top = 4860
Width = 2325
VariousPropertyBits= 746604571
DisplayStyle = 3
Size = "4101;556"
MatchEntry = 1
ShowDropButtonWhen= 2
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label lblFabNr
Caption = "FabNr:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 0
Left = 150
TabIndex = 42
Top = 1440
Width = 1455
End
Begin VB.Label LabelKndEigeneSerNr
Caption = "Kundeneigene SerNr NZ:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 150
TabIndex = 40
Top = 4380
Width = 1545
End
Begin VB.Label lblFGo
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 3240
TabIndex = 37
Top = 5880
Width = 795
End
Begin VB.Label lblFGu
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 3240
TabIndex = 35
Top = 5040
Width = 795
End
Begin VB.Label Label1
Caption = "FG+"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 16
Left = 2400
TabIndex = 30
Top = 5880
Width = 495
End
Begin VB.Label Label1
Caption = "FG-"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 15
Left = 2520
TabIndex = 29
Top = 5040
Width = 495
End
Begin VB.Label Label1
Caption = "Prüfpunkt"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 14
Left = 2040
TabIndex = 26
Top = 240
Width = 1095
End
Begin VB.Line Line1
Index = 3
Visible = 0 'False
X1 = 11040
X2 = 11040
Y1 = 480
Y2 = 6120
End
Begin VB.Line Line1
Index = 2
Visible = 0 'False
X1 = 1950
X2 = 12840
Y1 = 3840
Y2 = 3840
End
Begin VB.Line Line1
Index = 1
Visible = 0 'False
X1 = 2040
X2 = 12840
Y1 = 2280
Y2 = 2280
End
Begin VB.Line Line1
Index = 0
Visible = 0 'False
X1 = 2040
X2 = 12840
Y1 = 960
Y2 = 960
End
Begin VB.Label lblNr
Alignment = 2 'Zentriert
Caption = "1"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 3060
TabIndex = 25
Top = 240
Width = 975
End
Begin VB.Label Label1
Caption = "Fehler in %"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 13
Left = 1800
TabIndex = 24
Top = 5520
Width = 1215
End
Begin VB.Label Label1
Caption = "Beh.Vol"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 12
Left = 2040
TabIndex = 23
Top = 4560
Width = 855
End
Begin VB.Label Label1
Caption = "Zähl Vol"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 11
Left = 2040
TabIndex = 22
Top = 4080
Width = 855
End
Begin VB.Label Label1
Caption = "NZ Vol"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 10
Left = 2040
TabIndex = 21
Top = 3480
Width = 855
End
Begin VB.Label Label1
Caption = "NZ Stop"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 9
Left = 2040
TabIndex = 20
Top = 2880
Width = 1335
End
Begin VB.Label Label1
Caption = "NZ Start"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 8
Left = 2040
TabIndex = 19
Top = 2520
Width = 855
End
Begin VB.Label Label1
Caption = "HZ Vol"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 7
Left = 2040
TabIndex = 18
Top = 1920
Width = 855
End
Begin VB.Label Label1
Caption = "HZ Stop"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 6
Left = 2040
TabIndex = 17
Top = 1440
Width = 855
End
Begin VB.Label Label1
Caption = "HZ Start"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 5
Left = 2040
TabIndex = 16
Top = 1080
Width = 855
End
Begin VB.Label Label1
Caption = "Q (m^3/h)"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 4
Left = 2040
TabIndex = 15
Top = 600
Width = 975
End
Begin VB.Label Label1
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "Label1"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 765
Index = 2
Left = 90
TabIndex = 14
Top = 600
Width = 1815
End
Begin VB.Label Label1
Caption = "Nebenzähler:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 150
TabIndex = 13
Top = 2370
Width = 1335
End
Begin VB.Label Label1
Caption = "Hauptzähler:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 150
TabIndex = 12
Top = 300
Width = 1335
End
Begin VB.Label lblVol
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3000
TabIndex = 34
Top = 3960
Width = 1035
End
Begin VB.Label lblFehler
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3030
TabIndex = 36
Top = 5400
Width = 1035
End
Begin VB.Label lblNZVol
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3000
TabIndex = 33
Top = 3360
Width = 1035
End
Begin VB.Label lblHZVol
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3000
TabIndex = 32
Top = 1800
Width = 1035
End
End
Begin VB.CommandButton cmdCancel
Caption = "Abbruch ohne speichern"
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 = 10680
TabIndex = 28
Top = 8760
Width = 1935
End
Begin VB.CommandButton cmdOK
Caption = "Daten speichern"
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 = 12900
TabIndex = 27
Top = 8760
Width = 1935
End
Begin MSComctlLib.TabStrip TabStrip1
Height = 6975
Left = 1680
TabIndex = 11
Top = 300
Width = 14835
_ExtentX = 26167
_ExtentY = 12303
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 1
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
ImageVarType = 2
EndProperty
EndProperty
End
Begin VB.Label Label3
Caption = "°C"
Height = 255
Left = 1050
TabIndex = 45
Top = 5460
Width = 495
End
Begin VB.Label Label2
Caption = "Vorlauf Temperatur"
Height = 435
Left = 270
TabIndex = 44
Top = 4980
Width = 1215
End
Begin VB.Label Label1
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "ist nicht sichtbar, mus aber beleiben !!!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Index = 3
Left = 120
TabIndex = 31
Top = 2220
Visible = 0 'False
Width = 1335
End
Begin VB.Label LblAngaben
Height = 375
Left = 240
TabIndex = 9
Top = 120
Width = 9255
End
End
Attribute VB_Name = "frmManuellDetails"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_nRet As Integer
Public m_colEinbauplatz As Collection
Public m_Pruefgang As CPruefgang
Private AltSelectedTab As Integer
Private m_Pruefzaehler As CPruefzaehler
Private m_colUniquePP As Collection
Public m_blnRueckwaertspruefung As Boolean
Public m_blnSimpleInput As Boolean
Public mblnOeffnenSchliessenErgaenzen As Boolean
Public mbln_eRegister As Boolean
Private m_AnzahlPP As Integer
Private m_blnEingabeFehler As Boolean
Private Type NZ_PRUEFDATEN_TYP
SerienNrNebenzaehler As Long
KundeneigeneSerienNrNZ As String
Q1_Soll As Double
Fehler_Q1 As Double
Q2_Soll As Double
Fehler_Q2 As Double
MetrologNZ As String
End Type
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
'------------------------------------------------------------------------------
' Private Funktionalität
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
End Sub
Private Sub chkPruefNZ_GotFocus(Index As Integer)
SetGotLostFocusColor chkPruefNZ(Index), True
End Sub
Private Sub chkPruefNZ_KeyPress(Index As Integer, KeyAscii As Integer)
cmdOK.Enabled = True
If KeyAscii = 13 Then
If txtQ(Index * 100).Enabled = True Then
txtQ(Index * 100).SetFocus
End If
End If
End Sub
Private Sub chkPruefNZ_LostFocus(Index As Integer)
SetGotLostFocusColor chkPruefNZ(Index), False
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub cmdOk_Click()
If txtWasserVorlaufTemperatur.text = "" Then
MsgBox "Bitte Vorlauftemperatur eingeben!"
txtWasserVorlaufTemperatur.SetFocus
Exit Sub
End If
If ueberpruefe() = True Then
Call PruefdatenSpeichern
MsgBox ("Die Pruefergebnisse wurden gespeichert")
Call endDialog(IDOK)
End If
End Sub
Private Sub cmdCancel_Click()
Call endDialog(IDCANCEL)
End Sub
Private Sub cmdRuecklaeuferanalyse_Click()
Dim lngSerienNr As Long
Dim Pruefzaehler As CPruefzaehler
lngSerienNr = Val(TabStrip1.SelectedItem.Tag)
Dim objForm As frmRuecklaeuferanalyse
Set objForm = New frmRuecklaeuferanalyse
objForm.m_EinbauplatzNr = 0
Set Pruefzaehler = New CPruefzaehler
Pruefzaehler.loadForSerienNr lngSerienNr
Set objForm.m_Pruefzaehler = Pruefzaehler
objForm.Show vbModal, Me
End Sub
Private Sub Form_Activate()
If txtWasserVorlaufTemperatur.Enabled = True Then
If txtWasserVorlaufTemperatur.text = "" Then
txtWasserVorlaufTemperatur.SetFocus
End If
End If
' If txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).Enabled And txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).Visible Then
' txtSerienNrNZ(TabStrip1.SelectedItem.Index - 1).SetFocus
' Else
' txtFabNr(TabStrip1.SelectedItem.Index - 1).SetFocus
' End If
End Sub
''Private Sub cmdDruck_Click()
'' Call modDruck.PruefgangDruck(m_Pruefgang, 20, m_colEinbauplatz, 0, "Manuelle Eingabe")
''End Sub
Private Sub Form_Load()
Dim frame_index As Integer
Dim TextHZStart As TextBox
Dim i As Integer
Dim selectedTab As Integer
Dim bGefunden As Boolean
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim PPNr As Integer
Dim Pruefpunkte As CPruefpunkte
If m_Pruefgang.PruefgangNr <> 0 Then
lblPruefgangNr.caption = m_Pruefgang.PruefgangNr
Else
lblPruefgangNr.caption = "(neu)"
End If
Me.caption = "manuelle Eingabe der Zählerstände an der Prüfstation " & g_App.PruefstationNr
For i = 0 To 9
If i > 0 Then
' TabStrip.tabs.item(1) existiert und FrameTab(0) ist bereits geladen
' deshalb erst ab TabStrip.item(2) addieren und ab FrameTab(1) laden
' neuen Tab erzeugen
TabStrip1.Tabs.Add
' Neuen Frame erzeugen
load frameTab(i)
End If
' nach vorne
frameTab(i).ZOrder
frameTab(i).Visible = False
frameTab(i).caption = "Einbauplatz " & i + 1
Set Einbauplatz = m_colEinbauplatz.Item(i + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' TabStrip (1..6) initialisieren
TabStrip1.Tabs.Item(i + 1).Tag = Pruefzaehler.getSerienNr
If g_blnKundeneigeneSerienNrAnzeigen = False Then
TabStrip1.Tabs.Item(i + 1).caption = FormatSerienNr(Pruefzaehler.getSerienNr)
Else
TabStrip1.Tabs.Item(i + 1).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
End If
m_AnzahlPP = Pruefzaehler.getPruefpunkte.getPruefpunkteCount
' TabFrame (0..9) initialisieren
InitTabFrame i, Pruefzaehler.IstVerbundZaehler
' If bGefunden = False Then
' bGefunden = True
' ' Für ersten gefundenen Prüfzähler TabStrip-Tab auswählen
' selectedTab = i
' Call TabStrip_Auswaehlen(selectedTab)
' TabStrip1.Tabs.Item(selectedTab + 1).Selected = True
' End If
End If
next1:
Next i
For i = 0 To 9
Set Einbauplatz = m_colEinbauplatz.Item(i + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' Pruefpunkt Daten eintragen
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
m_AnzahlPP = Pruefpunkte.getPruefpunkteCount
For PPNr = 1 To m_AnzahlPP
txtQ(i * 100 + PPNr - 1).text = Pruefpunkte.getPruefpunkt(PPNr).getQ
lblFGo(i * 100 + PPNr - 1).caption = Format(Pruefpunkte.getPruefpunkt(PPNr).getFGo, "0.0")
lblFGu(i * 100 + PPNr - 1).caption = Format(Pruefpunkte.getPruefpunkt(PPNr).getFGu, "0.0")
Next
If Pruefzaehler.IstVerbundZaehler Then
FillFehlergrenzenVerbundzaehler (i)
End If
For PPNr = 1 To 10
If m_blnSimpleInput Then
txtHZStart(i * 100 + PPNr - 1).Enabled = False
txtHZStart(i * 100 + PPNr - 1).BackColor = &H8000000F
txtHZStop(i * 100 + PPNr - 1).Enabled = False
txtHZStop(i * 100 + PPNr - 1).BackColor = &H8000000F
txtNZStart(i * 100 + PPNr - 1).Enabled = False
txtNZStart(i * 100 + PPNr - 1).BackColor = &H8000000F
txtNZStop(i * 100 + PPNr - 1).Enabled = False
txtNZStop(i * 100 + PPNr - 1).BackColor = &H8000000F
txtBehVol(i * 100 + PPNr - 1).Enabled = False
txtBehVol(i * 100 + PPNr - 1).BackColor = &H8000000F
End If
Next
' SerienNr eintragen
If g_blnKundeneigeneSerienNrAnzeigen = True Then
Label1(2 + i * 100).caption = Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr & vbCrLf & "SensusSNr:" & vbCrLf & FormatSerienNr(Pruefzaehler.getSerienNr)
Else
Label1(2 + i * 100).caption = FormatSerienNr(Pruefzaehler.getSerienNr)
If Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr <> "" Then
Label1(2 + i * 100).caption = Label1(2 + i * 100).caption & vbCrLf & "KndEigene:" & vbCrLf & Pruefzaehler.getAuftragPositionSerienNr.getKundeneigeneSerienNr
End If
End If
Fillcmb2KundeneigeneSNr Pruefzaehler.getAuftragPosition.GetFertigungsauftragNr, i
Dim lngSerienNrNebenzaehler As Long
Dim strKndEigeneSerienNrNebenzaehler As String
Dim blnIstPruefnebenzaehler As Boolean
Dim dblPPOeffnen As Double
Dim dblPPSchliessen As Double
Dim dblPP_OeffnenFehler As Double
Dim dblPP_SchliessenFehler As Double
cmb2KundeneigeneSNr(i).Locked = False
cmb2KundeneigeneSNr(i).Style = fmStyleDropDownCombo
If GetNebenzaehlerDaten(m_Pruefgang.PruefgangNr, Pruefzaehler.getSerienNr, lngSerienNrNebenzaehler, strKndEigeneSerienNrNebenzaehler, blnIstPruefnebenzaehler, dblPPOeffnen, dblPPSchliessen, dblPP_OeffnenFehler, dblPP_SchliessenFehler) = 0 Then
cmb2KundeneigeneSNr(i).text = strKndEigeneSerienNrNebenzaehler
If lngSerienNrNebenzaehler > 0 Then
txtSerienNrNZ(i).text = lngSerienNrNebenzaehler
txtSerienNrNZ(i).Locked = True
End If
End If
End If
Next
If m_Pruefgang.PruefgangNr <> 0 Then
' Prüfgang ist vorhanden, dann Prüffehler lesen und Eingabefelder mit Prüffehler vorbesetzen
fillPrueffehler (m_Pruefgang.PruefgangNr)
End If
For i = 0 To 9
Set Einbauplatz = m_colEinbauplatz.Item(i + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If bGefunden = False Then
bGefunden = True
' Für ersten gefundenen Prüfzähler TabStrip-Tab auswählen
selectedTab = i
Call TabStrip_Auswaehlen(selectedTab)
TabStrip1.Tabs.Item(selectedTab + 1).Selected = True
End If
End If
Next
' eRegister
frameERegister.Visible = False
mbln_eRegister = False
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
frameERegister.Visible = True
mbln_eRegister = True
cmbeRegisterPP.Clear
cmbeRegisterPP.AddItem 1
cmbeRegisterPP.AddItem 2
cmbeRegisterPP.AddItem 3
' Voreinstellung Prüfpunkt 1
cmbeRegisterPP.ListIndex = 0
End If
End If
Next
End Sub
Private Sub InitTabFrame(frame_index As Integer, IstVerbundZaehler As Boolean)
' frame_index fängt mit 0 an
Dim i As Integer
'Dim Index As Integer
Dim xPos As Long
Dim newIndex As Integer
Dim istart As Integer
Dim TabIndex As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Position des Rahmens festlegen
frameTab(frame_index).Top = frameTab(0).Top
frameTab(frame_index).Left = frameTab(0).Left
frameTab(frame_index).Width = frameTab(0).Width
frameTab(frame_index).Height = frameTab(0).Height
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' neue Controls laden (kopieren) und Eigenschaften setzen
' Im ersten Tab (frame_index=0) sind schon Controls mit Index=0 vorhanden
istart = IIf(frame_index = 0, 1, 0)
If frame_index > 0 Then
load txtSerienNrNZ(frame_index)
'load txtKundeneigeneSerienNrNZ(frame_index)
load cmb2KundeneigeneSNr(frame_index)
load chkPruefNZ(frame_index)
load LabelKndEigeneSerNr(frame_index)
load lblFabNr(frame_index)
load txtFabNr(frame_index)
load cmdNZInfo(frame_index)
End If
For i = istart To 9
newIndex = frame_index * 100 + i
load lblNr(newIndex)
load txtQ(newIndex)
load txtHZStart(newIndex)
load txtHZStop(newIndex)
load txtNZStart(newIndex)
load txtNZStop(newIndex)
load txtBehVol(newIndex)
load lblHZVol(newIndex)
load lblNZVol(newIndex)
load lblVol(newIndex)
load lblFehler(newIndex)
load lblFGo(newIndex)
load lblFGu(newIndex)
xPos = lblNr(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i
With lblNr(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.caption = i + 1
.Visible = True
If IstVerbundZaehler Then
If i = 8 Then .caption = "Öffn."
If i = 9 Then .caption = "Schl."
End If
End With
With txtQ(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With txtHZStart(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With txtHZStop(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With txtNZStart(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With txtNZStop(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblHZVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblNZVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblNZVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblNZVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With txtBehVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblVol(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblFehler(newIndex)
Set .Container = frameTab(frame_index)
.Left = xPos
.Visible = True
End With
With lblFGo(newIndex)
Set .Container = frameTab(frame_index)
.Left = lblFGo(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i
.Visible = True
End With
With lblFGu(newIndex)
Set .Container = frameTab(frame_index)
.Left = lblFGu(0).Left + (IIf(i > 8, 0, 10) + Screen.TwipsPerPixelX * 10 + lblNr(0).Width) * i
.Visible = True
End With
Next
' im nullten Frame_index sind schon alle Labels und Linien vorhanden
If frame_index > 0 Then
For i = 0 To 14
newIndex = frame_index * 100 + i
load Label1(newIndex)
With Label1(newIndex)
Set .Container = frameTab(frame_index)
.Alignment = Label1(i).Alignment
.Visible = True
.Move Label1(i).Left, Label1(i).Top, Label1(i).Width, Label1(i).Height
.caption = Label1(i).caption
.Font = Label1(i).Font
.FontBold = Label1(i).FontBold
.FontSize = Label1(i).FontSize
.BorderStyle = Label1(i).BorderStyle
End With
Next
' Linien setzen
For i = 0 To 3
newIndex = frame_index * 100 + i
load Line1(newIndex)
With Line1(newIndex)
Set .Container = frameTab(frame_index)
If i = 3 And Not IstVerbundZaehler Then
.Visible = False
Else
.Visible = True
End If
.x1 = Line1(i).x1
.x2 = Line1(i).x2
.y1 = Line1(i).y1
.y2 = Line1(i).y2
End With
Next
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not IstVerbundZaehler Then
For i = 0 To 9
newIndex = (frame_index) * 100 + i
txtNZStart.Item(newIndex).Visible = False
txtNZStop.Item(newIndex).Visible = False
lblNZVol.Item(newIndex).Visible = False
Next i
Label1(8 + (frame_index) * 100).Visible = False
Label1(9 + (frame_index) * 100).Visible = False
Label1(10 + (frame_index) * 100).Visible = False
Label1(1 + (frame_index) * 100).Visible = False
Line1(3 + (frame_index) * 100).Visible = False
txtSerienNrNZ(frame_index).Visible = False
cmdNZInfo(frame_index).Visible = False
LabelKndEigeneSerNr(frame_index).Visible = False
'txtKundeneigeneSerienNrNZ(frame_index).Visible = False
cmb2KundeneigeneSNr(frame_index).Visible = False
chkPruefNZ(frame_index).Visible = False
txtInfoVerbundzaehler.Visible = False
Else
' Verbundzähler
If frame_index > 0 Then
Set cmdNZInfo(frame_index).Container = frameTab(frame_index)
Set txtSerienNrNZ(frame_index).Container = frameTab(frame_index)
'Set txtKundeneigeneSerienNrNZ(frame_index).Container = frameTab(frame_index)
Set cmb2KundeneigeneSNr(frame_index).Container = frameTab(frame_index)
Set chkPruefNZ(frame_index).Container = frameTab(frame_index)
Set LabelKndEigeneSerNr(frame_index).Container = frameTab(frame_index)
End If
'txtKundeneigeneSerienNrNZ(frame_index).Visible = True
cmb2KundeneigeneSNr(frame_index).Visible = True
txtSerienNrNZ(frame_index).Visible = True
chkPruefNZ(frame_index).Visible = True
LabelKndEigeneSerNr(frame_index).Visible = True
cmdNZInfo(frame_index).Visible = True
txtInfoVerbundzaehler.Visible = True
End If
Set lblFabNr(frame_index).Container = frameTab(frame_index)
lblFabNr(frame_index).Visible = True
Set txtFabNr(frame_index).Container = frameTab(frame_index)
txtFabNr(frame_index).Visible = True
' Alle Zähler:
Label1(3 + (frame_index) * 100).Visible = False
If m_blnSimpleInput Then
For i = istart To 10
If (Not IstVerbundZaehler And i > m_AnzahlPP) Or (IstVerbundZaehler And i > m_AnzahlPP And i < 9) Then
txtQ(frame_index * 100 + i - 1).Visible = False
txtHZStart(frame_index * 100 + i - 1).Visible = False
txtHZStop(frame_index * 100 + i - 1).Visible = False
lblHZVol(frame_index * 100 + i - 1).Visible = False
txtNZStart(frame_index * 100 + i - 1).Visible = False
txtNZStop(frame_index * 100 + i - 1).Visible = False
lblNZVol(frame_index * 100 + i - 1).Visible = False
lblVol(frame_index * 100 + i - 1).Visible = False
txtBehVol(frame_index * 100 + i - 1).Visible = False
lblFGu(frame_index * 100 + i - 1).Visible = False
lblFehler(frame_index * 100 + i - 1).Visible = False
lblFGo(frame_index * 100 + i - 1).Visible = False
lblNr(frame_index * 100 + i - 1).Visible = False
End If
Next
End If
End Sub
Private Sub Label1_Click(Index As Integer)
MsgBox "Ändern"
End Sub
Private Sub lblFehler_DblClick(Index As Integer)
Dim sNeuerWert As String
sNeuerWert = InputBox("Bitte geben Sie den Fehler in % ein!")
If sNeuerWert = "" Or Not IsNumeric(sNeuerWert) Then
' Eingabe abgebrochen
Exit Sub
End If
sNeuerWert = stringToDouble(Format(sNeuerWert, "0.0"))
sNeuerWert = Replace(sNeuerWert, ".", ",")
If IsNumeric(sNeuerWert) Then
'Wert OK
lblFehler(Index).caption = sNeuerWert
lblFehler(Index).Tag = "Handeingabe"
txtBehVol(Index).text = ""
txtHZStart(Index).text = ""
txtHZStop(Index).text = ""
txtNZStart(Index).text = ""
txtNZStop(Index).text = ""
lblHZVol(Index).caption = ""
lblNZVol(Index).caption = ""
lblVol(Index).caption = ""
checkToleranz (Index)
Else
' Falsche Eingabe
lblFehler(Index).caption = ""
checkToleranz (Index)
End If
End Sub
Private Sub TabStrip1_Click()
Dim selected_tab As Integer
' selected_tab im Bereich von 0 bis 9
selected_tab = TabStrip1.SelectedItem.Index - 1
' Wenn der Ausgewählte Tab immernoch gleich AltSelectedTab
' wie beim letzten Mal, dann nichts tun
If selected_tab = AltSelectedTab Then Exit Sub
TabStrip_Auswaehlen selected_tab
If txtSerienNrNZ(selected_tab).Visible And txtSerienNrNZ(selected_tab).Enabled Then
txtSerienNrNZ(selected_tab).SetFocus
Else
txtFabNr(selected_tab).SetFocus
End If
End Sub
Private Function NaechsterBelegterTab(istart As Integer) As Integer
Dim i As Integer
Dim Pruefzaehler As CPruefzaehler
Dim Einbauplatz As CEinbauplatz
' Anfang
i = istart
Set Pruefzaehler = Nothing
' Suche solange bis Prüfzähler gefunden wird
Do While Pruefzaehler Is Nothing
' es gibt möglicherweise noch weitere eingebaute Zähler auf höheren Einbauplatzen
i = i + 1
' am Ende
If i > 10 Then
'Am Anfang beginnen
i = 1
End If
If i = istart Then
' Am Startwert angekommen
' nichts gefunden
i = -1
Exit Do
End If
Set Einbauplatz = m_colEinbauplatz.Item(i)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
NaechsterBelegterTab = i
Loop
Debug.Print "Startbei " & istart & ", NaechsterBelegterTab = " & NaechsterBelegterTab; ""
End Function
Private Sub TabStrip_Auswaehlen(selected_tab As Integer)
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim bFlag1 As Boolean
bFlag1 = False
nochmal:
' Prüfzähler-Objekt zum ausgewählten Tab bestimmen
Set Einbauplatz = m_colEinbauplatz.Item(selected_tab + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
Set m_Pruefzaehler = Pruefzaehler
' Frame zum letzten ausgewählten Tab unsichtbar machen
frameTab(AltSelectedTab).Visible = False
' dafür aktuellen Frame sichtbar machen
frameTab(selected_tab).Visible = True
' und nach vorne setzen
frameTab(selected_tab).ZOrder
' Wenn Pruefzähler nicht definiert ist
If Pruefzaehler Is Nothing Then
' Frame unsichtbar machen (sieht aus wie ein leerer TabStrip)
frameTab(selected_tab).Visible = False
' zuletzt ausgewählten TabStrip wieder auswählen
TabStrip1.Tabs.Item(AltSelectedTab + 1).Selected = True
selected_tab = AltSelectedTab
If bFlag1 = False Then
bFlag1 = True
GoTo nochmal
End If
Else
AltSelectedTab = selected_tab
End If
ShowNZFehler selected_tab
End Sub
Private Sub checkToleranz(Index)
Dim Fehler As Double
Dim FGo As Double
Dim Fgu As Double
If lblFehler(Index).caption <> "" And lblFGo(Index).caption <> "" And lblFGu(Index).caption <> "" Then
Fehler = CDbl(lblFehler(Index).caption)
FGo = CDbl(lblFGo(Index).caption)
Fgu = CDbl(lblFGu(Index).caption)
If GrenzwertUeberschritten(FGo, Fehler, Fgu) Then
lblFehler(Index).BackColor = &HC0C0FF
Else
lblFehler(Index).BackColor = &H8000000F
End If
Else
lblFehler(Index).BackColor = &H8000000F
End If
End Sub
Private Sub txtBehVol_LostFocus(Index As Integer)
SetGotLostFocusColor txtBehVol(Index), False
End Sub
Private Sub txtFabNr_GotFocus(Index As Integer)
SetGotLostFocusColor txtFabNr(Index), True
End Sub
Private Sub txtFabNr_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If txtSerienNrNZ(Index).Visible And txtSerienNrNZ(Index).Enabled Then
txtSerienNrNZ(Index).SetFocus
Else
txtQ(Index * 100).SetFocus
End If
End If
End Sub
Private Sub txtFabNr_LostFocus(Index As Integer)
SetGotLostFocusColor txtFabNr(Index), False
End Sub
Private Sub txtHZStart_Change(Index As Integer)
lblFehler(Index).Tag = ""
checkToleranz (Index)
End Sub
Private Sub txtHZStart_LostFocus(Index As Integer)
SetGotLostFocusColor txtHZStart(Index), False
End Sub
Private Sub txtHZStop_Change(Index As Integer)
lblFehler(Index).Tag = ""
checkToleranz (Index)
End Sub
Private Sub txtHZStop_GotFocus(Index As Integer)
SetGotLostFocusColor txtHZStop(Index), True
End Sub
Private Sub txtHZStop_LostFocus(Index As Integer)
SetGotLostFocusColor txtHZStop(Index), False
End Sub
Private Sub cmb2KundeneigeneSNr_KeyPress(Index As Integer, KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
If chkPruefNZ(Index).Enabled = True Then
chkPruefNZ(Index).SetFocus
End If
End If
End Sub
'Private Sub txtKundeneigeneSerienNrNZ_KeyPress(Index As Integer, KeyAscii As Integer)
' If KeyAscii = 13 Then
' If chkPruefNZ(Index).Enabled = True Then
' chkPruefNZ(Index).SetFocus
' End If
' End If
'End Sub
Private Sub cmb2KundeneigeneSNr_LostFocus(Index As Integer)
SetGotLostFocusColor cmb2KundeneigeneSNr(Index), False
End Sub
'Private Sub txtKundeneigeneSerienNrNZ_LostFocus(Index As Integer)
' SetGotLostFocusColor txtKundeneigeneSerienNrNZ(Index), False
'End Sub
Private Sub txtWasserVorlaufTemperatur_GotFocus()
SetGotLostFocusColor txtWasserVorlaufTemperatur, True
End Sub
Private Sub txtWasserVorlaufTemperatur_LostFocus()
SetGotLostFocusColor txtWasserVorlaufTemperatur, False
End Sub
Private Sub txtNZStart_Change(Index As Integer)
lblFehler(Index).Tag = ""
checkToleranz (Index)
End Sub
Private Sub txtNZStart_LostFocus(Index As Integer)
SetGotLostFocusColor txtNZStart(Index), False
End Sub
Private Sub txtNZStop_Change(Index As Integer)
lblFehler(Index).Tag = ""
checkToleranz (Index)
End Sub
Private Sub txtBehVol_Change(Index As Integer)
lblFehler(Index).Tag = ""
checkToleranz (Index)
End Sub
Private Sub txtBehVol_Validate(Index As Integer, Cancel As Boolean)
If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub
lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text)
checkToleranz (Index)
End Sub
Private Sub txtHZStart_Validate(Index As Integer, Cancel As Boolean)
If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub
lblHZVol(Index).caption = BerechneDifTxt(txtHZStart(Index).text, txtHZStop(Index).text)
lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text)
checkToleranz (Index)
lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption)
End Sub
Private Sub txtHZStop_Validate(Index As Integer, Cancel As Boolean)
Dim frame_index As Integer
If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub
frame_index = Int(Index / 100)
lblHZVol(Index).caption = BerechneDifTxt(txtHZStart(Index).text, txtHZStop(Index).text)
lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text)
lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption)
checkToleranz (Index)
If m_Pruefzaehler.IstVerbundZaehler Then
' Wenn Verbundzähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 7
If txtHZStop(Index).text <> "" And Index Mod 100 <= 7 Then
If txtQ(Index + 1).text <> "" Then
' Übernehme StopWertes als nächsten StartWert
If txtHZStop(Index + 1).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtHZStart(Index + 1).text = txtHZStop(Index).text
End If
' Übernehme Stopwert als Öffnen-Startwert und Schließen-Startwert
If txtHZStop(frame_index * 100 + 8).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtHZStart(frame_index * 100 + 8).text = txtHZStop(Index).text
End If
If txtHZStop(frame_index * 100 + 9).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtHZStart(frame_index * 100 + 9).text = txtHZStop(Index).text
End If
End If
End If
Else
' Wenn kein eRegister und
If mbln_eRegister = False Then
' Wenn normaler Zähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 9
If txtHZStop(Index).text <> "" And Index Mod 100 <= 9 Then
' Übernehme StopWertes als nächsten StartWert
If txtHZStop(Index + 1).text = "" And txtQ(Index + 1).text <> "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt und Q vorhanden
txtHZStart(Index + 1).text = txtHZStop(Index).text
End If
End If
End If
End If
Call txtNZStop_Validate(Index, Cancel)
End Sub
Private Sub txtNZStart_Validate(Index As Integer, Cancel As Boolean)
If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub
lblNZVol(Index).caption = BerechneDifTxt(txtNZStart(Index).text, txtNZStop(Index).text)
lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text)
checkToleranz (Index)
lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption)
End Sub
Private Sub txtNZStop_LostFocus(Index As Integer)
SetGotLostFocusColor txtNZStop(Index), False
End Sub
Private Sub txtNZStop_Validate(Index As Integer, Cancel As Boolean)
Dim frame_index As Integer
If lblFehler(Index).Tag = "Handeingabe" Then Exit Sub
frame_index = Int(Index / 100)
lblNZVol(Index).caption = BerechneDifTxt(txtNZStart(Index).text, txtNZStop(Index).text)
lblFehler(Index).caption = BerechneMessfehlerTxt(lblHZVol(Index).caption, lblNZVol(Index).caption, txtBehVol(Index).text)
checkToleranz (Index)
lblVol(Index).caption = BerechneSummeTxt(lblHZVol(Index).caption, lblNZVol(Index).caption)
If m_Pruefzaehler.IstVerbundZaehler Then
' Wenn Verbundzähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 7
If txtNZStop(Index).text <> "" And Index Mod 100 <= 7 Then
If txtQ(Index + 1).text <> "" Then
' Übernehme StopWertes als nächsten StartWert
If txtHZStop(Index + 1).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtNZStart(Index + 1).text = txtNZStop(Index).text
End If
' Übernehme Stopwert als Öffnen-Startwert
If txtNZStop(frame_index * 100 + 8).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtNZStart(frame_index * 100 + 8).text = txtNZStop(Index).text
End If
' Übernehme Stopwert als Schließen-Startwert
If txtNZStop(frame_index * 100 + 9).text = "" Then
' aber nur, wenn nächster Stopwert noch nicht gefüllt
txtNZStart(frame_index * 100 + 9).text = txtNZStop(Index).text
End If
End If ' txtQ<>0
End If ' NZStop <> 0 and Index Mod 100 <= 7
Else
' Wenn normaler Zähler und Eingabe im Feld von Pruefpunkt Nr 1 bis 9
If txtNZStop(Index).text <> "" And Index Mod 100 <= 9 Then
' Übernehme StopWertes als nächsten StartWert
If txtNZStop(Index + 1).text = "" And txtQ(Index + 1).text <> "" Then
txtNZStart(Index + 1).text = txtNZStop(Index).text
End If
End If
End If
End Sub
Private Function BerechneMessfehlerTxt(VZH As String, VZN As String, VB As String) As String
Dim dVZH As Double
Dim dVZN As Double
Dim dVB As Double
Dim dVZ As Double
Dim Fehler As Double
If VZN = "" Then VZN = "0"
If IsNumeric(VZH) And IsNumeric(VZN) And IsNumeric(VB) Then
dVZ = CDbl(VZH) + CDbl(VZN)
dVB = CDbl(VB)
If dVB = 0 Then
MsgBox ("Volumen kann nicht 0 sein")
Exit Function
End If
If g_objExternePruefformel Is Nothing Then
DebugMsg "Interne Pruefformel"
Fehler = ((dVZ - dVB) / dVB) * 100
DebugMsg " dVZ=" & dVZ & ", dVB= " & dVB & ", Fehler = " & Fehler
Else
' Fehlerberechnung in Externer DLL, neu RH 30.5.2017
Fehler = modPruefformel.Errechne_Relative_Messabweichung_in_Prozent(dVZ, dVB, 0)
DebugMsg g_objExternePruefformel.GetLogText
End If
BerechneMessfehlerTxt = Format(Fehler, "0.0")
Else
BerechneMessfehlerTxt = ""
End If
End Function
Private Function BerechneSummeTxt(VolHZ As String, VolNZ As String) As String
If VolNZ = "" Then VolNZ = "0"
If IsNumeric(VolHZ) And IsNumeric(VolNZ) Then
BerechneSummeTxt = CStr(CDbl(VolHZ) + CDbl(VolNZ))
Else
BerechneSummeTxt = ""
End If
End Function
Private Function BerechneDifTxt(sStart As String, sStop As String) As String
Dim dStart As Double
Dim dStop As Double
Dim dDif As Double
If IsNumeric(sStart) And IsNumeric(sStop) Then
dStart = CDbl(sStart)
dStop = CDbl(sStop)
dDif = dStop - dStart
BerechneDifTxt = Format(dDif, "0.000")
Else
BerechneDifTxt = ""
End If
End Function
Private Function ueberpruefe() As Boolean
Dim i As Integer
Dim j As Integer
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim SerienNr As Long
Dim SerienNrNebenzaehler As Long
Dim HauptzaehlerSerienNr As Long
Screen.MousePointer = vbHourglass
For i = 0 To 9
Set Einbauplatz = m_colEinbauplatz.Item(i + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
SerienNr = Pruefzaehler.getSerienNr
'''''''''''''''''''
' Verbundzähler '
'''''''''''''''''''
If Pruefzaehler.IstVerbundZaehler Then
' Wenn Öffnen Prüfpunkt oder Schließen Prüfpunkt eingetragen ist, dann muss auch die
' Nebenzählerseriennr eingetragen werden:
If txtQ(i * 100 + 8).text <> "" Or txtQ(i * 100 + 9).text <> "" Then
If Val(txtSerienNrNZ(i).text) = 0 And Trim(cmb2KundeneigeneSNr(i).text) = "" Then
' TabStrip auswählen
TabStrip1.Tabs.Item(i + 1).Selected = True
MsgBox ("Die Nebenzähler Seriennummer oder Kundeneigene SerienNr muß eingetragen werden, wenn Öffnen- oder Schließen-Prüfpunkt eingetragen wurde.")
txtSerienNrNZ(i).SetFocus
Screen.MousePointer = vbNormal
Exit Function
End If
SerienNrNebenzaehler = Val(txtSerienNrNZ(i).text)
If SerienNrNebenzaehler > 0 Then
If chkPruefNZ(i).value = 0 Then
HauptzaehlerSerienNr = DoppelteHZSerienNr(SerienNr, SerienNrNebenzaehler)
If HauptzaehlerSerienNr <> 0 Then
MsgBox ("Der Nebenzähler " & SerienNrNebenzaehler & " wurde bereit mit dem Hauptzähler " & HauptzaehlerSerienNr & " geprüft." & vbCrLf _
& "Um diese Zähler zusammen prüfen zu können, muß der Nebenzähler als Prüfnebenzähler gewählt sein.")
'Geändert AP 25.09.2003; Wechsel auf den Tabstrip mit der falschen Nebenzählernummer
If TabStrip1.Tabs.Item(i + 1).Selected = True Then
txtSerienNrNZ(i).SetFocus
Else
TabStrip1.Tabs.Item(i + 1).Selected = True
txtSerienNrNZ(i).SetFocus
End If
Screen.MousePointer = vbNormal
Exit Function
End If
End If
End If
End If
' If (lblFehler(i * 100 + 8).Caption = "" And txtQ(i * 100 + 8).Text <> "") And mblnOeffnenSchliessenErgaenzen = True Then
' TabStrip1.Tabs.Item(i + 1).Selected = True
' MsgBox ("Bitte geben Sie auch die Daten für den 'Öffnen'-Prüfpunkt an")
' txtQ(i * 100 + 8).SetFocus
' Screen.MousePointer = vbNormal
' Exit Function
' End If
'
' If (lblFehler(i * 100 + 9).Caption = "" And txtQ(i * 100 + 9).Text <> "") And mblnOeffnenSchliessenErgaenzen = True Then
' TabStrip1.Tabs.Item(i + 1).Selected = True
' MsgBox ("Bitte geben Sie auch die Daten den 'Schließen'-Prüfpunkt an")
' txtQ(i * 100 + 8).SetFocus
' Screen.MousePointer = vbNormal
' Exit Function
' End If
End If ' Verbundzähler
''''''''''''''
' Alle Zähler
''''''''''''''
For j = 0 To 9
If txtQ(i * 100 + j).text = "" And lblHZVol(i * 100 + j).caption <> "" Then
TabStrip1.Tabs.Item(i + 1).Selected = True
MsgBox ("Es wurde kein Durchfluß eingetragen")
txtQ(i * 100 + j).SetFocus
Screen.MousePointer = vbNormal
Exit Function
End If
' wenn Pruefpunkt vorhanden, aber kein Fehler ermittelt worden ist
If lblFehler(i * 100 + j).caption = "" And Val(txtQ(i * 100 + j).text) > 0 Then
' TabStrip auswählen
TabStrip1.Tabs.Item(i + 1).Selected = True
' Hinweis und Fokus in Eingabefeld
ErrorMsg ("Es konnte kein Fehler ermittelt werden für Pruefpunkt Q=" & Val(txtQ(i * 100 + j).text))
txtHZStart((i) * 100 + j).Enabled = True
If txtHZStart((i) * 100 + j).Enabled = True Then
txtHZStart((i) * 100 + j).SetFocus
End If
Screen.MousePointer = vbNormal
Exit Function
End If
Next
End If
Next i
ueberpruefe = True
Screen.MousePointer = vbNormal
End Function
Private Sub txtQ_GotFocus(Index As Integer)
txtQ(Index).SelStart = 0
txtQ(Index).SelLength = Len(txtQ(Index).text)
SetGotLostFocusColor txtQ(Index), True
End Sub
Private Sub txtHZStart_GotFocus(Index As Integer)
SetGotLostFocusColor txtHZStart(Index), True
txtHZStart(Index).SelStart = 0
txtHZStart(Index).SelLength = Len(txtHZStart(Index).text)
End Sub
Private Sub txtNZStart_GotFocus(Index As Integer)
SetGotLostFocusColor txtNZStart(Index), True
txtNZStart(Index).SelStart = 0
txtNZStart(Index).SelLength = Len(txtNZStart(Index).text)
End Sub
Private Sub txtNZStop_GotFocus(Index As Integer)
SetGotLostFocusColor txtNZStop(Index), True
txtNZStop(Index).SelStart = 0
txtNZStop(Index).SelLength = Len(txtNZStop(Index).text)
End Sub
Private Sub txtBehVol_GotFocus(Index As Integer)
SetGotLostFocusColor txtBehVol(Index), True
txtBehVol(Index).SelStart = 0
txtBehVol(Index).SelLength = Len(txtBehVol(Index).text)
End Sub
Private Sub txtQ_LostFocus(Index As Integer)
SetGotLostFocusColor txtQ(Index), False
txtQ(Index).text = Trim(txtQ(Index).text)
If Len(txtQ(Index).text) > 0 Then
If Not IsNumericAndDouble(txtQ(Index).text) Then
MsgBox "Bitte einen Numerischen Wert eingeben!"
m_blnEingabeFehler = True
txtQ(Index).SetFocus
End If
End If
End Sub
Private Sub txtQ_Validate(Index As Integer, Cancel As Boolean)
txtQ(Index).text = Trim(txtQ(Index).text)
If Len(txtQ(Index).text) > 0 Then
If Not IsNumeric(txtQ(Index).text) Then
' MsgBox "Bitte einen Numerischen Wert eingeben!"
' m_blnEingabeFehler = True
' txtQ(Index).SetFocus
End If
End If
End Sub
Private Sub txtSerienNrNZ_DblClick(Index As Integer)
Dim strAlteSerienNr As String
Dim strNeueSerienNr As String
' bisherige NZ SerienNr anzeigen
strAlteSerienNr = Trim(txtSerienNrNZ(Index).text)
strNeueSerienNr = Trim(InputBox("Bitte geben Sie die NZ-SerienNr ein: ", "NZ SerienNr ändern", strAlteSerienNr))
If strNeueSerienNr <> "" And strNeueSerienNr <> strAlteSerienNr Then
txtSerienNrNZ(Index).text = strNeueSerienNr
ShowNZFehler (Index)
End If
End Sub
Private Sub txtSerienNrNZ_GotFocus(Index As Integer)
txtSerienNrNZ(Index).SelStart = 0
txtSerienNrNZ(Index).SelLength = Len(txtSerienNrNZ(Index).text)
txtSerienNrNZ(Index).BackColor = vbYellow
End Sub
'Private Sub txtKundeneigeneSerienNrNZ_gotFocus(Index As Integer)
' txtKundeneigeneSerienNrNZ(Index).SelStart = 0
' txtKundeneigeneSerienNrNZ(Index).SelLength = Len(txtKundeneigeneSerienNrNZ(Index).text)
' SetGotLostFocusColor txtKundeneigeneSerienNrNZ(Index), True
'End Sub
Private Sub cmb2KundeneigeneSNr_gotFocus(Index As Integer)
cmb2KundeneigeneSNr(Index).SelStart = 0
cmb2KundeneigeneSNr(Index).SelLength = Len(cmb2KundeneigeneSNr(Index).text)
SetGotLostFocusColor cmb2KundeneigeneSNr(Index), True
End Sub
Private Sub txtQ_KeyPress(Index As Integer, KeyAscii As Integer)
Dim PPNr As Integer
Dim neuIndex As Integer
On Error GoTo Errorhandler
PPNr = Index Mod 100
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
' Enter Taste wurde gedrückt
' Überprüfen auf Eingabefehler
m_blnEingabeFehler = False
Call txtQ_LostFocus(Index)
If Not m_blnEingabeFehler Then
' Eingabe-Inputbox für Fehler anzeigen
lblFehler_DblClick (Index)
If PPNr = 8 Then
' Ich bin in der Öffnen Spalte, also Fokus in den Schliessen Durchfluss
txtQ(Index + 1).SetFocus
txtQ_GotFocus (Index + 1)
Else
' normale Prüfpunkte (nicht öffnen/schliessen)
If m_blnSimpleInput Then
If PPNr < 9 Then
' es gibt noch weiter rechts einen weiteren Durchfluss (Q-Schliessen)
If txtQ(Index + 1).Visible And txtQ(Index + 1).Enabled Then
' Fokus in den nächsten Durchfluss, falls nicht gesperrt
txtQ(Index + 1).SetFocus
txtQ_GotFocus (Index + 1)
Else
If txtQ(AltSelectedTab * 100 + 8).Enabled Then
' Fokus in den Öffnen Durchfluss, falls Verbundzähler
txtQ(AltSelectedTab * 100 + 8).SetFocus
txtQ_GotFocus (AltSelectedTab * 100 + 8)
Else
' Fokus in den 1. Durchfluss + nächster freier Tab, falls kein Verbundzähler
neuIndex = NaechsterBelegterTab(AltSelectedTab + 1)
Debug.Print "Nächster belegter Tab: " & neuIndex
TabStrip1.Tabs(neuIndex).Selected = True
DoEvents
End If
End If
Else
' bin am Ende
Debug.Print "bin am Ende mit Q"
neuIndex = NaechsterBelegterTab(AltSelectedTab + 1)
Debug.Print "Nächster belegter Tab: " & neuIndex
TabStrip1.Tabs(neuIndex).Selected = True
DoEvents
End If
End If
End If
Else
' Fokus in dasselbe Q-Eingabefeld
txtQ(Index).SetFocus
txtQ_GotFocus (Index)
End If
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
Exit Sub
Errorhandler:
'MsgBox "Fehler " & Err.Number & " in frmManuellDetails.txtQ_keyPress(index=" & index & ",keyAscii=" & KeyAscii & ") " & Err.Description
LogIntoDB "Fehler " & Err.Number & " in frmManuellDetails.txtQ_keyPress(index=" & Index & ",keyAscii=" & KeyAscii & ") " & Err.Description, "Softwarefehler"
' Resume
End Sub
Private Sub txtHZStart_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
Call txtHZStart_Validate(Index, False)
txtHZStop(Index).SetFocus
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtHZStop_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
Call txtHZStop_Validate(Index, False)
If txtNZStart(Index).Visible = True Then
txtNZStart(Index).SetFocus
Else
txtBehVol(Index).SetFocus
End If
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtNZStart_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
Call txtNZStop_Validate(Index, False)
txtNZStop(Index).SetFocus
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtNZStop_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
Call txtNZStop_Validate(Index, False)
txtBehVol(Index).SetFocus
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtBehVol_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 0
If KeyAscii = 13 Then
Call txtBehVol_Validate(Index, False)
If (Index Mod 100) < 9 Then
txtQ(Index + 1).SetFocus
Else
txtQ(Index - (Index Mod 100)).SetFocus
End If
End If
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtSerienNrNZ_KeyPress(Index As Integer, KeyAscii As Integer)
Dim blnCancel As Boolean
Select Case KeyAscii
Case 13
If txtQ(Index * 100).Enabled Then
txtQ(Index * 100).SetFocus
'txtKundeneigeneSerienNrNZ(Index).SetFocus
Call txtSerienNrNZ_Validate(Index, blnCancel)
If blnCancel = False Then
cmb2KundeneigeneSNr(Index).SetFocus
End If
End If
Exit Sub
End Select
If Not IsNumericOrBlanc(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
' 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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'todo:
'If g_blnZulassungspruefung Then
' Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, m_DurchflussSoll, QIst, Impulse / ImpulswertigkeitPZ * 1000, 1000 * BehaelterVolumen, Fehler, Temperatur, PPStartZeit, True)
'End If
Private Sub PruefdatenSpeichern()
Dim TabSeite As Integer
Dim PruefpunktNr As Integer
Dim Pruefpunkt As CPruefpunkt
Dim AllePruefpunkte As CPruefpunkte
Dim colPruefpunkte As CPruefpunktCol
Dim AnzahlPZ As Integer
Dim Pruefzaehler As CPruefzaehler
Dim Fehler As Double
Dim FGo As Double
Dim Fgu As Double
Dim Einbauplatz As CEinbauplatz
Dim nPos As Integer
Dim SpalteNr As Integer
Dim KopiePruefpunkt As CPruefpunkt
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Dim strTemp As String
Dim PPZeit As Date
' Auf ausgefüllte Felder testen, ggf. Warnung, wenn Feld nicht ausgefüllt
' Sowie eindeutige Pruefpunkte feststellen
Screen.MousePointer = vbHourglass
PPZeit = Now()
m_Pruefgang.PrueferNr = g_App.Mitarbeiter.getNr
If Val(txtWasserVorlaufTemperatur.text) > 0 Then
txtWasserVorlaufTemperatur.text = Replace(txtWasserVorlaufTemperatur.text, ",", ".")
m_Pruefgang.Vorlauftemperatur = Val(txtWasserVorlaufTemperatur.text)
End If
MesseWetterdaten
m_Pruefgang.LuftDruck = g_dblLuftDruck
m_Pruefgang.Lufttemperatur = g_dblLuftTemperatur
m_Pruefgang.RelativeFeuchte = g_dblLuftFeuchte
'Geändert AP am 25.11.03 Unterdrückung der Prüfstationsnummer
' bei der Ergänzung der Prüfdaten Öffnen/Schließen
If mblnOeffnenSchliessenErgaenzen = False Then
'm_Pruefgang.PruefstationNr = g_App.PruefstationNr
End If
Set colPruefpunkte = New CPruefpunktCol
AnzahlPZ = 0
For TabSeite = 1 To 10
Set Einbauplatz = m_colEinbauplatz.Item(TabSeite)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
' Für jeden eingebauten Zähler
' zählen
AnzahlPZ = AnzahlPZ + 1
' Setzen des Ist-geprüft Status
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 30
Pruefzaehler.getAuftragPositionSerienNr.AlterStatusFlag StatusFlagBits.StatusFlagWert_Rueckwaerts_geprueft, m_blnRueckwaertspruefung
'Neu RH 23.4.2008
If Val(txtFabNr(TabSeite - 1).text) > 0 Then
' wegen dem Index Speicherabbild.FabNr mit AuftragpositionSerienNr.FabNr
If CheckAndCreateInSpeicherabbild(TabSeite - 1, Val(txtFabNr(TabSeite - 1).text)) Then
Pruefzaehler.getAuftragPositionSerienNr.setFabNr Val(txtFabNr(TabSeite - 1).text)
Else
MsgBox "Speicherabbild Datensatz für FabNr " & Val(txtFabNr(TabSeite - 1).text) & " wurde nicht gespeichert."
End If
End If
If AnzahlPZ = 1 Then
' Es handelt sich um den ersten eingebauten Zähler
m_Pruefgang.Typ = Pruefzaehler.getIdentNrObj.getTyp
m_Pruefgang.Typzusatz = Pruefzaehler.getIdentNrObj.getTypzusatz
m_Pruefgang.Nennweite = Pruefzaehler.getIdentNrObj.getNennweite
m_Pruefgang.Nenntemperatur = Pruefzaehler.getIdentNrObj.GetTemperatur
End If
For SpalteNr = 0 To IIf(Pruefzaehler.IstVerbundZaehler, 7, 9)
' Alle Pruefpunkte ohne Öffnen / Schliessen
Debug.Print SpalteNr & ": " & txtQ((TabSeite - 1) * 100 + SpalteNr).text
If txtQ((TabSeite - 1) * 100 + SpalteNr).text <> "" Then
Set Pruefpunkt = New CPruefpunkt
' Pruefpunkt vorhanden
Pruefpunkt.setQ CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text)
If lblFGo((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then
Pruefpunkt.setFGo CDbl(lblFGo((TabSeite - 1) * 100 + SpalteNr).caption)
Pruefpunkt.setFGu CDbl(lblFGu((TabSeite - 1) * 100 + SpalteNr).caption)
End If
' Pruefpunkt zur Collection hinzuaddieren
''''''''''''''''''''''''''''''''''''''''''
nPos = getEquivPruefpunktIndexFromCollection(Pruefpunkt, colPruefpunkte)
If nPos = 0 Then
Debug.Print "neuer Pruefpunkt: " & Pruefpunkt.getQ
Set KopiePruefpunkt = New CPruefpunkt
KopiePruefpunkt.copyFrom Pruefpunkt
Call KopiePruefpunkt.setUseCount(1)
colPruefpunkte.Add KopiePruefpunkt
Else
Call colPruefpunkte.Item(nPos).incUseCount
Debug.Print " wdh Pruefpunkt: " & Pruefpunkt.getQ
End If
End If
Next ' SpalteNr
End If ' not Pruefzaehler is nothing
Next TabSeite
m_Pruefgang.Anzahl = AnzahlPZ
If mblnOeffnenSchliessenErgaenzen = True And m_Pruefgang.PruefgangNr > 0 Then
'Neu RH 24.9.2006
' Prüfgang wird bei Verbundzählern nicht mehr überschrieben
Else
m_Pruefgang.save
End If
colPruefpunkte.sortQ
PruefpunktNr = 0
For Each Pruefpunkt In colPruefpunkte.getCollection
PruefpunktNr = PruefpunktNr + 1
m_Pruefgang.PP_Soll(PruefpunktNr) = CSng(Pruefpunkt.getQ)
m_Pruefgang.PP_Ist(PruefpunktNr) = CSng(Pruefpunkt.getQ)
m_Pruefgang.save
Debug.Print "- - - - - - - - - - - - - - "
Debug.Print "Pruefpunkt PP" & PruefpunktNr & " mit Q=" & Pruefpunkt.getQ
Debug.Print "Wird benutzt von " & Pruefpunkt.getUseCount & " Pruefzählern"
For TabSeite = 1 To 10
Set Einbauplatz = m_colEinbauplatz.Item(TabSeite)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
For SpalteNr = 0 To IIf(Pruefzaehler.IstVerbundZaehler, 7, 9)
' Alle Pruefpunkte ohne Öffnen / Schliessen
Debug.Print "SpalteNr: " & SpalteNr & ", Val(txtQ): " & Val(txtQ((TabSeite - 1) * 100 + SpalteNr).text)
Debug.Print " Index: " & (TabSeite - 1) * 100 + SpalteNr
Debug.Print " txt:" & txtQ((TabSeite - 1) * 100 + SpalteNr).text
If txtQ((TabSeite - 1) * 100 + SpalteNr).text <> "" Then
If CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr)) > 0 Then
Debug.Print "vergl: " & Pruefpunkt.getQ & " mit " & CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text)
If Pruefpunkt.getQ = CDbl(txtQ((TabSeite - 1) * 100 + SpalteNr).text) And lblFehler((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then
Fehler = CDbl(lblFehler((TabSeite - 1) * 100 + SpalteNr).caption)
' Prüfzähler-Prüfpunkt
''''''''''''''''''''''
Debug.Print "---------------------"
Debug.Print " Einbauplatz " & Einbauplatz.getNr
Debug.Print " SNr=" & FormatSerienNr(Pruefzaehler.getSerienNr)
Debug.Print " Q =" & txtQ((TabSeite - 1) * 100 + SpalteNr)
Debug.Print " Fehler: " & CStr(Fehler)
If g_blnZulassungspruefung Then
Dim dblIndicatedVolumen As Double
Dim dblActualVolumen As Double
If lblVol((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then
dblIndicatedVolumen = CDbl(lblVol((TabSeite - 1) * 100 + SpalteNr).caption)
End If
If txtBehVol((TabSeite - 1) * 100 + SpalteNr).text <> "" Then
dblActualVolumen = CDbl(txtBehVol((TabSeite - 1) * 100 + SpalteNr).text)
End If
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, Pruefpunkt.getQ, Pruefpunkt.getQ, dblIndicatedVolumen, dblActualVolumen, Fehler, 0, PPZeit, False)
End If
' Wenn Grenzwert Überschritten, dann AuftragPositionSerienNr.StatusFertigung = 25
'
If lblFGo((TabSeite - 1) * 100 + SpalteNr).caption <> "" And lblFGu((TabSeite - 1) * 100 + SpalteNr).caption <> "" Then
FGo = CDbl(lblFGo((TabSeite - 1) * 100 + SpalteNr).caption)
Fgu = CDbl(lblFGu((TabSeite - 1) * 100 + SpalteNr).caption)
If GrenzwertUeberschritten(FGo, Fehler, Fgu) Then
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25
' neu 18.8.2016 Bugfix
Pruefzaehler.getAuftragPositionSerienNr.save
Debug.Print "Grenzwert überschritten in Spalte " & SpalteNr
End If
End If
If Not FehlerSpeichern(Fehler, Pruefzaehler, m_Pruefgang, PruefpunktNr) Then
ErrorMsg ("FehlerSpeichernError mit PPNr=" & PruefpunktNr & " und SerienNr=" & FormatSerienNr(Pruefzaehler.getSerienNr))
End If ' FehlerSpeichern
End If 'PP.getQ = txtQ
End If 'txtQ<>""
End If ' CDbl(txtQ) > 0
Next ' SpalteNr
End If ' not Pruefzaehler is nothing
Next ' tabSeite
Next ' Pruefpunkt
' Verbundzähler-Daten und AuftragPositionSerienNr-Daten speichern
For TabSeite = 1 To 10
Set Einbauplatz = m_colEinbauplatz.Item(TabSeite)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
If Pruefzaehler.IstVerbundZaehler Then
' Verbundzähler Daten speichern
Debug.Print "Verbundzähler: "
Debug.Print " SNr=" & FormatSerienNr(Pruefzaehler.getSerienNr)
Debug.Print " PruefgangNr=" & m_Pruefgang.PruefgangNr
Debug.Print " PP_Oeffnen=" & txtQ((TabSeite - 1) * 100 + 8)
Debug.Print " PP_Oefnnen_Fehler=" & lblFehler((TabSeite - 1) * 100 + 8)
Debug.Print " PP_Schliessen=" & txtQ((TabSeite - 1) * 100 + 9)
Debug.Print " PP_SchliessenFehler=" & lblFehler((TabSeite - 1) * 100 + 9)
Debug.Print " SerienNrNebenzähler=" & txtSerienNrNZ(TabSeite - 1)
Debug.Print " Kundeneigene SerienNrNebenzähler=" & cmb2KundeneigeneSNr(TabSeite - 1)
Debug.Print " Prüfnebenzähler=" & chkPruefNZ(TabSeite - 1)
' Fehlergrenzen Öffnen Schliessen überprüfen
' öffnen
Debug.Print lblFehler((TabSeite - 1) * 100 + 8)
Debug.Print lblFGo((TabSeite - 1) * 100 + 8).caption
Debug.Print lblFGu((TabSeite - 1) * 100 + 8).caption
' schliessen
Debug.Print lblFehler((TabSeite - 1) * 100 + 9)
Debug.Print lblFGo((TabSeite - 1) * 100 + 9).caption
Debug.Print lblFGu((TabSeite - 1) * 100 + 9).caption
If IsNumeric(lblFGo((TabSeite - 1) * 100 + 8).caption) And IsNumeric(lblFehler((TabSeite - 1) * 100 + 8).caption) And IsNumeric(lblFGu((TabSeite - 1) * 100 + 8).caption) Then
If GrenzwertUeberschritten(Val(lblFGo((TabSeite - 1) * 100 + 8).caption), Val(lblFehler((TabSeite - 1) * 100 + 8).caption), Val(lblFGu((TabSeite - 1) * 100 + 8).caption)) Then
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25
End If
End If
If IsNumeric(lblFGo((TabSeite - 1) * 100 + 9).caption) And IsNumeric(lblFehler((TabSeite - 1) * 100 + 9).caption) And IsNumeric(lblFGu((TabSeite - 1) * 100 + 9).caption) Then
If GrenzwertUeberschritten(Val(lblFGo((TabSeite - 1) * 100 + 9).caption), Val(lblFehler((TabSeite - 1) * 100 + 9).caption), Val(lblFGu((TabSeite - 1) * 100 + 9).caption)) Then
Pruefzaehler.getAuftragPositionSerienNr.setStatusFertigung 25
End If
End If
Call VerbundzaehlerSpeichern(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, txtQ((TabSeite - 1) * 100 + 8), lblFehler((TabSeite - 1) * 100 + 8).caption, txtQ((TabSeite - 1) * 100 + 9), lblFehler((TabSeite - 1) * 100 + 9), txtSerienNrNZ(TabSeite - 1).text, CBool(chkPruefNZ(TabSeite - 1).value), cmb2KundeneigeneSNr(TabSeite - 1).text, Pruefzaehler.getAuftragPosition)
' neu RH 19.3.2012
Dim NZPruefdaten As NZ_PRUEFDATEN_TYP
Dim blnSchonvorhanden As Boolean
NZPruefdaten.SerienNrNebenzaehler = Val(txtSerienNrNZ(TabSeite - 1))
NZPruefdaten.KundeneigeneSerienNrNZ = Trim(cmb2KundeneigeneSNr(TabSeite - 1).text)
If NZPruefdaten.SerienNrNebenzaehler > 0 Or NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then
If GetNZPruefdaten(Pruefzaehler.getSerienNr, NZPruefdaten, blnSchonvorhanden) Then
If blnSchonvorhanden = False Then
Call SetNZPruefdaten(Pruefzaehler.getSerienNr, NZPruefdaten)
End If
End If
End If
End If
'---------------------------------------------------------------------------
' wenn kompletter Pruefgang bendet:
' Doublizieren des Datensatzes in Tabelle AuftragPositionSerienNr und setzen
' der neuen Angaben
' Kopieren des AuftragPositionSerienNr Objektes incl. aller Daten
'---------------------------------------------------------------------------
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
' Setzen der neuen Werte: PgangDatum, PgangNr, Einbauplatz, AnlageDatum, MitarbeiterNr
AuftragpositionSerienNr.setPruefgangDatum m_Pruefgang.Datum
AuftragpositionSerienNr.setPruefgangNr m_Pruefgang.PruefgangNr
AuftragpositionSerienNr.setEinbauplatzNr Einbauplatz.getNr
AuftragpositionSerienNr.setAnlageDatum Now()
AuftragpositionSerienNr.setAnlageMitarbeiterNr g_App.Mitarbeiter.getNr
'Angaben für Änderung löschen
AuftragpositionSerienNr.setAenderungDatum Empty
AuftragpositionSerienNr.setAenderungMitarbeiterNr Empty
' Metrologische Klasse unter der diese Prüfung durchgeführt wurde
If Pruefzaehler.getPruefklasseKZ <> "" Then
AuftragpositionSerienNr.setMetrolog Pruefzaehler.getPruefklasseKZ
Else
AuftragpositionSerienNr.setMetrolog Pruefzaehler.getPruefpunkte.getPruefklasseKZ
End If
' Speichern als neuer Datensatz
If mblnOeffnenSchliessenErgaenzen = True Then
AuftragpositionSerienNr.save False
Else
' Hochzählen des Wiederholungszählers (-1 = Original Datensatz, 0 = 1. Pruefung, 1 = 1.Wdh
AuftragpositionSerienNr.setWiederholungen AuftragpositionSerienNr.getWiederholungen + 1
AuftragpositionSerienNr.save True ' As New
End If
'---------------------------------------------------------------------------
End If ' Pruefzaehler is not nothing
Next TabSeite
For TabSeite = 1 To 10
Set Einbauplatz = m_colEinbauplatz.Item(TabSeite)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Pruefzaehler.getAuftragPosition.UpdateTLMenge_P
Pruefzaehler.getAuftragPosition.save Pruefzaehler.getAuftrag
If g_blnZulassungspruefung Then
Call SchreibeZulassungspruefdaten(Pruefzaehler.getSerienNr, m_Pruefgang.PruefgangNr, 0, 0, 0, 0, 0, 0, PPZeit)
End If
End If
Next
' Neu RH 28.3.2017
Verschiebe_Prueffehler_Befundpruefung_Eichung m_Pruefgang.PruefgangNr
Screen.MousePointer = vbNormal
End Sub
Private Function FehlerSpeichern(Fehler As Double, Pruefzaehler As CPruefzaehler, Pruefgang As CPruefgang, PruefpunktNr As Integer)
On Error GoTo FehlerSpeichernError
Dim PruefgangNr As Long
Dim SerienNr As Long
Dim PPNr As Integer
Dim rs As CRecordset
Dim Feldname As String
Dim sSQL As String
PruefgangNr = Pruefgang.PruefgangNr
SerienNr = Pruefzaehler.getSerienNr
Set rs = New CRecordset
sSQL = "SELECT * from Prueffehler where PruefgangNr=" & PruefgangNr & " and SerienNr=" & SerienNr & ";"
rs.openRS (sSQL)
Debug.Print sSQL
If rs.EOF Then
rs.addNew
End If
Call rs.setValue("SerienNr", SerienNr)
Call rs.setValue("PruefgangNr", PruefgangNr)
Feldname = "PP" & CStr(PruefpunktNr) & "_Fehler"
Debug.Print "Feldname=" & Feldname & "; Fehler=" & Fehler
Call rs.setValue(Feldname, Fehler)
Call rs.setValue("PruefDatum", Now)
Call rs.update
FehlerSpeichern = True
Exit Function
FehlerSpeichernError:
ErrorMsg ("FehlerSpeichern fehlgeschlagen: " & Err.Description)
End Function
Private Function VerbundzaehlerSpeichern(SerienNr As Long, PruefgangNr As Long, strPP_Oeffnen As String, strPP_OeffnenFehler As String, strPP_Schliessen As String, strPP_SchliessenFehler As String, strSerienNrNebenzaehler As String, bPruefNZ As Boolean, Optional strKundeneigeneSerienNrNZ As String = "", Optional objAuftragPosition As CAuftragPosition) As Boolean
On Error GoTo VerbundzaehlerSpeichernError
Dim rs As CRecordset
Dim Feldname As String
Dim sSQL As String
Set rs = New CRecordset
sSQL = "SELECT * from Verbundzaehler where PruefgangNr=" & PruefgangNr & " and SerienNr=" & SerienNr & ";"
rs.openRS sSQL, False
If rs.EOF Then
sSQL = "SELECT * from Verbundzaehler where PruefgangNr=0 and SerienNr=" & SerienNr & ";"
rs.openRS sSQL, False
If rs.EOF Then
rs.addNew
End If
End If
Call rs.setValue("SerienNr", SerienNr)
Call rs.setValue("PruefgangNr", PruefgangNr)
If Val(strPP_Oeffnen) <> 0 Then
Call rs.setValue("PP_Oeffnen", strPP_Oeffnen)
Call rs.setValue("PP_OeffnenFehler", strPP_OeffnenFehler)
End If
If Val(strPP_Schliessen) <> 0 Then
Call rs.setValue("PP_Schliessen", strPP_Schliessen)
Call rs.setValue("PP_SchliessenFehler", strPP_SchliessenFehler)
End If
If rs.getStringValue("SerienNrNebenzaehler") <> strSerienNrNebenzaehler Then
' NZSerienNr wurde geändert, also alle Daten zum NZ löschen.
' Diese werden dann durch die Funktion SetNZPruefdaten wieder aktualisiert.
rs.setValue "Q1_SOLL", Null
rs.setValue "FEHLER_Q1", Null
rs.setValue "Q2_SOLL", Null
rs.setValue "FEHLER_Q2", Null
rs.setValue "MetrologNZ", Null
rs.setValue "Herkunft", Null
End If
If Val(strSerienNrNebenzaehler) <> 0 Then
Call rs.setValue("SerienNrNebenzaehler", strSerienNrNebenzaehler)
Call rs.setValue("Pruefnebenzaehler", bPruefNZ)
End If
If strKundeneigeneSerienNrNZ <> "" Then
Call rs.setValue("KundeneigeneSerNrNbZ", strKundeneigeneSerienNrNZ)
End If
Call rs.setValue("PrueferNr", g_App.Mitarbeiter.getNr)
Call rs.setValue("Datum", Now())
' neu RH 17.11.2010
Call rs.setValue("Info_FertigungsauftragNr", objAuftragPosition.GetFertigungsauftragNr)
Call rs.update
VerbundzaehlerSpeichern = True
Exit Function
VerbundzaehlerSpeichernError:
ErrorMsg ("VerbundzaehlerSpeichern fehlgeschlagen: " & Err.Description)
VerbundzaehlerSpeichern = False
End Function
Private Function DoppelteHZSerienNr(SerienNr As Long, SerienNrNebenzaehler As Long) As Long
' Gibt 0 zurück, wenn keine NZSerienNr doppelt ist, sonst SerienNr des zugehörigen HZ
' Bei einem Fehler wird ebenfalls 0 zurückgegeben
On Error GoTo DoppelteHZSerienNrError
Dim rs As CRecordset
Dim sSQL As String
Set rs = New CRecordset
sSQL = "select * from Verbundzaehler where SerienNrNebenzaehler = " & SerienNrNebenzaehler & " and SerienNr <>" & SerienNr & " and Pruefnebenzaehler = 0;"
Debug.Print sSQL
rs.openRS (sSQL)
If Not rs.EOF Then
DoppelteHZSerienNr = CLng(rs.getLongValue("SerienNr"))
Else
DoppelteHZSerienNr = 0
End If
Exit Function
DoppelteHZSerienNrError:
ErrorMsg "Es konnte nicht ermittelt werden, ob die NZ-SNr schon mal verwendet wurde: " & Err.Description
End Function
Private Sub fillPrueffehler(lngPruefgangNr As Long)
Dim rs As CRecordset
Dim sSQL As String
Dim i As Integer
Dim j As Integer
Dim PPNr As Integer
Dim intGesperrte As Integer
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim lngSerienNrNebenzaehler As Long
Dim strKndEigeneSerienNrNebenzaehler As String
Dim blnIstPruefnebenzaehler As Boolean
Dim dblPPOeffnen As Double
Dim dblPPSchliessen As Double
Dim dblPP_OeffnenFehler As Double
Dim dblPP_SchliessenFehler As Double
Set rs = New CRecordset
sSQL = "SELECT Prueffehler.* , Pruefgang.* FROM (Pruefgang INNER JOIN Prueffehler"
sSQL = sSQL & " ON Pruefgang.PruefgangNr = Prueffehler.PruefgangNr)"
sSQL = sSQL & " WHERE Pruefgang.PruefgangNr = " & lngPruefgangNr
sSQL = sSQL & " ORDER BY Prueffehler.SerienNr"
rs.openRS sSQL, True
Debug.Print sSQL
' für alle Zähler des Prüfgangs
Do While Not rs.EOF
For i = 0 To 9 'Suche den Zähler in allen 10 Einbauplätzen
'Debug.Print TabStrip1.Tabs.Item(i + 1).Caption & " = " & CStr(rs.getLongValue("SerienNr"))
If Val(TabStrip1.Tabs.Item(i + 1).Tag) = rs.getLongValue("SerienNr") Then
' Zähler gefunden
Debug.Print "SerienNr: " & CStr(rs.getLongValue("SerienNr"))
Set Einbauplatz = m_colEinbauplatz(i + 1)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Pruefzaehler.getAuftragPositionSerienNr.getFabNr <> 0 Then
txtFabNr(i).text = Pruefzaehler.getAuftragPositionSerienNr.getFabNr
End If
If Pruefzaehler.IstVerbundZaehler = True Then
' Es ist ein Verbundzähler, also die ersten 8 Eingabefelder der Prüfpunkte sperren
intGesperrte = 8
Else
' Es ist kein Verbundzähler, also die ersten 10 Eingabefelder der Prüfpunkte sperren
intGesperrte = 10
End If
' für alle Pruefpunkte
For PPNr = 1 To 10
If PPNr <= intGesperrte Then
' Prüfpunkt Eingabefleder sperren
' nur Öffnen und Schließen zulassen
lblFehler(i * 100 + PPNr - 1).Enabled = False
txtQ(i * 100 + PPNr - 1).Enabled = False
lblFGo(i * 100 + PPNr - 1).Enabled = False
lblFGo(i * 100 + PPNr - 1).Enabled = False
lblHZVol(i * 100 + PPNr - 1).Enabled = False
lblNZVol(i * 100 + PPNr - 1).Enabled = False
txtBehVol(i * 100 + PPNr - 1).Enabled = False
txtHZStart(i * 100 + PPNr - 1).Enabled = False
txtHZStop(i * 100 + PPNr - 1).Enabled = False
txtNZStart(i * 100 + PPNr - 1).Enabled = False
txtNZStop(i * 100 + PPNr - 1).Enabled = False
End If
Debug.Print " Q=" & txtQ(i * 100 + PPNr - 1).text
' Suche Q in txtQ
If IsNumeric(txtQ(i * 100 + PPNr - 1).text) Then
For j = 1 To 10
If Val(txtQ(i * 100 + PPNr - 1).text) = Val(rs.getDoubleValue("PP" & j & "_Soll")) Then
' Wenn Q gefunden wurde, Fehler eintragen
If Not rs.isFieldNull("PP" & j & "_Fehler") Then
lblFehler(i * 100 + PPNr - 1).caption = Round(rs.getDoubleValue("PP" & j & "_Fehler"), 2)
Debug.Print "Fehler: feld=" & (i * 100 + PPNr - 1) & ": " & rs.getDoubleValue("PP" & j & "_Fehler")
End If
If lblFehler(i * 100 + PPNr - 1).caption = "" Then
'zum Nachtragen noch leerer Fehler Felder
lblFehler(i * 100 + PPNr - 1).Enabled = True
txtQ(i * 100 + PPNr - 1).Enabled = True
lblFGo(i * 100 + PPNr - 1).Enabled = True
lblFGo(i * 100 + PPNr - 1).Enabled = True
lblHZVol(i * 100 + PPNr - 1).Enabled = True
lblNZVol(i * 100 + PPNr - 1).Enabled = True
txtBehVol(i * 100 + PPNr - 1).Enabled = True
txtHZStart(i * 100 + PPNr - 1).Enabled = True
txtHZStop(i * 100 + PPNr - 1).Enabled = True
txtNZStart(i * 100 + PPNr - 1).Enabled = True
txtNZStop(i * 100 + PPNr - 1).Enabled = True
End If
End If
Next
End If
Next
If GetNebenzaehlerDaten(m_Pruefgang.PruefgangNr, rs.getLongValue("SerienNr"), lngSerienNrNebenzaehler, strKndEigeneSerienNrNebenzaehler, blnIstPruefnebenzaehler, dblPPOeffnen, dblPPSchliessen, dblPP_OeffnenFehler, dblPP_SchliessenFehler) = 0 Then
txtSerienNrNZ(i).text = FormatSerienNr(lngSerienNrNebenzaehler)
'txtKundeneigeneSerienNrNZ(i).text = strKndEigeneSerienNrNebenzaehler
cmb2KundeneigeneSNr(i).text = strKndEigeneSerienNrNebenzaehler
If blnIstPruefnebenzaehler Then
chkPruefNZ(i).value = vbChecked
End If
If dblPPOeffnen > 0 Then
txtQ(i * 100 + 8) = dblPPOeffnen
lblFehler(i * 100 + 8) = Round(dblPP_OeffnenFehler, 2)
End If
If dblPPSchliessen > 0 Then
txtQ(i * 100 + 9) = dblPPSchliessen
lblFehler(i * 100 + 9) = Round(dblPP_SchliessenFehler, 2)
End If
End If ' Nebenzaehlerdaten vorhanden
End If
Next
rs.MoveNext
Loop
txtWasserVorlaufTemperatur.text = m_Pruefgang.Vorlauftemperatur
End Sub
' TODO seit 24.1.2003
Private Function GetNebenzaehlerDaten(lngPruefgangNr As Long, lngSerienNr As Long, ByRef SerienNrNebenzaehler As Long, ByRef KndEigeneSerienNrNebenzaehler As String, ByRef blnIstPruefnebenzaehler As Boolean, ByRef dblPP_Oeffnen As Double, ByRef dblPP_Schliessen As Double, ByRef dblPP_OeffnenFehler As Double, ByRef dblPP_SchliessenFehler As Double) As Long
On Error GoTo Errorhandler
Dim rs As CRecordset
Dim sSQL As String
Set rs = New CRecordset
If lngPruefgangNr = 0 Then
sSQL = "select * from Verbundzaehler where SerienNr = " & lngSerienNr & " ORDER BY Datum desc"
Else
sSQL = "select * from Verbundzaehler where PruefgangNr = " & CStr(lngPruefgangNr) & " and SerienNr = " & lngSerienNr
End If
rs.openRS (sSQL)
If Not rs.EOF Then
SerienNrNebenzaehler = CLng(rs.getLongValue("SerienNrNebenzaehler"))
KndEigeneSerienNrNebenzaehler = rs.getStringValue("KundeneigeneSerNrNbZ")
blnIstPruefnebenzaehler = rs.getBooleanValue("Pruefnebenzaehler")
dblPP_Oeffnen = rs.getDoubleValue("PP_Oeffnen")
dblPP_OeffnenFehler = rs.getDoubleValue("PP_OeffnenFehler")
dblPP_Schliessen = rs.getDoubleValue("PP_Schliessen")
dblPP_SchliessenFehler = rs.getDoubleValue("PP_SchliessenFehler")
GetNebenzaehlerDaten = 0
Else
DebugMsg "Es gibt keinen Verbundzähler für Prüfzaehler " & lngSerienNr & " im Prüfgang " & lngPruefgangNr
GetNebenzaehlerDaten = -2
End If
Exit Function
Errorhandler:
ErrorMsg "GetNebenzaehlerDaten: Fehler " & Err.Description & ": " & Err.Description
GetNebenzaehlerDaten = -1
End Function
Private Sub txtSerienNrNZ_LostFocus(Index As Integer)
txtSerienNrNZ(Index).BackColor = -2147483643
End Sub
Private Sub SetGotLostFocusColor(TheObject As Object, blnGotFocus As Boolean)
If blnGotFocus Then
TheObject.BackColor = vbYellow
Else
TheObject.BackColor = &H80000005
End If
End Sub
Private Function IsNumericAndDouble(strNumber As String) As Boolean
If IsNumeric(strNumber) Then
IsNumericAndDouble = True
End If
End Function
Private Function CheckPruefnebenzaehler(Index As Integer) As Boolean
Dim lngSerienNrNZ As Long
lngSerienNrNZ = Val(txtSerienNrNZ(Index).text)
'If lngSerienNrNZ > 0 Then
' Nebenzähler ist eingegeben
If chkPruefNZ(Index).value = vbChecked Then
' Prüfer hat diesen Nebenzähler als Prüfnebenzähler deklariert
If Not IstPruefnebenzaehler(lngSerienNrNZ) Then
DoEvents
'Nebenzähler ist aber kein Prüfnebenzähler
MsgBox "Nebenzaehler " & lngSerienNrNZ & " ist kein Prüfnebenzähler! Bitte geben Sie die korrekte Serien-Nr ein."
chkPruefNZ(Index).value = vbUnchecked
If txtSerienNrNZ(Index).Enabled = True Then
cmdOK.Enabled = False
chkPruefNZ(Index).value = vbUnchecked
txtSerienNrNZ(Index).SetFocus
End If
End If
End If
'End If
End Function
Private Function IstPruefnebenzaehler(lngSerienNrNebenzaehler As Long) As Boolean
Dim strSQL As String
Dim rs As CRecordset
strSQL = "SELECT * From Pruefnebenzaehler WHERE SerienNr = " & lngSerienNrNebenzaehler
Set rs = New CRecordset
rs.openRS strSQL, True
If Not rs.EOF Then
IstPruefnebenzaehler = True
End If
End Function
Private Sub chkPruefNZ_Click(Index As Integer)
UeberprüfePruefnebenzaehlerserienNr Index
End Sub
Private Sub chkPruefNZ_Validate(Index As Integer, Cancel As Boolean)
UeberprüfePruefnebenzaehlerserienNr Index
End Sub
Private Sub UeberprüfePruefnebenzaehlerserienNr(Index As Integer)
cmdOK.Enabled = True
If chkPruefNZ(Index).value = vbChecked Then
CheckPruefnebenzaehler (Index)
If chkPruefNZ(Index).value = vbChecked Then
'mb2KundeneigeneSNr(Index).Enabled = False
Else
cmb2KundeneigeneSNr(Index).Enabled = True
End If
Else
cmb2KundeneigeneSNr(Index).Enabled = True
End If
End Sub
Private Sub Fillcmb2KundeneigeneSNr(lngFANr As Long, Index As Integer)
Dim strSQL As String
Dim rs As CRecordset
Set rs = New CRecordset
strSQL = "SELECT KundeneigeneSerNrNbZ From Verbundzaehler Where Info_FertigungsauftragNr = " & lngFANr
rs.openRS strSQL, True
Do While Not rs.EOF
cmb2KundeneigeneSNr(Index).AddItem rs.getStringValue("KundeneigeneSerNrNbZ")
rs.MoveNext
'cmb2KundeneigeneSNr(Index).Style = fmStyleDropDownList
Loop
End Sub
Private Sub FillFehlergrenzenVerbundzaehler(iTabIndex As Integer)
Dim Pruefzaehler As CPruefzaehler
Dim Pruefpunkte As CPruefpunkte
Dim dblFGoOeff As Double
Dim dblFGuOeff As Double
Dim dblFGoSchl As Double
Dim dblFGuSchl As Double
Set Pruefzaehler = m_colEinbauplatz.Item(iTabIndex + 1).getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set Pruefpunkte = Pruefzaehler.getPruefpunkte
If Pruefzaehler.getPruefpunkte.GetFehlergrenzenOeffnenSchliessen(dblFGoOeff, dblFGuOeff, dblFGoSchl, dblFGuSchl) Then
Debug.Print dblFGoOeff, dblFGuOeff, dblFGoSchl, dblFGuSchl
lblFGo(iTabIndex * 100 + 9 - 1).caption = dblFGoOeff
lblFGu(iTabIndex * 100 + 9 - 1).caption = dblFGuOeff
lblFGo(iTabIndex * 100 + 10 - 1).caption = dblFGoSchl
lblFGu(iTabIndex * 100 + 10 - 1).caption = dblFGuSchl
End If
End If
End Sub
Private Sub txtSerienNrNZ_Validate(Index As Integer, ByRef Cancel As Boolean)
Dim lngSerienNr As Long
Dim lngSerienNrNZ As Long
lngSerienNr = m_colEinbauplatz.Item(Index + 1).getPruefzaehler.getSerienNr
txtSerienNrNZ(Index).text = Trim(txtSerienNrNZ(Index).text)
If Trim(Str(Val(txtSerienNrNZ(Index).text))) <> txtSerienNrNZ(Index).text And txtSerienNrNZ(Index).text <> "" Then
MsgBox "Bitte geben Sie die NZ SerienNr rein numerisch ein."
Cancel = True
Exit Sub
End If
lngSerienNrNZ = Val(txtSerienNrNZ(Index).text)
If lngSerienNr = lngSerienNrNZ Then
Call MsgBox("Die Nebenzähler SerienNr ist gleich der SerienNr. Bitte überprüfen!", vbCritical)
txtSerienNrNZ(Index).Locked = False
txtSerienNrNZ(Index).Enabled = True
txtSerienNrNZ(Index).SetFocus
txtSerienNrNZ(Index).SelStart = 0
txtSerienNrNZ(Index).SelLength = Len(txtSerienNrNZ(Index).text)
Cancel = True
Exit Sub
End If
'' todo: SerienNrNz darf noch nicht in Tabelle Verbundzähler oder Formular eingetragen sein, sonst Warnung anzeigen
If txtSerienNrNZ(Index) <> "" Then
ShowNZFehler Index
Else
MSFlexGrid1.Visible = False
End If
End Sub
Private Sub cmdNZInfo_Click(Index As Integer)
ShowNZFehler Index
End Sub
Private Function GetNZPruefdaten(ByVal lngSerienNr As Long, ByRef NZPruefdaten As NZ_PRUEFDATEN_TYP, ByRef blnSchonvorhanden As Boolean) As Boolean
On Error GoTo Errorhandler
Dim strSQL As String
Dim rs As CRecordset
Dim rsLU As CRecordset
If lngSerienNr = 0 Then Exit Function
If NZPruefdaten.SerienNrNebenzaehler > 0 Then
' SerienNr des NZ bekannt
strSQL = "SELECT * from [Verbundzaehler] where SerienNrNebenzaehler = " & NZPruefdaten.SerienNrNebenzaehler & " and Q1_soll > 0 and SerienNr = " & lngSerienNr
ElseIf NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then
' sind lokale Daten vorhanden für den Nebenzähler in dieser Kombination vorhanden?
strSQL = "SELECT * from [Verbundzaehler] where KundeneigeneSerNrNbZ = '" & NZPruefdaten.KundeneigeneSerienNrNZ & "' and Q1_soll > 0 and SerienNr = " & lngSerienNr
Else
Exit Function
End If
Set rs = New CRecordset
rs.openRS strSQL, False
Debug.Print strSQL
If rs.EOF Then
'es sind KEINE lokalen Daten vorhanden, also holen aus anderer Tabelle
Set rsLU = GetNZPruefdatenAusLuRecordset(NZPruefdaten.SerienNrNebenzaehler)
If Not rsLU Is Nothing Then
If Not rsLU.EOF Then
GetNZPruefdaten = True
' Es sind Daten aus LU vorhanden
'NZPruefdaten.MetrologNZ = rsLU.getStringValue("MetrologNZ")
NZPruefdaten.Q1_Soll = Round(rsLU.getDoubleValue("Q1_SOLL") / 1000, 3)
NZPruefdaten.Fehler_Q1 = Round(Val(rsLU.getStringValue("FEHLER_Q1")), 2)
NZPruefdaten.Fehler_Q2 = Round(Val(rsLU.getStringValue("FEHLER_Q2")), 2)
NZPruefdaten.Q2_Soll = Round(rsLU.getDoubleValue("Q2_SOLL") / 1000, 3)
Else
'Es sind KEINE Daten aus LU vorhanden
Set rsLU = GetNZPruefdatenAusMetegraRecordset(NZPruefdaten.SerienNrNebenzaehler)
If Not rsLU.EOF Then
GetNZPruefdaten = True
' Es sind Daten von Metegra vorhanden
NZPruefdaten.MetrologNZ = rsLU.getStringValue("MetrologNZ")
NZPruefdaten.Q1_Soll = Round(rsLU.getDoubleValue("Q1_SOLL") / 1000, 3)
NZPruefdaten.Fehler_Q1 = Round(rsLU.getDoubleValue("FEHLER_Q1"), 2)
NZPruefdaten.Q2_Soll = Round(rsLU.getDoubleValue("Q2_SOLL") / 1000, 3)
NZPruefdaten.Fehler_Q2 = Round(rsLU.getDoubleValue("FEHLER_Q2"), 2)
Else
' Es sind auch KEINE Daten von Metegra vorhanden
GetNZPruefdaten = False
Exit Function
End If
End If
Else
' Fehler
End If
Else
GetNZPruefdaten = True
blnSchonvorhanden = True
'Daten sind schon vorhanden
NZPruefdaten.Q1_Soll = Round(rs.getDoubleValue("Q1_SOLL"), 2)
NZPruefdaten.Fehler_Q1 = Round(rs.getDoubleValue("FEHLER_Q1"), 2)
NZPruefdaten.Q2_Soll = Round(rs.getDoubleValue("Q2_SOLL"), 3)
NZPruefdaten.Fehler_Q2 = Round(rs.getDoubleValue("FEHLER_Q2"), 2)
NZPruefdaten.MetrologNZ = rs.getStringValue("MetrologNZ")
End If
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in GetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description, "NZPruefdaten"
MsgBox "Fehler " & Err.Number & " in GetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description
End Function
Private Sub SetNZPruefdaten(ByVal lngSerienNr As Long, ByRef NZPruefdaten As NZ_PRUEFDATEN_TYP)
On Error GoTo Errorhandler
Dim strSQL As String
Dim rs As CRecordset
strSQL = "SELECT * from [Verbundzaehler] where SerienNrNebenzaehler = " & NZPruefdaten.SerienNrNebenzaehler & " and SerienNr = " & lngSerienNr
Set rs = New CRecordset
Debug.Print strSQL
rs.openRS strSQL, False
If rs.EOF Then
rs.addNew
rs.setValue "SerienNr", lngSerienNr
End If
Do While Not rs.EOF
rs.setValue "SerienNrNebenzaehler", NZPruefdaten.SerienNrNebenzaehler
rs.setValue "Q1_SOLL", NZPruefdaten.Q1_Soll
rs.setValue "FEHLER_Q1", NZPruefdaten.Fehler_Q1
rs.setValue "Q2_SOLL", NZPruefdaten.Q2_Soll
rs.setValue "FEHLER_Q2", NZPruefdaten.Fehler_Q2
rs.setValue "MetrologNZ", NZPruefdaten.MetrologNZ
rs.update
rs.MoveNext
Loop
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in SetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description, "NZPruefdaten"
MsgBox "Fehler " & Err.Number & " in SetNZPruefdaten(" & lngSerienNr & ",...): " & Err.Description
End Sub
Private Function GetNZPruefdatenAusMetegraRecordset(lngSerienNrNZ As Long) As CRecordset
On Error GoTo Errorhandler
Dim rs As CRecordset
Dim strSQL As String
strSQL = "SELECT * from Metegra_Pruefergebnisse where [SerienNrNebenzaehler]= " & lngSerienNrNZ
Set rs = New CRecordset
Debug.Print strSQL
rs.openRS strSQL
Set GetNZPruefdatenAusMetegraRecordset = rs
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in GetNZPruefdatenAusMetegraRecordset(" & lngSerienNrNZ & "): " & Err.Description, "NZPruefdaten"
MsgBox "Fehler " & Err.Number & " in GetNZPruefdatenAusMetegraRecordset(" & lngSerienNrNZ & "): " & Err.Description
End Function
Private Function GetNZPruefdatenAusLuRecordset(lngSerienNrNZ As Long) As CRecordset
On Error GoTo Errorhandler
Dim rs As CRecordset
Dim strSQL As String
Dim errnum As Long
Dim errdesc As String
strSQL = "SELECT * FROM OPENQUERY( MyOraDB, 'SELECT * FROM PRIMA_RO.DT01_LAATZEN where ZAEHLERNUMMER = ''" & lngSerienNrNZ & "''') "
Set rs = New CRecordset
Debug.Print strSQL
rs.openRS strSQL
Set GetNZPruefdatenAusLuRecordset = rs
Exit Function
Errorhandler:
errnum = Err.Number
errdesc = Err.Description
LogIntoDB "Fehler " & errnum & " in GetNZPruefdatenAusLuRecordset(" & lngSerienNrNZ & "): " & errdesc, "NZPruefdaten"
MsgBox "Die Prüfergebnisse aus Ludwigshafen können zur Zeit nicht abgerufen werden." & vbCrLf & "Fehler " & errnum & " in GetNZPruefdatenAusLuRecordset(" & lngSerienNrNZ & "): " & errdesc
End Function
Private Sub ShowNZFehler(Index As Integer)
On Error GoTo Errorhandler
Dim lngSerienNrNZ As Long
Dim lngSerienNr As Long
Dim strKundeneigeneSNrNZ As String
Dim blnPrf_nach_MID As Boolean
Dim strSQL As String
Dim rs As CRecordset
Dim col As Long
Dim row As Long
Dim strVal As String
Dim NZPruefdaten As NZ_PRUEFDATEN_TYP
If Not IsNumeric(txtSerienNrNZ(Index).text) Then
MSFlexGrid1.Visible = False
Exit Sub
End If
If Val(txtSerienNrNZ(Index).text) = 0 Then
' hier ist die Seriennr des Nebenzählers zwar nicht bekannt aber es könnte ja sein, das es eine KundeneigeneSnr des NZ gibt
If Trim(cmb2KundeneigeneSNr(Index).text) <> "" Then
strKundeneigeneSNrNZ = Trim(cmb2KundeneigeneSNr(Index).text)
cmb2KundeneigeneSNr(Index).Enabled = False
Else
MSFlexGrid1.Visible = False
Exit Sub
End If
End If
blnPrf_nach_MID = GetPrfNachMID(Index + 1)
lngSerienNr = m_colEinbauplatz.Item(Index + 1).getPruefzaehler.getSerienNr
lngSerienNrNZ = Val(txtSerienNrNZ(Index).text)
If lngSerienNrNZ = Val(MSFlexGrid1.TextMatrix(1, 0)) Then
If MSFlexGrid1.Visible = True Then
Exit Sub
End If
End If
cmdNZInfo(Index).Enabled = False
Me.MousePointer = vbHourglass
NZPruefdaten.SerienNrNebenzaehler = lngSerienNrNZ
Dim blnSchonvorhanden As Boolean
NZPruefdaten.KundeneigeneSerienNrNZ = strKundeneigeneSNrNZ
If GetNZPruefdaten(lngSerienNr, NZPruefdaten, blnSchonvorhanden) Then
MSFlexGrid1.Left = txtInfoVerbundzaehler.Left
MSFlexGrid1.Top = txtInfoVerbundzaehler.Top
MSFlexGrid1.Width = txtInfoVerbundzaehler.Width
MSFlexGrid1.Height = txtInfoVerbundzaehler.Height
MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "SerienNr NZ | Q1 Soll | Fehler Q1 | Q2 Soll | Fehler Q2|Metrolog"
MSFlexGrid1.Rows = 2
MSFlexGrid1.FixedRows = 1
MSFlexGrid1.Cols = 6
If NZPruefdaten.KundeneigeneSerienNrNZ <> "" Then
MSFlexGrid1.TextMatrix(1, 0) = NZPruefdaten.KundeneigeneSerienNrNZ
Else
MSFlexGrid1.TextMatrix(1, 0) = NZPruefdaten.SerienNrNebenzaehler
End If
MSFlexGrid1.TextMatrix(1, 1) = NZPruefdaten.Q1_Soll
MSFlexGrid1.TextMatrix(1, 2) = Round(NZPruefdaten.Fehler_Q1, 2)
MSFlexGrid1.TextMatrix(1, 3) = NZPruefdaten.Q2_Soll
MSFlexGrid1.TextMatrix(1, 4) = Round(NZPruefdaten.Fehler_Q2, 2)
MSFlexGrid1.TextMatrix(1, 5) = NZPruefdaten.MetrologNZ
MSFlexGrid1.Visible = True
Else
If blnPrf_nach_MID Then
txtInfoVerbundzaehler.text = txtInfoVerbundzaehler.text & vbCrLf & "Dieser Zähler darf NICHT geprüft werden, da für den Nebenzähler " & lngSerienNrNZ & " keine Prüfergbenisse vorliegen."
txtInfoVerbundzaehler.BackColor = RGB(255, 128, 128) ' light red
txtInfoVerbundzaehler.FontBold = True
Else
txtInfoVerbundzaehler.text = "Für den Nebenzähler " & lngSerienNrNZ & " liegen keine Prüfergbenisse vor."
txtInfoVerbundzaehler.BackColor = RGB(255, 255, 128) ' light red
txtInfoVerbundzaehler.FontBold = False
End If
MSFlexGrid1.Visible = False
End If
Fertig:
Me.MousePointer = vbNormal
cmdNZInfo(Index).Enabled = True
Exit Sub
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in ShowNZFehler(" & Index & "): " & Err.Description, "NZPruefdaten"
MsgBox "Fehler " & Err.Number & " in ShowNZFehler(" & Index & "): " & Err.Description
End Sub
Private Function GetPrfNachMID(Index As Integer) As Boolean
On Error GoTo Errorhandler
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim AuftragPosition As CAuftragPosition
Set Einbauplatz = m_colEinbauplatz.Item(Index)
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
Set AuftragPosition = Pruefzaehler.getAuftragPosition
GetPrfNachMID = AuftragPosition.getPrf_nach_MID
End If
Exit Function
TrueSprung:
GetPrfNachMID = True
Exit Function
Errorhandler:
LogIntoDB "Fehler " & Err.Number & " in GetPrfNachMID(" & Index & ")" & Err.Description
End Function
Private Sub cmdeRegisterpruefpunkt_Click()
Dim dblVolumen As Double
Dim PPNr As Integer
Dim dblBehaelterVBolumen As Double
PPNr = Val(cmbeRegisterPP.text)
Set frmeRegisterPrf.m_colEinbauplatz = m_colEinbauplatz
frmeRegisterPrf.mblnManuellePruefung = True
MsgBox "Klicken Sie auf OK um den Start-Zählerstand auszulesen. Danach starten Sie bitte den Durchfluss."
frmeRegisterPrf.Show vbNormal, Me
frmeRegisterPrf.Visible = True
frmeRegisterPrf.MesspunktAufnehmen
Sleep 2000
frmeRegisterPrf.Visible = False
Dim Einbauplatz As CEinbauplatz
Dim eRegister_Auftragposition As CeRegister_Auftragposition
Dim FAKTOR As Double
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
' Einheit vom LED Pulse ist Milliliter , Umrechnung in m³
txtHZStart((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = Val(frmeRegisterPrf.MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr)) / 1000
txtHZStart_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False
End If
End If
Next
dblBehaelterVBolumen = Val(Replace(InputBox("Bitte geben Sie das Volumen im Behälter in Litern an, wenn der Behälter gefüllt ist. Danach wird das Zählerstand erneut ausgelesen."), ",", "."))
If dblBehaelterVBolumen = 0 Then
Exit Sub
End If
frmeRegisterPrf.Visible = True
frmeRegisterPrf.MesspunktAufnehmen
Sleep 2000
frmeRegisterPrf.Visible = False
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If Not Einbauplatz.eRegister Is Nothing Then
' Behlter Volumen wurde in Litern angegeben. Umechnung in m³
txtBehVol((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = dblBehaelterVBolumen
txtBehVol_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False
' Einheit vom LED Pulse ist Milliliter , Umrechnung in m³
txtHZStop((Einbauplatz.getNr - 1) * 100 + PPNr - 1) = Val(frmeRegisterPrf.MSFlexGrid1.TextMatrix(fgZeile.Zeile_Pz_Volume, Einbauplatz.getNr)) / 1000
txtHZStop_Validate ((Einbauplatz.getNr - 1) * 100 + PPNr - 1), False
End If
End If
Next
If cmbeRegisterPP.ListIndex < cmbeRegisterPP.ListCount - 1 Then
cmbeRegisterPP.ListIndex = cmbeRegisterPP.ListIndex + 1
End If
End Sub