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ä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ä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üllt werden?", vbYesNo Or vbDefaultButton2, "SPS meldet: Strecke ist nicht prü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ählt" Else MsgBox "Strecke Prüfbereit machen" End If PrintStatus "Strecke ist Prü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