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

593 lines
17 KiB
Plaintext

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmBehaelterTest
Caption = "Behälter Test"
ClientHeight = 7215
ClientLeft = 60
ClientTop = 345
ClientWidth = 13395
LinkTopic = "Form1"
ScaleHeight = 7215
ScaleWidth = 13395
StartUpPosition = 3 'Windows-Standard
Begin VB.TextBox txtSollVol
Alignment = 1 'Rechts
Height = 300
Left = 4905
TabIndex = 12
Text = "50"
Top = 6375
Width = 660
End
Begin VB.CommandButton Command1
Caption = "Starte Test für einen Behälter"
Height = 450
Left = 2850
TabIndex = 11
Top = 6300
Width = 2025
End
Begin VB.TextBox txtStatus
Height = 3705
Left = 5640
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 7
Text = "frmBehaelterTest.frx":0000
Top = 2310
Width = 7665
End
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 3675
Left = 30
TabIndex = 3
Top = 2340
Width = 5595
Begin VB.TextBox txtAbfluss
Height = 405
Left = 2490
TabIndex = 9
Top = 1620
Width = 1125
End
Begin VB.TextBox txtVolumen
Height = 405
Left = 2490
TabIndex = 6
Top = 1050
Width = 1125
End
Begin VB.TextBox txtQ
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2490
TabIndex = 4
Top = 510
Width = 1095
End
Begin VB.Label Label2
Caption = "Abfluss l/min"
Height = 315
Left = 1080
TabIndex = 10
Top = 1710
Width = 1335
End
Begin VB.Label lblVolumen
Caption = "Volumen "
Height = 315
Left = 1590
TabIndex = 8
Top = 1110
Width = 705
End
Begin VB.Label Label1
Caption = "Q"
Height = 285
Left = 2040
TabIndex = 5
Top = 630
Width = 345
End
End
Begin VB.CommandButton cmdStart
Caption = "Start alle"
Height = 405
Left = 300
TabIndex = 2
Top = 6240
Width = 1155
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 2235
Left = 0
TabIndex = 0
Top = 30
Width = 13365
_ExtentX = 23574
_ExtentY = 3942
_Version = 393216
SelectionMode = 1
End
Begin VB.Label Label3
Caption = " Liter"
Height = 210
Left = 5655
TabIndex = 13
Top = 6420
Width = 435
End
Begin VB.Label lblAutosize
AutoSize = -1 'True
BorderStyle = 1 'Fest Einfach
Caption = "Label1"
Height = 255
Left = 510
TabIndex = 1
Top = 6840
Visible = 0 'False
Width = 540
End
End
Attribute VB_Name = "frmBehaelterTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_Behaelter As CBehaelter ' aktueller Behälter
Private m_SPS As CSPS ' SPS
Private m_Waage As CWaage ' Waage
Private m_ColPumpen As Collection ' Collection mit allen Pumpen
Private m_Pumpe As CPumpe ' Aktuelle Pumpen
Private m_Referenzzaehler As CRefzaehler
Private m_bitsAlleLeeren As Byte ' Byte zum entleeren aller Behälter gleichzeitig
Private m_DurchflussSoll As Double
Private m_dblTemperatur As Double
Private m_lngZeitpunktletzteMessung As Long
Private m_dblVolumenletzteMessung As Double
Const SPALTE_NR = 0
Const SPALTE_OVOL = 1
Const SPALTE_UVOL = 2
Const SPALTE_VB_BEH = 3
Const SPALTE_VB_ABLASS = 4
Const SPALTE_VB_ART = 5
Private Sub Command1_Click()
Dim BehaelterNr As Integer
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadForVolumen(Val(txtSollVol.text)) Then
m_Waage.Initialize m_Behaelter.m_Nr
' eine Minute Wasser ablassen aus allen Behältern, bis alle Behälter leer
m_SPS.WassserAblassen m_bitsAlleLeeren
Dim i As Integer
For i = 1 To 360
Sleep 1000, True
MesseAlles
Next
m_SPS.WassserAblassen 0
TesteBehaelter
End If
End Sub
Private Sub Form_Load()
Dim BehaelterNr As Integer
MSFlexGrid1.Clear
MSFlexGrid1.Rows = 1
MSFlexGrid1.FormatString = "Nr|OVolumen inkl.|UVolumen|VB_Behaelter|AblassAnwahl|Art|"
' wichtige Objekte erzeugen
Set m_Behaelter = New CBehaelter
Set m_SPS = g_App.getSPS
Set m_Waage = g_App.getWaage
Set m_ColPumpen = g_App.Settings.getPumpen
' SPS zurücksetzen
m_SPS.setBetrieb 0
m_SPS.AllePumpenAbwaehlen
'm_SPS.SetMID 0 unbekannt
' schleife um alle Behälter zu testen
For BehaelterNr = 1 To 5
If m_Behaelter.LoadFromIni(BehaelterNr) Then
MSFlexGrid1.AddItem ""
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
MSFlexGrid1.RowSel = MSFlexGrid1.row
MSFlexGrid1.col = SPALTE_NR
MSFlexGrid1.text = BehaelterNr
MSFlexGrid1.col = SPALTE_OVOL
MSFlexGrid1.text = m_Behaelter.m_OVolumen
MSFlexGrid1.col = SPALTE_UVOL
MSFlexGrid1.text = m_Behaelter.m_UVolumen
MSFlexGrid1.col = SPALTE_VB_BEH
MSFlexGrid1.text = m_Behaelter.m_BehaelterAnwahl
MSFlexGrid1.col = SPALTE_VB_ART
Select Case m_Behaelter.m_Waagenart
Case WAAGENART_BIZERBA
MSFlexGrid1.text = "BIZERBA"
Case WAAGENART_METTLER
MSFlexGrid1.text = "METTLER"
Case WAAGENART_METTLER_2
MSFlexGrid1.text = "METTLER 2"
Case WAAGENART_FUELLSTAND
MSFlexGrid1.text = "FUELLSTAND"
End Select
MSFlexGrid1.col = SPALTE_VB_ABLASS
MSFlexGrid1.text = m_Behaelter.m_AblassAnwahl
' diese Werte können noch in die Tabelle gebracht werden
PrintStatus m_Behaelter.m_Fuelldurchfluss
PrintStatus m_Behaelter.m_Fuellvolumen
PrintStatus m_Behaelter.m_Genauigkeit
PrintStatus m_Behaelter.m_Mindestmenge
PrintStatus m_Behaelter.m_nUeberlaufFaktor
PrintStatus m_Behaelter.m_RuheGrenzwert
' wird für später noch gebraucht
m_bitsAlleLeeren = m_bitsAlleLeeren Or m_Behaelter.m_AblassAnwahl
End If
Next
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Sub
Private Sub cmdStart_Click()
StartPruefung
End Sub
Sub StartPruefung()
Dim BehaelterNr As Integer
MsgBox "Bitte in Hand alle Behälter leeren und dann SPS auf Automatik schalten. Klicken Sie auf OK wenn fertig."
' Prüfen auf Automatik
If Not m_SPS.IstAutomatik Then
MsgBox "SPS bitte auf Automatik stellen."
Do While Not m_SPS.IstAutomatik
DoEvents
Sleep 1000
Loop
PrintStatus "Automatisk"
End If
' Prüfen auf Prüfbereit
If Not m_SPS.IstStreckePruefbereit Then
PrintStatus "Warte auf Prüfbereitschaft"
Do While Not m_SPS.IstStreckePruefbereit
DoEvents
Sleep 1000
Loop
PrintStatus "Prüfbereit!"
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Waagengrenzwerte für alle Behälter hoch setzen
For BehaelterNr = 1 To 5
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadFromIni(BehaelterNr) Then
m_Waage.Initialize BehaelterNr
m_Waage.SetNettoGrenzwert1 m_Behaelter.m_OVolumen
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For BehaelterNr = 1 To 5
' Behälter wählen
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadFromIni(BehaelterNr) Then
m_Waage.Initialize BehaelterNr
' eine Minute Wasser ablassen aus allen Behältern, bis alle Behälter leer
m_SPS.WassserAblassen m_bitsAlleLeeren
Dim i As Integer
For i = 1 To 60
Sleep 1000, True
MesseAlles
Next
m_SPS.WassserAblassen 0
TesteBehaelter
End If
Next
End Sub
Private Sub TesteBehaelter()
'''''''''''''''''''''''''''''''''''''''''''''
' Bereite die Waage vor: tariere wenn in Ruhe
' TaraReset
m_Waage.TaraReset
m_Waage.SoftTaraReset
m_Waage.SetNettoGrenzwert1 m_Behaelter.m_OVolumen / 4
'''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' Wasser marsch!
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_Waage.Tara
' Soll Durchfluss = Fuelldurchfluss
m_DurchflussSoll = m_Behaelter.m_Fuelldurchfluss
If m_DurchflussSoll = 0 Then
MsgBox "Bitte Fuelldurchfluss für Behälter " & m_Behaelter.m_OVolumen & "l angeben"
End
End If
' MID Strang vorwählen
m_dblTemperatur = m_SPS.GetEinlaufTemperatur
Set m_Referenzzaehler = New CRefzaehler
m_Referenzzaehler.loadForDurchfluss m_DurchflussSoll, g_App.Settings.getMIDGruppe
m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl
'SPS setzen: Pumpe, Qsoll, Servostellung, Regelart, Strang, Qdif
Call initSPSfuerPP
' Starten
m_SPS.setBetrieb 2
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
m_dblTemperatur = m_SPS.GetEinlaufTemperatur()
' Warten bis Füllmenge erreicht
Do While Not m_SPS.GrenzwertWaageErreicht
' Volumen auslesen
Select Case m_Waage.m_Waagenart
Case WAAGENART_FUELLSTAND
txtVolumen.text = m_SPS.GetFuellstand_neu(m_Behaelter.m_Nr)
Case Else
txtVolumen.text = Round(Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, m_dblTemperatur), 6) * 1000
End Select
If m_SPS.SolldurchflussErreicht Then
txtQ.BackColor = vbGreen
Else
txtQ.BackColor = vbRed
End If
MesseAlles
Sleep 1000, True
Loop
m_SPS.setBetrieb 0
txtQ.BackColor = vbWhite
Dim i As Long
For i = 1 To 360
Sleep 1000, True
MesseAlles
Next
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
For i = 1 To 360
Sleep 4000, True
MesseAlles
Next
m_SPS.WassserAblassen 0
m_SPS.setBetrieb 0
' diese Funktion muss verfeinert werden. Es muss nur geleert werden. Die Waggen-Ruhe ist hier egal
End Sub
Private Sub MesseAlles()
Dim dblVol As Double
txtAbfluss.text = MesseAbfluss(dblVol)
txtQ.text = Round(m_SPS.getQIst, 3)
WriteToLog Round(m_SPS.getQIst, 3) & vbTab & txtAbfluss.text & vbTab & dblVol
End Sub
Private Sub MSFlexGrid1_Click()
Frame1.Enabled = False
If MSFlexGrid1.RowSel >= 1 Then
Set m_Behaelter = New CBehaelter
If m_Behaelter.LoadFromIni(MSFlexGrid1.RowSel) Then
Frame1.Enabled = True
txtQ.text = m_Behaelter.m_Fuelldurchfluss
Else
MsgBox "Fehler! kein passender Behälter"
End If
End If
End Sub
Private Sub MSFlexGrid1_SelChange()
MSFlexGrid1_Click
End Sub
Private Sub PrintStatus(sText As String)
txtStatus.text = txtStatus.text & sText & vbCrLf
txtStatus.SelStart = Len(txtStatus.text)
DebugMsg ": " & sText
End Sub
Public Function getVoreinstellwert(ByVal dblDurchfluss As Double, ByRef blnWurdeNichtGefunden As Boolean) As Integer
Dim strSQL As String
Dim rs As CRecordset
Dim iNennweite As Integer
Dim sTyp As String
getVoreinstellwert = 50
Exit Function
' On Error GoTo Errorhandler
'
' Set rs = New CRecordset
'
' iNennweite = m_ersterPruefzaehler.getIdentNrObj.getNennweite
' sTyp = m_ersterPruefzaehler.getIdentNrObj.getTyp
'
' strSQL = "SELECT * FROM Voreinstellwerte where Durchfluss = " & doubleToSQLString(dblDurchfluss) & " and Nennweite = " & iNennweite & " and Pruefstation= " & g_App.PruefstationNr & " and Typ = '" & sTyp & "'"
' rs.openRS strSQL, True
'
' If Not rs.EOF Then
' getVoreinstellwert = rs.getDoubleValue("Voreinstellwert")
' 'geändert am 02.03.2005 Andreas Pfeiffer
' 'Durch "True" wird immer gespeichert und aktualisiert
' 'blnWurdeNichtGefunden = False
' blnWurdeNichtGefunden = True
' Else
' blnWurdeNichtGefunden = True
' getVoreinstellwert = 50
' End If
'
' If getVoreinstellwert > 100 Then getVoreinstellwert = 100
'
Exit Function
Errorhandler:
ErrorMsg "Fehler " & Err.Number & " in GetVoreinstellwert: " & Err.Description
End Function
Private Function initSPSfuerPP()
' SPS für diesen Prüfpunkt initialisieren, unabhängig von Waage/Behälter oder Durchlauf
' -------------------------------------------------------------------------------------
' Betrieb stoppen und Pumpen Abwählen
' Durchfluß vorgabe
' Pumpe auswählen und anwählen
' Regelart und Regel-Position setzen
' MID Strang setzen
Dim i As Integer
Dim iStellwert As Integer
Dim AnzahlPP As Integer
Dim blndummy As Boolean
' Betrieb Start zurücksetzen
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
m_SPS.SetQSoll m_DurchflussSoll
PrintStatus "Nächster Durchfluss: " & m_DurchflussSoll
' Pumpenauswahl
' Hochbehälter Auswahl wenn Q < 1 m ^3 -> Pumpe.Nr = 4
' siehe modPumpe
m_SPS.AllePumpenAbwaehlen
Set m_Pumpe = Pumpenwahl(m_DurchflussSoll, m_ColPumpen)
PrintStatus "zu startende Pumpe: " & m_Pumpe.GetSPSVarname
m_Pumpe.Anwahl
Select Case m_Pumpe.GetRegelart
Case "Servo"
' Servo vorgeschrieben
m_SPS.SetRegelart ("Servo")
iStellwert = getVoreinstellwert(m_DurchflussSoll, blndummy)
PrintStatus "Stellwert: " & iStellwert
m_SPS.SetServoStellung iStellwert
Case "FU"
' Frequenzumrichter vorgeschrieben
m_SPS.SetRegelart ("FU")
' Formel für ServoPosition zur Feinregulierung des Durchflusses
iStellwert = getVoreinstellwert(m_DurchflussSoll, blndummy)
If iStellwert > 100 Then iStellwert = 100
PrintStatus "Stellwert: " & iStellwert
m_SPS.SetServoStellung iStellwert
Case Else
ErrorMsg "Es ist keine Regelart für die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert."
Exit Function
End Select
' Vorwahl Referenzzaehler
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
m_SPS.SetQDiff 0
End Function
Private Function MesseAbfluss(dblVolumen As Double) As Double
Dim lng_DeltaZeit_MS As Long
Dim dbl_DeltaVolumen_l As Double
Dim dblZufluss_l_pro_min As Double
lng_DeltaZeit_MS = GetTickCount - m_lngZeitpunktletzteMessung
m_lngZeitpunktletzteMessung = GetTickCount
dblVolumen = Errechne_Volumen_Von_Wasser_in_m3(m_Waage.GetGewicht, m_dblTemperatur)
txtVolumen.text = Round(dblVolumen * 1000, 6)
dbl_DeltaVolumen_l = (dblVolumen - m_dblVolumenletzteMessung) * 1000
m_dblVolumenletzteMessung = dblVolumen
dblZufluss_l_pro_min = 60 * dbl_DeltaVolumen_l / (lng_DeltaZeit_MS / 1000)
MesseAbfluss = Round(-dblZufluss_l_pro_min, 6)
txtAbfluss.text = MesseAbfluss
End Function