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 ' '