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

1444 lines
42 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSPSTest
Caption = "SPS Test"
ClientHeight = 8655
ClientLeft = 60
ClientTop = 345
ClientWidth = 12330
LinkTopic = "Form1"
ScaleHeight = 8655
ScaleWidth = 12330
StartUpPosition = 3 'Windows-Standard
Begin VB.TextBox txtStellwertSoll
Alignment = 1 'Rechts
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 = 7680
TabIndex = 53
Top = 3000
Width = 495
End
Begin VB.Frame Frame3
Caption = "Ablass Durchfluss Messung"
Height = 2085
Left = 3480
TabIndex = 45
Top = 6000
Width = 5775
Begin VB.CommandButton cmdAblassStop
Caption = "Ablass STOP"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1980
TabIndex = 50
Top = 300
Width = 1620
End
Begin VB.TextBox txtIntervall
Alignment = 1 'Rechts
Height = 285
Left = 960
TabIndex = 47
Text = "1000"
Top = 840
Width = 615
End
Begin VB.CommandButton cmdAktuellenBehaelterLeeren
Caption = "Ablass START"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 270
TabIndex = 46
Top = 300
Width = 1620
End
Begin MSForms.Label Label24
Height = 255
Left = 1680
TabIndex = 54
Top = 960
Width = 495
Caption = "ms"
Size = "873;450"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.Label Label23
Height = 285
Left = 2970
TabIndex = 52
Top = 870
Width = 585
Caption = "Abfluss"
Size = "1032;503"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin MSForms.Label Label22
Height = 405
Left = 4680
TabIndex = 51
Top = 900
Width = 975
Caption = "Liter / min"
Size = "1720;714"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label lblAbflussDurchfluss
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 3600
TabIndex = 49
Top = 840
Width = 1035
End
Begin VB.Label Label21
Caption = "intervall"
Height = 285
Left = 240
TabIndex = 48
Top = 960
Width = 615
End
End
Begin VB.Frame Frame2
Height = 2295
Left = 9000
TabIndex = 34
Top = 3570
Width = 3255
Begin VB.CheckBox chkLoggen
Caption = "Ist Werte Loggen"
Height = 285
Left = 240
TabIndex = 41
Top = 1860
Value = 1 'Aktiviert
Width = 2385
End
Begin VB.Label Label20
Caption = "Stellwert ist"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 44
Top = 1200
Width = 1455
End
Begin VB.Label Label19
Caption = "%"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2640
TabIndex = 43
Top = 1200
Width = 285
End
Begin VB.Label lblStellwert
Alignment = 1 'Rechts
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 = 375
Left = 1920
TabIndex = 42
Top = 1200
Width = 615
End
Begin VB.Label Label18
Caption = "m<>/h"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2580
TabIndex = 40
Top = 330
Width = 525
End
Begin VB.Label Label17
Caption = "Liter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2640
TabIndex = 39
Top = 750
Width = 525
End
Begin VB.Label lblVist
Alignment = 1 'Rechts
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 = 375
Left = 1320
TabIndex = 38
Top = 750
Width = 1215
End
Begin VB.Label Label16
Caption = "V ist"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 600
TabIndex = 37
Top = 750
Width = 585
End
Begin VB.Label lblQist
Alignment = 1 'Rechts
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 = 375
Left = 1320
TabIndex = 36
Top = 270
Width = 1215
End
Begin VB.Label Label15
Caption = "Q ist"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 35
Top = 270
Width = 615
End
End
Begin VB.CommandButton cmdStrangW<67>hlen
Caption = "Strang f<>r Q ausw<73>hlen"
Height = 285
Left = 5610
TabIndex = 29
Top = 1650
Width = 1935
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Unten ausrichten
Height = 435
Left = 0
TabIndex = 28
Top = 8220
Width = 12330
_ExtentX = 21749
_ExtentY = 767
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.Frame Frame1
Caption = "intermittierender Betrieb"
Height = 2295
Left = 1590
TabIndex = 17
Top = 3600
Width = 7305
Begin VB.TextBox txtLaufzeitLiter
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 4080
TabIndex = 30
Top = 330
Width = 765
End
Begin VB.CommandButton cmdAbbruchIntermit
Caption = "Abbruch"
Height = 525
Left = 5790
TabIndex = 27
Top = 1230
Width = 1095
End
Begin VB.CommandButton cmdStartIntermet
Caption = "Start"
Height = 525
Left = 5760
TabIndex = 26
Top = 360
Width = 1095
End
Begin VB.TextBox txtWdh
Alignment = 1 'Rechts
BeginProperty DataFormat
Type = 0
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2010
TabIndex = 24
Text = "10"
Top = 1470
Width = 975
End
Begin VB.TextBox txtWarteSek
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2040
TabIndex = 21
Text = "60"
Top = 870
Width = 975
End
Begin VB.TextBox txtLaufzeit
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 2040
TabIndex = 18
Text = "300"
Top = 300
Width = 1005
End
Begin VB.Label Label14
Caption = "oder "
Height = 255
Left = 3420
TabIndex = 33
Top = 420
Width = 495
End
Begin VB.Label Label13
Caption = "Liter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 4920
TabIndex = 31
Top = 390
Width = 645
End
Begin VB.Label Label11
Caption = "Wiederholungen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 120
TabIndex = 25
Top = 1470
Width = 1755
End
Begin VB.Label Label10
Caption = "Pausenzeit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 150
TabIndex = 23
Top = 900
Width = 1515
End
Begin VB.Label Label9
Caption = "s"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 3180
TabIndex = 22
Top = 930
Width = 375
End
Begin VB.Label Label8
Caption = "s"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 3180
TabIndex = 20
Top = 360
Width = 195
End
Begin VB.Label Label7
Caption = "Laufzeit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 19
Top = 390
Width = 1005
End
End
Begin VB.CommandButton cmdGrenzwertSetzen
Caption = "Setzen"
Height = 375
Left = 7680
TabIndex = 16
Top = 120
Width = 1215
End
Begin VB.ComboBox cmbStrang
Height = 315
Left = 5580
Style = 2 'Dropdown-Liste
TabIndex = 12
Top = 1200
Width = 6165
End
Begin VB.CommandButton cmdGetRuheGewicht
Caption = "Ruhegewicht lesen"
Enabled = 0 'False
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 = 210
TabIndex = 11
Top = 7470
Width = 2880
End
Begin VB.CommandButton cmdRohrFuellen
Caption = "Rohr f<>llen"
Enabled = 0 'False
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 = 210
TabIndex = 10
Top = 6840
Width = 2880
End
Begin VB.CommandButton cmdBehaelterLeeren
Caption = "Alle Beh<65>lter Leeren"
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 = 210
TabIndex = 9
Top = 6180
Width = 2880
End
Begin VB.TextBox txtGrenzwert
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 5760
TabIndex = 7
Top = 120
Width = 1260
End
Begin VB.TextBox txtSolldurchfluss
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2280
TabIndex = 4
Text = "1"
Top = 2430
Width = 1980
End
Begin VB.CommandButton cmdStop
Caption = "STOP"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 990
Left = 90
TabIndex = 1
Top = 4650
Width = 1320
End
Begin VB.CommandButton cmdStart
Caption = "START"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 990
Left = 120
TabIndex = 0
Top = 3420
Width = 1305
End
Begin VB.ListBox lstBehaelterAuswahl
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2220
Left = 0
TabIndex = 2
Top = 0
Width = 4245
End
Begin VB.Label Label12
Caption = "%"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 32
Top = 3000
Width = 405
End
Begin VB.Label Label6
Caption = "Stellwert soll"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5400
TabIndex = 15
Top = 3000
Width = 2295
End
Begin MSForms.ScrollBar ScrollBar1
Height = 315
Left = 5520
TabIndex = 14
Top = 2490
Width = 6405
Size = "11298;556"
End
Begin VB.Label Label5
Caption = "Strang"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4620
TabIndex = 13
Top = 1080
Width = 855
End
Begin VB.Label Label4
Caption = "kg"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7080
TabIndex = 8
Top = 120
Width = 600
End
Begin VB.Label Label3
Caption = "Grenzwert"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4350
TabIndex = 6
Top = 180
Width = 1665
End
Begin VB.Label Label2
Caption = "m<>/h"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4410
TabIndex = 5
Top = 2460
Width = 720
End
Begin VB.Label Label1
Caption = "Soll-Durchfluss"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 90
TabIndex = 3
Top = 2400
Width = 2115
End
End
Attribute VB_Name = "frmSPSTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_ArrayBehaelter(4) As CBehaelter
Private m_Behaelter As CBehaelter
Const TXT_DURCHLAUF = "Durchlauf"
Private m_SPS As CSPS
Private m_Referenzzaehler As CRefzaehler
Private m_RefezaehlerStrang As Integer
Private m_Pumpe As CPumpe
Private m_Waage As CWaage
Private m_dblDurchflussSoll As Double
Private m_ColPumpen As Collection
Private m_lngStartzeit As Long
Private m_Logfile As String
Private m_bolAbbruchIntermit As Boolean
Private m_bolAbbruchAblass As Boolean
Private Sub cmbStrang_Click()
cmbStrang_Change
End Sub
Private Sub cmdAbbruchIntermit_Click()
m_bolAbbruchIntermit = True
m_SPS.setBetrieb 0
m_SPS.WassserAblassen 0
ClearStatus
End Sub
Private Sub cmdBehaelterLeeren_Click()
cmdBehaelterLeeren.Enabled = False
m_bolAbbruchIntermit = False
m_SPS.WassserAblassen 1 + 2 + 4 + 8
Do While Not m_bolAbbruchIntermit
UpdateStatus
DoEvents
Loop
m_SPS.WassserAblassen 0
cmdBehaelterLeeren.Enabled = True
End Sub
Private Sub cmdGrenzwertSetzen_Click()
m_Waage.SetNettoGrenzwert1 CDbl(txtGrenzwert.text)
End Sub
Private Sub cmdStart_Click()
cmdStart.Enabled = False
cmdStop.Enabled = True
StartBetrieb
End Sub
Private Sub StartBetrieb()
Dim dummy As Variant
Dim m_RefZaehlerPruefpunkt As CRefZaehlerPruefpunkt
Dim Servostellwert As Integer
m_SPS.setBetrieb 0
m_SPS.WassserAblassen 0
TestAutomatik:
If Not m_SPS.IstAutomatik Then
dummy = MsgBox("Bitte SPS auf Automatik stellen", vbOKCancel)
If dummy = vbCancel Then
Exit Sub
End If
GoTo TestAutomatik
End If
m_dblDurchflussSoll = CDbl(txtSolldurchfluss.text)
Set m_Referenzzaehler = New CRefzaehler
If m_Referenzzaehler.loadForDurchfluss(m_dblDurchflussSoll, 1) Then
If cmbStrang.ListIndex = -1 Then
FillCmbStrang
End If
Else
MsgBox ("RefZ f<>r Durchfluss konnte nocht geladen werden")
Exit Sub
End If
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
If Not m_Behaelter Is Nothing Then
m_SPS.setBehaelter m_Behaelter.m_BehaelterAnwahl
txtGrenzwert.text = m_Behaelter.m_OVolumen
m_Waage.Initialize m_Behaelter.m_Nr
m_Waage.Nullstellen
m_Waage.Tara
m_Waage.SoftTara
Else
m_SPS.setBehaelter 1 ' Durchlauf
End If
m_SPS.SetQSoll m_dblDurchflussSoll
m_SPS.AllePumpenAbwaehlen
Set m_ColPumpen = g_App.Settings.getPumpen
Set m_Pumpe = Pumpenwahl(m_dblDurchflussSoll, m_ColPumpen)
If m_Pumpe Is Nothing Then
Exit Sub
Else
m_SPS.AnwahlPumpe m_Pumpe.getNr
Set m_RefZaehlerPruefpunkt = New CRefZaehlerPruefpunkt
Servostellwert = lookupFUServoStellwert(m_dblDurchflussSoll, m_Pumpe.GetRegelart)
txtStellwertSoll.text = Servostellwert
Select Case m_Pumpe.GetRegelart
' Servo Vorgeschrieben
Case "Servo"
m_SPS.SetRegelart ("Servo")
m_SPS.SetServoStellung Servostellwert
Case "FU"
' FU vorgeschrieben
m_SPS.SetRegelart ("FU")
m_SPS.SetServoStellung Servostellwert
Case Else
MsgBox "Es ist keine Regelart f<>r die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert."
Exit Sub
End Select
End If
m_SPS.setBetrieb 0
Sleep 500
m_SPS.setBetrieb 2
m_Logfile = "C:\intermitt_" & Format(Now, "yyyy-mm-dd_hh-mm") & ".txt"
m_lngStartzeit = GetTickCount()
End Sub
Private Sub cmdStop_Click()
cmdStop.Enabled = False
m_SPS.setBetrieb 0
cmdStart.Enabled = True
End Sub
Private Sub Form_Load()
Dim Behaelter As CBehaelter
Dim i As Integer
Dim Einbauplatz As Integer
Set m_SPS = g_App.getSPS
Set m_Waage = g_App.getWaage
lstBehaelterAuswahl.Clear
lstBehaelterAuswahl.AddItem TXT_DURCHLAUF, 0
For i = 1 To 5
Set Behaelter = New CBehaelter
If Behaelter.LoadFromIni(i) Then
lstBehaelterAuswahl.AddItem Behaelter.m_OVolumen & " Liter Beh<65>lter", i
End If
Next
Call FillCmbStrang
txtLaufzeit_Change
cmdStart.Enabled = True
cmdStop.Enabled = False
End Sub
Private Sub FillCmbStrang()
Dim EinbauplatzNr As Integer
cmbStrang.Clear
For m_RefezaehlerStrang = 1 To 5
EinbauplatzNr = (m_RefezaehlerStrang - 1) * 2 + 1
Set m_Referenzzaehler = New CRefzaehler
If m_Referenzzaehler.LoadForRefzaehlerpruefung(EinbauplatzNr) = 0 Then
cmbStrang.AddItem EinbauplatzNr & " : " & "NW " & m_Referenzzaehler.Nennweite & " (" & Round(m_Referenzzaehler.UDurchfluss, 5) & " - " & Round(m_Referenzzaehler.ODurchfluss, 5) & ")"
If m_dblDurchflussSoll > 0 Then
If m_Referenzzaehler.IstOkFuerDurchfluss(m_dblDurchflussSoll) Then
cmbStrang.Enabled = False
cmbStrang.ListIndex = cmbStrang.ListCount - 1
DoEvents
cmbStrang.Enabled = True
End If
End If
End If
Next
End Sub
Private Sub lstBehaelterAuswahl_Click()
Me.MousePointer = vbHourglass
On Error GoTo Errorhandler
If lstBehaelterAuswahl.List(lstBehaelterAuswahl.ListIndex) = TXT_DURCHLAUF Then
txtGrenzwert.Enabled = False
txtGrenzwert.text = ""
Else
txtGrenzwert.Enabled = True
Set m_Behaelter = New CBehaelter
m_Behaelter.LoadFromIni (lstBehaelterAuswahl.ListIndex)
txtGrenzwert.text = m_Behaelter.m_OVolumen
Set m_Waage = g_App.getWaage
m_Waage.Initialize m_Behaelter.m_Nr
If m_Behaelter.m_WaageAnwahl > 0 Then
m_Waage.Anwahl m_Behaelter.m_WaageAnwahl
End If
End If
Me.MousePointer = vbNormal
Exit Sub
Errorhandler:
MsgBox "Fehler " & Err.Number & " in lstBehaelterAuswahl_Click(): " & Err.Description
Me.MousePointer = vbNormal
Exit Sub
Resume
End Sub
Private Sub cmbStrang_Change()
Dim ODurchfluss As Double
Dim UDurchfluss As Double
If cmbStrang.Enabled = True Then
If m_Referenzzaehler.LoadForRefzaehlerpruefung(Val(cmbStrang.text)) = 0 Then
ScrollBar1.Min = 0
ScrollBar1.Max = 100
ScrollBar1_Change
End If
End If
End Sub
Private Sub ScrollBar1_Change()
txtSolldurchfluss.text = Round(Round(m_Referenzzaehler.UDurchfluss, 5) + ScrollBar1.value * (Round(m_Referenzzaehler.ODurchfluss, 5) - Round(m_Referenzzaehler.UDurchfluss, 5)) / 100, 5)
End Sub
Private Sub intermittierendenBetrieb()
'''Hallo Reinhard, ist es m<>glich ein kl. Programm zu schreiben,
'''mit Hilfe dessen, man einen intermittierenden Betrieb laufen lassen kann?
'''Soll hei<65>en,
'''man br<62>uchte:
'''1) Durchfluss (m<>/h)
'''2) Laufzeit (entweder nach Litern oder Zeit)
'''3) Pausenzeit (sek. bzw. min.)
'''4) Wiederholungen
'''z.B.
'''5 m<>/h -> 200 Liter -> 1 Min. Pause -> 10 Wiederholungen
'''Bzw.
'''5 m<>/h -> 144 sek -> 60 sek Pause -> 10 Wiederholungen
'''Mit freundlichen Gr<47><72>en Karsten Nettemann
Dim intWdh As Integer
Call StartBetrieb
' l<>uft
For intWdh = 1 To Val(txtWdh.text)
If m_bolAbbruchIntermit Then Exit For
m_SPS.SetServoStellung Val(txtStellwertSoll.text)
m_SPS.setBetrieb 2
WarteSekunden Val(txtLaufzeit.text), "Wdh=" & intWdh & ", Betrieb, "
If m_bolAbbruchIntermit Then Exit For
m_SPS.setBetrieb 0
m_SPS.SetServoStellung Val(txtStellwertSoll.text)
WarteSekunden Val(txtWarteSek.text), "Wdh=" & intWdh & ", Pause, "
Next
StatusBar1.SimpleText = "fertig"
End Sub
Private Sub ClearStatus()
lblQIst.caption = ""
lblVist.caption = ""
lblQIst.BackColor = &H8000000F
End Sub
Private Sub cmdStartIntermet_Click()
cmdStartIntermet.Enabled = False
m_bolAbbruchIntermit = False
Call intermittierendenBetrieb
ClearStatus
cmdStartIntermet.Enabled = True
End Sub
Private Sub WarteSekunden(lngWarteSek As Long, Optional strDebugText As String = "")
Dim lngSekunden As Long
For lngSekunden = 1 To lngWarteSek
If m_bolAbbruchIntermit Then Exit For
Call UpdateStatus
StatusBar1.SimpleText = strDebugText & " " & lngWarteSek - lngSekunden + 1 & " / " & lngWarteSek
Sleep 1000, True
Next
End Sub
Private Sub UpdateStatus()
lblQIst.caption = Round(m_SPS.getQIst, 3)
lblStellwert.caption = m_SPS.GetStellwert
If Not m_Waage Is Nothing Then
lblVist.caption = Round(Errechne_Volumen_Von_Wasser_in_m3(1000 * m_Waage.GetGewicht, m_SPS.GetEinlaufTemperatur), 3)
End If
If chkLoggen.value = vbChecked Then
AppendToFile m_Logfile, GetTickCount() - m_lngStartzeit & vbTab & lblQIst.caption & vbTab & lblVist.caption
End If
If m_SPS.SolldurchflussErreicht Then
lblQIst.BackColor = RGB(220, 255, 220)
Else
lblQIst.BackColor = RGB(255, 220, 220)
End If
End Sub
Private Sub UpdateStatusAblass()
Dim dblGewichtVorher As Double
Dim dblGewichtNachher As Double
Dim dblAbfluss As Double
Dim lngIntervall As Long
lngIntervall = Val(txtIntervall.text)
' Messung
dblGewichtVorher = m_Waage.GetGewicht
lblVist.caption = Round(Errechne_Volumen_Von_Wasser_in_m3(1000 * dblGewichtVorher, m_SPS.GetEinlaufTemperatur), 3)
Sleep lngIntervall, True
dblGewichtNachher = m_Waage.GetGewicht
lblVist.caption = Round(Errechne_Volumen_Von_Wasser_in_m3(1000 * dblGewichtNachher, m_SPS.GetEinlaufTemperatur), 3)
dblAbfluss = 60000 * (dblGewichtVorher - dblGewichtNachher) / lngIntervall ' kg / min
lblAbflussDurchfluss.caption = Round(dblAbfluss, 3)
If chkLoggen.value = vbChecked And m_Logfile <> "" Then
AppendToFile m_Logfile, GetTickCount() - m_lngStartzeit & vbTab & -Round(dblAbfluss, 3) & vbTab & lblVist.caption
End If
End Sub
Private Sub cmdStrangW<67>hlen_Click()
m_dblDurchflussSoll = CDbl(txtSolldurchfluss.text)
FillCmbStrang
End Sub
Private Sub txtLaufzeit_Change()
Dim dblQlsec As Double
Dim dblTsec As Double
If txtLaufzeit.Enabled = False Then Exit Sub
If IsNumeric(txtLaufzeit.text) And IsNumeric(txtSolldurchfluss.text) Then
dblQlsec = CDbl(txtSolldurchfluss.text) * 1000 / 3600
dblTsec = CDbl(txtLaufzeit.text)
txtLaufzeitLiter.Enabled = False
txtLaufzeitLiter.text = Round(dblQlsec * dblTsec)
txtLaufzeitLiter.Enabled = True
Else
txtLaufzeitLiter.text = ""
End If
End Sub
Private Sub txtLaufzeitLiter_GotFocus()
txtLaufzeit.BackColor = RGB(220, 220, 220)
txtLaufzeitLiter.BackColor = RGB(255, 255, 255)
End Sub
Private Sub txtLaufzeit_GotFocus()
txtLaufzeit.BackColor = RGB(255, 255, 255)
txtLaufzeitLiter.BackColor = RGB(220, 220, 220)
End Sub
Private Sub txtLaufzeit_KeyPress(KeyAscii As Integer)
' nur numerische Werte mit Komma zulassen
Select Case KeyAscii
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
Case 44
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
End If
Case 46
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
Else
KeyAscii = 44
End If
Case 3, 22, 24, 8
' cut copy Paste Backspace
Case 13
Call txtSolldurchfluss_Validate(False)
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub txtLaufzeitLiter_Change()
Dim dblQlsec As Double
Dim dblVolLiter As Double
If txtLaufzeitLiter.Enabled = False Then Exit Sub
If IsNumeric(txtLaufzeitLiter.text) And IsNumeric(txtSolldurchfluss.text) Then
dblQlsec = CDbl(txtSolldurchfluss.text) * 1000 / 3600
dblVolLiter = CDbl(txtLaufzeitLiter.text)
txtLaufzeit.Enabled = False
txtLaufzeit.text = Round(dblVolLiter / dblQlsec, 0)
txtLaufzeit.Enabled = True
Else
txtLaufzeit.text = ""
End If
End Sub
Private Sub txtLaufzeitLiter_KeyPress(KeyAscii As Integer)
' nur numerische Werte mit Komma zulassen
Select Case KeyAscii
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
Case 44
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
End If
Case 46
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
Else
KeyAscii = 44
End If
Case 3, 22, 24, 8
' cut copy Paste Backspace
Case 13
Call txtSolldurchfluss_Validate(False)
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub txtSolldurchfluss_Change()
If IsNumeric(txtSolldurchfluss.text) Then
If CDbl(txtSolldurchfluss.text) = 0 Then
txtLaufzeitLiter.Enabled = False
Else
txtLaufzeitLiter.Enabled = True
End If
If txtLaufzeitLiter.BackColor = RGB(255, 255, 255) Then
Call txtLaufzeitLiter_Change
Else
Call txtLaufzeit_Change
End If
End If
End Sub
Private Sub txtSolldurchfluss_KeyPress(KeyAscii As Integer)
' nur numerische Werte mit Komma zulassen
Select Case KeyAscii
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
Case 44
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
End If
Case 46
If InStr(1, txtSolldurchfluss, ",") > 0 Then
KeyAscii = 0
Else
KeyAscii = 44
End If
Case 3, 22, 24, 8
' cut copy Paste Backspace
Case 13
Call txtSolldurchfluss_Validate(False)
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub txtSolldurchfluss_Validate(Cancel As Boolean)
On Error GoTo Errorhandler
m_dblDurchflussSoll = CDbl(txtSolldurchfluss.text)
FillCmbStrang
Exit Sub
Errorhandler:
MsgBox "Fehler: " & Err.Description
End Sub
Private Sub AppendToFile(strFile As String, sText As String)
On Error Resume Next
Debug.Print sText
LogFileHandle = FreeFile()
Open strFile For Append As LogFileHandle
Print #LogFileHandle, sText
Close #LogFileHandle
End Sub
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ' Alle Ablassventile <20>ffnen
' For i = 1 To 5
' Set Behaelter = New CBehaelter
' If Behaelter.LoadFromIni(i) Then
' AblassAnwahlGes = AblassAnwahlGes Or Behaelter.m_AblassAnwahl
' End If
' Next
' m_SPS.WassserAblassen AblassAnwahlGes
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdAktuellenBehaelterLeeren_Click()
m_Logfile = "C:\ablass_" & Format(Now, "yyyy-mm-dd_hh-mm") & ".txt"
If m_Behaelter Is Nothing Then
MsgBox "bitte Beh<65>lter ausw<73>hlen"
Exit Sub
End If
m_bolAbbruchAblass = False
cmdAktuellenBehaelterLeeren.Enabled = False
cmdAblassStop.Enabled = True
' AblassDurchflussGrenzwert z.B. beim grossen Beh<65>lter: -2 Liter/s
' Ablass <20>ffnen
' AblassDurchfluss_pro_sekunde berechnen
' Warten, solange AblassDurchfluss_pro_sekunde > AblassDurchflussGrenzwert
' Ablass schliessen
m_Waage.Initialize (m_Behaelter.m_Nr)
m_Waage.Anwahl m_Behaelter.m_WaageAnwahl
m_Waage.TaraReset
m_Waage.SoftTaraReset
m_SPS.WassserAblassen m_Behaelter.m_AblassAnwahl
Do
If m_bolAbbruchAblass Then Exit Do
UpdateStatusAblass
Loop While True
m_SPS.WassserAblassen 0
cmdAktuellenBehaelterLeeren.Enabled = True
End Sub
Private Sub cmdAblassStop_Click()
m_bolAbbruchAblass = True
cmdAblassStop.Enabled = False
End Sub