898 lines
31 KiB
Plaintext
898 lines
31 KiB
Plaintext
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmReferenzzaehlerPruefpunkte
|
|
Caption = " Prüfpunkt Auswahl für die Referenzzählerprüfung"
|
|
ClientHeight = 8190
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 11925
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 8190
|
|
ScaleWidth = 11925
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.CommandButton cmdPruefstationAendern
|
|
Caption = "..."
|
|
Height = 255
|
|
Left = 6765
|
|
TabIndex = 15
|
|
ToolTipText = "Sperre für die PrüfstationsNr Wahl aufheben"
|
|
Top = 510
|
|
Width = 345
|
|
End
|
|
Begin VB.Timer Timer1
|
|
Left = 11430
|
|
Top = 330
|
|
End
|
|
Begin VB.ComboBox cmbPruefstationNr
|
|
Height = 315
|
|
Left = 5175
|
|
Style = 2 'Dropdown-Liste
|
|
TabIndex = 12
|
|
Top = 480
|
|
Width = 1515
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 300
|
|
Left = 0
|
|
TabIndex = 8
|
|
Top = 7890
|
|
Width = 11925
|
|
_ExtentX = 21034
|
|
_ExtentY = 529
|
|
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 cmdNeueinlesen
|
|
Caption = "Reset"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 555
|
|
Left = 3795
|
|
TabIndex = 7
|
|
ToolTipText = "Verwerfen der Änderungen und erneutes Einlesen der Prüfpunkte"
|
|
Top = 7260
|
|
Width = 1755
|
|
End
|
|
Begin VB.CommandButton cmdSave
|
|
Caption = "Speichern"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 555
|
|
Left = 5760
|
|
TabIndex = 6
|
|
ToolTipText = "Speichern der Änderungen"
|
|
Top = 7275
|
|
Width = 1755
|
|
End
|
|
Begin VB.OptionButton optPruefergruppe
|
|
Caption = "Versuch"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 1
|
|
Left = 0
|
|
TabIndex = 4
|
|
Top = 450
|
|
Width = 2835
|
|
End
|
|
Begin VB.OptionButton optPruefergruppe
|
|
Caption = "Produktion"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Index = 0
|
|
Left = 15
|
|
TabIndex = 3
|
|
Top = 45
|
|
Width = 2835
|
|
End
|
|
Begin VB.Frame frameStrang
|
|
Caption = "Nennweite"
|
|
Height = 6285
|
|
Index = 0
|
|
Left = 30
|
|
TabIndex = 1
|
|
Top = 840
|
|
Visible = 0 'False
|
|
Width = 2115
|
|
Begin MSComctlLib.ListView LstviewPruefpunkte
|
|
Height = 4245
|
|
Index = 0
|
|
Left = 120
|
|
TabIndex = 9
|
|
Top = 495
|
|
Width = 1860
|
|
_ExtentX = 3281
|
|
_ExtentY = 7488
|
|
View = 3
|
|
LabelEdit = 1
|
|
LabelWrap = -1 'True
|
|
HideSelection = -1 'True
|
|
Checkboxes = -1 'True
|
|
GridLines = -1 'True
|
|
_Version = 393217
|
|
ForeColor = -2147483640
|
|
BackColor = -2147483643
|
|
BorderStyle = 1
|
|
Appearance = 1
|
|
NumItems = 0
|
|
End
|
|
Begin VB.CheckBox chkStrang
|
|
Caption = "alle aus/abwählen"
|
|
Height = 375
|
|
Index = 0
|
|
Left = 165
|
|
TabIndex = 5
|
|
Top = 5775
|
|
Width = 1755
|
|
End
|
|
Begin VB.Label lblNennweite
|
|
Caption = "NW"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 315
|
|
Index = 0
|
|
Left = 1020
|
|
TabIndex = 2
|
|
Top = 165
|
|
Width = 1035
|
|
End
|
|
Begin VB.Label lblRZInfo
|
|
BorderStyle = 1 'Fest Einfach
|
|
Height = 930
|
|
Index = 0
|
|
Left = 135
|
|
TabIndex = 11
|
|
Top = 4755
|
|
Width = 1845
|
|
End
|
|
End
|
|
Begin VB.CommandButton cmdSchliessen
|
|
Caption = "Schliessen"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 555
|
|
Left = 9780
|
|
TabIndex = 0
|
|
ToolTipText = "Beenden und Schliessen des Formulars"
|
|
Top = 7260
|
|
Width = 1755
|
|
End
|
|
Begin VB.Label lblZeitTotal
|
|
Height = 360
|
|
Left = 45
|
|
TabIndex = 14
|
|
Top = 7380
|
|
Width = 3510
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "für Prüfstation"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 12
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 315
|
|
Left = 3315
|
|
TabIndex = 13
|
|
Top = 480
|
|
Width = 1905
|
|
End
|
|
Begin VB.Label lblUeberschrift
|
|
Caption = "Referenzprüfpunkte für Versuch/Produktion"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 360
|
|
Left = 2910
|
|
TabIndex = 10
|
|
Top = 45
|
|
Width = 8865
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmReferenzzaehlerPruefpunkte"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Const CONST_Produktion = "PRODUKTION"
|
|
Const CONST_Versuch = "VERSUCH"
|
|
|
|
' gibt an, ob die Referenzzählerprüfpunkte für den Versuch oder die Produktion bearbeitet werden. Ein Prüfstellenleiter darf nämlich beides
|
|
Private m_blnProduktion As Boolean
|
|
|
|
' gibt an, ob eine Änderung stattgefunden hat, die gespeichert oder verworfen werden müsste,
|
|
' Es wird ein Dialog angezeigt, wenn das Formular geschlossen wird.
|
|
Private m_blnGeaendert As Boolean
|
|
Private m_bActivated As Boolean
|
|
|
|
Private m_lngPruefstationNr As Long
|
|
Private m_lngSekundenTotal As Long
|
|
|
|
' alle Datensätze in ReferenzzaehlerPruefpunkt mit der Eigenschaft Pflichtpruefpunkte=1 sind die Pflichtprüfpunkte für die Produktion
|
|
' Wenn ein Strang für die Referenzzählerprüfung der Produktion abgewählt wird, werden alle Prüfpunkte des Stranges mit Ausfuehren=1 auf Ausfuehren gesetzt.
|
|
' Deshalb gibt es zwei Speicher-Funktionen.
|
|
' Für den Versuch: Haken berücksichtigen
|
|
|
|
' Für die Produktion gilt:
|
|
|
|
' Strang für Produktion einschalten (Die Produiktion führt nur Pflichtprüfpunkte aus)
|
|
' update ReferenzzaehlerPruefpunkt set Ausfuehren = Pflichtpruefpunkt
|
|
' Where Herkunft like '20xx-032-A" oder SerienNr in (select SerienNr from Referenzzaehler where Pruefstation = 20xx and Nennweite = xx)
|
|
|
|
' Strang für Produktion ausschalten (Die Produiktion führt nur Pflichtprüfpunkte aus)
|
|
' update ReferenzzaehlerPruefpunkt set Ausfuehren = 0
|
|
' Where Herkunft like '20xx-032-A" oder SerienNr in (select SerienNr from Referenzzaehler where Pruefstation = 20xx and Nennweite = xx)
|
|
|
|
|
|
' Für den Versuch gilt:
|
|
' Der Versuch bekommt eine eigene Ausführen-Spalte [Ausfuehren_Versuch]
|
|
|
|
' Prüfpunkte für Versuch einschalten
|
|
' update ReferenzzaehlerPruefpunkt set Ausfuehren_Versuch = [Haken ja/nein]
|
|
' Where SerienNr = ...
|
|
|
|
|
|
' Der Haken für den gesamten Strang wurde angeklickt
|
|
Private Sub chkStrang_Click(Index As Integer)
|
|
If chkStrang(Index).Enabled = False Then Exit Sub
|
|
|
|
Dim i As Integer
|
|
If chkStrang(Index).value = vbChecked Then
|
|
' kompletter Strang angewählt: Alle Prüfpunkt-Haken setzen
|
|
For i = 1 To LstviewPruefpunkte(Index).ListItems.Count
|
|
LstviewPruefpunkte(Index).ListItems(i).Checked = True
|
|
Next
|
|
Else
|
|
' kompletter Strang NICHT angewählt: Alle Prüfpunkt-Haken entfernen
|
|
For i = 1 To LstviewPruefpunkte(Index).ListItems.Count
|
|
LstviewPruefpunkte(Index).ListItems(i).Checked = False
|
|
Next
|
|
End If
|
|
|
|
If chkStrang(Index).Enabled = True Then
|
|
' gesamtZeit aktualisieren
|
|
UpdateZeitenTotal Index
|
|
End If
|
|
|
|
UpdateGesZeit
|
|
|
|
' vermerken, dass Änderungen gemacht worden sind
|
|
AenderungenWurdenGemacht
|
|
End Sub
|
|
|
|
Private Sub UpdateGesZeit()
|
|
Dim i As Integer
|
|
m_lngSekundenTotal = 0
|
|
|
|
'Für alle Stränge
|
|
For i = 0 To frameStrang.Count - 1
|
|
' Zeiten der Prüfpunkte eines Stranges zusammenzählen
|
|
UpdateZeitenTotal i
|
|
Next
|
|
' Gesamtzeit anzeigen
|
|
lblZeitTotal.Caption = "Dauer ges: " & Format((m_lngSekundenTotal / 60 / 60 / 24), "hh:mm")
|
|
End Sub
|
|
|
|
Private Sub cmbPruefstationNr_Change()
|
|
' eine andere Prüfstation wurde ausgewählt
|
|
cmbPruefstationNr_Click
|
|
End Sub
|
|
|
|
Private Sub cmbPruefstationNr_Click()
|
|
If cmbPruefstationNr.Enabled = False Then Exit Sub
|
|
|
|
' eine andere Prüfstation wurde ausgewählt
|
|
m_lngPruefstationNr = Val(cmbPruefstationNr.Text)
|
|
|
|
' Formular neu aufbauen
|
|
Timer1.Interval = 1
|
|
Timer1.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub cmdNeueinlesen_Click()
|
|
' Reset Button wurde geklickt:
|
|
' alle Listboxen der Nennweiten neu erzeugen/aktualiseren
|
|
CreateListboxNennweiten False
|
|
' Originalzustand vermerken
|
|
KeineAenderungenWurdenGemacht
|
|
End Sub
|
|
|
|
Private Sub cmdPruefstationAendern_Click()
|
|
' Prüfstationswahl freigeben
|
|
cmbPruefstationNr.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub cmdSchliessen_Click()
|
|
If optPruefergruppe(1).value = True And g_blnVersuch = False Then
|
|
If MsgBox("Möchten Sie jetzt von 'Produktion' in den Modus 'Versuch' umschalten?", vbYesNo Or vbDefaultButton1) = vbYes Then
|
|
g_blnVersuch = True
|
|
End If
|
|
End If
|
|
If optPruefergruppe(0).value = True And g_blnVersuch = True Then
|
|
If MsgBox("Möchten Sie jetzt von 'Versuch' in den Modus 'Produktion' umschalten?", vbYesNo Or vbDefaultButton1) = vbYes Then
|
|
g_blnVersuch = False
|
|
End If
|
|
End If
|
|
|
|
' nur wenn Ändernungen vorgenommen wurden
|
|
If m_blnGeaendert Then
|
|
' Benutzer Fragen, ob diese Änderungen aus gespeichert werden sollen
|
|
If MsgBox("Sie haben Änderungen vorgenommen! Möchten Sie die Änderungen jetzt speichern?", vbYesNo Or vbDefaultButton2, "Änderungen speichern?") = vbYes Then
|
|
' Speichern nachholen
|
|
cmdSave_Click
|
|
End If
|
|
End If
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub cmdSave_Click()
|
|
' Speichern-Button wurde geklickt
|
|
' Speichern-Button dekativieren (Feedback, damit nicht nochmal ohne Änderungen auf Speichern-Button geklickt wird)
|
|
cmdSave.Enabled = False
|
|
|
|
Me.MousePointer = vbHourglass
|
|
' alles speichern
|
|
speichern
|
|
|
|
LogIntoDB "Prüfer ändert Referenzzähler Prüfpunkte Ausführen für P" & m_lngPruefstationNr, "Referenzzaehlerpp"
|
|
|
|
' alle Listboxen der Nennweiten aktualisieren (controls nicht neu laden)
|
|
CreateListboxNennweiten False
|
|
|
|
' keine Änderungen zum speichern
|
|
KeineAenderungenWurdenGemacht
|
|
|
|
Me.MousePointer = vbNormal
|
|
StatusBar1.SimpleText = "Änderungen wurden gespeichert"
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Activate()
|
|
Screen.MousePointer = vbHourglass
|
|
|
|
' alle Listboxen der Nennweiten laden und aktualisieren
|
|
CreateListboxNennweiten True
|
|
|
|
KeineAenderungenWurdenGemacht
|
|
|
|
m_bActivated = True
|
|
Screen.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
m_bActivated = False
|
|
|
|
m_lngPruefstationNr = g_App.PruefstationNr
|
|
|
|
FillComboPruefstationen m_lngPruefstationNr
|
|
If g_blnVersuch Or g_App.Mitarbeiter.GetPruefstellenleiter Then
|
|
cmbPruefstationNr.Enabled = True
|
|
cmdPruefstationAendern.Enabled = False
|
|
Else
|
|
cmbPruefstationNr.Enabled = False
|
|
cmdPruefstationAendern.Enabled = True
|
|
End If
|
|
|
|
|
|
' Listbox Header festlegen
|
|
Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "Q [m³/h]")
|
|
Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "t [s]")
|
|
Call LstviewPruefpunkte(0).ColumnHeaders.Add(, , "Vol [m³]")
|
|
|
|
optPruefergruppe(0).Tag = CONST_Produktion
|
|
optPruefergruppe(0).Enabled = False
|
|
optPruefergruppe(1).Tag = CONST_Versuch
|
|
optPruefergruppe(1).Enabled = False
|
|
|
|
If g_blnVersuch Then
|
|
' Versuch darf nur Versuch-Prüfpunkte ändern
|
|
optPruefergruppe(1).value = True
|
|
optPruefergruppe(1).Enabled = True
|
|
Else
|
|
' Produktion darf nur Produktion-Prüfpunkte ändern
|
|
optPruefergruppe(0).value = True
|
|
optPruefergruppe(0).Enabled = True
|
|
End If
|
|
|
|
' Pruefstellenleiter darf Versuch UND Produktion ändern
|
|
If g_App.Mitarbeiter.GetPruefstellenleiter = True Then
|
|
optPruefergruppe(0).Enabled = True
|
|
optPruefergruppe(1).Enabled = True
|
|
End If
|
|
|
|
' Ändernungen Versuch/Produktion-Modus anzeigen
|
|
optPruefergruppe_Click 0
|
|
|
|
' alles auf Anfang
|
|
KeineAenderungenWurdenGemacht
|
|
End Sub
|
|
|
|
Private Sub FillComboPruefstationen(PruefstationNr As Long)
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim LngListindex As Long
|
|
|
|
' Alle Prüfstationen, die referenzzählerprüfpunkte haben
|
|
strSQL = "SELECT distinct [PruefstationNr] From [Referenzzaehler] inner join ReferenzzaehlerPruefpunkt on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr order by PruefstationNr"
|
|
Debug.Print strSQL
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
Do While Not rs.EOF
|
|
cmbPruefstationNr.AddItem rs.getLongValue("PruefstationNr")
|
|
If rs.getLongValue("PruefstationNr") = PruefstationNr Then
|
|
LngListindex = cmbPruefstationNr.ListCount - 1
|
|
End If
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
cmbPruefstationNr.Enabled = False
|
|
cmbPruefstationNr.ListIndex = LngListindex
|
|
cmbPruefstationNr.Enabled = True
|
|
End Sub
|
|
|
|
|
|
Private Sub FillListboxNennweite(intIndex As Integer, lngNennweite As Long)
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim i As Integer
|
|
|
|
Dim intCountPPchecked As Integer
|
|
Dim intCountPP As Integer
|
|
Dim lngZeitSumme As Long
|
|
Dim lngSerienNr As Long
|
|
|
|
LstviewPruefpunkte(intIndex).ListItems.Clear
|
|
|
|
' Der Versuch darf einzelne Prüfpunkte ändern
|
|
' Die Produktion darf KEINE einzelne Prüfpunkte ändern
|
|
|
|
LstviewPruefpunkte(intIndex).Enabled = Not m_blnProduktion
|
|
|
|
If m_blnProduktion Then
|
|
strSQL = "select distinct Durchfluss, Pruefzeit , Ausfuehren from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr "
|
|
strSQL = strSQL & " Where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " and Nennweite = " & lngNennweite
|
|
' Produktion: nur die Pflichtprüfpunkte der Produktion anzeigen und auch die, die auf "ausführen" gestellt sind
|
|
strSQL = strSQL & " and (PflichtPruefpunkt = 1 or Ausfuehren=1)"
|
|
strSQL = strSQL & "order by Durchfluss desc"
|
|
Else
|
|
strSQL = "select distinct Durchfluss, Pruefzeit , Ausfuehren_Versuch from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr "
|
|
strSQL = strSQL & " Where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " and Nennweite = " & lngNennweite
|
|
strSQL = strSQL & "order by Durchfluss desc"
|
|
End If
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print strSQL
|
|
|
|
rs.openRS strSQL, True
|
|
i = 0
|
|
|
|
intCountPP = 0
|
|
intCountPPchecked = 0
|
|
|
|
Dim mylistitem As ListItem
|
|
|
|
Do While Not rs.EOF
|
|
|
|
Set mylistitem = LstviewPruefpunkte(intIndex).ListItems.Add(, , Round(rs.getDoubleValue("Durchfluss"), 5))
|
|
mylistitem.ListSubItems.Add , , rs.getDoubleValue("Pruefzeit")
|
|
mylistitem.ListSubItems.Add , , Round(rs.getDoubleValue("Durchfluss") * rs.getDoubleValue("Pruefzeit") / 3600, 4)
|
|
|
|
'lngSerienNr = rs.getLongValue("SerienNr")
|
|
i = LstviewPruefpunkte(intIndex).ListItems.Count
|
|
|
|
intCountPP = intCountPP + 1
|
|
|
|
|
|
If m_blnProduktion Then
|
|
' Produktion
|
|
If rs.getBooleanValue("Ausfuehren") = True Then
|
|
' Häkchen setzen, wenn Ausfuehren=1
|
|
intCountPPchecked = intCountPPchecked + 1
|
|
|
|
LstviewPruefpunkte(intIndex).Tag = "locked"
|
|
LstviewPruefpunkte(intIndex).ListItems(i).Checked = True
|
|
LstviewPruefpunkte(intIndex).Tag = ""
|
|
|
|
lngZeitSumme = lngZeitSumme + rs.getDoubleValue("Pruefzeit")
|
|
|
|
' Produktion:
|
|
|
|
End If
|
|
Else
|
|
' Versuch
|
|
If rs.getBooleanValue("Ausfuehren_Versuch") = True Then
|
|
lngZeitSumme = lngZeitSumme + rs.getDoubleValue("Pruefzeit")
|
|
|
|
LstviewPruefpunkte(intIndex).Tag = "locked"
|
|
LstviewPruefpunkte(intIndex).ListItems(i).Checked = True
|
|
LstviewPruefpunkte(intIndex).Tag = ""
|
|
End If
|
|
End If
|
|
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
If m_blnProduktion Then
|
|
If intCountPPchecked = intCountPP And intCountPP > 0 Then
|
|
' für Produktion: Haken bei "alle aus/abwählen" setzen, wenn alle Pruefpunkt "ausgeführt" stehen
|
|
chkStrang(intIndex).Enabled = False
|
|
chkStrang(intIndex).value = vbChecked
|
|
chkStrang(intIndex).Enabled = True
|
|
Else
|
|
chkStrang(intIndex).Enabled = False
|
|
chkStrang(intIndex).value = vbUnchecked
|
|
chkStrang(intIndex).Enabled = True
|
|
End If
|
|
End If
|
|
|
|
LstviewPruefpunkte(intIndex).ColumnHeaders(1).Width = 900
|
|
LstviewPruefpunkte(intIndex).ColumnHeaders(2).Width = 555
|
|
LstviewPruefpunkte(intIndex).ColumnHeaders(3).Width = 1440
|
|
|
|
UpdateZeitenTotal intIndex
|
|
|
|
End Sub
|
|
|
|
Private Sub UpdateZeitenTotal(intIndex As Integer)
|
|
Dim AnzahlPP As Integer
|
|
Dim i As Integer
|
|
Dim lngSekundenTotal As Long
|
|
Dim lngZeitSumme As Long
|
|
Dim lngCountProStrang As Long
|
|
|
|
AnzahlPP = LstviewPruefpunkte(intIndex).ListItems.Count
|
|
lngSekundenTotal = 0
|
|
|
|
For i = 1 To AnzahlPP
|
|
'Debug.Print LstviewPruefpunkte(intIndex).ListItems(i).ListSubItems(1).text
|
|
If LstviewPruefpunkte(intIndex).ListItems(i).Checked = True Then
|
|
lngCountProStrang = lngCountProStrang + 1
|
|
lngSekundenTotal = lngSekundenTotal + Val(LstviewPruefpunkte(intIndex).ListItems(i).ListSubItems(1).Text)
|
|
End If
|
|
Next
|
|
|
|
|
|
m_lngSekundenTotal = m_lngSekundenTotal + lngSekundenTotal
|
|
lblRZInfo(intIndex).Caption = "Dauer " & Format(lngSekundenTotal / 60 / 60 / 24, "hh:mm") & vbCrLf
|
|
|
|
|
|
Dim lngDatum As Date
|
|
|
|
lngDatum = getLetztePruefungDesStrangesDatum(m_lngPruefstationNr, Val(lblNennweite(intIndex)))
|
|
If lngDatum <> 0 Then
|
|
lblRZInfo(intIndex).Caption = lblRZInfo(intIndex).Caption & "letzte Prf vor " & Round(Now - lngDatum, 0) & " Tagen"
|
|
End If
|
|
|
|
If lngCountProStrang > 10 Then
|
|
lblRZInfo(intIndex).Caption = "zuviele (11) Prüfpunkte angewählt! 10 sind möglich."
|
|
lblRZInfo(intIndex).BackColor = RGB(255, 128, 128)
|
|
Sleep 500, True
|
|
lblRZInfo(intIndex).BackColor = &H8000000F
|
|
Sleep 500, True
|
|
lblRZInfo(intIndex).BackColor = RGB(255, 128, 128)
|
|
Else
|
|
lblRZInfo(intIndex).BackColor = &H8000000F
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Function getLetztePruefungDesStrangesDatum(lngPruefstationNr As Long, intNennweite As Integer) As Date
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
strSQL = "SELECT TOP 1 Referenzzaehler.PruefstationNr, ReferenzzaehlerFehler.Datum, Referenzzaehler.Nennweite FROM ReferenzzaehlerFehler "
|
|
strSQL = strSQL & " INNER JOIN Referenzzaehler ON ReferenzzaehlerFehler.SerienNr = Referenzzaehler.SerienNr "
|
|
strSQL = strSQL & " Where (Referenzzaehler.PruefstationNr = " & lngPruefstationNr & ") And (Referenzzaehler.Nennweite = " & intNennweite & ") ORDER BY ReferenzzaehlerFehler.Datum DESC;"
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
getLetztePruefungDesStrangesDatum = rs.getDateValue("Datum")
|
|
End If
|
|
End Function
|
|
|
|
Private Sub UnloadControls()
|
|
Dim intIndex As Integer
|
|
For intIndex = 1 To frameStrang.Count - 1
|
|
Unload LstviewPruefpunkte(intIndex)
|
|
Unload chkStrang(intIndex)
|
|
Unload lblNennweite(intIndex)
|
|
Unload lblRZInfo(intIndex)
|
|
Unload frameStrang(intIndex)
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub CreateListboxNennweiten(blnLoadControls As Boolean)
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim lngNennweite As Long
|
|
Dim intIndex As Integer
|
|
Dim intAnzahl As Integer
|
|
|
|
KeineAenderungenWurdenGemacht
|
|
|
|
' alle vorhandenen Nennweiten ermitteln
|
|
strSQL = "select distinct Nennweite from Referenzzaehler inner join ReferenzzaehlerPruefpunkt on Referenzzaehler.SerienNr = ReferenzzaehlerPruefpunkt.SerienNr where Referenzzaehler.PruefstationNr = " & m_lngPruefstationNr & " order by Nennweite "
|
|
Debug.Print strSQL
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL
|
|
intAnzahl = rs.RecordCount
|
|
|
|
intIndex = 0
|
|
Do While Not rs.EOF
|
|
lngNennweite = rs.getLongValue("Nennweite")
|
|
|
|
If blnLoadControls Then
|
|
' erste Listview
|
|
If intIndex = 0 Then
|
|
lblNennweite(0).Caption = CStr(lngNennweite)
|
|
frameStrang(0).Left = (Me.ScaleWidth / (intAnzahl + 1)) * 0.5
|
|
frameStrang(0).Width = Me.ScaleWidth / (intAnzahl + 1)
|
|
frameStrang(0).Visible = True
|
|
lblRZInfo(0).Caption = ""
|
|
Else
|
|
On Error Resume Next
|
|
|
|
load frameStrang(intIndex)
|
|
frameStrang(intIndex).Visible = True
|
|
frameStrang(intIndex).Width = Me.ScaleWidth / (intAnzahl + 1)
|
|
frameStrang(intIndex).Left = frameStrang(intIndex - 1).Left + frameStrang(intIndex - 1).Width + 100
|
|
|
|
|
|
load LstviewPruefpunkte(intIndex)
|
|
Set LstviewPruefpunkte(intIndex).Container = frameStrang(intIndex)
|
|
LstviewPruefpunkte(intIndex).Visible = True
|
|
|
|
|
|
load lblNennweite(intIndex)
|
|
Set lblNennweite(intIndex).Container = frameStrang(intIndex)
|
|
lblNennweite(intIndex).Caption = CStr(lngNennweite)
|
|
lblNennweite(intIndex).Visible = True
|
|
|
|
|
|
load chkStrang(intIndex)
|
|
chkStrang(intIndex).Enabled = False
|
|
chkStrang(intIndex).value = vbUnchecked
|
|
chkStrang(intIndex).Enabled = True
|
|
|
|
Set chkStrang(intIndex).Container = frameStrang(intIndex)
|
|
chkStrang(intIndex).Visible = True
|
|
|
|
|
|
load lblRZInfo(intIndex)
|
|
Set lblRZInfo(intIndex).Container = frameStrang(intIndex)
|
|
lblRZInfo(intIndex).Caption = ""
|
|
lblRZInfo(intIndex).Visible = True
|
|
End If
|
|
End If
|
|
|
|
|
|
LstviewPruefpunkte(intIndex).Width = frameStrang(intIndex).Width - LstviewPruefpunkte(intIndex).Left * 2
|
|
|
|
FillListboxNennweite intIndex, lngNennweite
|
|
intIndex = intIndex + 1
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
UpdateGesZeit
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub LstviewPruefpunkte_Click(Index As Integer)
|
|
If LstviewPruefpunkte(Index).Tag <> "locked" Then
|
|
AenderungenWurdenGemacht
|
|
UpdateZeitenTotal Index
|
|
UpdateGesZeit
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub optPruefergruppe_Click(Index As Integer)
|
|
If optPruefergruppe(Index).Enabled = False Then Exit Sub
|
|
|
|
If optPruefergruppe(0).value = True Then
|
|
m_blnProduktion = True
|
|
Else
|
|
m_blnProduktion = False
|
|
End If
|
|
|
|
lblUeberschrift.Caption = "Prüfpunkte der Referenzzählerprüfung für '" & IIf(m_blnProduktion, "Produktion", "Versuch") & "'"
|
|
|
|
If m_bActivated Then
|
|
' erst wenn das Formular aktiviert wurde, die Listboxen aktualisieren (nicht neu laden)
|
|
CreateListboxNennweiten False
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub speichern()
|
|
' speichert die Änderungen
|
|
Dim Strang As Integer
|
|
Dim PPNr As Integer
|
|
Dim AnzahlProStrang As Integer
|
|
Dim dblQ As Double
|
|
Dim strSQL As String
|
|
Dim Nennweite As Integer
|
|
Dim lngSerienNrRZ As Long
|
|
Dim lngRecordsaffected As Long
|
|
|
|
Dim rs As CRecordset
|
|
|
|
''''''''''
|
|
' Anzahl der angewählten Prüfpunkte pro Strang zählen
|
|
For Strang = 0 To LstviewPruefpunkte.Count - 1
|
|
AnzahlProStrang = 0
|
|
For PPNr = 1 To LstviewPruefpunkte(Strang).ListItems.Count
|
|
If LstviewPruefpunkte(Strang).ListItems(PPNr).Checked = True Then
|
|
AnzahlProStrang = AnzahlProStrang + 1
|
|
End If
|
|
Next
|
|
If m_blnProduktion Then
|
|
If AnzahlProStrang = 1 Then
|
|
MsgBox "WARNUNG: Bei einem Prüfpunkt pro Strang kann später nicht interpoliert werden!"
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
''''''''''
|
|
' für alle Stränge
|
|
For Strang = 0 To LstviewPruefpunkte.Count - 1
|
|
Nennweite = lblNennweite(Strang)
|
|
|
|
If m_blnProduktion Then
|
|
' Produktion: zuerst alle betroffenen Pruefpunkte zurücksetzen: NICHT ausführen
|
|
strSQL = "update ReferenzzaehlerPruefpunkt set Ausfuehren = 0 where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "%'"
|
|
g_App.getDB.getConnection.Execute strSQL, lngRecordsaffected
|
|
Debug.Print strSQL & " ===>" & lngRecordsaffected & " zurückgesetzt"
|
|
|
|
If chkStrang(Strang).value = vbChecked Then
|
|
strSQL = "update ReferenzzaehlerPruefpunkt set Ausfuehren = Pflichtpruefpunkt where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "-%'"
|
|
g_App.getDB.getConnection.Execute strSQL, lngRecordsaffected & " wie Pflichtpruefpunkt gesetzt"
|
|
Debug.Print strSQL & " ===>" & lngRecordsaffected
|
|
End If
|
|
Else
|
|
' Versuch
|
|
' für alle Prüfpunkte des Stranges
|
|
For PPNr = 1 To LstviewPruefpunkte(Strang).ListItems.Count
|
|
' alle Durchflüsse gesondert betrachten
|
|
dblQ = LstviewPruefpunkte(Strang).ListItems(PPNr).Text
|
|
|
|
strSQL = "select * from ReferenzzaehlerPruefpunkt where Herkunft like '" & m_lngPruefstationNr & "-" & Format(Nennweite, "000") & "-%' and cast(Durchfluss as decimal(18,5)) = cast(" & Replace(dblQ, ",", ".") & " as decimal(18,5)) "
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, False
|
|
|
|
Debug.Print strSQL
|
|
|
|
If rs.EOF Then
|
|
MsgBox ("Es gibt keinen Datensatz für Abfrage " & vbCrLf & strSQL)
|
|
Else
|
|
' Das Auführen des Versuchs-Prüfpunkt ein/ausschalten
|
|
Do While Not rs.EOF
|
|
rs.setValue "Ausfuehren_Versuch", LstviewPruefpunkte(Strang).ListItems(PPNr).Checked
|
|
rs.update
|
|
rs.MoveNext
|
|
Loop
|
|
End If
|
|
Next
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
|
|
Private Sub AenderungenWurdenGemacht()
|
|
' Es wurden Änderungen gemacht, also z.B. den Save-Button aktivieren
|
|
cmdSave.Enabled = True
|
|
m_blnGeaendert = True
|
|
StatusBar1.SimpleText = "ungespeicherte Änderungen"
|
|
End Sub
|
|
|
|
Private Sub KeineAenderungenWurdenGemacht()
|
|
' Es wurden Änderungen gespeichert oder rückgängig gemacht, also z.B. den Save-Button deaktivieren
|
|
cmdSave.Enabled = False
|
|
m_blnGeaendert = False
|
|
StatusBar1.SimpleText = "keine Änderungen"
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Timer1_Timer()
|
|
Timer1.Enabled = False
|
|
' Listboxen der Nennweiten entfernen
|
|
UnloadControls
|
|
' alle Listboxen der Nennweiten neu erzeugen
|
|
CreateListboxNennweiten True
|
|
' Originalzustand vermerken
|
|
KeineAenderungenWurdenGemacht
|
|
End Sub
|
|
|
|
'
|
|
'Private Sub Reparieren()
|
|
' Dim strSQL As String
|
|
' Dim rs As CRecordset
|
|
'
|
|
' strSQL = "select ReferenzzaehlerPruefpunkt.id, Referenzzaehler.PruefstationNr, Referenzzaehler.Nennweite, Referenzzaehler.MIDGruppe, ReferenzzaehlerPruefpunkt.SerienNr, Durchfluss, Herkunft from ReferenzzaehlerPruefpunkt inner join Referenzzaehler on ReferenzzaehlerPruefpunkt.SerienNr = Referenzzaehler.SerienNr "
|
|
'
|
|
' Debug.Print strSQL
|
|
'
|
|
' Set rs = New CRecordset
|
|
' rs.openRS strSQL
|
|
'
|
|
'
|
|
' Do While Not rs.EOF
|
|
' If rs.getStringValue("Herkunft") <> Format(rs.getLongValue("PruefstationNr"), "0000") & "-" & Format(rs.getLongValue("Nennweite"), "000") & "-" & rs.getStringValue("MidGruppe") Then
|
|
'
|
|
' strSQL = "UPDATE ReferenzzaehlerPruefpunkt set Herkunft = '" & Format(rs.getLongValue("PruefstationNr"), "0000") & "-" & Format(rs.getLongValue("Nennweite"), "000") & "-" & rs.getStringValue("MidGruppe") & "' where ID= " & rs.getLongValue("ID")
|
|
' Debug.Print strSQL
|
|
'
|
|
' End If
|
|
' rs.MoveNext
|
|
' Loop
|
|
'
|
|
'End Sub
|