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

1188 lines
39 KiB
Plaintext

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSchottumdrehungen
Caption = "Pruef2000 Schottumdrehungen"
ClientHeight = 10335
ClientLeft = 60
ClientTop = 345
ClientWidth = 13845
LinkTopic = "Form1"
ScaleHeight = 10335
ScaleWidth = 13845
StartUpPosition = 3 'Windows-Standard
Begin VB.Timer Timer1
Left = 1140
Top = 9360
End
Begin VB.CommandButton cmdDelete
Caption = "Rückgängig / Löschen"
Height = 435
Left = 180
TabIndex = 12
ToolTipText = "Löschen der letzten eigenen Schotwerte rückwärts in der Historie"
Top = 8820
Width = 2055
End
Begin VB.Frame frameHistorie
Caption = "Historie"
Height = 3555
Left = 0
TabIndex = 6
Top = 5160
Width = 13695
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid2
Height = 2415
Left = 240
TabIndex = 11
Top = 1020
Width = 12795
_ExtentX = 22569
_ExtentY = 4260
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ComboBox cmbRatio
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7620
Style = 2 'Dropdown-Liste
TabIndex = 10
Top = 360
Width = 1455
End
Begin VB.ComboBox cmbPruefstation
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 11400
Style = 2 'Dropdown-Liste
TabIndex = 9
Top = 360
Width = 1575
End
Begin VB.ComboBox cmbBaulaenge
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9300
Style = 2 'Dropdown-Liste
TabIndex = 8
Top = 360
Width = 1995
End
Begin VB.Label Label4
Caption = "Zählertyp"
Height = 195
Left = 840
TabIndex = 17
Top = 120
Width = 735
End
Begin VB.Label Label3
Caption = "Prüfstation"
Height = 255
Left = 11460
TabIndex = 16
Top = 120
Width = 1035
End
Begin VB.Label Label2
Caption = "Baulänge"
Height = 255
Left = 9300
TabIndex = 15
Top = 120
Width = 1035
End
Begin VB.Label Label1
Caption = "Ratio"
Height = 255
Left = 7740
TabIndex = 14
Top = 120
Width = 1035
End
Begin VB.Label lblTyP
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 240
TabIndex = 7
Top = 360
Width = 7155
End
End
Begin VB.TextBox txtEingabe
Alignment = 1 'Rechts
Height = 375
Left = 12660
TabIndex = 5
Top = 120
Visible = 0 'False
Width = 975
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 4635
Left = 0
TabIndex = 4
Top = 540
Width = 13755
_ExtentX = 24262
_ExtentY = 8176
_Version = 393216
Rows = 11
Cols = 3
FixedCols = 0
FormatString = "Platz|Zählertyp|Wert"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Unten ausrichten
Height = 375
Left = 0
TabIndex = 3
Top = 9960
Width = 13845
_ExtentX = 24421
_ExtentY = 661
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.CommandButton cmdWeiter
Caption = "Weiter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 10980
TabIndex = 2
Top = 9000
Width = 2175
End
Begin VB.Label lblInfo
BorderStyle = 1 'Fest Einfach
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 2400
TabIndex = 13
Top = 8820
Width = 8295
End
Begin VB.Label lblUeberschrift
Alignment = 2 'Zentriert
Caption = "Schott - Einstellungen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 1
Top = 0
Width = 11475
End
Begin VB.Label lblAutosize
BorderStyle = 1 'Fest Einfach
Caption = "lblAutosize"
Height = 315
Left = 11880
TabIndex = 0
Top = 60
Visible = 0 'False
Width = 1035
End
End
Attribute VB_Name = "frmSchottumdrehungen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public m_colEinbauplatz As Collection
Private m_AlleSchottumdrehungenData(10) As TYP_SCHOTTUMDREHUNGEN
Private m_intletzteZeile As Integer
Public m_blnSchottwertMoeglich As Boolean
Private m_blnActivated As Boolean
Private m_intWeiterCounter As Integer
Private m_blnFormularSchliessen As Boolean
Private Enum fgSpalte
Einbauplatz = 0
Typ = 1
alterWert = 2
neuerWert = 3
End Enum
Private Type TYP_SCHOTTUMDREHUNGEN
Typ As String
Typzusatz As String
Nennweite As Integer
Temperatur As Integer
Druck As Integer
eRegister As Boolean
Baulaenge As Integer
Ratio As Integer
TypenKennung As String
PruefstationNr As Integer
Schottumdrehungen_alt As Double
Schottumdrehungen_neu As Double
Schottumdrehungen_aendern As Boolean
PrueferNr As String
GeaendertDatum As Date
Bemerkung As String
blnErsterZaehlerSeinerArt As Boolean
End Type
Public Sub setInfo(strText As String)
lblInfo.Caption = strText
End Sub
Private Sub cmbBaulaenge_Click()
If cmbBaulaenge.Enabled = False Then Exit Sub
AktualisiereHistorie
End Sub
Private Sub cmbPruefstation_click()
If cmbPruefstation.Enabled = False Then Exit Sub
AktualisiereHistorie
End Sub
Private Sub cmbRatio_Click()
If cmbRatio.Enabled = False Then Exit Sub
AktualisiereHistorie
End Sub
Private Sub cmdDelete_Click()
Loeschen
RefreshSchotteinstellungen
End Sub
Private Sub cmdWeiter_Click()
m_blnFormularSchliessen = True
End Sub
Private Sub Form_Activate()
Select Case g_App.PruefstationNr
Case 2006
Unload Me
Exit Sub
Case Else
End Select
RefreshSchotteinstellungen
ModaleSchleife
End Sub
Private Sub Form_Load()
Me.Width = 14160
Me.Height = 10740
m_blnSchottwertMoeglich = False
m_intWeiterCounter = -1
m_blnFormularSchliessen = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
m_blnFormularSchliessen = True
End Sub
Private Sub Form_Resize()
On Error Resume Next
lblUeberschrift.Left = 0
lblUeberschrift.Top = 0
lblUeberschrift.Width = Me.ScaleWidth
MSFlexGrid1.Left = 0
MSFlexGrid1.Width = Me.ScaleWidth
frameHistorie.Left = 0
frameHistorie.Width = Me.ScaleWidth
cmdWeiter.Left = frameHistorie.Left + frameHistorie.Width - 1.5 * cmdWeiter.Width
'Debug.Print Me.Width & ", " & Me.Height
If m_blnFormularSchliessen = True Then
Unload Me
End If
End Sub
Private Sub RefreshSchotteinstellungen()
Dim Einbauplatz As CEinbauplatz
Dim Pruefzaehler As CPruefzaehler
Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
Dim intErsteZeile As Integer
' Schott-Einstellung wird von mind. einem Zähler unterstützt
Dim blnEinZaehlerUnterstuetzt As Boolean
intErsteZeile = 0
MSFlexGrid1.Clear
MSFlexGrid1.FormatString = "Nr|Typ|aktueller Wert|neuer Wert"
MSFlexGrid1.Rows = 1
MSFlexGrid2.Clear
blnEinZaehlerUnterstuetzt = False
For Each Einbauplatz In m_colEinbauplatz
If Einbauplatz.getNr <= g_App.Settings.EinbauplaetzeJeStrang Then
Set Pruefzaehler = Einbauplatz.getPruefzaehler
If Not Pruefzaehler Is Nothing Then
MSFlexGrid1.AddItem Einbauplatz.getNr
If GetZaehlerdaten(Pruefzaehler.getAuftragPosition, SchottumdrehungenData) Then
blnEinZaehlerUnterstuetzt = True
If m_intletzteZeile = 0 Then m_intletzteZeile = Einbauplatz.getNr
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.Typ) = SchottumdrehungenData.TypenKennung
If SchotteinstellungenSuchen(SchottumdrehungenData) = True Then
' Wert vorhanden, als anzeigen
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.alterWert) = SchottumdrehungenData.Schottumdrehungen_alt
Else
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.alterWert) = "?"
End If
m_AlleSchottumdrehungenData(Einbauplatz.getNr) = SchottumdrehungenData
m_blnSchottwertMoeglich = True
Else
End If
Else
MSFlexGrid1.AddItem Einbauplatz.getNr
End If
End If
Next
If blnEinZaehlerUnterstuetzt = False Then
lblInfo.BackColor = RGB(255, 128, 128)
lblInfo.Font.Size = 16
lblInfo.Caption = "Die Schott-Einstellung Datenbank wird für diesen Zählertyp/Ratio nicht unterstützt."
Timer1.Enabled = True
Timer1.Interval = 1000
End If
ZeigeDetails
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Sub
Private Function GetZaehlerdaten(ByRef AuftragPosition As CAuftragPosition, ByRef SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN) As Boolean
Dim objIdenNr As CIdentNr
Dim objVako As CVakoCode
Set objIdenNr = AuftragPosition.getIdentNrObj
Set objVako = New CVakoCode
If objVako.load(objIdenNr.GetVakoCode) = True Then
Select Case objVako.GetWert("KurzBez")
Case "GE"
GoTo SchotteinstellungenNichtUnterstuetzt
End Select
Select Case objVako.GetWert("Typ")
Case "MS"
' OK
Case Else
GoTo SchotteinstellungenNichtUnterstuetzt
End Select
If Val(objVako.GetWert("Ratio")) = 0 Then
' kein Ratio
GoTo SchotteinstellungenNichtUnterstuetzt
End If
SchottumdrehungenData = GetSchottumdrehungenDataFromOrder(objVako)
GetZaehlerdaten = True
End If
Exit Function
SchotteinstellungenNichtUnterstuetzt:
GetZaehlerdaten = False
End Function
' Holt alle Angaben für die Ermittlung der Schottumdrehungen aus den Auftragsdaten
Private Function GetSchottumdrehungenDataFromOrder(objVako As CVakoCode) As TYP_SCHOTTUMDREHUNGEN
Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
SchottumdrehungenData.Typ = objVako.GetWert("Typ")
SchottumdrehungenData.Typzusatz = objVako.GetWert("Typzusatz")
' "" = (family), "Plus", "Flow Sensor"
SchottumdrehungenData.Nennweite = objVako.GetWert("Nennweite")
' Temperaturstufe kalt (30°-50°) / heiss (90°-130°)
SchottumdrehungenData.Temperatur = Val(objVako.GetWert("Temperatur"))
If SchottumdrehungenData.Temperatur > 50 Then
SchottumdrehungenData.Temperatur = 90
Else
SchottumdrehungenData.Temperatur = 50
End If
If SchottumdrehungenData.Temperatur <> Val(objVako.GetWert("Temperatur")) Then
MsgBox "Temperatur normalisiert von " & Val(objVako.GetWert("Temperatur")) & " auf " & SchottumdrehungenData.Temperatur
End If
SchottumdrehungenData.Druck = Val(Replace(objVako.GetWert("Druck"), "PN", ""))
If SchottumdrehungenData.Druck >= 25 Then
SchottumdrehungenData.Druck = 40
Else
SchottumdrehungenData.Druck = 16
End If
If SchottumdrehungenData.Druck <> Val(Replace(objVako.GetWert("Druck"), "PN", "")) Then
MsgBox "Druck normalisiert von " & Val(Replace(objVako.GetWert("Druck"), "PN", "")) & " auf " & SchottumdrehungenData.Druck
End If
If objVako.GetWert("Zählwerk") = "eRegister" Then
SchottumdrehungenData.eRegister = True
Else
SchottumdrehungenData.eRegister = False
End If
SchottumdrehungenData.Ratio = Val(objVako.GetWert("Ratio"))
SchottumdrehungenData.Baulaenge = Val(objVako.GetWert("Baulaenge"))
SchottumdrehungenData.PruefstationNr = g_App.PruefstationNr
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.Typ
SchottumdrehungenData.TypenKennung = Trim(SchottumdrehungenData.TypenKennung & " " & SchottumdrehungenData.Typzusatz)
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & " DN" & SchottumdrehungenData.Nennweite
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & " " & SchottumdrehungenData.Temperatur & "°C"
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & " PN" & SchottumdrehungenData.Druck
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & " " & IIf(SchottumdrehungenData.eRegister, ", eRegister", "")
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & ", R" & SchottumdrehungenData.Ratio
SchottumdrehungenData.TypenKennung = SchottumdrehungenData.TypenKennung & ", l=" & SchottumdrehungenData.Baulaenge
GetSchottumdrehungenDataFromOrder = SchottumdrehungenData
End Function
Private Function SchotteinstellungenSuchen(ByRef SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN, Optional rs As CRecordset) As Boolean
Dim strSQL As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Vorhandene Schotteinstellungen suchen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
strSQL = "SELECT * FROM Schottumdrehungen where "
strSQL = strSQL & " Typ = '" & SchottumdrehungenData.Typ & "'"
strSQL = strSQL & " and Typzusatz = '" & SchottumdrehungenData.Typzusatz & "'"
strSQL = strSQL & " and Nennweite = " & SchottumdrehungenData.Nennweite
strSQL = strSQL & " and Temperatur = '" & SchottumdrehungenData.Temperatur & "'"
strSQL = strSQL & " and Druck ='" & SchottumdrehungenData.Druck & "'"
strSQL = strSQL & " and eRegister = " & IIf(SchottumdrehungenData.eRegister, 1, 0)
strSQL = strSQL & " and Baulaenge = " & SchottumdrehungenData.Baulaenge
strSQL = strSQL & " and Ratio = " & SchottumdrehungenData.Ratio
strSQL = strSQL & " and Pruefstation = " & SchottumdrehungenData.PruefstationNr
strSQL = strSQL & " order by [AnlageDatum] desc"
Set rs = New CRecordset
rs.openRS strSQL, False
If Not rs.EOF Then
' Schottumdrehungen Wert schon vorhanden
SchottumdrehungenData.Schottumdrehungen_alt = rs.getDoubleValue("Schottumdrehungen")
SchottumdrehungenData.PrueferNr = rs.getIntValue("AnlagePruefer")
SchottumdrehungenData.GeaendertDatum = rs.getStringValue("AnlageDatum")
SchottumdrehungenData.Bemerkung = rs.getStringValue("Bemerkung")
SchotteinstellungenSuchen = True
Else
' noch kein Schottumdrehungen Wert vorhanden
SchotteinstellungenSuchen = False
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
m_blnFormularSchliessen = True
End Sub
Private Sub MSFlexGrid1_Click()
m_intletzteZeile = MSFlexGrid1.row
If m_AlleSchottumdrehungenData(m_intletzteZeile).Typ = "" Then
' klick auf eine Zeile eines nicht belegten Einbauplatz
m_intletzteZeile = 0
Exit Sub
End If
' Start editing
MSFlexGrid1.col = fgSpalte.neuerWert
StatusBar1.SimpleText = "edit Zeile " & m_intletzteZeile
txtEingabe.Top = MSFlexGrid1.Top + MSFlexGrid1.CellTop
txtEingabe.Left = MSFlexGrid1.Left + MSFlexGrid1.CellLeft
txtEingabe.Width = MSFlexGrid1.CellWidth
txtEingabe.Height = MSFlexGrid1.CellHeight
txtEingabe.Font = MSFlexGrid1.Font
txtEingabe.Font.Size = MSFlexGrid1.Font.Size - 2
txtEingabe.Visible = True
txtEingabe.text = MSFlexGrid1.text
txtEingabe.SetFocus
txtEingabe.SelStart = 0
txtEingabe.SelLength = Len(txtEingabe.text)
ZeigeDetails
End Sub
Private Sub ZeigeDetails()
' Historie
Dim strTyp As String
Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
cmbRatio.Enabled = False
cmbBaulaenge.Enabled = False
cmbPruefstation.Enabled = False
SchottumdrehungenData = m_AlleSchottumdrehungenData(m_intletzteZeile)
strTyp = SchottumdrehungenData.Typ
strTyp = strTyp & " " & SchottumdrehungenData.Typzusatz
strTyp = strTyp & " DN" & SchottumdrehungenData.Nennweite
strTyp = strTyp & " " & SchottumdrehungenData.Temperatur & "°C"
strTyp = strTyp & " PN" & SchottumdrehungenData.Druck
strTyp = strTyp & " " & IIf(SchottumdrehungenData.eRegister, ", eRegister", "")
lblTyP.Caption = strTyp
Dim strSQL As String
Dim strWhere As String
Dim rs As CRecordset
strWhere = "Typ = '" & SchottumdrehungenData.Typ & "' and Typzusatz = '" & SchottumdrehungenData.Typzusatz & "' and Nennweite= " & SchottumdrehungenData.Nennweite & " and Temperatur = '" & SchottumdrehungenData.Temperatur & "' and Druck = " & SchottumdrehungenData.Druck & " and eRegister = " & IIf(SchottumdrehungenData.eRegister, "1", "0")
strSQL = "SELECT distinct Ratio FROM Schottumdrehungen WHERE " & strWhere & " order by Ratio"
Set rs = New CRecordset
rs.openRS strSQL
cmbRatio.Clear
cmbRatio.AddItem "*"
Do While Not rs.EOF
cmbRatio.AddItem "R" & rs.getIntValue("Ratio")
If rs.getIntValue("Ratio") = SchottumdrehungenData.Ratio Then
cmbRatio.ListIndex = cmbRatio.ListCount - 1
End If
rs.MoveNext
Loop
strSQL = "SELECT distinct Baulaenge FROM Schottumdrehungen WHERE " & strWhere & " order by Baulaenge"
Set rs = New CRecordset
rs.openRS strSQL
cmbBaulaenge.Clear
cmbBaulaenge.AddItem "*"
Do While Not rs.EOF
cmbBaulaenge.AddItem "l=" & rs.getIntValue("Baulaenge")
If rs.getIntValue("Baulaenge") = SchottumdrehungenData.Baulaenge Then
cmbBaulaenge.ListIndex = cmbBaulaenge.ListCount - 1
End If
rs.MoveNext
Loop
strSQL = "SELECT distinct Pruefstation FROM Schottumdrehungen WHERE " & strWhere & " order by Pruefstation "
Set rs = New CRecordset
rs.openRS strSQL
cmbPruefstation.Clear
cmbPruefstation.AddItem "*"
Do While Not rs.EOF
cmbPruefstation.AddItem "P" & rs.getIntValue("Pruefstation")
If rs.getIntValue("Pruefstation") = SchottumdrehungenData.PruefstationNr Then
cmbPruefstation.ListIndex = cmbPruefstation.ListCount - 1
End If
rs.MoveNext
Loop
AktualisiereHistorie
cmbRatio.Enabled = True
cmbBaulaenge.Enabled = True
cmbPruefstation.Enabled = True
End Sub
Private Sub AktualisiereHistorie()
Dim rs As CRecordset
Dim strSQL As String
Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
Dim intPruefstation As Integer
Dim intBaulaenge As Integer
Dim intRatio As Integer
SchottumdrehungenData = m_AlleSchottumdrehungenData(m_intletzteZeile)
intRatio = Val(Replace(cmbRatio.text, "R", ""))
intBaulaenge = Val(Replace(cmbBaulaenge.text, "l=", ""))
intPruefstation = Val(Replace(cmbPruefstation.text, "P", ""))
strSQL = "SELECT * from Schottumdrehungen where "
strSQL = strSQL & " Typ = '" & SchottumdrehungenData.Typ & "' "
strSQL = strSQL & "and Typzusatz = '" & SchottumdrehungenData.Typzusatz & "' "
strSQL = strSQL & "and Nennweite = " & SchottumdrehungenData.Nennweite & " "
strSQL = strSQL & "and Temperatur = " & SchottumdrehungenData.Temperatur & " "
strSQL = strSQL & "and Druck = " & SchottumdrehungenData.Druck & " "
strSQL = strSQL & "and eRegister = " & IIf(SchottumdrehungenData.eRegister, "1", "0") & " "
If cmbRatio.text <> "*" Then
strSQL = strSQL & "and Ratio = " & intRatio
End If
If cmbBaulaenge.text <> "*" Then
strSQL = strSQL & "and Baulaenge = " & intBaulaenge
End If
If cmbPruefstation.text <> "*" And intPruefstation > 0 Then
strSQL = strSQL & " and Pruefstation = " & intPruefstation
End If
strSQL = strSQL & " order by Anlagedatum desc"
MSFlexGrid2.Clear
MSFlexGrid2.Rows = 1
MSFlexGrid2.FormatString = "Typ|Typzusatz|NW|Temp|Druck|eReg|Ratio|Baulänge|Station|Pruefer|Datum|Wert"
Debug.Print strSQL
Set rs = New CRecordset
rs.openRS strSQL
Do While Not rs.EOF
MSFlexGrid2.AddItem ""
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 0) = rs.getStringValue("Typ")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 1) = rs.getStringValue("Typzusatz")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 2) = rs.getIntValue("Nennweite")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 3) = rs.getIntValue("Temperatur")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 4) = rs.getIntValue("Druck")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 5) = IIf(rs.getBooleanValue("eRegister"), "1", "0")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 6) = rs.getIntValue("Ratio")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 7) = rs.getIntValue("Baulaenge")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 8) = rs.getIntValue("Pruefstation")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 9) = rs.getStringValue("AnlagePruefer")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 10) = Format(rs.getDateValue("AnlageDatum"), "dd.mm.yyyy")
MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 11) = rs.getStringValue("Schottumdrehungen")
rs.MoveNext
Loop
AutoSpaltenBreite MSFlexGrid2, lblAutosize
End Sub
Private Sub Timer1_Timer()
If m_intWeiterCounter = -1 Then
' Start
m_intWeiterCounter = 10
ElseIf m_intWeiterCounter = 0 Then
' stop
m_blnFormularSchliessen = True
Else
m_intWeiterCounter = m_intWeiterCounter - 1
End If
cmdWeiter.Caption = "Weiter (" & m_intWeiterCounter & ")"
End Sub
Private Sub txtEingabe_GotFocus()
txtEingabe.SelStart = 0
txtEingabe.SelLength = Len(txtEingabe.text)
End Sub
Private Sub txtEingabe_KeyPress(KeyAscii As Integer)
m_intletzteZeile = MSFlexGrid1.row
Select Case KeyAscii
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
' Zahlen 0-9 sind erlaubt
Case 8, 3, 22, 24
' back,ctrl+c, ctrl+v
Case 27
EingabeAbgebrochen
Case 44, 46 'Komma, Punkt
KeyAscii = 44 'Komma
If InStr(1, txtEingabe.text, ",") > 0 Then
' nur ein Komma in der Zahl erlaubt
KeyAscii = 0
End If
Case 13
' Return
If m_intletzteZeile <> 0 And txtEingabe.text <> "" Then
EingabeAbgeschlossen
End If
Case Else
Debug.Print "Taste nicht erlaub Ascii=" & KeyAscii
KeyAscii = 0
End Select
End Sub
Private Sub EingabeAbgebrochen()
txtEingabe.text = ""
txtEingabe.Visible = False
End Sub
Private Sub EingabeAbgeschlossen()
Dim strText As String
txtEingabe.Visible = False
If txtEingabe.text = "" Then
Exit Sub
End If
strText = Round(CDbl(txtEingabe.text), 1)
txtEingabe.text = ""
' Schott für diesen und alle gleichen Zähler ändern
Dim Einbauplatz As CEinbauplatz
For Each Einbauplatz In m_colEinbauplatz
If Not Einbauplatz.getPruefzaehler Is Nothing Then
If m_AlleSchottumdrehungenData(m_intletzteZeile).TypenKennung = m_AlleSchottumdrehungenData(Einbauplatz.getNr).TypenKennung Then
' für alle gleichen Typen
' neuen Wert übernehmen
m_AlleSchottumdrehungenData(Einbauplatz.getNr).Schottumdrehungen_neu = CDbl(strText)
' neuen Wert anzeigen
MSFlexGrid1.TextMatrix(Einbauplatz.getNr, fgSpalte.neuerWert) = m_AlleSchottumdrehungenData(Einbauplatz.getNr).Schottumdrehungen_neu
' alten Wert übernehmen
m_AlleSchottumdrehungenData(Einbauplatz.getNr).Schottumdrehungen_alt = m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_alt
End If
End If
Next
If m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_neu <> m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_alt Then
SpeichereWert m_AlleSchottumdrehungenData(m_intletzteZeile)
m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_alt = m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_neu
cmdDelete.Enabled = True
LogIntoDB "Schott-Einstellung für " & m_AlleSchottumdrehungenData(m_intletzteZeile).TypenKennung & " geändert auf " & m_AlleSchottumdrehungenData(m_intletzteZeile).Schottumdrehungen_neu
End If
RefreshSchotteinstellungen
If m_intletzteZeile > 0 Then
' Auswahl aktualisieren & Historie anzeigen
ZeigeDetails
End If
End Sub
Private Sub SpeichereWert(SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN)
Dim rs As CRecordset
Set rs = New CRecordset
rs.openRS "SELECT * from Schottumdrehungen where 1=0"
rs.addNew
rs.setValue "Typ", SchottumdrehungenData.Typ
rs.setValue "Typzusatz", SchottumdrehungenData.Typzusatz
rs.setValue "Nennweite", SchottumdrehungenData.Nennweite
rs.setValue "Temperatur", SchottumdrehungenData.Temperatur
rs.setValue "Druck", SchottumdrehungenData.Druck
rs.setValue "eRegister", SchottumdrehungenData.eRegister
rs.setValue "Baulaenge", SchottumdrehungenData.Baulaenge
rs.setValue "Ratio", SchottumdrehungenData.Ratio
rs.setValue "Pruefstation", g_App.PruefstationNr
rs.setValue "Schottumdrehungen", SchottumdrehungenData.Schottumdrehungen_neu
rs.setValue "AnlagePruefer", g_App.Mitarbeiter.getNr
rs.setValue "AnlageDatum", Now()
rs.update
End Sub
Private Sub txtEingabe_LostFocus()
If m_AlleSchottumdrehungenData(m_intletzteZeile).Typ = "" Then Exit Sub
If txtEingabe.text <> "" Then
EingabeAbgeschlossen
End If
End Sub
Private Sub Loeschen()
' Löscht den jeweils letzen Datensatz, wenn er von diesem Prüfer angelegt wurde
Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
Dim rs As CRecordset
If m_intletzteZeile > 0 Then
' Es wurde eine gültige Zeile angeklickt
SchottumdrehungenData = m_AlleSchottumdrehungenData(m_intletzteZeile)
SchotteinstellungenSuchen SchottumdrehungenData, rs
If rs.EOF Then
cmdDelete.Enabled = False
Exit Sub
End If
rs.MoveFirst
If SchottumdrehungenData.PrueferNr = g_App.Mitarbeiter.getNr Then
If Format(SchottumdrehungenData.GeaendertDatum, "dd.mm.yyyy") = Format(Now, "dd.mm.yyyy") Then
rs.delete
LogIntoDB "letzte Schott-Einstellung " & SchottumdrehungenData.Schottumdrehungen_alt & " für " & SchottumdrehungenData.TypenKennung & " gelöscht."
Else
StatusBar1.SimpleText = "Dieser Wert kann nicht gelöscht werden, da er nicht von heute ist."
cmdDelete.Enabled = False
End If
Else
StatusBar1.SimpleText = "Dieser Wert kann nicht gelöscht werden, da er nicht von Ihnen eingegeben wurde."
cmdDelete.Enabled = False
End If
AktualisiereHistorie
End If
End Sub
Private Sub ModaleSchleife()
SetWindowTopMost Me.hwnd
Do While m_blnFormularSchliessen = False
SleepWithEvents 100, True
Loop
Unload Me
End Sub
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'Private Sub cmdCancel_Click()
' If m_blnUngespeicherteAenderungen Then
' If MsgBox("Sie haben Ihre Änderungen noch nicht gespeichert. Möchten Sie die Änderungen verwerfen?", vbOKCancel) = vbOK Then
' Unload Me
' End If
' Else
' Unload Me
' End If
'End Sub
'
'Private Sub cmdSpeichern_Click()
' speichern
' cmdSpeichern.Enabled = False
'
' If mintErsterBelegterEbp > 0 Then
' MSFlexGrid1.row = mintErsterBelegterEbp
' MSFlexGrid1.col = 0
' MSFlexGrid1_Click
' End If
'End Sub
'
'
'
'Private Sub InitTabelle()
' Dim EinbauplatzNr As Integer
' Dim Einbauplatz As CEinbauplatz
' Dim Pruefzaehler As CPruefzaehler
' Dim objIdenNr As CIdentNr
' Dim objVako As CVakoCode
' Dim AuftragPosition As CAuftragPosition
' Dim Schottwert As Double
'
' Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
'
' Me.Visible = True
'
' txtBemerkung.Enabled = False
' MSFlexGrid1.Clear
' MSFlexGrid1.FormatString = "Einbauplatz|SerienNr|Typ|Schottumdrehungen"
' MSFlexGrid1.Rows = 1
' cmdSpeichern.Enabled = False
' mintErsterBelegterEbp = 0
'
' For EinbauplatzNr = 1 To 10
' MSFlexGrid1.AddItem EinbauplatzNr
'
' Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
'
' If Not Pruefzaehler Is Nothing Then
' If mintErsterBelegterEbp = 0 Then
' mintErsterBelegterEbp = EinbauplatzNr
' End If
'
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ' Zählerdaten
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Set AuftragPosition = Pruefzaehler.getAuftragPosition
' Set objIdenNr = AuftragPosition.getIdentNrObj
' Set objVako = New CVakoCode
'
' If objVako.load(objIdenNr.GetVakoCode) = True Then
' Select Case objVako.GetWert("KurzBez")
' Case "GE"
' GoTo SchotteinstellungenNichtUnterstuetzt
' End Select
'
' Select Case objVako.GetWert("Typ")
' Case "MS"
' ' OK
' Case Else
' GoTo SchotteinstellungenNichtUnterstuetzt
' End Select
'
' If Val(objVako.GetWert("Ratio")) = 0 Then
' ' kein Ratio
' GoTo SchotteinstellungenNichtUnterstuetzt
' End If
' SchottumdrehungenData = GetSchottumdrehungenDataFromOrder(objVako)
' End If
'
'
' MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.SerienNr) = IIf(Pruefzaehler.m_strKundeneigeneSerienNr <> "", Pruefzaehler.m_strKundeneigeneSerienNr, Pruefzaehler.getSerienNr)
' MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.Typ) = SchottumdrehungenData.Typ & " " & SchottumdrehungenData.Typzusatz & " DN " & SchottumdrehungenData.Nennweite & " " & SchottumdrehungenData.Temperatur & "°C PN" & SchottumdrehungenData.Druck & ", " & IIf(SchottumdrehungenData.eRegister, "eRegister", "") & ", l=" & SchottumdrehungenData.Baulaenge & ", Ratio=" & SchottumdrehungenData.Ratio & ", " & " P" & SchottumdrehungenData.PruefstationNr
'
' Dim rs As CRecordset
'
' If SchotteinstellungenSuchen(SchottumdrehungenData, rs) = True Then
' ' Wert vorhanden, als anzeigen
' MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, fgSpalte.Wert) = SchottumdrehungenData.Schottumdrehungen_alt
' End If
' End If
'
' m_AlleSchottumdrehungenData(Einbauplatz.getNr) = SchottumdrehungenData
' Next
'
'SchotteinstellungenNichtUnterstuetzt:
'
' AutoSpaltenBreite MSFlexGrid1, lblAutosize
' MSFlexGrid1.Width = MSFlexGrid1.ColPos(MSFlexGrid1.Cols - 1) + MSFlexGrid1.ColWidth(MSFlexGrid1.Cols - 1) * 1.1
' Me.Width = MSFlexGrid1.Left + MSFlexGrid1.Width * 1.1
' MSFlexGrid1.Height = MSFlexGrid1.RowHeight(1) * 12
'
' If mintErsterBelegterEbp > 0 Then
' MSFlexGrid1.row = mintErsterBelegterEbp
' MSFlexGrid1.col = 0
' MSFlexGrid1_Click
' End If
'End Sub
'
'
'
''
'Private Sub MSFlexGrid1_Click()
' Dim strWert As String
' Dim strTyp As String
' Dim Einbauplatz As CEinbauplatz
' Dim EinbauplatzNr As Integer
' Dim dblNeuerWert As Double
' Dim blnErsterZaehlerSeinerArt As Boolean
'
' Typ des Zählers, bei dem der Schottwert geändert wird
' strTyp = MSFlexGrid1.TextMatrix(MSFlexGrid1.row, fgSpalte.Typ)
' Set Einbauplatz = m_colEinbauplatz(MSFlexGrid1.row)
'
' ZeigeGeschichte m_AlleSchottumdrehungenData(MSFlexGrid1.row)
'
' If strTyp = "" Then Exit Sub
' If Einbauplatz.getPruefzaehler Is Nothing Then Exit Sub
'
' If MSFlexGrid1.col = fgSpalte.Wert Then
' strWert = InputBox("Bitte neue Schottumdrehungen eingeben: ")
' If strWert = "" Then
' Abbruch
' Exit Sub
' Else
' Es wurde ein neuer Wert eingegeben
' m_blnUngespeicherteAenderungen = True
'
' dblNeuerWert = CDbl(strWert)
' For EinbauplatzNr = 1 To MSFlexGrid1.Rows - 1
' m_AlleSchottumdrehungenData(EinbauplatzNr).blnErsterZaehlerSeinerArt = False
' Next
'
' blnErsterZaehlerSeinerArt = False
' neu eingegebenen Wert für alle gleichen Zähler anzeigen und merken
' For EinbauplatzNr = 1 To MSFlexGrid1.Rows - 1
' If MSFlexGrid1.TextMatrix(EinbauplatzNr, fgSpalte.Typ) = strTyp Then
' If blnErsterZaehlerSeinerArt = False Then
' Der Zähler dieses Typs wird das erste mal behandelt
' blnErsterZaehlerSeinerArt = True
' Passiert nur einmal, nur dieser Wert wird am Ende gespeichert
' m_AlleSchottumdrehungenData(EinbauplatzNr).blnErsterZaehlerSeinerArt = True
' txtBemerkung.Enabled = True
' cmdSpeichern.Enabled = True
' End If
'
' MSFlexGrid1.TextMatrix(EinbauplatzNr, fgSpalte.Wert) = dblNeuerWert
' m_AlleSchottumdrehungenData(EinbauplatzNr).Schottumdrehungen_neu = dblNeuerWert
' m_AlleSchottumdrehungenData(EinbauplatzNr).Schottumdrehungen_aendern = True
' End If
' Next
' End If
' End If
'End Sub
'
'
'Private Sub ZeigeGeschichte(SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN)
' MSFlexGrid2.Clear
' MSFlexGrid2.Rows = 1
' MSFlexGrid2.FormatString = "Datum|Pruefer|Schott|Bemerkung"
'
' Dim rs As CRecordset
' If SchotteinstellungenSuchen(SchottumdrehungenData, rs) Then
'
' Do While Not rs.EOF
' MSFlexGrid2.AddItem Format(rs.getDateValue("AnlageDatum"), "dd.mm.yyyy hh:mm")
' MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 1) = rs.getStringValue("AnlagePruefer")
' MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 2) = rs.getStringValue("Schottumdrehungen")
' MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 3) = rs.getStringValue("Bemerkung")
' rs.MoveNext
' Loop
' End If
'
' AutoSpaltenBreite MSFlexGrid2, lblAutosize
'End Sub
'
'Private Sub speichern()
' Dim Einbauplatz As CEinbauplatz
' Dim SchottumdrehungenData As TYP_SCHOTTUMDREHUNGEN
' Dim rs As CRecordset
'
' For Each Einbauplatz In m_colEinbauplatz
' SchottumdrehungenData = m_AlleSchottumdrehungenData(Einbauplatz.getNr)
'
' If SchottumdrehungenData.Schottumdrehungen_aendern = True And SchottumdrehungenData.blnErsterZaehlerSeinerArt = True And _
' SchottumdrehungenData.Schottumdrehungen_alt <> SchottumdrehungenData.Schottumdrehungen_neu Then
'
' Set rs = New CRecordset
' rs.openRS "SELECT * from Schottumdrehungen where 1=0"
' rs.addNew
' rs.setValue "Typ", SchottumdrehungenData.Typ
' rs.setValue "Typzusatz", SchottumdrehungenData.Typzusatz
' rs.setValue "Nennweite", SchottumdrehungenData.Nennweite
'
' rs.setValue "Temperatur", SchottumdrehungenData.Temperatur
' rs.setValue "Druck", SchottumdrehungenData.Druck
' rs.setValue "eRegister", SchottumdrehungenData.eRegister
' rs.setValue "Baulaenge", SchottumdrehungenData.Baulaenge
' rs.setValue "Ratio", SchottumdrehungenData.Ratio
'
' rs.setValue "Pruefstation", g_App.PruefstationNr
' rs.setValue "Schottumdrehungen", SchottumdrehungenData.Schottumdrehungen_neu
' rs.setValue "AnlagePruefer", g_App.Mitarbeiter.getNr
' rs.setValue "AnlageDatum", Now()
' rs.setValue "Bemerkung", txtBemerkung.Text
' rs.update
' End If
' Next
'
' m_blnUngespeicherteAenderungen = False
'End Sub
'
'
'
'Private Sub Command34_Click()
'End Sub
'
'