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

199 lines
5.2 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmSelbsttest
Caption = "Pruef2000 Selbsttest"
ClientHeight = 8040
ClientLeft = 60
ClientTop = 345
ClientWidth = 6510
LinkTopic = "Form1"
ScaleHeight = 8040
ScaleWidth = 6510
StartUpPosition = 3 'Windows-Standard
Begin VB.CommandButton cmdSchliessen
Caption = "Weiter"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 2
Top = 7440
Width = 1695
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 7305
Left = 30
TabIndex = 0
Top = 60
Width = 6465
_ExtentX = 11404
_ExtentY = 12885
_Version = 393216
End
Begin VB.Label lblAutosize
BorderStyle = 1 'Fest Einfach
Caption = "Autosize"
Height = 315
Left = 480
TabIndex = 1
Top = 7650
Visible = 0 'False
Width = 1155
End
End
Attribute VB_Name = "frmSelbsttest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mblnActivated As Boolean
Dim m_FM8us As CFMBus
Dim m_blnFehler As Boolean
Dim mblnAbbruch As Boolean
Const TXT_FAIL = "fail"
Const TXT_OK = "OK"
Private Sub cmdSchliessen_Click()
Unload Me
End Sub
Private Sub Form_Activate()
If mblnActivated = False Then
SetWindowTopMost Me.hwnd
StartSelbsttest
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End If
mblnActivated = True
End Sub
Private Sub Form_Load()
Set m_FM8us = g_App.getFMBus
m_blnFehler = False
End Sub
Private Sub StartSelbsttest()
Dim i As Integer
Dim blnTestErfolgtWarteAufWeiter As Boolean
On Error GoTo Errorhandler
cmdSchliessen.Enabled = False
MSFlexGrid1.Clear
MSFlexGrid1.Rows = 1
MSFlexGrid1.FormatString = "Sektion|Test|Wert|Pass"
DoEvents
''''''''''''''''''''''' FM85 testen '''''''''''''''''''''''
If g_App.Settings.getCOMPort(DEVPORT_FMBus) > 0 Then
' FM85 Com Port ist definiert
blnTestErfolgtWarteAufWeiter = True
For i = 1 To g_App.Settings.EinbauplaetzeJeStrang()
testFM85 i
If mblnAbbruch Then Exit Sub
Next
If g_App.Settings.EinbauplaetzeJeStrang() < g_App.Settings.FM85RefZAdresse Then
' Referenzz<7A>hler Vergleich
testFM85 Val(g_App.Settings.FM85RefZAdresse)
End If
''''''''''''''''''''''' Waagen testen '''''''''''''''''''''''
Call testWaagen
Else
Unload Me
Exit Sub
End If
''''''''''''''''''''''' ''''''''''''''''''''''' '''''''''''''''''''''''
If m_blnFehler = True Then
cmdSchliessen.Enabled = True
Else
If blnTestErfolgtWarteAufWeiter Then
Sleep 5000
End If
Unload Me
Exit Sub
End If
Exit Sub
Errorhandler:
Unload Me
End Sub
Private Sub testFM85(Adresse As Integer)
On Error GoTo Errorhandler
Dim strReceive As String
Dim strLog As String
Dim strPass As String
m_FM8us.send "**" & Adresse & "@"
strReceive = m_FM8us.receive(500)
strLog = "FM an Adresse " & Adresse & " antwortet '" & strReceive & "'"
WriteToLog strLog
If Len(strReceive) = 0 Then
strPass = TXT_FAIL
AddToListe "FM", "Adresse " & Adresse, strReceive, strPass
m_blnFehler = True
LogIntoDB "Selbsttest: FM an Einbauplatz " & Adresse & " antwortet nicht."
Else
strPass = TXT_OK
AddToListe "FM", "Adresse " & Adresse, strReceive, strPass
End If
Errorhandler:
DoEvents
End Sub
Private Sub testWaagen()
' Dim Behaelter As CBehaelter
' Dim index As Integer
' For index = 1 To 10
' Set Behaelter = New CBehaelter
' If Behaelter.LoadFromIni(index) Then
' AddToListe "Beh<65>lter", Behaelter.m_OVolumen & " L", "", ""
' End If
' Next
End Sub
Private Sub AddToListe(strSektion As String, strTest As String, strWert As String, strPass As String)
MSFlexGrid1.AddItem ""
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = strSektion
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = strTest
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 2) = strWert
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 3) = strPass
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
MSFlexGrid1.col = 3
If strPass = TXT_FAIL Then
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
ElseIf strPass = TXT_OK Then
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
End If
AutoSpaltenBreite MSFlexGrid1, lblAutosize
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mblnAbbruch = True
End Sub