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

1734 lines
47 KiB
Plaintext

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmTest
Caption = "Pruef2000"
ClientHeight = 13470
ClientLeft = 60
ClientTop = 345
ClientWidth = 15285
LinkTopic = "Form1"
ScaleHeight = 13470
ScaleWidth = 15285
StartUpPosition = 3 'Windows-Standard
Begin VB.CommandButton Command36
Caption = "korrektur 1"
Height = 315
Left = 8640
TabIndex = 99
Top = 60
Width = 1455
End
Begin VB.CommandButton Command35
Caption = "Prueffehler =>Eichung"
Height = 735
Left = 3420
TabIndex = 98
Top = 10860
Width = 1635
End
Begin VB.CommandButton Command34
Caption = "Schott"
Height = 675
Left = 660
TabIndex = 97
Top = 10920
Width = 2535
End
Begin VB.CommandButton cmdIniCOM
Caption = "US COM aus Ini"
Height = 555
Left = 8700
TabIndex = 96
Top = 3120
Width = 1155
End
Begin VB.CommandButton Command33
Caption = "BUP SEMI"
Height = 555
Left = 2460
TabIndex = 95
Top = 9180
Width = 1515
End
Begin VB.CommandButton Command32
Caption = "AES"
Height = 435
Left = 14160
TabIndex = 94
Top = 4980
Width = 855
End
Begin VB.CommandButton Command25
Caption = "Prüfprotokoll für einen Prüfgang"
Height = 495
Left = 4980
TabIndex = 93
Top = 9660
Width = 1575
End
Begin VB.CommandButton Command31
Caption = "Command31"
Height = 585
Left = 13320
TabIndex = 92
Top = 9690
Width = 1215
End
Begin VB.CommandButton cmdTestFW2
Caption = "FW2 Fkt Test"
Height = 405
Left = 60
TabIndex = 91
Top = 9960
Width = 2295
End
Begin VB.CommandButton Command30
Caption = "Mail senden"
Height = 255
Left = 1080
TabIndex = 90
Top = 9360
Width = 1035
End
Begin VB.CommandButton Command29
Caption = "Auswertung Q3 Q2 Q1"
Height = 1035
Left = 8220
TabIndex = 89
Top = 9180
Width = 2235
End
Begin VB.CommandButton Command28
Caption = "off forms"
Height = 465
Left = 7020
TabIndex = 88
Top = 60
Width = 825
End
Begin VB.CommandButton Command27
Caption = "AlleBehaelterLeeren"
Height = 495
Left = 12300
TabIndex = 87
Top = 8640
Width = 1710
End
Begin VB.TextBox txtQtest
Alignment = 1 'Rechts
Height = 375
Left = 13125
TabIndex = 85
Text = "Text9"
Top = 2385
Width = 1395
End
Begin VB.CommandButton Command26
Caption = "Prüfgang PPx_T_Start/Ende"
Height = 675
Left = 12840
TabIndex = 84
Top = 210
Width = 1965
End
Begin VB.CommandButton Command24
Caption = "test fertigmeldemail"
Height = 765
Left = 10305
TabIndex = 83
Top = 8580
Width = 1635
End
Begin VB.CommandButton Command23
Caption = "Command23"
Height = 975
Left = 12720
TabIndex = 82
Top = 1110
Width = 885
End
Begin VB.TextBox txtProcessname
Height = 285
Left = 10260
TabIndex = 81
Text = "Notepad"
Top = 7680
Width = 1935
End
Begin VB.CommandButton cmdKill
Caption = "Kill"
Height = 345
Left = 12300
TabIndex = 80
Top = 7770
Width = 885
End
Begin VB.Frame Frame8
Caption = " Einbaulage "
Height = 2115
Left = 8220
TabIndex = 74
Top = 420
Width = 1605
Begin VB.OptionButton optEinbaulage
Caption = "Fallleitung"
Height = 255
Index = 4
Left = 150
TabIndex = 79
Tag = "F"
Top = 1380
Width = 1215
End
Begin VB.OptionButton optEinbaulage
Caption = "vertikal"
Height = 375
Index = 2
Left = 150
TabIndex = 78
Tag = "V"
Top = 660
Width = 1185
End
Begin VB.OptionButton optEinbaulage
Caption = "Steigleitung"
Height = 255
Index = 3
Left = 150
TabIndex = 77
Tag = "S"
Top = 1050
Width = 1155
End
Begin VB.OptionButton optEinbaulage
Caption = "horizontal"
Height = 375
Index = 1
Left = 150
TabIndex = 76
Tag = "H"
Top = 330
Width = 1125
End
Begin VB.OptionButton optEinbaulage
Caption = "-unsichtbar-"
Height = 255
Index = 0
Left = 150
TabIndex = 75
Top = 1740
Value = -1 'True
Visible = 0 'False
Width = 1215
End
End
Begin VB.CommandButton Command22
Caption = "RZAbbruch"
Height = 525
Left = 6600
TabIndex = 73
Top = 1560
Width = 1125
End
Begin VB.CommandButton Command21
Caption = "Mail fertighmelde test"
Height = 525
Left = 5520
TabIndex = 72
Top = 330
Width = 1125
End
Begin VB.CommandButton cmdDruckprüfung
Caption = "SerienNr durch FabNr in Druckprüfung nachtragen"
Height = 675
Left = 12030
TabIndex = 71
Top = 6990
Width = 1995
End
Begin VB.Frame Frame7
Caption = "Gewicht -> Volumen"
Height = 1035
Left = 5040
TabIndex = 63
Top = 8040
Width = 2355
Begin VB.CommandButton cmdGewicht2Volumen
Caption = "G 2 V"
Height = 315
Left = 60
TabIndex = 67
Top = 600
Width = 555
End
Begin VB.TextBox txtT
Alignment = 1 'Rechts
Height = 285
Left = 1500
TabIndex = 66
Text = "22"
Top = 180
Width = 495
End
Begin VB.TextBox txtGewicht2Vol
Alignment = 1 'Rechts
Height = 315
Left = 60
TabIndex = 64
Text = "100"
Top = 180
Width = 855
End
Begin VB.Label Label6
Caption = "m³"
Height = 315
Left = 2040
TabIndex = 70
Top = 660
Width = 255
End
Begin VB.Label Label5
Caption = "°C"
Height = 315
Left = 2040
TabIndex = 69
Top = 240
Width = 195
End
Begin VB.Label Label4
Caption = "kg"
Height = 315
Left = 960
TabIndex = 68
Top = 240
Width = 315
End
Begin VB.Label lblVol
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = " Volumen "
Height = 315
Left = 780
TabIndex = 65
Top = 600
Width = 1155
End
End
Begin VB.TextBox TextT
Height = 345
Left = 11280
TabIndex = 62
Top = 330
Width = 495
End
Begin VB.CommandButton Command20
Caption = "T"
Height = 585
Left = 10620
TabIndex = 61
Top = 240
Width = 585
End
Begin VB.CommandButton cmdDBTest
Caption = "DB Test 1"
Height = 675
Left = 10860
TabIndex = 54
Top = 1920
Width = 1215
End
Begin VB.CommandButton Command19
Caption = "load VorPruefpunkte"
Height = 435
Left = 10620
TabIndex = 53
Top = 7080
Width = 1395
End
Begin VB.TextBox txtStellwert
Height = 1515
Left = 7500
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 50
Top = 7560
Width = 2655
End
Begin VB.CommandButton Command18
Caption = "Stellwert"
Height = 315
Left = 6540
TabIndex = 49
Top = 7620
Width = 855
End
Begin VB.TextBox txtQ
Height = 315
Left = 5460
TabIndex = 48
Text = "80"
Top = 7620
Width = 975
End
Begin VB.CommandButton Command17
Caption = "Druck test"
Height = 795
Left = 6900
TabIndex = 46
Top = 2280
Width = 735
End
Begin VB.TextBox Text8
Height = 285
Left = 12120
TabIndex = 45
Text = "test"
Top = 4140
Width = 615
End
Begin VB.TextBox Text7
Height = 255
Left = 12780
TabIndex = 44
Text = "2"
Top = 3720
Width = 495
End
Begin VB.TextBox Text6
Height = 255
Left = 12060
TabIndex = 43
Text = "2"
Top = 3720
Width = 495
End
Begin VB.CommandButton Command16
Caption = "Edit"
Height = 435
Left = 10920
TabIndex = 42
Top = 4080
Width = 735
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 2115
Left = 8820
TabIndex = 41
Top = 4620
Width = 4995
_ExtentX = 8811
_ExtentY = 3731
_Version = 393216
Rows = 7
Cols = 11
End
Begin VB.CommandButton Command15
Caption = "letzterFehlerdes RefZ genau"
Height = 435
Left = 5430
TabIndex = 40
Top = 3720
Width = 1515
End
Begin VB.CommandButton Command9
Caption = "Command9"
Height = 615
Left = 5340
TabIndex = 39
Top = 2280
Width = 555
End
Begin VB.CommandButton Command14
Caption = "Command14"
Height = 555
Left = 6090
TabIndex = 38
Top = 2310
Width = 615
End
Begin VB.CommandButton Command13
Caption = "SPS Var PT_Strecke1 Lesen "
Height = 855
Left = 5370
TabIndex = 37
Top = 1200
Width = 1755
End
Begin VB.Frame Frame5
Caption = "Behälter"
Height = 1515
Left = 240
TabIndex = 33
Top = 2160
Width = 4635
Begin VB.TextBox Text5
Height = 315
Left = 3600
TabIndex = 36
Text = "Vol"
Top = 900
Width = 855
End
Begin VB.TextBox Text4
Height = 975
Left = 240
MultiLine = -1 'True
TabIndex = 35
Top = 360
Width = 3075
End
Begin VB.CommandButton Command12
Caption = "test"
Height = 375
Left = 3600
TabIndex = 34
Top = 300
Width = 795
End
End
Begin VB.Frame Frame4
Caption = "SPS Test"
Height = 1755
Left = 120
TabIndex = 26
Top = 120
Width = 4935
Begin VB.CommandButton cmdSchreibe
Caption = "Schreiben"
Height = 735
Left = 3840
TabIndex = 32
Top = 720
Width = 975
End
Begin VB.CommandButton cmdLese
Caption = "Lesen"
Height = 735
Left = 3000
TabIndex = 31
Top = 720
Width = 735
End
Begin VB.TextBox txtVarValue
Height = 285
Left = 1320
TabIndex = 29
Top = 1200
Width = 1455
End
Begin VB.TextBox txtVarName
Height = 285
Left = 1320
TabIndex = 27
Text = "PT_Strecke1"
Top = 720
Width = 1455
End
Begin VB.Label Label2
Caption = "Wert"
Height = 255
Left = 240
TabIndex = 30
Top = 1200
Width = 975
End
Begin VB.Label Label1
Caption = "Var Name"
Height = 255
Left = 240
TabIndex = 28
Top = 720
Width = 975
End
End
Begin VB.Frame Frame3
Caption = "FM85 Test"
Height = 1815
Left = 5040
TabIndex = 21
Top = 5520
Width = 3375
Begin VB.CommandButton Command1
Caption = "Reset && Start"
Height = 495
Left = 240
TabIndex = 25
Top = 360
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "Lese"
Height = 495
Left = 1800
TabIndex = 24
Top = 360
Width = 1335
End
Begin VB.TextBox Text1
Height = 495
Left = 240
TabIndex = 23
Text = "Text1"
Top = 960
Width = 1095
End
Begin VB.TextBox Text2
Height = 495
Left = 1440
TabIndex = 22
Text = "Text2"
Top = 960
Width = 1095
End
End
Begin VB.CommandButton Command10
Caption = "letzterFehlerdes RefZ"
Height = 435
Left = 5430
TabIndex = 19
Top = 3180
Width = 1515
End
Begin VB.Frame Frame2
Caption = "Waagen Test"
Height = 5385
Left = 120
TabIndex = 8
Top = 3840
Width = 4695
Begin VB.CommandButton cmdNullstellen
Caption = "Nullstellen"
Height = 555
Left = 180
TabIndex = 60
Top = 2940
Width = 1155
End
Begin VB.CheckBox chkDauerGewicht
Caption = "Dauer"
Height = 315
Left = 1200
TabIndex = 59
Top = 1740
Width = 885
End
Begin VB.Frame Frame6
Caption = "mit den Einstellungen aus Pruef2000.ini"
Height = 825
Left = 240
TabIndex = 55
Top = 4350
Width = 4215
Begin VB.CommandButton cmdGetWaageFromIni
Caption = "Get Waage"
Height = 255
Left = 2400
TabIndex = 57
Top = 240
Width = 1455
End
Begin VB.TextBox txtVolumen
Alignment = 1 'Rechts
Height = 285
Left = 1680
TabIndex = 56
Text = "300"
Top = 240
Width = 495
End
Begin VB.Label Label3
Caption = "Volumen"
Height = 255
Left = 720
TabIndex = 58
Top = 240
Width = 975
End
End
Begin VB.CommandButton cmdWaageRelease
Caption = "Waage freigeben"
Height = 345
Left = 2730
TabIndex = 52
Top = 1200
Width = 1605
End
Begin VB.CommandButton cmdWaageGet
Caption = "Waage holen"
Height = 345
Left = 2730
TabIndex = 51
Top = 780
Width = 1575
End
Begin VB.CommandButton cmdCOMReset
Caption = "COM Reset"
Height = 375
Left = 2970
TabIndex = 47
Top = 3330
Width = 1275
End
Begin VB.CommandButton Command11
Caption = "Warte Auf Ruhe"
Height = 495
Left = 1650
TabIndex = 20
Top = 3330
Width = 1215
End
Begin VB.TextBox txtGrenzwert
Height = 315
Left = 2520
TabIndex = 18
Top = 240
Width = 1695
End
Begin VB.TextBox txtWaageOut
Height = 735
Left = 2340
TabIndex = 17
Top = 2460
Width = 2175
End
Begin VB.CommandButton cmdTestWaage
Caption = "Sende an Waage"
Height = 435
Left = 3420
TabIndex = 16
Top = 1800
Width = 1095
End
Begin VB.TextBox txtWaageIn
Height = 435
Left = 2340
TabIndex = 15
Top = 1800
Width = 975
End
Begin VB.CommandButton cmdWaagenTest
Caption = "Reset Waage"
Height = 495
Left = 180
TabIndex = 14
Top = 1140
Width = 975
End
Begin VB.CommandButton cmdgetWeight
Caption = "Lese Gewicht"
Height = 495
Left = 180
TabIndex = 13
Top = 1680
Width = 975
End
Begin VB.CommandButton cmdTara
Caption = "Tara"
Height = 495
Left = 1020
TabIndex = 12
Top = 2280
Width = 735
End
Begin VB.CommandButton cmdTaraReset
Caption = "Tara löschen"
Height = 495
Left = 210
TabIndex = 11
Top = 2280
Width = 735
End
Begin VB.CommandButton Command4
Caption = "Waage 1"
Height = 675
Left = 180
TabIndex = 10
Top = 300
Width = 915
End
Begin VB.CommandButton Command5
Caption = "Waage 2"
Height = 675
Left = 1200
TabIndex = 9
Top = 300
Width = 915
End
End
Begin VB.Frame Frame1
Caption = "Pruefgang Objekt"
Height = 3375
Left = 10380
TabIndex = 3
Top = 510
Width = 1635
Begin VB.CommandButton Command6
Caption = "ändere Pruefgang"
Height = 795
Left = 240
TabIndex = 7
Top = 1200
Width = 1155
End
Begin VB.CommandButton Command7
Caption = "init Pruefgang"
Height = 795
Left = 240
TabIndex = 6
Top = 360
Width = 1155
End
Begin VB.CommandButton Command8
Caption = "save Pruefgang"
Height = 795
Left = 240
TabIndex = 5
Top = 2040
Width = 1155
End
Begin VB.TextBox Text3
Height = 375
Left = 240
TabIndex = 4
Text = "Text3"
Top = 2880
Width = 1155
End
End
Begin VB.CommandButton Command3
Caption = "Pumpentest"
Height = 315
Left = 8040
TabIndex = 2
Top = 4200
Width = 1275
End
Begin VB.TextBox txtDaten
Height = 1215
Left = 5400
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 1
Top = 4200
Width = 2475
End
Begin VB.CommandButton CmdQuit
Caption = "QUIT"
Height = 495
Left = 8880
TabIndex = 0
Top = 6840
Width = 735
End
Begin VB.Label lblQtest
Alignment = 1 'Rechts
BorderStyle = 1 'Fest Einfach
Caption = "Label7"
BeginProperty Font
Name = "Courier New"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 12735
TabIndex = 86
Top = 2835
Width = 2265
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private oFM85P As CFM85P
Private oWaage As CWaage
Private Pruefgang As New CPruefgang
Private m_colEinbauplatz As Collection
Private m_DruckMsg As String
Dim Waage(2) As CWaage
Private Sub cmdCOMReset_Click()
frmSerial.commWaage.PortOpen = False
Sleep 1000, True
frmSerial.commWaage.PortOpen = True
End Sub
Private Sub cmdDBTest_Click()
g_Logger.log 1, "123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345"
End Sub
Private Sub cmdDruckprüfung_Click()
On Error Resume Next
Dim geleseneFabNr As Long
geleseneFabNr = InputBox("FabNr")
If UpdateInDruckpruefung(geleseneFabNr, InputBox("SerienNr")) = False Then
Call MsgBox("Für diesen Zähler (FabNr=" & geleseneFabNr & ") liegen keine Ergebnisse der Druckprüfung vor!", vbCritical)
End If
End Sub
Private Sub cmdGetWaageFromIni_Click()
Dim Behaelter As CBehaelter
Set Behaelter = New CBehaelter
Behaelter.LoadForVolumen (CDbl(txtVolumen.text))
Set oWaage = g_App.getWaage
oWaage.Initialize (Behaelter.m_Nr)
oWaage.Anwahl Behaelter.m_WaageAnwahl
End Sub
Private Sub cmdgetWeight_Click()
On Error GoTo getWeightError
MsgBox (oWaage.GetGewicht)
Exit Sub
getWeightError:
MsgBox ("waage steht nicht zur verfügung")
End Sub
Private Sub cmdGewicht2Volumen_Click()
lblVol.caption = Format(Errechne_Volumen_Von_Wasser_in_m3(Val(txtGewicht2Vol.text) * 1000, Val(txtT.text)), "0.000")
End Sub
Private Sub cmdIniCOM_Click()
Dim comport As Integer
Dim i As Integer
txtDaten.text = ""
For i = 1 To 10
comport = Val(g_App.Settings.getUSComPort(i))
If comport = 0 Then
txtDaten.text = txtDaten.text & i & ": -- " & vbCrLf
Else
txtDaten.text = txtDaten.text & i & ": COM " & comport & vbCrLf
End If
Next
End Sub
Private Sub cmdKill_Click()
KillProcessByName txtProcessname.text, False
End Sub
Private Sub cmdLese_Click()
Dim mystr As String
Dim ProToolObj As CProTool
Dim SPS As CSPS
txtVarValue = ""
Set SPS = g_App.getSPS
Set ProToolObj = SPS.ProToolObj
txtVarValue = ProToolObj.VarLesen(txtVarName)
Set SPS = Nothing
Set ProToolObj = Nothing
End Sub
Private Sub cmdNullstellen_Click()
If oWaage.Nullstellen Then
MsgBox ("Nullstellen OK")
Else
MsgBox ("Nullstellen fehlgeschlagen:" + Str(oWaage.getErrorCode) + " : " + oWaage.getErrorDesc)
End If
End Sub
Private Sub cmdSchreibe_Click()
Dim mystr As String
Dim ProToolObj As CProTool
Dim SPS As CSPS
Dim Wert As String
Set SPS = g_App.getSPS
Set ProToolObj = SPS.ProToolObj
Call ProToolObj.VarSchreiben(txtVarName, txtVarValue)
Set SPS = Nothing
End Sub
Private Sub cmdTara_Click()
If oWaage.Tara Then
MsgBox ("Tara OK")
Else
MsgBox ("Tara fehlgeschlagen:" + Str(oWaage.getErrorCode) + " : " + oWaage.getErrorDesc)
End If
End Sub
Private Sub cmdTaraReset_Click()
If oWaage.TaraReset Then
MsgBox ("Tara Reset OK")
Else
MsgBox ("Tara Reset fehlgeschlagen")
End If
End Sub
Private Sub cmdWaageGet_Click()
Set oWaage = g_App.getWaage
End Sub
Private Sub cmdWaagenTest_Click()
If oWaage.Reset Then
MsgBox ("OK")
Else
MsgBox ("Reset fehlgeschlagen")
End If
End Sub
Private Sub cmdWaageRelease_Click()
Set oWaage = Nothing
End Sub
Private Sub Command10_Click()
Dim RefZ As CRefzaehler
Dim Q As Double
Dim Fehler As Double
Set RefZ = New CRefzaehler
Q = InputBox("Bitte Q angeben", 0)
Call RefZ.loadForDurchfluss(Q, 1)
Fehler = RefZ.letzterFehler(Q, 19.2)
MsgBox "Fehler: " & Fehler & vbCrLf & RefZ.letzterFehlerString(Q, 19.2) & vbCrLf & RefZ.DatumDesFehlers
End Sub
Private Sub Command11_Click()
MsgBox "Achtung: alte Funktion"
MsgBox ("Warte auf Ruhe startet")
oWaage.WarteAufRuhe
MsgBox ("Warte auf Ruhe beendet")
End Sub
Private Sub Command12_Click()
Dim Behaelter As CBehaelter
Dim i As Integer
Text4.text = "testing..." & vbCrLf
For i = 1 To 3
Set Behaelter = New CBehaelter
Behaelter.LoadFromIni (i)
Text4.text = Text4.text & "Nr: " & i & vbCrLf
Text4.text = Text4.text & "======" & vbCrLf
Text4.text = Text4.text & " Anwahl:" & Behaelter.m_WaageAnwahl & vbCrLf
Text4.text = Text4.text & " OVolumen:" & Behaelter.m_OVolumen & vbCrLf
Text4.text = Text4.text & " UVolumen:" & Behaelter.m_UVolumen & vbCrLf
Text4.text = Text4.text & " Ueb.Faktor:" & Behaelter.m_nUeberlaufFaktor & vbCrLf
Text4.text = Text4.text & " BehaelterAw:" & Behaelter.m_BehaelterAnwahl & vbCrLf
Text4.text = Text4.text & " Ist OK für " & Text5.text & " :" & CStr(Behaelter.IstOkFuerVolumen(Val(Text5.text))) & vbCrLf
Next
End Sub
Private Sub Command13_Click()
Dim SPS As CSPS
Dim ProToolObj As CProTool
Dim myVar As Integer
Set SPS = g_App.getSPS
Set ProToolObj = SPS.ProToolObj
myVar = ProToolObj.VarLesen("PT_Strecke1")
MsgBox myVar
End Sub
Private Sub Command14_Click()
PrinterEndDoc
End Sub
Private Sub Command15_Click()
Dim RefZ As CRefzaehler
Dim Q As Double
Dim Fehler As Double
Set RefZ = New CRefzaehler
Q = InputBox("Bitte Q angeben", 0)
Call RefZ.loadForDurchfluss(Q, 1)
Fehler = RefZ.letzterFehler(Q, 19.2)
MsgBox "Fehler: " & Fehler & vbCrLf & RefZ.letzterFehlerString(Q, 19.2) & vbCrLf & RefZ.DatumDesFehlers
End Sub
Private Sub Command16_Click()
MSFlexGrid1.col = Text6
MSFlexGrid1.row = Text7
MSFlexGrid1.text = Text8
End Sub
Private Sub Command17_Click()
'initPrint (g_App.Settings.PrintDir & "test2.txt")
'PrintString "hallo dies ist ein Test1"
'PrintEnd
'initPrint (g_App.Settings.PrintDir & "test2.txt")
'PrintString "hallo dies ist ein Test2"
'PrintEnd
'frmVorjustage.Show vbModal, Me
End Sub
Private Sub Command18_Click()
Dim Referenzzaehler As CRefzaehler
Dim Q As Double
Dim alteNennweite As Integer
Dim altePumpe As String
Dim ServoFUStellung As Integer
Dim Pumpe As CPumpe
Dim ColPumpen As Collection
Set ColPumpen = g_App.Settings.getPumpen
txtStellwert.text = ""
Set Referenzzaehler = New CRefzaehler
Q = 300
looop:
Q = Q * 0.95
Call Referenzzaehler.loadForDurchfluss(Q, g_App.Settings.getMIDGruppe)
If alteNennweite <> Referenzzaehler.Nennweite Then
txtStellwert.text = txtStellwert.text & " - - - - NW " & Referenzzaehler.Nennweite & " - - - " & vbCrLf
End If
Set Pumpe = Pumpenwahl(Q, ColPumpen)
If Pumpe Is Nothing Then
txtStellwert.text = txtStellwert.text & "keine Pumpe für Q=" & Format(Q, "0.000") & vbCrLf
Else
If Pumpe.getNr <> Val(altePumpe) Then
txtStellwert.text = txtStellwert.text & " - - Pm " & Pumpe.GetSPSVarname & " - - - " & vbCrLf
altePumpe = Pumpe.getNr
End If
alteNennweite = Referenzzaehler.Nennweite
ServoFUStellung = lookupFUServoStellwert(Q)
txtStellwert.text = txtStellwert.text & Format(Q, "0.000") & vbTab & ServoFUStellung & vbCrLf
DoEvents
End If
If Q > 0.04 Then GoTo looop
End Sub
Private Sub Command19_Click()
Dim usv As CVorpruefpunkte
Set usv = New CVorpruefpunkte
MsgBox "CVorpruefpunkte.load Returnwert " & usv.load(829306, 2)
End Sub
'
'Private Sub Command20_Click()
' Dim SPS As CSPS
' Dim ProToolObj As CProTool
' Dim myVar As Integer
' Set SPS = g_App.getSPS
'
' MsgBox SPS.GetTemperatur(Val(TextT.text))
'
'End Sub
Private Sub Command21_Click()
SendMail "Pruefstation" & g_App.PruefstationNr & "@sensus.com", "juergen.dreyer@sensus.com; reinhard.henning@sensus.com", "Benachrichtigung von Pruefstation " & g_App.PruefstationNr, "Messeinsätze=falsch !" & vbCrLf & "Strecke nicht prüfbereit!"
End Sub
Private Sub Command22_Click()
'Call frmRefZaehlerPrf.RZPruefungvorzeitigAbbrechenWegenAbweichung(125, "A", 0.2, 0.5, 200, "...info...", Now, Nothing, Nothing)
End Sub
Private Sub Command24_Click()
Dim AuftragPosition As CAuftragPosition
Set AuftragPosition = New CAuftragPosition
AuftragPosition.load 100190365, 10
AuftragPosition.AlsGeprueftFertigmelden
End Sub
Private Sub Command25_Click()
Dim Einbauplatz As CEinbauplatz
Dim PruefgangNr As Long
Dim Pruefgang As CPruefgang
Dim m_colEinbauplatz As Collection
Dim Pruefzaehler As CPruefzaehler
Dim Prueffehler As CPrueffehler
Set Einbauplatz = New CEinbauplatz
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
Dim Pruefpunkt As CPruefpunkt
Dim strSQL As String
Dim rs As CRecordset
Dim rs1 As CRecordset
Dim rs2 As CRecordset
Dim PPNr As Integer
Dim PPNr2 As Integer
Set m_colEinbauplatz = New Collection
PruefgangNr = 2020015647#
Set Pruefgang = New CPruefgang
If Pruefgang.load(PruefgangNr) Then
''' alle eingebauten beteiligten SerienNr im Prüfgang
strSQL = "SELECT * from AuftragpositionSerienNr where PruefgangNr = " & PruefgangNr & " order by Einbauplatz"
Set rs = New CRecordset
rs.openRS strSQL, True
Debug.Print strSQL
Do While Not rs.EOF
Set Einbauplatz = New CEinbauplatz
Einbauplatz.setNr rs.getIntValue("Einbauplatz")
m_colEinbauplatz.Add Einbauplatz
Set Pruefzaehler = New CPruefzaehler
If Pruefzaehler.loadForSerienNr(rs.getLongValue("SerienNr")) Then
Einbauplatz.setPruefzaehler Pruefzaehler
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
AuftragpositionSerienNr.loadFromRecordset rs
Pruefzaehler.SetAuftragPositionSerienNr AuftragpositionSerienNr
strSQL = "SELECT * from Prueffehler where PruefgangNr = " & PruefgangNr & " and SerienNr = " & Pruefzaehler.getSerienNr
Set rs1 = New CRecordset
rs1.openRS strSQL, True
If Not rs1.EOF Then
PPNr = 0
' Dim Index As Integer
' For Index = 1 To 10
' If Pruefgang.PP_Soll(Index) = 0 Then
' ' Abbruch der Schleife wenn Durchfluß = 0
' Exit For
' End If
'
' If Pruefzaehler.getPruefpunkte.getPruefpunkte.hasQ(Pruefgang.PP_Soll(Index)) Then
'
' Set Pruefpunkt = Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(Index)
'
' Pruefpunkt.setQ Pruefgang.PP_Soll(Index)
' Pruefpunkt.SetTime Pruefgang.PP_Zeit(PPNr)
' Pruefpunkt.setFehler rs1.getDoubleValue("PP" & Index & "_Fehler")
'
'
' End If
' Next
'
' For PPNr = 1 To UBound(Pruefgang.PP_Soll)
'
' Next
'
' For Each Pruefpunkt In Pruefzaehler.getPruefpunkte.getPruefpunkte.getCollection
'
' ' Für alle PP in Prufgang
' ' wenn Pruefzähler hasQ
' ' Pruefzaehler.getPruefpunkte.getPruefpunkte Collection neu erzeugen
'
' 'Pruefzaehler.getPruefpunkte.getPruefpunkte.getCollection = New Collection
' Set Pruefpunkt = New CPruefpunkt
' PPNr = PPNr + 1
' Pruefpunkt.setQ Pruefgang.PP_Soll(PPNr)
' Pruefpunkt.SetTime Pruefgang.PP_Zeit(PPNr)
' Pruefpunkt.setFehler rs1.getDoubleValue("PP" & PPNr & "_Fehler")
' Pruefzaehler.getPruefpunkte.getPruefpunkte.getCollection.Add Pruefpunkt
' Next
End If
End If
rs.MoveNext
Loop
modDruck.PruefgangDruck Pruefgang, 20, m_colEinbauplatz, 10
End If
End Sub
'Private Sub Command25_Click()
' Dim AP As CAuftragPosition
' Dim A As CAuftrag
' Dim Aps As CAuftragPositionSerienNr
'
' Dim lngSNr As Long
'
' Set A = New CAuftrag
' Set Aps = New CAuftragPositionSerienNr
' Set AP = New CAuftragPosition
'
' Dim strSQL As String
' Dim rs As CRecordset
'
' strSQL = "SELECT SerienNr from Seriennummer"
' Set rs = New CRecordset
'
' rs.openRS strSQL, True
' Do While Not rs.EOF
' lngSNr = rs.getLongValue("SerienNr")
'
' Set Aps = New CAuftragPositionSerienNr
' Aps.load lngSNr
'
' Set AP = New CAuftragPosition
' AP.load Aps.getAuftragNr, Aps.getPositionNr
' Set A = New CAuftrag
' A.load Aps.getAuftragNr, False
'
' If AP.GetTLMenge_G < AP.getMenge Then
' AP.updateTLMenge_G
'
' If AP.getMenge = AP.GetTLMenge_G Then
' AP.AlsGeschlossenFertigmelden
' End If
' End If
'
'
' Debug.Print AP.GetTLMenge_G & " =?= "; AP.getMenge
' DoEvents
'
' AP.save A
'
' rs.MoveNext
' Loop
'
'
'
'
'End Sub
Private Sub Command26_Click()
Dim pg As CPruefgang
Set pg = New CPruefgang
pg.save
Dim i As Integer
For i = 1 To 10
MsgBox i & " " & pg.PruefgangNr
pg.PP_T_Start(i) = 10 + i
pg.PP_T_Ende(i) = 10 + i + 0.5
pg.save
Next
End Sub
Private Sub Command27_Click()
Call AlleBehaelterLeeren(Me, g_App.getSPS, g_App.getWaage)
End Sub
Private Sub Command29_Click()
Dim strSQL As String
Dim rs As CRecordset
Dim rsSNr As CRecordset
Dim strVako As String
Dim objVako As CVakoCode
Dim Qn As Double
Dim Ratio As Double
Dim Nennweite As Long
Dim strAusgabe As String
Dim lngIdentNr As Long
Dim lngSerienNr As Long
Dim i As Integer
Dim Pruefpunkt As CPruefpunkt
Dim Vorpruefpunkt As CVorpruefpunkt
On Error GoTo Skip
strAusgabe = strAusgabe & "SerienNr" & vbTab
strAusgabe = strAusgabe & "IdentNr" & vbTab
strAusgabe = strAusgabe & "Nennweite" & vbTab
strAusgabe = strAusgabe & "Qn" & vbTab
strAusgabe = strAusgabe & "Ratio" & vbTab
For i = 1 To 3
strAusgabe = strAusgabe & "Q" & i & vbTab
strAusgabe = strAusgabe & "T" & i & vbTab
strAusgabe = strAusgabe & "Vol" & i & vbTab
strAusgabe = strAusgabe & "FGo" & i & vbTab
strAusgabe = strAusgabe & "FGu" & i & vbTab
Next
strAusgabe = strAusgabe & vbCrLf
strSQL = "select * from Identnr where IdentNr > = 2500000 and IdentNr <= 2600000 order by Nennweite, Temperatur, Druck, Baulaenge"
Set rs = New CRecordset
rs.openRS strSQL
Do While Not rs.EOF
lngIdentNr = rs.getStringValue("IdentNr")
strVako = rs.getStringValue("VakoCode")
Set objVako = New CVakoCode
On Error Resume Next
objVako.load strVako
Nennweite = Val(objVako.GetWert("Nennweite"))
Qn = Val(objVako.GetWert("Qn"))
Ratio = Val(objVako.GetWert("Ratio"))
strSQL = "select SerienNrVon from AlleAuftragPositionen Where IdentNr = " & lngIdentNr & " and Metrolog = ''"
Set rsSNr = New CRecordset
rsSNr.openRS strSQL
If Not rsSNr.EOF Then
lngSerienNr = rsSNr.getLongValue("SerienNrVon")
Dim Pruefzaehler As CPruefzaehler
Set Pruefzaehler = New CPruefzaehler
If Pruefzaehler.loadForSerienNr(lngSerienNr) Then
If Pruefzaehler.getPruefklasseKZ = "" Then
strAusgabe = strAusgabe & lngSerienNr & vbTab & lngIdentNr & vbTab & Nennweite & vbTab & Qn & vbTab & Ratio & vbTab
For i = 1 To 3
strAusgabe = strAusgabe & Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).getQ & vbTab
strAusgabe = strAusgabe & Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).GetTime & vbTab
strAusgabe = strAusgabe & Round(Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).getQ * Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).GetTime / 3.6, 2) & vbTab
strAusgabe = strAusgabe & Round(Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).getFGo, 1) & vbTab
strAusgabe = strAusgabe & Round(Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(i).getFGu, 1) & vbTab
Next
strAusgabe = strAusgabe & vbCrLf
End If
End If
End If
DoEvents
Skip:
rs.MoveNext
Loop
Clipboard.setText strAusgabe
MsgBox "Fertig"
End Sub
'Private Sub Command23_Click()
'Dim strSQL As String
'Dim rs As CRecordset
'Dim strZusatz As String
'Dim varZeile As Variant
'
'strSQL = "SELECT ZusatzText, AuftragNr , PositionNr From AlleAuftragPositionen WHERE (ZusatzText LIKE '%DKD%') OR (ZusatzText LIKE '%NATA%')"
'Set rs = New CRecordset
'rs.openRS strSQL
'
'Do While Not rs.EOF
' strZusatz = rs.getStringValue("Zusatztext")
' For Each varZeile In Split(strZusatz, vbCrLf)
' If InStr(1, LCase(varZeile), LCase("DKD")) > 0 Or InStr(1, LCase(varZeile), LCase("NATA")) > 0 Then
' Debug.Print varZeile
' End If
' Next
' rs.MoveNext
'Loop
'
'
'End Sub
Private Sub Command3_Click()
Dim ColPumpen As Collection
Dim Pumpe As CPumpe
Set ColPumpen = g_App.Settings.getPumpen
For Each Pumpe In ColPumpen
PrintStatus Pumpe.getNr & ": " & Pumpe.GetDurchflussUnten & ": " & Pumpe.getNennweite & " : " & Pumpe.GetDurchflussUnten
Next
End Sub
Private Sub Command30_Click()
Call SendMail("reinhard.henning@sensus.com", "reinhard.henning@sensus.com", "Testmail von ASPEMail", "testing....")
End Sub
Private Sub Command31_Click()
WriteToFM85Log "**0@" & vbCrLf, ">"
WriteToFM85Log "FM85OK" & vbCrLf, "<"
End Sub
Private Sub Command32_Click()
Dim strSecret As String
strSecret = Trim(InputBox("X-Node-Token"))
If Len(strSecret) > 0 Then
strSecret = g_App.Settings.AESEncryptString(strSecret)
If Len(strSecret) > 0 Then
g_App.Settings.saveStringValue "eRegister", "X-Node-Token-Encrypted", strSecret
End If
End If
strSecret = ""
strSecret = g_App.Settings.readStringValue("eRegister", "X-Node-Token-Encrypted", "")
MsgBox g_App.Settings.AESDecryptString(strSecret)
End Sub
Private Sub Command35_Click()
Verschiebe_Prueffehler_Befundpruefung_Eichung 2016054583
End Sub
'Sub Korrigiere(lngSerienNr As Long, lngPruefgangNr As Long)
' Dim lngSerieNr As Long
' Dim APS As CAuftragPositionSerienNr
'
' Set APS = New CAuftragPositionSerienNr
' APS.load (lngSerienNr)
'
' APS.setPruefgangNr lngPruefgangNr
' APS.setWiederholungen (APS.getWiederholungen + 1)
' APS.setAnlageDatum Now
' APS.setAnlageMitarbeiterNr 10
' APS.setBemerkung "Wiederhergestellt von RH"
'
' APS.save True
'
'End Sub
Private Sub Command36_Click()
' Korrigiere 17778269, 2004012756
End Sub
Private Sub Command4_Click()
Command4.caption = "Waage 1 aktiv"
Command5.caption = "Waage 2"
Set oWaage = Waage(1)
End Sub
Private Sub Command5_Click()
Command4.caption = "Waage 1"
Command5.caption = "Waage 2 aktiv"
Set oWaage = Waage(2)
End Sub
Private Sub Command6_Click()
Text3.text = Pruefgang.PruefgangNr
Pruefgang.Anzahl = 2
Pruefgang.Typ = "WPD"
Pruefgang.PP_Ist(1) = Pruefgang.PP_Ist(1) + 1
Pruefgang.PP_Ist(2) = Pruefgang.PP_Ist(2) + 2
Pruefgang.PP_RefZSerienNr(1) = 1234561
Pruefgang.PP_RefZSerienNr(2) = 1234562
Pruefgang.PP_Zeit(1) = 1111
Pruefgang.PP_Zeit(2) = 2222
Pruefgang.PP_Soll(1) = 331111
Pruefgang.PP_Soll(2) = 332222
End Sub
Private Sub Command8_Click()
If Pruefgang.save Then
Text3.text = Pruefgang.PruefgangNr
MsgBox ("save ok")
Else
Text3.text = Pruefgang.PruefgangNr
MsgBox ("save nicht ok")
End If
End Sub
Private Sub Command7_Click()
Set Pruefgang = New CPruefgang
Text3.text = Pruefgang.PruefgangNr
End Sub
Private Sub Form_Load()
'Set oWaage = g_App.getWaage
End Sub
Private Sub cmdTestWaage_Click()
txtWaageOut = "..."
oWaage.send (txtWaageIn.text)
txtWaageOut = oWaage.receive(2000)
End Sub
Private Sub Command1_Click()
frmTest.Enabled = False
frmTest.MousePointer = vbHourglass
Set oFM85P = g_App.getFMBus().getFM85P(1)
MousePointer = vbHourglass
If Not oFM85P.sendAttention Then
MsgBox ("keine Attention")
MousePointer = vbDefault
Exit Sub
End If
MousePointer = vbDefault
' starte Zählvorgang
oFM85P.send ("O")
'FM85P.receive
oFM85P.send ("Q")
'FM85P.receive
frmTest.MousePointer = vbDefault
frmTest.Enabled = True
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
Command1.Enabled = False
oFM85P.send ("L")
oFM85P.receive
Text1.text = oFM85P.getLastAnswer
oFM85P.send ("U")
oFM85P.receive
text2.text = oFM85P.getLastAnswer
Command1.Enabled = True
Command2.Enabled = True
End Sub
Private Sub setError(strQuittung)
strQuittung = Mid(strQuittung, 1, 2)
Select Case strQuittung
Case "w0"
Case "w1"
Case "w3"
Case "w5"
Case "w6"
Case "w9"
Case Else
End Select
End Sub
Private Sub PrintStatus(sText As String)
txtDaten.text = txtDaten.text & sText & vbCrLf
txtDaten.SelStart = Len(txtDaten.text)
Debug.Print sText
End Sub
Private Sub txtQtest_Change()
lblQtest.caption = FormatDurchfluss(Val(txtQtest.text))
End Sub