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

504 lines
14 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Begin VB.Form frmDauerlauf
Caption = "Dauerlauf Timer"
ClientHeight = 5730
ClientLeft = 60
ClientTop = 345
ClientWidth = 6750
LinkTopic = "Form1"
ScaleHeight = 5730
ScaleWidth = 6750
StartUpPosition = 3 'Windows-Standard
Begin VB.Timer Timer1
Enabled = 0 'False
Left = 5280
Top = 240
End
Begin VB.CommandButton cmdStop
Caption = "Stop"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 3360
TabIndex = 12
Top = 3210
Width = 1125
End
Begin VB.ComboBox cmbMID
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = 1890
Style = 2 'Dropdown-Liste
TabIndex = 7
Top = 1950
Width = 4695
End
Begin VB.CommandButton cmdStartTimer
Caption = "Start"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 2070
TabIndex = 4
Top = 3210
Width = 1125
End
Begin VB.TextBox txtCountDown
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1890
TabIndex = 3
Text = "00:01:00"
Top = 2460
Width = 1665
End
Begin VB.TextBox txtQ
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1890
TabIndex = 2
Text = "10"
Top = 840
Width = 1665
End
Begin VB.TextBox txtStatus
Height = 1755
Left = 30
MultiLine = -1 'True
TabIndex = 1
Top = 3810
Width = 6675
End
Begin VB.ComboBox cmbPumpen
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 480
Left = 1890
Style = 2 'Dropdown-Liste
TabIndex = 0
Top = 1410
Width = 4665
End
Begin VB.Label lblCountdown
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "00:00:00"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Left = 4680
TabIndex = 13
Top = 3150
Width = 1725
End
Begin VB.Label Label4
Caption = "Timer"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 60
TabIndex = 11
Top = 2490
Width = 1785
End
Begin VB.Label Label3
Caption = "MID-Strang"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 30
TabIndex = 10
Top = 1950
Width = 1845
End
Begin VB.Label Label2
Caption = "Pumpe"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 60
TabIndex = 9
Top = 1440
Width = 1755
End
Begin VB.Label Label1
Caption = "Durchfluss"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 60
TabIndex = 8
Top = 900
Width = 1755
End
Begin VB.Label Label24
Caption = "m<>/h"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3630
TabIndex = 6
Top = 900
Width = 855
End
Begin VB.Label Label23
Caption = "hh:mm:ss"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3630
TabIndex = 5
Top = 2520
Width = 1575
End
End
Attribute VB_Name = "frmDauerlauf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_SPS As CSPS
Private m_Pumpe As CPumpe
Private m_ColPumpen As Collection
Private m_Referenzzaehler As CRefzaehler
Private m_lcountdown As Long
Private Sub cmbMID_Click()
Dim Referenzzaehler As CRefzaehler
Dim i As Integer
If cmbMID.Enabled = False Then Exit Sub
Set Referenzzaehler = New CRefzaehler
For i = 1 To 8
Referenzzaehler.LoadForRefzaehlerpruefung i
If Referenzzaehler.MidGruppe = IIf(g_App.Settings.getMIDGruppe = 1, "A", "B") Then
If Referenzzaehler.Nennweite = Split(cmbMID.text, ":")(0) Then
m_Referenzzaehler.LoadForRefzaehlerpruefung Referenzzaehler.EinbauplatzNr
If Not g_ohneSPS Then
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
End If
PrintStatus "Gew<65>hlter Referenzzaehler " & m_Referenzzaehler.Nennweite & " " & m_Referenzzaehler.MidGruppe
End If
End If
Next i
End Sub
Private Sub cmbPumpen_Click()
If cmbPumpen.Enabled = False Then Exit Sub
Dim Nr As Integer
Nr = Split(cmbPumpen.text, ":")(0)
For Each m_Pumpe In m_ColPumpen
If m_Pumpe.getNr = Split(cmbPumpen.text, ":")(0) Then
PrintStatus "Gew<65>hlte Pumpe " & m_Pumpe.getNr
m_Pumpe.Anwahl
Exit Sub
End If
Next
End Sub
Private Sub cmdStop_Click()
cmdStop.Enabled = False
cmdStartTimer.Enabled = True
Timer1.Enabled = False
If Not g_ohneSPS Then
m_SPS.SetQSoll 0
m_SPS.setBetrieb 0
End If
PrintStatus "Betrieb gestoppt"
End Sub
Private Sub Form_Activate()
cmdStop.Enabled = False
Vorbereiten
cmbMID_Click
cmbPumpen_Click
End Sub
Private Sub Form_Load()
Set m_SPS = g_App.getSPS
Set m_ColPumpen = g_App.Settings.getPumpen
Set m_Referenzzaehler = New CRefzaehler
Set m_Pumpe = New CPumpe
initCombos
End Sub
Private Sub initCombos()
Dim Pumpe As CPumpe
Dim Referenzzaehler As CRefzaehler
Dim i As Integer
cmbPumpen.Enabled = False
cmbPumpen.Clear
For Each Pumpe In m_ColPumpen
cmbPumpen.AddItem Pumpe.getNr & ": " & "(" & Pumpe.GetDurchflussUnten & "m<>/h -" & Pumpe.GetDurchflussOben & "m<>/h)"
If Val(txtQ.text) > 0 Then
If Pumpe.IstOkFuerDurchfluss(Val(txtQ.text)) Then
cmbPumpen.ListIndex = cmbPumpen.ListCount - 1
End If
End If
Next
cmbPumpen.Enabled = True
cmbMID.Enabled = False
cmbMID.Clear
Set Referenzzaehler = New CRefzaehler
For i = 1 To 8
Referenzzaehler.LoadForRefzaehlerpruefung i
If Referenzzaehler.MidGruppe = IIf(g_App.Settings.getMIDGruppe = 1, "A", "B") Then
cmbMID.AddItem Referenzzaehler.Nennweite & ": (" & Round(Referenzzaehler.UDurchfluss, 3) & "m<>/h -" & Round(Referenzzaehler.ODurchfluss, 3) & "m<>/h)"
If Val(txtQ.text) > 0 Then
If Referenzzaehler.IstOkFuerDurchfluss(Val(txtQ.text)) Then
cmbMID.ListIndex = cmbMID.ListCount - 1
End If
End If
End If
Next
cmbMID.Enabled = True
End Sub
Private Sub Vorbereiten()
If Not g_ohneSPS Then
m_SPS.SetQSoll 0
m_SPS.setBetrieb 0
m_SPS.AllePumpenAbwaehlen
If Not m_SPS.IstAutomatik Then
MsgBox "SPS: Bitte Automatik w<>hlen"
Exit Sub
End If
If Not m_SPS.IstStreckeGefuellt Then
If MsgBox("Soll die Strecke jetzt automatisch gespannt u. gef<65>llt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht pr<70>fbereit") = vbYes Then
m_SPS.setBetrieb 1
PrintStatus "Betrieb vorbereiten: Spannen und F<>llen..."
Do While Not m_SPS.IstStreckeGefuellt
Sleep 1000, True
If g_Abbruch = True Then
Exit Sub
End If
Loop
' nach dem F<>llen: Betrieb auf 0
Sleep 500
m_SPS.setBetrieb 0
End If
PrintStatus "Warte auf Pruefbereitschaft der SPS..."
Do While Not m_SPS.IstStreckePruefbereit
Sleep 1000, True
If g_Abbruch = True Then
Exit Sub
End If
Loop
End If
' Durchlauf w<>hlen
m_SPS.setBehaelter 1
PrintStatus "Durchlauf gew<65>hlt"
Else
MsgBox "Strecke Pr<50>fbereit machen"
End If
PrintStatus "Strecke ist Pr<50>fbereit !"
End Sub
Private Sub cmdStartTimer_Click()
On Error GoTo Errorhandler
Dim DurchflussSoll As Double
Dim Referenzzaehler As CRefzaehler
cmdStop.Enabled = True
cmdStartTimer.Enabled = False
Vorbereiten
DurchflussSoll = Val(txtQ.text)
If Not g_ohneSPS Then
m_Pumpe.Anwahl
m_SPS.SetQSoll DurchflussSoll
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
Select Case m_Pumpe.GetRegelart
' Servo Vorgeschrieben
Case "Servo"
m_SPS.SetRegelart ("Servo")
m_SPS.SetServoStellung 50
Case "FU"
' FU vorgeschrieben
m_SPS.SetRegelart ("FU")
m_SPS.SetServoStellung 50
Case Else
ErrorMsg "Es ist keine Regelart f<>r die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert."
Exit Sub
End Select
' Pumpe starten
m_SPS.setBetrieb 2
End If
m_lcountdown = CDate(txtCountDown.text) * 24 * 60 * 60
Timer1.Interval = 1000
Timer1.Enabled = True
Exit Sub
Errorhandler:
MsgBox Err.Description
If Not g_ohneSPS Then
m_SPS.setBetrieb 0
End If
MsgBox Err.Description
End Sub
Private Sub PrintStatus(sText As String)
txtStatus.text = Now() & " " & txtStatus.text & sText & vbCrLf
txtStatus.SelStart = Len(txtStatus.text)
DebugMsg ": " & sText
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
cmdStop_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
cmdStop_Click
End Sub
Private Sub Timer1_Timer()
m_lcountdown = m_lcountdown - 1
lblCountdown.Caption = Format(m_lcountdown / 24 / 60 / 60, "hh:mm:ss")
If m_lcountdown < 0 Then
Timer1.Enabled = False
Call cmdStop_Click
End If
End Sub
Private Sub txtQ_Change()
initCombos
m_SPS.SetQSoll Val(txtQ.text)
End Sub
Private Sub txtQ_GotFocus()
txtQ.SelStart = 0
txtQ.SelLength = Len(txtQ.text)
End Sub