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

2539 lines
72 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmUSFW2Tools
Caption = "Pruef2000 PSE FW2 Tools"
ClientHeight = 9975
ClientLeft = 60
ClientTop = 345
ClientWidth = 16620
LinkTopic = "Form1"
ScaleHeight = 9975
ScaleWidth = 16620
StartUpPosition = 3 'Windows-Standard
Begin VB.Frame Frame6
Caption = "Vor-Justage"
Height = 2715
Left = 10440
TabIndex = 99
Top = 60
Width = 4575
Begin VB.TextBox txtQistRZ
Alignment = 1 'Rechts
Height = 315
Left = 1680
TabIndex = 104
Top = 1320
Width = 1995
End
Begin VB.TextBox txtQSollUS
Alignment = 1 'Rechts
Height = 315
Left = 1680
TabIndex = 103
Top = 1740
Width = 1995
End
Begin VB.TextBox txtFehler
Alignment = 1 'Rechts
Height = 315
Left = 1680
TabIndex = 102
Top = 2160
Width = 1995
End
Begin VB.Timer Timer4
Left = 3900
Top = 360
End
Begin VB.CommandButton cmdStartVP
Caption = "Start"
Height = 495
Left = 180
TabIndex = 101
Top = 300
Width = 1635
End
Begin VB.CommandButton cmdStopVP
Caption = "STOP"
Enabled = 0 'False
Height = 495
Left = 1920
TabIndex = 100
Top = 300
Width = 1635
End
Begin VB.Label Label30
Caption = "IstFluss (RZ)"
Height = 195
Left = 300
TabIndex = 107
Top = 1380
Width = 1095
End
Begin VB.Label Label28
Caption = "SollFluss (US)"
Height = 195
Left = 240
TabIndex = 106
Top = 1800
Width = 1095
End
Begin VB.Label Label27
Caption = "Fehler"
Height = 195
Left = 240
TabIndex = 105
Top = 2220
Width = 1095
End
End
Begin VB.CommandButton cmdFileOpen
Caption = "<22>ffnen"
Height = 225
Left = 4155
TabIndex = 98
Top = 9405
Width = 735
End
Begin VB.CheckBox chkLogFile
Caption = "write log to"
Height = 255
Left = 45
TabIndex = 97
Top = 9405
Width = 1260
End
Begin VB.TextBox txtLogfile
Height = 285
Left = 1380
TabIndex = 96
Text = "c:\RZ-Messung.log"
Top = 9375
Width = 2625
End
Begin VB.Frame Frame3
Caption = "Justage"
Height = 405
Left = 14280
TabIndex = 38
Top = 120
Width = 675
Begin VB.CommandButton cmdKorrektur
Caption = "Korrektur"
Height = 495
Left = 330
TabIndex = 81
Top = 7470
Width = 1935
End
Begin VB.CommandButton cmdKonfigurationsvergleich
Caption = "Konfigurationsvergleich"
Height = 585
Left = 2190
TabIndex = 76
Top = 6420
Width = 2340
End
Begin VB.CommandButton cmdTest
Caption = "test"
Height = 315
Left = 330
TabIndex = 71
Top = 7050
Width = 1635
End
Begin VB.CommandButton cmdFunktionstest
Caption = "Funktionstest"
Height = 495
Left = 360
TabIndex = 70
Top = 6420
Width = 1635
End
Begin VB.Frame Frame4
Height = 5775
Left = 390
TabIndex = 39
Top = 420
Width = 4155
Begin VB.CommandButton cmdJustageStart
Caption = "Justage durchf<68>hren"
Height = 555
Left = 300
TabIndex = 49
Top = 5100
Width = 1275
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGridJustage
Height = 2685
Left = 270
TabIndex = 48
Top = 2310
Width = 3705
_ExtentX = 6535
_ExtentY = 4736
_Version = 393216
End
Begin VB.TextBox txtTimeQi
Alignment = 1 'Rechts
Height = 345
Left = 1770
TabIndex = 47
Text = "120"
Top = 1710
Width = 885
End
Begin VB.TextBox txtQi
Alignment = 1 'Rechts
Height = 345
Left = 1770
TabIndex = 45
Text = "0,1"
Top = 1290
Width = 885
End
Begin VB.TextBox txtTimeQp
Alignment = 1 'Rechts
Height = 345
Left = 1770
TabIndex = 43
Text = "60"
Top = 750
Width = 885
End
Begin VB.TextBox txtQp
Alignment = 1 'Rechts
Height = 345
Left = 1770
TabIndex = 41
Text = "50"
Top = 330
Width = 885
End
Begin VB.Label Label14
Caption = "s"
Height = 285
Left = 2760
TabIndex = 53
Top = 1770
Width = 375
End
Begin VB.Label Label13
Caption = "s"
Height = 285
Left = 2760
TabIndex = 52
Top = 750
Width = 375
End
Begin VB.Label Label12
Caption = "m<>/h"
Height = 285
Left = 2760
TabIndex = 51
Top = 1350
Width = 525
End
Begin VB.Label Label11
Caption = "m<>/h"
Height = 285
Left = 2760
TabIndex = 50
Top = 360
Width = 525
End
Begin VB.Label Label10
Caption = "Pr<50>fzeit 2"
Height = 315
Left = 360
TabIndex = 46
Top = 1740
Width = 1155
End
Begin VB.Label Label9
Caption = "Durchfluss Qi"
Height = 315
Left = 360
TabIndex = 44
Top = 1320
Width = 1155
End
Begin VB.Label Label8
Caption = "Pr<50>fzeit 1"
Height = 315
Left = 360
TabIndex = 42
Top = 780
Width = 1155
End
Begin VB.Label Label7
Caption = "Durchfluss Qp"
Height = 315
Left = 360
TabIndex = 40
Top = 390
Width = 1155
End
End
End
Begin VB.Frame Frame2
Caption = "SPS"
Height = 2175
Left = 0
TabIndex = 21
Top = 5295
Width = 5145
Begin VB.TextBox txtServo
Alignment = 1 'Rechts
Height = 375
Left = 1200
TabIndex = 72
Text = "50"
Top = 720
Width = 735
End
Begin VB.Timer Timer1
Left = 4140
Top = 720
End
Begin VB.CommandButton cmdSPS_Stop
Caption = "STOP"
Enabled = 0 'False
Height = 435
Left = 1500
TabIndex = 31
Top = 1155
Width = 1155
End
Begin VB.CommandButton cmdSPS_Start
Caption = "Start"
Enabled = 0 'False
Height = 435
Left = 210
TabIndex = 30
Top = 1155
Width = 1155
End
Begin VB.TextBox txtQ
Alignment = 1 'Rechts
Height = 315
Left = 1200
TabIndex = 28
Top = 240
Width = 1005
End
Begin VB.Label Label29
Caption = "<22>C"
Height = 225
Left = 4575
TabIndex = 95
Top = 1740
Width = 300
End
Begin VB.Label lblTemp
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 = 405
Left = 3720
TabIndex = 94
Top = 1650
Width = 645
End
Begin VB.Label labelx28
Caption = "Vorlauftemp."
Height = 330
Left = 2715
TabIndex = 93
Top = 1725
Width = 915
End
Begin VB.Label Label25
Caption = "Fehler RZ"
Height = 255
Left = 240
TabIndex = 75
Top = 1710
Width = 975
End
Begin VB.Label lblFehlerRZ
BorderStyle = 1 'Fest Einfach
Height = 375
Left = 1440
TabIndex = 74
Top = 1710
Width = 975
End
Begin VB.Label Label24
Caption = "Servo"
Height = 195
Left = 480
TabIndex = 73
Top = 840
Width = 615
End
Begin VB.Label Label5
Caption = "m<>/h"
Height = 285
Left = 4410
TabIndex = 33
Top = 270
Width = 615
End
Begin VB.Label lblQist
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 3270
TabIndex = 32
Top = 240
Width = 1035
End
Begin VB.Label Label4
Caption = "m<>/h"
Height = 285
Left = 2280
TabIndex = 29
Top = 270
Width = 375
End
Begin VB.Label Label3
Caption = "Durchfluss"
Height = 315
Left = 330
TabIndex = 27
Top = 300
Width = 1455
End
End
Begin VB.Frame frame5
Caption = "Pr<50>fpunkt Messen"
Height = 4410
Left = 5160
TabIndex = 20
Top = 5295
Width = 5145
Begin VB.Timer Timer3
Enabled = 0 'False
Interval = 500
Left = 4320
Top = 3360
End
Begin VB.CommandButton cmdStartRZ
Caption = "Start RZ"
Height = 375
Left = 180
TabIndex = 92
Top = 3750
Width = 1335
End
Begin VB.CommandButton cmdStopRZ
Caption = "Stop RZ"
Height = 375
Left = 1740
TabIndex = 91
Top = 3750
Width = 1335
End
Begin VB.CheckBox chkAutostop
Caption = "NOWA Stop automatisch"
Height = 255
Left = 2280
TabIndex = 79
Top = 840
Width = 2535
End
Begin VB.Timer Timer2
Left = 4440
Top = 240
End
Begin VB.TextBox txtPruefzeit
Alignment = 1 'Rechts
Height = 375
Left = 3090
TabIndex = 36
Text = "60"
Top = 360
Width = 615
End
Begin VB.CommandButton cmdFM85Stop
Caption = "STOP"
Enabled = 0 'False
Height = 435
Left = 240
TabIndex = 35
Top = 960
Width = 1305
End
Begin VB.CommandButton cmdFM85Start
Caption = "START"
Height = 435
Left = 210
TabIndex = 26
Top = 360
Width = 1305
End
Begin VB.Label Label22
Caption = "Fehler"
Height = 225
Left = 240
TabIndex = 65
Top = 3300
Width = 975
End
Begin VB.Label lblFehler
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 345
Left = 2010
TabIndex = 64
Top = 3210
Width = 1275
End
Begin VB.Label Label20
Caption = "Durchfluss"
Height = 225
Left = 210
TabIndex = 63
Top = 2790
Width = 705
End
Begin VB.Label lblRZVolume
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 345
Left = 2850
TabIndex = 62
Top = 1800
Width = 1665
End
Begin VB.Label lblRZ_Durchfluss
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 375
Left = 2850
TabIndex = 61
Top = 2745
Width = 1665
End
Begin VB.Label Label18
Caption = "Referenzz<7A>hler"
Height = 285
Left = 3120
TabIndex = 60
Top = 1560
Width = 1575
End
Begin VB.Label Label17
Caption = "NOWA"
Height = 255
Left = 1230
TabIndex = 59
Top = 1530
Width = 555
End
Begin VB.Label lblNOWA_Durchfluss
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 375
Left = 1050
TabIndex = 58
Top = 2730
Width = 1665
End
Begin VB.Label lblNOWA_Time_s
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 345
Left = 2040
TabIndex = 57
Top = 2250
Width = 1275
End
Begin VB.Label lblNOWA_Volume
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Height = 345
Left = 1050
TabIndex = 56
Top = 1830
Width = 1665
End
Begin VB.Label Label16
Caption = "Pr<50>fzeit"
Height = 225
Left = 270
TabIndex = 55
Top = 2280
Width = 975
End
Begin VB.Label Label15
Caption = "Volume"
Height = 225
Left = 270
TabIndex = 54
Top = 1890
Width = 1245
End
Begin VB.Label Label6
Caption = "Pr<50>fzeit [s]"
Height = 225
Left = 2160
TabIndex = 37
Top = 480
Width = 885
End
End
Begin VB.TextBox txtDebug
Height = 1860
Left = 15
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 19
Top = 7470
Width = 5085
End
Begin VB.Frame Frame1
Height = 5310
Left = 0
TabIndex = 0
Top = 0
Width = 10305
Begin VB.CommandButton cmdSetTimeToZero
Caption = "Time to ZERO"
Height = 285
Left = 3405
TabIndex = 90
ToolTipText = "FW2_SetTimeToZero"
Top = 4680
Width = 1305
End
Begin VB.Timer TimerZeitLesen
Left = 3420
Top = 4725
End
Begin VB.CommandButton cmdZeitSetzen
Caption = "SET"
Height = 285
Left = 2550
TabIndex = 89
Top = 4665
Width = 765
End
Begin VB.CheckBox chkZeitLesen
Caption = "lesen"
Height = 225
Left = 2550
TabIndex = 88
Top = 4995
Width = 1005
End
Begin VB.TextBox txtSec
Alignment = 2 'Zentriert
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 = 1860
TabIndex = 85
Text = "00"
Top = 4695
Width = 525
End
Begin VB.TextBox txtMin
Alignment = 2 'Zentriert
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 = 1170
TabIndex = 84
Text = "00"
Top = 4695
Width = 525
End
Begin VB.TextBox txtHour
Alignment = 2 'Zentriert
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 = 510
TabIndex = 83
Text = "00"
Top = 4695
Width = 525
End
Begin VB.CommandButton cmdClose
Caption = "Close"
Height = 345
Left = 6780
TabIndex = 82
Top = 3840
Width = 1035
End
Begin VB.CommandButton cmdOpen
Caption = "Open"
Height = 345
Left = 5640
TabIndex = 80
Top = 3840
Width = 1035
End
Begin VB.TextBox txtWriteDez
Alignment = 1 'Rechts
Height = 315
Left = 7710
TabIndex = 78
Top = 2940
Width = 2295
End
Begin VB.TextBox txtReadDez
Alignment = 1 'Rechts
BackColor = &H80000004&
Height = 315
Left = 7710
Locked = -1 'True
TabIndex = 77
Top = 2550
Width = 2265
End
Begin VB.ComboBox cmbBaudrate
Height = 315
Left = 8580
TabIndex = 69
Text = "Combo1"
Top = 630
Width = 1395
End
Begin VB.CheckBox chkOptoHeader
Alignment = 1 'Rechts ausgerichtet
Caption = "OptoHeader"
Height = 195
Left = 3690
TabIndex = 67
Top = 600
Value = 1 'Aktiviert
Width = 1305
End
Begin VB.ComboBox cmbEinbauplatz
Height = 315
Left = 1260
TabIndex = 34
Text = "cmbEinbauplatz"
Top = 240
Width = 855
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 8520
Top = 1560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ComboBox cmbInitCmd
Height = 315
Left = 5610
Style = 2 'Dropdown-Liste
TabIndex = 24
Top = 4260
Width = 1965
End
Begin VB.CommandButton cmdINIT_FW2
Caption = "INIT_FW2"
Height = 345
Left = 4200
TabIndex = 23
Top = 4260
Width = 1305
End
Begin VB.CheckBox chkCS_Korrektur
Caption = "TEST_CS"
Height = 315
Left = 6510
TabIndex = 22
Top = 3420
Width = 1095
End
Begin VB.TextBox txtMapfile
Height = 285
Left = 6450
TabIndex = 18
Top = 270
Width = 3525
End
Begin VB.CommandButton cmdQuit
Caption = "ENDE"
Height = 795
Left = 8820
TabIndex = 17
Top = 3780
Width = 1275
End
Begin VB.CommandButton cmdSuch
Caption = "Suchen"
Height = 285
Left = 5940
TabIndex = 16
ToolTipText = "Variable suchen nach Substring"
Top = 900
Width = 855
End
Begin VB.TextBox txtSuch
Height = 285
Left = 4650
TabIndex = 15
Top = 900
Width = 1245
End
Begin VB.CommandButton cmdNowaStop
Caption = "NOWA_STOP"
Height = 345
Left = 4200
TabIndex = 14
Top = 3840
Width = 1305
End
Begin VB.CommandButton cmdNowaStart
Caption = "NOWA_START"
Height = 345
Left = 4200
TabIndex = 13
Top = 3420
Width = 1305
End
Begin VB.TextBox txtWriteVar
Alignment = 1 'Rechts
Height = 315
Left = 5370
TabIndex = 11
Top = 2940
Width = 2265
End
Begin VB.CommandButton cmdWriteVar
Caption = "Write"
Enabled = 0 'False
Height = 315
Left = 4230
TabIndex = 10
Top = 2940
Width = 1005
End
Begin VB.TextBox txtReadvar
Alignment = 1 'Rechts
BackColor = &H80000004&
Height = 315
Left = 5370
Locked = -1 'True
TabIndex = 9
Top = 2550
Width = 2265
End
Begin VB.CommandButton cmdReadVar
Caption = "Read"
Enabled = 0 'False
Height = 315
Left = 4230
TabIndex = 8
Top = 2550
Width = 1005
End
Begin VB.CommandButton cmdDelFavorit
Caption = "-"
Height = 285
Left = 4020
TabIndex = 7
Top = 1320
Width = 555
End
Begin VB.CommandButton cmdAddFavorit
Caption = "+"
Height = 285
Left = 4020
TabIndex = 6
Top = 900
Width = 555
End
Begin VB.ListBox lstFavoriten
Height = 3375
Left = 180
TabIndex = 5
Top = 1260
Width = 3705
End
Begin VB.ComboBox cmbVarname
Height = 315
Left = 180
Style = 2 'Dropdown-Liste
TabIndex = 4
Top = 870
Width = 3735
End
Begin MSCommLib.MSComm MSComm1
Left = 9240
Top = 1740
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton cmdInit
Caption = "Init"
Height = 315
Left = 4590
TabIndex = 3
Top = 240
Width = 945
End
Begin VB.ComboBox cmbComPort
Height = 315
Left = 3240
TabIndex = 2
Text = "Combo1"
Top = 240
Width = 1185
End
Begin VB.Label Label26
Caption = ":"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1740
TabIndex = 87
Top = 4725
Width = 165
End
Begin VB.Label Label23
Caption = ":"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1050
TabIndex = 86
Top = 4725
Width = 165
End
Begin VB.Label Label21
Caption = "Baudrate"
Height = 345
Left = 7470
TabIndex = 68
Top = 690
Width = 795
End
Begin VB.Label Label19
Caption = "Einbauplatz"
Height = 315
Left = 210
TabIndex = 66
Top = 300
Width = 945
End
Begin VB.Label Label2
Caption = "Mapfile:"
Height = 315
Left = 5730
TabIndex = 25
Top = 270
Width = 645
End
Begin VB.Label lblVarname
BorderStyle = 1 'Fest Einfach
Height = 315
Left = 4230
TabIndex = 12
Top = 2130
Width = 3405
End
Begin VB.Label Label1
Caption = "COM Port"
Height = 255
Left = 2460
TabIndex = 1
Top = 300
Width = 765
End
End
End
Attribute VB_Name = "frmUSFW2Tools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const INISECTION = "PSE_FW2_tools"
Private m_COMPort As Integer
Private m_EinbauplatzNr As Integer
Private m_FW_Version As Integer
Private m_FW_Revision As Integer
Private m_strMapfile As String
Private m_strVariablenListeFile As String
Private m_SPS As CSPS
Private m_ColPumpen As Collection
Private m_Referenzzaehler As CRefzaehler
Private m_DurchflussSoll As Double
Private m_FMBus As CFMBus
Dim m_Einbauplatz As CEinbauplatz
Dim m_blnPruefungLaeuft As Boolean
Private m_Nr As Long
Dim m_lngmillisec As Long
Private m_Pumpe As CPumpe
Const FEHLER_ZUSPAET As Long = -15
Const KEIN_FEHLER As Long = 0
Const KEINE_ANTWORT_FEHLER As Long = -16
Private Sub chkLogFile_Click()
If chkLogFile.value = vbChecked Then
If txtLogfile.text <> "" Then
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FileExists(txtLogfile.text) Then
If MsgBox("Datei " & txtLogfile.text & " existiert bereits. M<>chten sie die Datei l<>schen?", vbYesNo Or vbDefaultButton2) = vbYes Then
fso.DeleteFile txtLogfile.text
End If
End If
Else
MsgBox "Bitte Dateinamen angeben!"
txtLogfile.SetFocus
chkLogFile.value = vbUnchecked
End If
End If
End Sub
Private Sub cmbComPort_Change()
ChangeCOMPort
End Sub
Private Sub cmbComPort_Click()
ChangeCOMPort
End Sub
Private Sub ChangeCOMPort()
m_COMPort = Val(cmbComPort.text)
Call g_App.Settings.saveStringValue(INISECTION, "lastCOMPort", CStr(m_COMPort))
End Sub
Private Sub cmbEinbauplatz_Change()
cmbEinbauplatz_Click
End Sub
Private Sub cmbEinbauplatz_Click()
On Error Resume Next
If cmbEinbauplatz.Enabled = False Then Exit Sub
m_EinbauplatzNr = Val(cmbEinbauplatz.text)
m_COMPort = Val(g_App.Settings.getUSComPort(m_EinbauplatzNr))
cmbComPort.text = m_COMPort
m_Einbauplatz.setNr Val(cmbEinbauplatz.text)
Call g_App.Settings.saveStringValue(INISECTION, "lastEinbauplatz", CStr(m_EinbauplatzNr))
End Sub
Private Sub cmbVarname_Click()
If cmbVarname.ListIndex <> -1 And cmbVarname.Enabled = True Then
lblVarname.caption = cmbVarname.List(cmbVarname.ListIndex)
End If
End Sub
Private Sub cmdAddFavorit_Click()
If lstFavoriten.ListIndex >= 0 Then
' nn Position einf<6E>gen
lstFavoriten.AddItem cmbVarname.text, lstFavoriten.ListIndex
lstFavoriten.ListIndex = lstFavoriten.ListIndex - 1
Else
' nm Ende einf<6E>gen
lstFavoriten.AddItem cmbVarname.text
End If
UpdateFavoriten
End Sub
Private Sub cmdFileOpen_Click()
ExecuteAndWait "notepad.exe ", txtLogfile.text, , , False
End Sub
Private Sub cmdOpen_Click()
Dim iReturn As Integer
iReturn = modMBUS_SMS.open_fw2()
PrintStatus "open(): " & iReturn & ": " & modMBUS_SMS.Errorstring(iReturn)
End Sub
Private Sub cmdClose_Click()
Dim iReturn As Integer
iReturn = modMBUS_SMS.close_fw2()
PrintStatus "close(): " & iReturn & ": " & modMBUS_SMS.Errorstring(iReturn)
End Sub
Private Sub cmdQuit_Click()
modMBUS_SMS.IECCOM_CloseCom
Unload Me
End Sub
Private Sub cmdDelFavorit_Click()
Dim LngListindex As Long
Dim strName As String
LngListindex = lstFavoriten.ListIndex
strName = lstFavoriten.List(LngListindex)
lstFavoriten.RemoveItem LngListindex
UpdateFavoriten
If lstFavoriten.ListCount = 0 Then
cmdDelFavorit.Enabled = False
ElseIf LngListindex = lstFavoriten.ListCount Then
' letze Position
lstFavoriten.Selected(LngListindex - 1) = True
Else
' nicht letzte
lstFavoriten.Selected(LngListindex) = True
End If
If strName <> "" Then
On Error Resume Next
cmbVarname.text = strName
End If
End Sub
Private Sub UpdateFavoriten()
Dim Index As Long
Dim strAlles As String
Dim strTrenner As String
strTrenner = ""
For Index = 0 To lstFavoriten.ListCount
If lstFavoriten.List(Index) <> "" Then
strAlles = strAlles & strTrenner & lstFavoriten.List(Index)
strTrenner = ";"
End If
Next
WriteTextToFile strAlles, m_strVariablenListeFile
End Sub
Private Function ReadTextFromFile(strFileName As String)
Dim fso As scripting.FileSystemObject
Dim ts As scripting.TextStream
Set fso = New FileSystemObject
If fso.FileExists(strFileName) Then
Set ts = fso.OpenTextFile(strFileName, ForReading, False, TristateTrue)
ReadTextFromFile = ts.ReadAll
ts.Close
End If
End Function
Private Sub WriteTextToFile(strText As String, strFileName As String)
Dim fso As scripting.FileSystemObject
Dim ts As scripting.TextStream
Set fso = New FileSystemObject
Set ts = fso.CreateTextFile(strFileName, True, True)
ts.Write strText
ts.Close
End Sub
Private Sub AppendTextToFile(strText As String, strFileName As String)
Dim fso As scripting.FileSystemObject
Dim ts As scripting.TextStream
Set fso = New FileSystemObject
Set ts = fso.OpenTextFile(strFileName, ForAppending, True, TristateUseDefault)
ts.Write strText
ts.Close
End Sub
Private Sub cmdFM85Start_Click()
Dim lngPruefzeit_s As Long
cmdFM85Start.Enabled = False
cmdFM85Stop.Enabled = True
lngPruefzeit_s = Val(txtPruefzeit.text)
lblFehler.caption = ""
lblNOWA_Durchfluss.caption = ""
lblRZ_Durchfluss.caption = ""
lblNOWA_Volume.caption = ""
lblRZVolume.caption = ""
lblNOWA_Time_s.caption = ""
Call MessungDurchf<68>hren
txtPruefzeit.text = lngPruefzeit_s
cmdFM85Start.Enabled = True
cmdFM85Stop.Enabled = False
End Sub
Private Sub MessungDurchf<68>hren()
Dim lngPruefzeit_s As Long
g_Abbruch = False
If PruefpunktStart() Then
lngPruefzeit_s = Val(txtPruefzeit.text)
If lngPruefzeit_s > 0 Then
Timer2.Enabled = True
Timer2.Interval = 1000
Call Sleep(lngPruefzeit_s * 1000, True)
Timer2.Enabled = False
End If
End If
If chkAutostop.value = vbChecked Then
PruefpunktStop
End If
End Sub
Private Sub cmdFM85Stop_Click()
g_Abbruch = True
End Sub
Private Function PruefpunktStart() As Boolean
Dim US_COM_Port As Integer
Dim dblTemp As Double
lblNOWA_Volume.caption = ""
Set m_FMBus = g_App.getFMBus
m_EinbauplatzNr = Val(cmbEinbauplatz.text)
Set m_Referenzzaehler = New CRefzaehler
m_Referenzzaehler.loadForDurchfluss m_DurchflussSoll, g_App.Settings.getMIDGruppe
modMBUS_SMS.ReadValue "u32_volume", dblTemp
PrintStatus "Z<>hlerstand: " & dblTemp
m_FMBus.send "**" & m_EinbauplatzNr & "@"
If m_FMBus.receive(500) = "" Then
PrintStatus "FM85 an Einbauplatz " & m_EinbauplatzNr & ": keine Antwort"
PruefpunktStart = False
Exit Function
End If
PrintStatus "Starte Z<>hlung der Referenzz<7A>hler Impulse"
m_FMBus.send "O"
modMBUS_SMS.NOWA_START_FW2
PrintStatus "NOWA_START"
PruefpunktStart = True
End Function
Private Function GetRZVolumen(ByRef dblVolumen As Double) As Long
Dim strTemp As String
Dim Impulse As Long
Set m_FMBus = g_App.getFMBus
dblVolumen = 0
m_FMBus.send "**" & m_EinbauplatzNr & "@"
If m_FMBus.receive(500) = "" Then
GetRZVolumen = -1
Exit Function
End If
m_FMBus.send "L"
strTemp = m_FMBus.receive(1000)
If strTemp = "" Then
GetRZVolumen = -1
Exit Function
End If
If Not IsNumeric("&H0" & strTemp) Then
''WriteToLog "FM85 " & m_Einbauplatz & " antwortet mit " & strTemp
MsgBox "Referenzz<7A>hler antwortet mit '" & strTemp & "'"
Else
Impulse = CLng("&H0" & strTemp)
dblVolumen = Impulse / m_Referenzzaehler.ImpulseQM * 1000 ' in liter
End If
End Function
Private Sub PruefpunktStop()
Dim dblNOWA_Volume As Double
Dim dblNOWA_Time_s As Long
Dim dblRefZVolumen As Double
Dim intTemp As Integer
' Hier gilt NOWA_Timer auch f<>r die Referenzz<7A>hler Impulssz<73>hlung
Set m_FMBus = g_App.getFMBus()
m_FMBus.send "**" & m_EinbauplatzNr & "@"
m_FMBus.receive (500)
Debug.Print "RZ Z<>hlung gestopt"
' Impulse zwischenspeichern
m_FMBus.send "q"
Debug.Print m_FMBus.receive(500)
PrintStatus "NOWA_Stop"
modMBUS_SMS.NOWA_STOP_FW2
If modMBUS_SMS.GetNowaVolume(dblNOWA_Volume) = 0 Then
PrintStatus "NOWA_Volume = " & dblNOWA_Volume
lblNOWA_Volume.caption = Format(dblNOWA_Volume, "0.000")
If modMBUS_SMS.ReadValue("u16_nowa_timer", intTemp) = 0 Then
dblNOWA_Time_s = intTemp * 62.5 / 1000
lblNOWA_Time_s.caption = Format(dblNOWA_Time_s, "0.000")
PrintStatus "NOWA_Time = " & lblNOWA_Time_s
If GetRZVolumen(dblRefZVolumen) = 0 Then
PrintStatus "RefZVolumen (unkorrigiert) = " & dblRefZVolumen
Dim Temperatur As Double
Temperatur = m_SPS.GetEinlaufTemperatur
dblRefZVolumen = dblRefZVolumen / (1 + m_Referenzzaehler.letzterFehler(m_DurchflussSoll, Temperatur) / 100)
PrintStatus "RefZVolumen (mit RZ Fehler korrigiert) = " & Round(dblRefZVolumen, 4) & " Liter"
lblRZVolume.caption = Format(dblRefZVolumen, "0.000")
lblNOWA_Durchfluss.caption = Format(dblNOWA_Volume * 3.6 / (dblNOWA_Time_s), "0.00000")
lblRZ_Durchfluss.caption = Format(dblRefZVolumen * 3.6 / (dblNOWA_Time_s), "0.00000")
Dim dblFehler As Double
dblFehler = ((dblNOWA_Volume - dblRefZVolumen) / dblRefZVolumen) * 100
PrintStatus " Fehler = " & dblFehler
lblFehler.caption = Format(dblFehler, "0.000")
Else
PrintStatus "GetRZVolumen fehlgeschlagen"
End If
Else
PrintStatus "ReadValue(u16_nowa_timer) fehlgeschlagen"
End If
Else
PrintStatus "ReadValue(f_nowa_volume) fehlgeschlagen"
End If
Dim dblTemp As Double
modMBUS_SMS.ReadValue "u32_volume", dblTemp
PrintStatus "Z<>hlerstand: " & dblTemp
End Sub
Private Sub cmdFunktionstest_Click()
On Error Resume Next
frmFunktionstest.Show
End Sub
Private Sub cmdINIT_FW2_Click()
Dim byteCmd As Byte
Dim iReturn As Integer
Me.MousePointer = vbHourglass
cmdINIT_FW2.Enabled = False
DoEvents
byteCmd = Val("&h" & Left(cmbInitCmd.text, 2))
iReturn = modMBUS_SMS.Init_FW2(byteCmd)
PrintStatus "Init_FW2(" & cmbInitCmd.text & ") : " & modMBUS_SMS.Errorstring(iReturn)
Me.MousePointer = vbNormal
cmdINIT_FW2.Enabled = True
End Sub
Private Sub cmdJustageStart_Click()
cmdJustageStart.Enabled = False
MSFlexGridJustage.Clear
txtQ.text = txtQp.text
cmdSPS_Start_Click
txtPruefzeit.text = txtTimeQp.text
cmdFM85Start_Click
cmdSPS_Stop_Click
ShowValueOnFlexgrid "NOWA_Volume Qp", lblNOWA_Volume.caption, MSFlexGridJustage
ShowValueOnFlexgrid "IstFluss2", lblNOWA_Durchfluss.caption, MSFlexGridJustage
ShowValueOnFlexgrid "RZ Volume Qp", lblRZVolume.caption, MSFlexGridJustage
ShowValueOnFlexgrid "IstFluss2", lblNOWA_Durchfluss.caption, MSFlexGridJustage
txtQ.text = txtQi.text
cmdSPS_Start_Click
txtPruefzeit.text = txtTimeQi.text
cmdFM85Start_Click
ShowValueOnFlexgrid "NOWA_Volume Qi", lblNOWA_Volume.caption, MSFlexGridJustage
ShowValueOnFlexgrid "IstFluss1", lblNOWA_Durchfluss.caption, MSFlexGridJustage
ShowValueOnFlexgrid "RZ Volume Qi", lblRZVolume.caption, MSFlexGridJustage
ShowValueOnFlexgrid "IstFluss1", lblNOWA_Durchfluss.caption, MSFlexGridJustage
cmdSPS_Stop_Click
MsgBox "Justage beendet"
cmdJustageStart.Enabled = True
End Sub
Private Sub ShowValueOnFlexgrid(strVarname As String, strValue As String, flexgrid As MSFlexGrid)
Dim row As Integer
For row = 1 To flexgrid.Rows - 1
If flexgrid.TextMatrix(row, 0) = strVarname Then
flexgrid.TextMatrix(row, 1) = strValue
Exit Sub
End If
Next
flexgrid.AddItem strVarname
flexgrid.TextMatrix(flexgrid.Rows - 1, 1) = strValue
End Sub
Private Sub WarteBisSollDurchflussErreicht()
lblQIst.BackColor = vbYellow
Do While Not m_SPS.SolldurchflussErreicht
Sleep 1000, True
Loop
End Sub
Private Sub cmdKonfigurationsvergleich_Click()
Dim objForm As frmUSFW2Konfigurationsvergleich
Set objForm = New frmUSFW2Konfigurationsvergleich
m_Einbauplatz.m_strMapfile = m_strMapfile
m_Einbauplatz.m_strCompareFile = txtMapfile.text ' "C:\CompareFile\DEFAULT.CMP"
m_Einbauplatz.setNr Val(cmbEinbauplatz.text)
Set objForm.m_Einbauplatz = m_Einbauplatz
objForm.Show vbModal, Me
End Sub
Private Sub cmdNowaStart_Click()
Dim iReturn As Integer
cmdNowaStart.Enabled = False
Me.MousePointer = vbHourglass
DoEvents
iReturn = modMBUS_SMS.NOWA_START_FW2
PrintStatus "NOWA_START_FW2: " & modMBUS_SMS.Errorstring(iReturn)
cmdNowaStart.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub cmdNowaStop_Click()
Dim iReturn As Integer
cmdNowaStop.Enabled = False
Me.MousePointer = vbHourglass
DoEvents
iReturn = modMBUS_SMS.NOWA_STOP_FW2
PrintStatus "NOWA_STOP_FW2: " & modMBUS_SMS.Errorstring(iReturn)
cmdNowaStop.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub cmdReadVar_Click()
Dim strVarname As String
Dim varValue As Variant
Dim iReturn As Integer
cmdReadVar.Enabled = False
Me.MousePointer = vbHourglass
txtReadvar.text = ""
DoEvents
strVarname = lblVarname.caption
iReturn = modMBUS_SMS.ReadValue(strVarname, varValue)
PrintStatus "ReadValue: " & modMBUS_SMS.Errorstring(iReturn) & ", " & strVarname & "=" & varValue
If iReturn = MBUS_SMS_ERR_OK Then
txtReadvar.text = CStr(varValue)
If varValue < 2 ^ 16 Then
txtReadDez.text = Hex(varValue)
Else
txtReadDez.text = "??"
End If
End If
cmdReadVar.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub cmdSPS_Stop_Click()
cmdSPS_Stop.Enabled = False
If Not g_ohneSPS Then
m_SPS.SetQSoll 0
m_SPS.AllePumpenAbwaehlen
m_SPS.setBetrieb 0
End If
Timer1.Enabled = False
cmdSPS_Start.Enabled = True
End Sub
Private Sub cmdStartRZ_Click()
cmdStartRZ.Enabled = False
Me.MousePointer = vbHourglass
txtDebug.text = ""
m_lngmillisec = GetTickCount()
If txtQ.text = "" Then
txtQ.text = Round(m_SPS.getQIst, 3) ' wird Komma
End If
lblTemp.caption = Round(m_SPS.GetEinlaufTemperatur, 1)
PrintStatus "Durchfluss: " & txtQ.text & " m<>/h"
Dim dblTemp As Double
Set m_FMBus = g_App.getFMBus
m_EinbauplatzNr = Val(cmbEinbauplatz.text)
Set m_Referenzzaehler = New CRefzaehler
m_DurchflussSoll = Val(Replace(txtQ.text, ",", "."))
If m_Referenzzaehler.loadForDurchfluss(m_DurchflussSoll, g_App.Settings.getMIDGruppe) = False Then
MsgBox "Kein RZ f<>r Durchfluss " & m_DurchflussSoll & " definiert. Bitte Durchfluss angeben!"
txtQ.SetFocus
GoTo Fertig
End If
m_FMBus.send "**" & m_EinbauplatzNr & "@"
If m_FMBus.receive(500) = "" Then
PrintStatus "FM85 an Einbauplatz " & m_EinbauplatzNr & ": keine Antwort"
GoTo Fertig
End If
m_FMBus.send "O"
PrintStatus "Referenzz<7A>hler Volumen-Messung gestartet"
PrintStatus "Vorlauftemperatur: " & Round(m_SPS.GetEinlaufTemperatur, 1) & "<22>C"
m_lngmillisec = GetTickCount()
Timer3.Enabled = True
Timer3.Interval = 100
Fertig:
Me.MousePointer = vbNormal
cmdStartRZ.Enabled = True
End Sub
Private Sub cmdStopRZ_Click()
cmdStopRZ.Enabled = False
Me.MousePointer = vbHourglass
Dim dblRefZVolumen As Double
Dim intTemp As Integer
Dim lngZeit As Long
Dim dblFehler As Double
Timer3.Enabled = False
Set m_FMBus = g_App.getFMBus()
m_FMBus.send "**" & m_EinbauplatzNr & "@"
m_FMBus.receive (500)
' Impulse zwischenspeichern
m_FMBus.send "q"
lngZeit = GetTickCount - m_lngmillisec
Debug.Print m_FMBus.receive(500)
PrintStatus "Pr<50>fzeit " & Round(lngZeit / 1000, 3) & " s"
If GetRZVolumen(dblRefZVolumen) = 0 Then
PrintStatus "RefZVolumen (unkorrigiert) = " & dblRefZVolumen & " Liter"
Dim Temperatur As Double
Temperatur = m_SPS.GetEinlaufTemperatur
PrintStatus "Vorlauftemperatur: " & Round(Temperatur, 1)
dblFehler = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, Temperatur)
PrintStatus "Fehler RZ =" & Round(dblFehler, 4) & "%"
dblRefZVolumen = dblRefZVolumen / (1 + dblFehler / 100)
PrintStatus "RefZVolumen (mit RZ Fehler korrigiert) = " & Round(dblRefZVolumen, 3) & " Liter"
lblRZVolume.caption = Format(dblRefZVolumen, "0.000")
lblNOWA_Time_s.caption = Round(lngZeit / 1000, 1)
lblRZ_Durchfluss.caption = Round(3600 * dblRefZVolumen / lngZeit, 3)
Else
PrintStatus "RefZVolumen konnte nicht ermittelt werden (=0)"
End If
PrintStatus "Referenzz<7A>hler Volumen-Messung beendet"
Fertig:
cmdStopRZ.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub cmdTest_Click()
frmUSFW2Tools.Show
End Sub
Private Sub cmdUpdateQ_Click()
End Sub
Private Sub cmdWriteVar_Click()
Dim strVarname As String
Dim iReturn As Integer
Dim varValue As Variant
cmdWriteVar.Enabled = False
Me.MousePointer = vbHourglass
If txtWriteVar.text <> "" And txtWriteDez.text = "" Then
varValue = CVar(txtWriteVar.text)
ElseIf txtWriteVar.text = "" And txtWriteDez.text <> "" Then
varValue = CVar("&H" & txtWriteDez.text)
Else
cmdWriteVar.Enabled = True
Me.MousePointer = vbNormal
Exit Sub
End If
strVarname = lblVarname.caption
iReturn = modMBUS_SMS.WriteValue(strVarname, varValue)
PrintStatus "WriteValue: " & modMBUS_SMS.Errorstring(iReturn) & ", " & strVarname & "=" & varValue
If chkCS_Korrektur.value = vbChecked Then
iReturn = modMBUS_SMS.do_test2(&HE8, &H5A)
PrintStatus "do_test2(TEST_CS): " & modMBUS_SMS.Errorstring(iReturn)
End If
cmdWriteVar.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub cmdSuch_Click()
Dim lngIndex As Long
Dim lngStart As Long
lngStart = cmbVarname.ListIndex
lngIndex = cmbVarname.ListIndex + 1
If lngIndex > cmbVarname.ListCount - 1 Then
lngIndex = 0
End If
Do While lngIndex < cmbVarname.ListCount - 1
If InStr(1, LCase(cmbVarname.List(lngIndex)), LCase(txtSuch.text)) > 0 Then
cmbVarname.ListIndex = lngIndex
Exit Sub
End If
lngIndex = lngIndex + 1
Loop
If cmbVarname.ListIndex = lngStart Then
If cmbVarname.ListCount > 0 Then
cmbVarname.ListIndex = 0
End If
Else
cmbVarname.ListIndex = lngStart
End If
beep
End Sub
'Private Sub Command1_Click()
'
' Dim strFavoriten As String
' strFavoriten = ReadTextFromFile(m_strVariablenListeFile)
' strFavoriten = Replace(strFavoriten, vbCr, "")
' strFavoriten = Replace(strFavoriten, vbLf, "")
'
' Dim arVars() As String
' Dim varname As Variant
' MSFlexGrid1.Clear
' MSFlexGrid1.Rows = 1
' MSFlexGrid1.TextMatrix(0, 0) = "Variablenname"
' MSFlexGrid1.Cols = 1
'
' arVars = Split(strFavoriten, ";")
' For Each varname In arVars
' MSFlexGrid1.AddItem varname
' Next
'
' AutoSpaltenBreite MSFlexGrid1, lblAutosize
'End Sub
Private Sub Form_Load()
If g_App Is Nothing Then
Set g_App = New CApplication
End If
If m_SPS Is Nothing Then
Set m_SPS = g_App.getSPS
End If
Dim i As Integer
cmbComPort.Clear
cmbComPort.text = ""
For i = 1 To 16
If TestComPort(i) Then
cmbComPort.AddItem i
If Val(g_App.Settings.readStringValue(INISECTION, "lastCOMPort", "")) = i Then
cmbComPort.ListIndex = cmbComPort.ListCount - 1
End If
End If
Next
m_strVariablenListeFile = App.Path & "\FW2_Variablen.txt"
Dim strFavoriten As String
strFavoriten = ReadTextFromFile(m_strVariablenListeFile)
strFavoriten = Replace(strFavoriten, vbCr, "")
strFavoriten = Replace(strFavoriten, vbLf, "")
Dim arVars() As String
Dim Varname As Variant
lstFavoriten.Clear
arVars = Split(strFavoriten, ";")
For Each Varname In arVars
lstFavoriten.AddItem Varname
Next
lstFavoriten.AddItem ""
cmbInitCmd.Clear
'cmbInitCmd.AddItem "01 INIT_PSE"
cmbInitCmd.AddItem "02 INIT_KEV1"
cmbInitCmd.ListIndex = cmbInitCmd.ListCount - 1
'cmbInitCmd.AddItem "04 INIT_HISTORICAL_DATA"
'cmbInitCmd.AddItem "08 INIT_LOGGER_HOURLY"
'cmbInitCmd.AddItem "10 RESET_PSE"
cmbInitCmd.AddItem "20 RESET_KEV1"
'cmbInitCmd.AddItem "40 INIT_LOGGER_DAILY"
Set m_ColPumpen = g_App.Settings.getPumpen
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang
Debug.Print "Einbauplatz " & i & " = COM " & g_App.Settings.getUSComPort(i)
If Val(g_App.Settings.getUSComPort(i)) > 0 Then
cmbEinbauplatz.AddItem i
If Val(g_App.Settings.readStringValue(INISECTION, "lastEinbauplatz", "")) = i Then
cmbEinbauplatz.Enabled = False
cmbEinbauplatz.ListIndex = cmbEinbauplatz.ListCount - 1
cmbEinbauplatz.Enabled = True
End If
End If
Next
If m_FMBus Is Nothing Then
Set m_FMBus = New CFMBus
End If
cmbBaudrate.Clear
cmbBaudrate.AddItem 1200
cmbBaudrate.AddItem 2400
cmbBaudrate.ListIndex = cmbBaudrate.ListCount - 1
cmbBaudrate.AddItem 4800
cmbBaudrate.AddItem 9600
cmbBaudrate.AddItem 19200
txtQ_Change
Set m_Einbauplatz = New CEinbauplatz
chkZeitLesen_Click
End Sub
Private Function TestComPort(ComportNr As Integer) As Boolean
On Error GoTo Errorhandler
MSComm1.CommPort = ComportNr
MSComm1.PortOpen = True
DoEvents
MSComm1.PortOpen = False
TestComPort = True
Exit Function
Errorhandler:
' MSComm1.PortOpen = False
TestComPort = False
End Function
Private Sub cmdInit_Click()
Dim iReturn As Integer
Dim sBuffer As String
cmdInit.Enabled = False
Me.MousePointer = vbHourglass
cmbVarname.Clear
m_strMapfile = "\\sla12file\PolluStatDataExchangeLULA\Mapfiles\PSEV523_R286.txt"
DoEvents
If FileSystem.Dir(m_strMapfile) = "" Then
iReturn = modMBUS_SMS.fw2_open_comport(m_COMPort, CInt(Val(cmbBaudrate.text)), "", chkOptoHeader.value = vbChecked, 1)
Else
iReturn = modMBUS_SMS.fw2_open_comport(m_COMPort, CInt(Val(cmbBaudrate.text)), m_strMapfile, chkOptoHeader.value = vbChecked, 1)
End If
PrintStatus "Open Comport " & m_COMPort & " : " & iReturn & " " & modMBUS_SMS.Errorstring(iReturn)
If iReturn = MBUS_SMS_ERR_OK Then
'reqUD2
sBuffer = Space(250)
iReturn = modMBUS_SMS.REQ_UD2(sBuffer)
PrintStatus "REQ_UD2: " & modMBUS_SMS.Errorstring(iReturn)
If iReturn = MBUS_SMS_ERR_OK Then
' PSE erkannt
PrintStatus "REQ_UD2 Ausgabe: " & Trim(sBuffer)
PrintStatus ""
' Firmware Generation bestimmen
Const BytePosition = 7
Const LaengeBytes = 1
sBuffer = Mid(sBuffer, BytePosition * 2 - 1, LaengeBytes * 2)
Select Case LCase(sBuffer)
Case "60", "61"
PrintStatus "Generationbyte: " & sBuffer & " => FW 1"
Case "0e", "0f", "10", "11", "12", "13"
PrintStatus "Generationbyte: " & sBuffer & " => FW 2"
iReturn = modMBUS_SMS.read_Word("u16_fw_version", m_FW_Version)
PrintStatus "readULong u16_fw_version " & modMBUS_SMS.Errorstring(iReturn)
If iReturn = MBUS_SMS_ERR_OK Then
PrintStatus "u16_fw_version=" & m_FW_Version
iReturn = modMBUS_SMS.read_Word("u16_fw_revision", m_FW_Revision)
PrintStatus "readULong u16_fw_revision" & modMBUS_SMS.Errorstring(iReturn)
If iReturn = MBUS_SMS_ERR_OK Then
PrintStatus "m_fw_revision = " & m_FW_Revision
Dim strMapfileTest As String
strMapfileTest = "\\sla12file\PolluStatDataExchangeLULA\Mapfiles\PSEV523_R286.txt"
'strMapfileTest = "\\sla12file\PolluStatDataExchangeLULA\Mapfiles\PSEV" & m_fw_version & "_R" & m_fw_revision & ".txt"
TryAgain:
If Dir(strMapfileTest) <> "" Then
m_strMapfile = strMapfileTest
PrintStatus "loading Mapfile " & strMapfileTest
txtMapfile.text = strMapfileTest
iReturn = modMBUS_SMS.IECCOM_CloseCom
iReturn = modMBUS_SMS.fw2_open_comport(m_COMPort, 1, m_strMapfile, True)
m_Einbauplatz.m_strMapfile = strMapfileTest
m_Einbauplatz.m_iComport = Val(cmbComPort.text)
PrintStatus modMBUS_SMS.Errorstring(iReturn)
Else
PrintStatus "Mapfile " & strMapfileTest & " does not exist!"
CommonDialog1.filename = strMapfileTest
CommonDialog1.ShowOpen
strMapfileTest = CommonDialog1.filename
GoTo TryAgain
End If
End If
End If
If Dir(m_strMapfile) <> "" Then
FillcmbVarnames
PrintStatus cmbVarname.ListCount & " Variablen geladen"
cmdReadVar.Enabled = True
cmdWriteVar.Enabled = True
Else
PrintStatus "Mapfile " & m_strMapfile & " nicht gefunden"
End If
Case Else
PrintStatus "Generationbyte: " & sBuffer & " => FW ?"
End Select
End If
End If
'iReturn = modMBUS_SMS.IECCOM_CloseCom
cmdInit.Enabled = True
Me.MousePointer = vbNormal
End Sub
Private Sub PrintStatus(strText As String)
Debug.Print strText
If txtLogfile.text <> "" And chkLogFile.value = vbChecked Then
AppendTextToFile Format(Now, "yyyy-mm-dd hh:mm:ss") & vbTab & strText & vbCrLf, txtLogfile.text
End If
txtDebug.text = txtDebug.text & strText & vbCrLf
txtDebug.SelStart = Len(txtDebug.text)
txtDebug.SelLength = 0
DoEvents
End Sub
Private Sub FillcmbVarnames()
Dim fso As scripting.FileSystemObject
Dim fsoFile As scripting.TextStream
Dim strZeile As String
Dim Varname As String
Set fso = New scripting.FileSystemObject
Set fsoFile = fso.OpenTextFile(m_strMapfile, ForReading, False)
cmbVarname.Enabled = False
cmbVarname.Clear
Do While Not fsoFile.AtEndOfStream
strZeile = fsoFile.ReadLine
If InStr(1, Left(strZeile, 4), "_") > 0 Then
Varname = Split(strZeile, ";")(0)
cmbVarname.AddItem Varname
cmbVarname.ListIndex = cmbVarname.ListCount - 1
DoEvents
End If
Loop
cmbVarname.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
PrintStatus "***********************"
TimerZeitLesen.Enabled = False
modMBUS_SMS.IECCOM_CloseCom
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
End Sub
Private Sub lstFavoriten_Click()
If lstFavoriten.SelCount = 1 Then
lblVarname.caption = lstFavoriten.List(lstFavoriten.ListIndex)
End If
End Sub
Private Sub Timer1_Timer()
If Not g_ohneSPS Then
lblQIst.caption = Format(m_SPS.getQIst, "0.000")
If m_SPS.SolldurchflussErreicht Then
lblQIst.BackColor = vbGreen
Else
lblQIst.BackColor = vbYellow
End If
End If
End Sub
Private Sub Timer2_Timer()
txtPruefzeit.text = Val(txtPruefzeit.text - 1)
End Sub
Private Sub Timer3_Timer()
lblNOWA_Time_s.caption = Round((GetTickCount - m_lngmillisec) / 1000, 2)
lblTemp.caption = Round(m_SPS.GetEinlaufTemperatur, 1)
End Sub
Private Sub txtQ_Change()
' Val m<>chte "." als Dezimaltrennzeichen
If Val(Replace(txtQ.text, ",", ".")) > 0 Then
cmdSPS_Start.Enabled = True
Else
cmdSPS_Start.Enabled = False
End If
End Sub
Private Sub txtQ_KeyPress(KeyAscii As Integer)
' Wir m<>chten im Textfeld das , als Dezimaltrenner
Debug.Print KeyAscii
Select Case KeyAscii
Case 44, 46 ' aus . wird
KeyAscii = 44
If InStr(1, txtQ.text, ",") > 0 Then
KeyAscii = 0
PrintStatus "In deisem Eingabefeld ist nur ein Komma erlaubt."
End If
Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57 ' Ziffern 0-9
Case 8, 3, 22, 24, 13 ' BS
Case Else
PrintStatus "Eingabe von '" & Chr(KeyAscii) & "' nicht m<>glich"
KeyAscii = 0
End Select
End Sub
Private Sub txtQ_Validate(Cancel As Boolean)
' Wir m<>chten im Textfeld das , als Dezimaltrenner
txtQ.text = Replace(txtQ.text, ".", ",")
End Sub
Private Sub txtSuch_Change()
If Trim(txtSuch.text) <> "" Then
cmdSuch.Enabled = True
cmdSuch.Default = True
End If
End Sub
Sub AutoSpaltenBreite(flexgrid As MSFlexGrid, SizeLbl As Label)
Dim Spalte As Long
Dim Zeile As Integer
Dim Breite As Double
With flexgrid
' Font-Eigenschaften des Flexgrids auf Label
' <20>bertragen
SizeLbl.Font = .Font
SizeLbl.FontSize = .Font.Size
SizeLbl.FontItalic = .Font.Italic
SizeLbl.FontBold = .Font.Bold
' Autosize des Labels aktivieren und Label
' ausblenden
SizeLbl.AutoSize = True
SizeLbl.Visible = False
' Aktualisierung des Flexgrids verhindern, bis
' Vorgang abgeschlossen ist
.Redraw = False
' Flexgrid spaltenweise "abtasten"...
For Spalte = 0 To .Cols - 1
' ermittelte H<>chstbreite vor jedem
' Spaltendurchlauf zur<75>cksetzen
Breite = 0
' Alle Zeilen der aktuellen Spalte durchlaufen...
For Zeile = 0 To .Rows - 1
' Inhalt der aktuellen Zelle in Label schreiben...
SizeLbl.caption = .TextMatrix(Zeile, Spalte)
' Ist die aktuelle Breite des Labels gr<67><72>er als die
' bisher ermittelte h<>chste Breite ?
If SizeLbl.Width > Breite Then
' Ja, dann Breite in VAR Breite ablegen
Breite = SizeLbl.Width
End If
Next Zeile
' Wenn alle Zeilen der aktuellen Spalte durchlaufen sind,
' ermittelte h<>chste Spaltenbreite als optimale Spaltenbreite
' der aktuellen Zeile des Flexgrids setzen
.ColWidth(Spalte) = Breite * 1.1 + 50
Next Spalte
' Aktualiaierung des Flexgrids wieder zulassen
.Redraw = True
End With
End Sub
Private Sub txtSuch_KeyPress(KeyAscii As Integer)
If Trim(txtSuch.text) <> "" Then
cmdSuch.Enabled = True
End If
End Sub
Private Sub cmdSPS_Start_Click()
Dim dblLetzterFehler As Double
cmdSPS_Start.Enabled = False
Me.MousePointer = vbHourglass
Dim Pumpe As CPumpe
cmdSPS_Stop.Enabled = True
m_DurchflussSoll = Val(Replace(txtQ.text, ",", "."))
m_DurchflussSoll = CDbl(txtQ.text)
Dim Temperatur As Double
If Not g_ohneSPS Then
' todo Pr<50>fbereitschaft testen
Set m_Referenzzaehler = New CRefzaehler
m_Referenzzaehler.loadForDurchfluss m_DurchflussSoll, g_App.Settings.getMIDGruppe
Temperatur = m_SPS.GetEinlaufTemperatur()
lblTemp.caption = Round(Temperatur, 1)
dblLetzterFehler = m_Referenzzaehler.letzterFehler(m_DurchflussSoll, Temperatur)
lblFehlerRZ.caption = Format(dblLetzterFehler, "0.000")
m_SPS.setBehaelter 1 ' Durchlauf
initSPSfuerPP
m_SPS.setBetrieb 2
WarteBisSollDurchflussErreicht
txtServo.text = m_SPS.GetStellwert
Timer1.Interval = 1000
Timer1.Enabled = True
Else
MsgBox "Keine Verbindung zur SPS! Bitte Durchfluss " & m_DurchflussSoll & " starten"
End If
Me.MousePointer = vbNormal
End Sub
Private Function initSPSfuerPP()
' SPS f<>r diesen Pr<50>fpunkt initialisieren, unabh<62>ngig von Waage/Beh<65>lter oder Durchlauf
' -------------------------------------------------------------------------------------
' Betrieb stoppen und Pumpen Abw<62>hlen
' Durchflu<6C> vorgabe
' Pumpe ausw<73>hlen und anw<6E>hlen
' Regelart und Regel-Position setzen
' MID Strang setzen
Dim i As Integer
Dim iStellwert As Integer
Dim AnzahlPP As Integer
' Betrieb Start zur<75>cksetzen
m_SPS.setBetrieb 8
Sleep 500
m_SPS.setBetrieb 0
PrintStatus "*********************"
m_SPS.SetQSoll m_DurchflussSoll
PrintStatus "N<>chster Durchfluss: " & m_DurchflussSoll
' Pumpenauswahl
' Hochbeh<65>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")
' Wenn letzter PP
'AnzahlPP = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkteCount
'If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(AnzahlPP).getQ Then
' iStellwert = getUSVoreinstellwert(m_DurchflussSoll, True)
'Else
' ' Formel f<>r ServoPosition zur Feinregulierung des Durchflusses
' iStellwert = CInt(lookupFUServoStellwert(m_DurchflussSoll, "Servo"))
'End If
iStellwert = Val(txtServo.text)
Case "FU"
' Frequenzumrichter vorgeschrieben
m_SPS.SetRegelart ("FU")
' Formel f<>r ServoPosition zur Feinregulierung des Durchflusses
iStellwert = 50
' If m_DurchflussSoll = m_ersterPruefzaehler.getPruefpunkte.getPruefpunkt(1).getQ Then
' iStellwert = getUSVoreinstellwert(m_DurchflussSoll, False)
' Else
' iStellwert = 50
' End If
Case Else
ErrorMsg "Es ist keine Regelart f<>r die Pumpe " & m_Pumpe.getNr & " in der ini-Datei definiert."
'Call Abbruch
Exit Function
End Select
If iStellwert > 100 Then iStellwert = 100
PrintStatus "Stellwert: " & iStellwert
m_SPS.SetServoStellung iStellwert
' Vorwahl Referenzzaehler
m_SPS.SetMID m_Referenzzaehler.EinbauplatzNr
m_SPS.SetQDiff 0
End Function
Private Sub txtWriteDez_Change()
txtWriteVar.text = ""
End Sub
Private Sub txtWriteVar_Change()
txtWriteDez.text = ""
End Sub
Private Sub cmdKorrektur_Click()
Korrektur "u8_us_para_version", 2
'Korrektur "f_fp_o_geber", 0
Korrektur "f_fp_k_geber1", 0.00809
Korrektur "f_fp_k_geber2", 0.00809
Korrektur "f_fp_qoffset1", 0
Korrektur "f_fp_qoffset2", 0
Korrektur "f_fp_st_geber", 0
Korrektur "f_fp_bereich", 0
Korrektur "f_fp_flow_max", 0.009722223
Korrektur "f_fp_flow_min", 0.0000083333
Korrektur "f_fp_flow_simu", 0.004166667
Korrektur "u32_asic_sr1", &H6A60110
Korrektur "u32_asic_sr2", &H12BA0FF
Korrektur "u32_asic_sr3", &H3308200
Korrektur "f_fp_impulswertigkeit", 10
Korrektur "f_fp_impulswertigkeit_pruef", 0.08
';i32_difftof_min , -525
Korrektur "u16_flow_nominal", 150
MsgBox "Fertig"
End Sub
Private Sub Korrektur(strVarname As String, varSollwert As Variant)
Dim lngRet As Long
Dim varValue As Variant
Dim iret As Integer
Test:
iret = modMBUS_SMS.ReadValue(strVarname, varValue)
If iret = MBUS_SMS_ERR_OK Then
If varValue = varSollwert Then
MsgBox strVarname & "= " & varSollwert & " OK"
Else
lngRet = MsgBox("IstW: " & strVarname & "=" & Format(varValue, "0.000000000000") & vbCrLf & "Soll " & strVarname & " mit " & Format(varSollwert, "0.000000000000") & " korrigiert werden?", vbYesNoCancel Or vbDefaultButton2)
If lngRet = vbYes Then
iret = modMBUS_SMS.WriteValue(strVarname, varSollwert)
If iret = MBUS_SMS_ERR_OK Then
GoTo Test
Else
MsgBox "Fehler beim schreiben: " & iret & ": " & modMBUS_SMS.Errorstring(iret)
End If
Else
If lngRet = vbCancel Then Exit Sub
End If
End If
Else
MsgBox "Fehler beim lesen: " & iret & ": " & modMBUS_SMS.Errorstring(iret)
End If
End Sub
Private Sub TimerZeitLesen_Timer()
UpdateZeit
End Sub
Private Sub UpdateZeit()
Dim dblZeit As Double
Label26.Visible = False
Label23.Visible = True
DoEvents
If FW2_GetTime(m_Einbauplatz, dblZeit) = 0 Then
Label26.Visible = True
Label23.Visible = False
DoEvents
txtHour.text = Format(Hour(dblZeit), "00")
txtMin.text = Format(Minute(dblZeit), "00")
txtSec.text = Format(Second(dblZeit), "00")
DoEvents
Else
txtHour.text = "?"
txtMin.text = "?"
txtSec.text = "?"
End If
End Sub
Private Sub cmdZeitSetzen_Click()
Dim dblZeit As Double
dblZeit = TimeSerial(Val(txtHour.text), Val(txtMin.text), Val(txtSec.text))
Call FW2_SetTime(m_Einbauplatz, dblZeit)
ClearTime
UpdateZeit
'fw2_open_comport m_COMPort,
End Sub
Private Sub chkZeitLesen_Click()
If chkZeitLesen.value = vbChecked Then
Call ClearTime
TimerZeitLesen.Interval = 300
TimerZeitLesen.Enabled = True
cmdZeitSetzen.Enabled = False
Else
TimerZeitLesen.Enabled = False
cmdZeitSetzen.Enabled = True
End If
End Sub
Private Sub ClearTime()
txtHour.text = ""
txtMin.text = ""
txtSec.text = ""
DoEvents
End Sub
Private Sub cmdSetTimeToZero_Click()
Call FW2_SetTimeToZero(m_Einbauplatz)
ClearTime
UpdateZeit
End Sub
Private Sub cmdStart_Click()
If m_blnPruefungLaeuft = True Then
Timer4.Enabled = False
Call MessungVP
Timer4.Enabled = True
Else
Timer4.Enabled = False
End If
End Sub
Private Sub cmdStartVP_Click()
cmdStartVP.Enabled = False
cmdStopVP.Enabled = True
m_Nr = GetTickCount
WriteToFile "C:\FW2Durchflusslog.csv", "Nr;Q_FM85;Q_USZ;Fehler"
m_blnPruefungLaeuft = True
Timer4.Interval = 100
Timer4.Enabled = True
End Sub
Private Sub cmdStopVP_Click()
Timer4.Enabled = False
m_blnPruefungLaeuft = False
cmdStartVP.Enabled = True
cmdStopVP.Enabled = False
WriteToFile "C:\FW2Durchflusslog.csv", ""
End Sub
Private Sub MessungVP()
Dim dblQIstRZ As Double
Dim dblQSollUS As Double
Dim dblFehler As Double
If g_ohneSPS Then
dblQIstRZ = 123
Else
dblQIstRZ = m_SPS.getQIst
End If
txtQistRZ.text = Format(dblQIstRZ, "0.0000")
If modUSchall.FW2_ReadVar(m_Einbauplatz, "u32_flow", dblQSollUS) = 0 Then
dblQSollUS = dblQSollUS / 100
txtQSollUS.text = Format(dblQSollUS, "0.0000")
Else
Debug.Print "Flow konnte nicht gelesen werden"
dblQSollUS = 124
txtQSollUS.text = Format(dblQSollUS, "0.0000")
End If
If dblQIstRZ > 0 And dblQSollUS > 0 Then
dblFehler = 100 * (dblQSollUS - dblQIstRZ) / dblQIstRZ
txtFehler.text = Format(dblFehler, "0.000")
End If
WriteToFile "C:\FW2Durchflusslog.csv", Int((GetTickCount - m_Nr) / 100) & ";" & txtQistRZ.text & ";" & txtQSollUS.text & ";" & txtFehler.text
End Sub
Private Sub WriteToFile(LogFilePath As String, sText As String)
Debug.Print sText
If LogFilePath <> "" Then
LogFileHandle = FreeFile()
Open LogFilePath For Append As LogFileHandle
Print #LogFileHandle, sText
Close #LogFileHandle
End If
End Sub
Private Sub Timer4_Timer()
Call MessungVP
End Sub