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

419 lines
12 KiB
Plaintext

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmTestDurchflussmessung
Caption = "Pruef2000 Durchflussmessung"
ClientHeight = 5850
ClientLeft = 60
ClientTop = 345
ClientWidth = 7500
LinkTopic = "Form1"
ScaleHeight = 5850
ScaleWidth = 7500
StartUpPosition = 3 'Windows-Standard
Begin VB.Frame Frame2
Height = 3015
Left = 0
TabIndex = 9
Top = 2805
Width = 7485
Begin MSForms.CheckBox chkVollbild
Height = 285
Left = 75
TabIndex = 22
Top = 2625
Width = 1275
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2249;503"
Value = "0"
Caption = "Vollbild"
FontHeight = 165
FontCharSet = 0
FontPitchAndFamily= 2
End
Begin VB.Label Label9
Caption = "%"
Height = 255
Left = 3000
TabIndex = 21
Top = 360
Width = 375
End
Begin VB.Label lblRZ
BorderStyle = 1 'Fest Einfach
Height = 375
Left = 3600
TabIndex = 19
Top = 240
Width = 2055
End
Begin VB.Label Label7
Caption = "Q (bereinigt)"
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 = 240
TabIndex = 18
Top = 1200
Width = 1815
End
Begin VB.Label Label6
Caption = "Q (SPS)"
Height = 375
Left = 1080
TabIndex = 17
Top = 720
Width = 615
End
Begin VB.Label Label5
Caption = "Fehler RZ"
Height = 255
Left = 960
TabIndex = 16
Top = 360
Width = 855
End
Begin VB.Label lblQist
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "123.456"
BeginProperty Font
Name = "Arial Narrow"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 2160
TabIndex = 15
Top = 1080
Width = 2505
End
Begin VB.Label lblQsps
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 1890
TabIndex = 14
Top = 660
Width = 1065
End
Begin VB.Label lblFehlerRZ
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 1890
TabIndex = 13
Top = 270
Width = 1065
End
End
Begin VB.Frame Frame1
Height = 2805
Left = 0
TabIndex = 0
Top = 0
Width = 7485
Begin MSComDlg.CommonDialog CommonDialog1
Left = 450
Top = 1500
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ComboBox cmbIntervall
Height = 315
Left = 3480
Style = 2 'Dropdown-Liste
TabIndex = 12
Top = 1830
Width = 855
End
Begin VB.Timer Timer1
Left = 6120
Top = 480
End
Begin VB.CommandButton cmdOpen
Caption = "Open"
Height = 375
Left = 6630
TabIndex = 8
Top = 2280
Width = 645
End
Begin VB.CommandButton cmdPfad
Caption = "..."
Height = 375
Left = 6150
TabIndex = 6
Top = 2280
Width = 435
End
Begin VB.CommandButton cmdStop
Caption = "STOP"
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 = 405
Left = 3570
TabIndex = 4
Top = 1170
Width = 1365
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 = 405
Left = 2040
TabIndex = 3
Top = 1170
Width = 1365
End
Begin VB.TextBox txtQ
Alignment = 1 'Rechts
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3690
TabIndex = 1
Top = 360
Width = 1455
End
Begin VB.Label Label8
Caption = "Logging"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 5160
TabIndex = 20
Top = 1200
Width = 2295
End
Begin VB.Label Label4
Caption = "s"
Height = 225
Left = 4470
TabIndex = 11
Top = 1860
Width = 285
End
Begin VB.Label Label3
Caption = "Intervall"
Height = 195
Left = 2760
TabIndex = 10
Top = 1890
Width = 825
End
Begin VB.Label Label2
Caption = "Logdatei:"
Height = 315
Left = 180
TabIndex = 7
Top = 2340
Width = 735
End
Begin VB.Label lblPfad
BorderStyle = 1 'Fest Einfach
Caption = "c:\Durchfluss.log"
Height = 315
Left = 990
TabIndex = 5
Top = 2340
Width = 5115
End
Begin VB.Label Label1
Caption = "Soll Durchfluss"
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Left = 240
TabIndex = 2
Top = 360
Width = 3435
End
End
End
Attribute VB_Name = "frmTestDurchflussmessung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_Referenzzaehler As CRefzaehler
Dim mblnVollbild As Boolean
Dim objSPS As CSPS
Private Sub chkVollbild_Click()
If chkVollbild.Value = True Then
Me.WindowState = 2
lblQist.Width = Frame2.Width - lblQist.Left
lblQist.Height = Frame2.Height - lblQist.Top
lblQist.Font.Size = 240
Else
Me.WindowState = 0
lblQist.Width = 2505
lblQist.Height = 555
lblQist.Font.Size = 24
End If
End Sub
Private Sub cmdOpen_Click()
ExecuteAndWait lblPfad.Caption, ""
End Sub
Private Sub cmdPfad_Click()
CommonDialog1.filename = lblPfad.Caption
CommonDialog1.ShowSave
lblPfad.Caption = CommonDialog1.filename
End Sub
Private Sub AppendToFile(strFile As String, sText As String)
Debug.Print sText
LogFileHandle = FreeFile()
Open strFile For Append As LogFileHandle
Print #LogFileHandle, sText
Close #LogFileHandle
End Sub
Private Sub cmdStart_Click()
On Error GoTo Errorhandler
If Not IsNumeric(txtQ.text) Then
MsgBox "Bitte Q Soll eingeben"
txtQ.SetFocus
Exit Sub
End If
Set m_Referenzzaehler = New CRefzaehler
m_Referenzzaehler.loadForDurchfluss CDbl(txtQ.text), g_App.Settings.getMIDGruppe
lblFehlerRZ.Caption = Round(m_Referenzzaehler.letzterFehler(CDbl(txtQ.text)), 4)
lblRZ.Caption = "Nr.:" & m_Referenzzaehler.SerienNr
txtQ.Enabled = False
cmdStart.Enabled = False
cmdStop.Enabled = True
cmbIntervall.Enabled = False
Timer1.Interval = Val(cmbIntervall.text) * 1000
Timer1.Enabled = True
Exit Sub
Errorhandler:
MsgBox Err.Description
Exit Sub
Resume
End Sub
Private Sub cmdStop_Click()
cmbIntervall.Enabled = True
txtQ.Enabled = True
cmdStart.Enabled = True
cmdStop.Enabled = False
Timer1.Enabled = False
End Sub
Public Function getExitCode() As Boolean
End Function
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 60
cmbIntervall.AddItem i
Next i
cmbIntervall.ListIndex = 9
Set objSPS = g_App.getSPS()
txtQ.text = Round(objSPS.getQIst, 1)
Me.Visible = True
Sleep 1000, True
txtQ.text = Round(objSPS.getQIst, 1)
End Sub
Private Sub Form_Resize()
Frame2.Width = Me.ScaleWidth - Frame2.Left
Frame2.Height = Me.ScaleHeight - Frame2.Top
lblQist.Width = Frame2.Width - lblQist.Left
lblQist.Height = Frame2.Height - lblQist.Top
End Sub
Private Sub Form_Unload(Cancel As Integer)
g_frmMain.Visible = True
End Sub
Private Sub Timer1_Timer()
Dim QIst As Double
If CDbl(txtQ.text) > 0 And Not m_Referenzzaehler Is Nothing Then
QIst = objSPS.getQIst
lblQsps.Caption = Round(QIst, 3) & " m³/h"
QIst = QIst * (1 - m_Referenzzaehler.letzterFehler(CDbl(txtQ.text)) / 100)
lblQist.Caption = Round(QIst, 3) & " m³/h"
If lblPfad.Caption <> "" Then
Call AppendToFile(lblPfad.Caption, Format(Now, "dd.mm.yyyy hh:nn:ss") & vbTab & Format(QIst, "0.000"))
End If
End If
End Sub