3764 lines
136 KiB
Plaintext
3764 lines
136 KiB
Plaintext
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
|
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
|
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 frmUSFW2Pruefzaehlerpruefung
|
|
BorderStyle = 0 'Kein
|
|
Caption = "Pruef2000 FW Ultraschallprüfung"
|
|
ClientHeight = 10950
|
|
ClientLeft = 0
|
|
ClientTop = 0
|
|
ClientWidth = 19305
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 10950
|
|
ScaleWidth = 19305
|
|
ShowInTaskbar = 0 'False
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 435
|
|
Left = 0
|
|
TabIndex = 5
|
|
Top = 10515
|
|
Width = 19305
|
|
_ExtentX = 34052
|
|
_ExtentY = 767
|
|
Style = 1
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin VB.Frame frMain
|
|
Height = 10695
|
|
Left = 0
|
|
TabIndex = 0
|
|
Top = 0
|
|
Width = 15420
|
|
Begin VB.CommandButton cmdRückläufer
|
|
Caption = "Rückläufer"
|
|
Height = 405
|
|
Left = 10770
|
|
TabIndex = 53
|
|
Top = 5250
|
|
Width = 1935
|
|
End
|
|
Begin VB.CommandButton cmdCopy
|
|
Caption = "Copy"
|
|
Height = 255
|
|
Left = 3660
|
|
TabIndex = 39
|
|
ToolTipText = "Ausgewählte Tabellen-Zelle wird in die Zwischenablage kopiert"
|
|
Top = 5160
|
|
Width = 795
|
|
End
|
|
Begin VB.CommandButton cmdQuit
|
|
Caption = "Zurück / Abbrechen"
|
|
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 = 10920
|
|
TabIndex = 37
|
|
Top = 8820
|
|
Width = 3225
|
|
End
|
|
Begin VB.CommandButton cmdWeiter
|
|
Caption = " Starten"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 13.5
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 465
|
|
Left = 10920
|
|
TabIndex = 36
|
|
ToolTipText = "Startet den Ablauf (Überprüfung / Justage / Prüfung / KonfigVergleich)"
|
|
Top = 9420
|
|
Width = 3255
|
|
End
|
|
Begin VB.TextBox txtStatus
|
|
Height = 2760
|
|
Left = 10725
|
|
MultiLine = -1 'True
|
|
ScrollBars = 2 'Vertikal
|
|
TabIndex = 26
|
|
Top = 5940
|
|
Width = 4200
|
|
End
|
|
Begin VB.Frame Frame4
|
|
Caption = "Prüfung / Eichung"
|
|
Height = 4575
|
|
Left = 3630
|
|
TabIndex = 10
|
|
Top = 5880
|
|
Width = 3375
|
|
Begin VB.CheckBox chkOptimiertePPReihenfolge
|
|
Caption = "optimierte Reihenfolge"
|
|
Height = 195
|
|
Left = 180
|
|
TabIndex = 56
|
|
Top = 4200
|
|
Value = 1 'Aktiviert
|
|
Width = 1995
|
|
End
|
|
Begin VB.CommandButton cmdPP_Up
|
|
Caption = "<<"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 360
|
|
Left = 2130
|
|
TabIndex = 33
|
|
ToolTipText = "Prüfpunkt zeitlich zum Anfang verschieben"
|
|
Top = 1380
|
|
Width = 405
|
|
End
|
|
Begin VB.CommandButton cmdPP_Down
|
|
Caption = ">>"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 2130
|
|
TabIndex = 32
|
|
ToolTipText = "Prüfpunkt zeitlich zum Ende verschieben"
|
|
Top = 1845
|
|
Width = 405
|
|
End
|
|
Begin VB.TextBox txtAnzahlDauerPrf
|
|
Alignment = 1 'Rechts
|
|
Height = 315
|
|
Left = 1350
|
|
TabIndex = 23
|
|
Text = "1"
|
|
Top = 3660
|
|
Width = 375
|
|
End
|
|
Begin VB.OptionButton OptPrfArt
|
|
Caption = "Referenzzähler"
|
|
Height = 255
|
|
Index = 1
|
|
Left = 1770
|
|
TabIndex = 21
|
|
ToolTipText = "Prüfung gegen Referenzzähler durchführen. Prüfpunkte werden zurückgesetzt."
|
|
Top = 3180
|
|
Width = 1455
|
|
End
|
|
Begin VB.OptionButton OptPrfArt
|
|
Caption = "Waage"
|
|
Height = 285
|
|
Index = 0
|
|
Left = 270
|
|
TabIndex = 20
|
|
ToolTipText = "Prüfung gegen Waage durchführen. Prüfpunkte werden an die Behältergröße angepasst."
|
|
Top = 3150
|
|
Width = 945
|
|
End
|
|
Begin VB.CheckBox chkHauptpruefung
|
|
Caption = "durchführen"
|
|
Height = 375
|
|
Left = 210
|
|
TabIndex = 14
|
|
ToolTipText = "Bei Aktivierung wird die Prüfung durchgeführt."
|
|
Top = 180
|
|
Value = 1 'Aktiviert
|
|
Width = 1275
|
|
End
|
|
Begin VB.ListBox lstPruefpunkte
|
|
Height = 2205
|
|
Left = 270
|
|
TabIndex = 11
|
|
Top = 780
|
|
Width = 1665
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Dauerprüfung"
|
|
Height = 405
|
|
Left = 180
|
|
TabIndex = 22
|
|
Top = 3690
|
|
Width = 1125
|
|
End
|
|
Begin VB.Label Label3
|
|
Caption = "Q [m³/h]"
|
|
Height = 225
|
|
Left = 270
|
|
TabIndex = 15
|
|
Top = 570
|
|
Width = 1095
|
|
End
|
|
End
|
|
Begin VB.Frame Frame3
|
|
Caption = "Vorprüfung / Justage"
|
|
Height = 4575
|
|
Left = 120
|
|
TabIndex = 9
|
|
Top = 5880
|
|
Width = 3435
|
|
Begin VB.TextBox txtAnzahlJustageDurchgaenge
|
|
Alignment = 1 'Rechts
|
|
Height = 315
|
|
Left = 720
|
|
TabIndex = 51
|
|
Text = "1"
|
|
Top = 2610
|
|
Width = 435
|
|
End
|
|
Begin VB.CheckBox chkJustagewerteNICHTschreiben
|
|
Caption = "Justagewerte NICHT schreiben"
|
|
Enabled = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 50
|
|
ToolTipText = "Justagewerte werden nicht in das RW geschrieben, wenn diese Option aktiviert ist."
|
|
Top = 3900
|
|
Width = 3195
|
|
End
|
|
Begin VB.CheckBox chkBedingteQminJustage
|
|
Caption = "bedingte o_geber_roh Justage bei Qi"
|
|
Height = 315
|
|
Left = 540
|
|
TabIndex = 48
|
|
Top = 3540
|
|
Width = 2655
|
|
End
|
|
Begin VB.CheckBox chkGetrennteJustage
|
|
Caption = "Getrennte Justage (K-/O-Geber)"
|
|
Enabled = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 47
|
|
ToolTipText = "Zuerst wird der K-Geber bei Qp und dann O_Geber_roh bei Qi getrennt justiert"
|
|
Top = 3180
|
|
Width = 3195
|
|
End
|
|
Begin VB.Frame Frame5
|
|
Height = 1695
|
|
Left = 1920
|
|
TabIndex = 42
|
|
Top = 420
|
|
Width = 1455
|
|
Begin VB.CheckBox chkOffset_Qi
|
|
BackColor = &H8000000B&
|
|
Caption = "Fehler Offset"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 44
|
|
Top = 180
|
|
Width = 1215
|
|
End
|
|
Begin VB.TextBox txtOffset_Qi
|
|
Alignment = 1 'Rechts
|
|
BackColor = &H8000000B&
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 600
|
|
TabIndex = 43
|
|
Top = 480
|
|
Width = 435
|
|
End
|
|
Begin VB.Label Label5
|
|
Caption = "Qi"
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 46
|
|
Top = 480
|
|
Width = 255
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "%"
|
|
Height = 255
|
|
Left = 1080
|
|
TabIndex = 45
|
|
Top = 480
|
|
Width = 135
|
|
End
|
|
End
|
|
Begin VB.CheckBox chkMittelwertQi
|
|
Caption = "Mittelwert aus 3 mal Qi"
|
|
Enabled = 0 'False
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 35
|
|
ToolTipText = "Qi wird 3 mal geprüft. Es wid dann der Mittelwert aus den Messwerten verrechnet."
|
|
Top = 2880
|
|
Visible = 0 'False
|
|
Width = 2535
|
|
End
|
|
Begin VB.CheckBox chkVorpruefung
|
|
Caption = "durchführen"
|
|
Height = 375
|
|
Left = 210
|
|
TabIndex = 13
|
|
ToolTipText = "Bei Aktivierung wird die Justage durchgeführt."
|
|
Top = 270
|
|
Width = 1275
|
|
End
|
|
Begin VB.ListBox lstVorpruefpunkte
|
|
Height = 1230
|
|
Left = 180
|
|
TabIndex = 12
|
|
Top = 900
|
|
Width = 1665
|
|
End
|
|
Begin MSForms.Label Label6
|
|
Height = 225
|
|
Left = 120
|
|
TabIndex = 52
|
|
Top = 2640
|
|
Width = 525
|
|
Caption = "Anzahl "
|
|
Size = "926;397"
|
|
FontHeight = 165
|
|
FontCharSet = 0
|
|
FontPitchAndFamily= 2
|
|
End
|
|
Begin MSForms.OptionButton OptVorPrfArt
|
|
Height = 375
|
|
Index = 1
|
|
Left = 1320
|
|
TabIndex = 18
|
|
ToolTipText = "Justage gegen Referenzzähler durchführen. Vorprüfpunkte werden zurückgesetzt."
|
|
Top = 2220
|
|
Width = 1125
|
|
BackColor = -2147483633
|
|
ForeColor = -2147483630
|
|
DisplayStyle = 5
|
|
Size = "1984;661"
|
|
Value = "0"
|
|
Caption = "ReferenzZ"
|
|
FontHeight = 165
|
|
FontCharSet = 0
|
|
FontPitchAndFamily= 2
|
|
End
|
|
Begin MSForms.OptionButton OptVorPrfArt
|
|
Height = 375
|
|
Index = 0
|
|
Left = 240
|
|
TabIndex = 17
|
|
ToolTipText = "Justage gegen Waage durchführen. Vorprüfpunkte werden an die Behältergröße angepasst."
|
|
Top = 2220
|
|
Width = 915
|
|
BackColor = -2147483633
|
|
ForeColor = -2147483630
|
|
DisplayStyle = 5
|
|
Size = "1614;661"
|
|
Value = "0"
|
|
Caption = "Waage"
|
|
FontHeight = 165
|
|
FontCharSet = 0
|
|
FontPitchAndFamily= 2
|
|
End
|
|
Begin VB.Label Label4
|
|
Caption = "Q [m³/h]"
|
|
Height = 225
|
|
Left = 210
|
|
TabIndex = 16
|
|
Top = 660
|
|
Width = 1095
|
|
End
|
|
End
|
|
Begin VB.Frame Frame2
|
|
Caption = "Optionen"
|
|
Height = 4575
|
|
Left = 7080
|
|
TabIndex = 6
|
|
Top = 5880
|
|
Width = 3615
|
|
Begin VB.CommandButton cmdPruefungsinitialisierung
|
|
Caption = "Prüfungsvorbereitung + INIT_KEV1"
|
|
Height = 495
|
|
Left = 180
|
|
TabIndex = 55
|
|
Top = 2400
|
|
Width = 1635
|
|
End
|
|
Begin VB.CheckBox chkBefundpruefung
|
|
Caption = "Befundprüfung"
|
|
Height = 405
|
|
Left = 210
|
|
TabIndex = 54
|
|
Top = 4080
|
|
Width = 1875
|
|
End
|
|
Begin VB.CheckBox chkPositionenFertigmelden
|
|
Caption = "Positionen fertigmelden"
|
|
Height = 375
|
|
Left = 210
|
|
TabIndex = 49
|
|
ToolTipText = "gut und komplett geprüfte Auftragspositionen fertigmelden"
|
|
Top = 3720
|
|
Value = 1 'Aktiviert
|
|
Width = 3135
|
|
End
|
|
Begin VB.ComboBox cmbKonfigEbp
|
|
Height = 315
|
|
Left = 2640
|
|
Style = 2 'Dropdown-Liste
|
|
TabIndex = 40
|
|
Top = 1680
|
|
Width = 690
|
|
End
|
|
Begin VB.CheckBox chkKontinuierlich
|
|
Caption = "kontinuierliche Prüfung"
|
|
Enabled = 0 'False
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 38
|
|
Top = 660
|
|
Width = 2055
|
|
End
|
|
Begin VB.CheckBox chkRechenwerkSystemzeit
|
|
Caption = "Rechenwerk Systemzeit ändern"
|
|
Enabled = 0 'False
|
|
Height = 255
|
|
Left = 180
|
|
TabIndex = 34
|
|
ToolTipText = $"frmUSFW2Pruefzaehlerpruefung.frx":0000
|
|
Top = 3360
|
|
Value = 1 'Aktiviert
|
|
Width = 2805
|
|
End
|
|
Begin VB.CheckBox chkZulassung
|
|
Caption = "Zulassungsprüfung PTB/DKD"
|
|
Height = 375
|
|
Left = 180
|
|
TabIndex = 31
|
|
Top = 3000
|
|
Width = 3135
|
|
End
|
|
Begin VB.CheckBox chkPruefungsabschluss
|
|
Caption = "Prüfungsabschluss Reset_KEV1"
|
|
Height = 255
|
|
Left = 270
|
|
TabIndex = 30
|
|
ToolTipText = "Nach der Prüfung werden die Zähler zurückgesetzt."
|
|
Top = 2100
|
|
Value = 1 'Aktiviert
|
|
Width = 2895
|
|
End
|
|
Begin VB.CommandButton cmdPruefungsabschluss
|
|
Caption = "Prüfungsabschluss Reset_KEV1"
|
|
Height = 495
|
|
Left = 1980
|
|
TabIndex = 29
|
|
Top = 2400
|
|
Width = 1515
|
|
End
|
|
Begin VB.CommandButton cmdKonfigVergleich
|
|
Caption = "Konfigurationsvergleich"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 315
|
|
Left = 240
|
|
TabIndex = 28
|
|
Top = 1680
|
|
Width = 2355
|
|
End
|
|
Begin VB.CheckBox chkKonfigurationsvergleich
|
|
Caption = "Konfigurationsvergleich durchführen"
|
|
Height = 255
|
|
Left = 240
|
|
TabIndex = 27
|
|
ToolTipText = "Bei Aktivierung wird nach der Prüfung ein Konfigurationsvergleich durchgeführt."
|
|
Top = 1380
|
|
Value = 1 'Aktiviert
|
|
Width = 3015
|
|
End
|
|
Begin VB.CheckBox chkExternalTemperatur
|
|
Caption = "Vorlauf-Temperatur benutzen"
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 300
|
|
TabIndex = 25
|
|
ToolTipText = "Vorlauftemperatur (aus der SPS) statt angeschlossene Fühler verwenden"
|
|
Top = 240
|
|
Value = 1 'Aktiviert
|
|
Width = 2535
|
|
End
|
|
Begin VB.CheckBox chkProtokolldruck
|
|
Caption = "Protokoll drucken"
|
|
Height = 435
|
|
Left = 240
|
|
TabIndex = 19
|
|
ToolTipText = "Aktivieren Sie diese Checkbox, um nach der Prüfung ein Protokoll zu drucken."
|
|
Top = 960
|
|
Width = 1995
|
|
End
|
|
End
|
|
Begin VB.Timer Timer1
|
|
Enabled = 0 'False
|
|
Interval = 3000
|
|
Left = 14760
|
|
Top = 300
|
|
End
|
|
Begin VB.Frame Frame1
|
|
Caption = "kontinuierliches Scannen der Einbauplätze"
|
|
Height = 825
|
|
Left = 90
|
|
TabIndex = 2
|
|
Top = 5040
|
|
Width = 3405
|
|
Begin VB.CheckBox chkScanCont
|
|
Caption = "auto"
|
|
Height = 255
|
|
Left = 2340
|
|
TabIndex = 24
|
|
ToolTipText = "Bei aktivierung werden alle Einbauplatze wiederholt gescannt."
|
|
Top = 330
|
|
Width = 765
|
|
End
|
|
Begin VB.CommandButton cmdClear
|
|
Caption = "CLR"
|
|
Height = 375
|
|
Left = 180
|
|
TabIndex = 8
|
|
ToolTipText = "Alle gescannten Felder leeren."
|
|
Top = 300
|
|
Width = 855
|
|
End
|
|
Begin VB.CommandButton cmdStart
|
|
Caption = "Scan "
|
|
Height = 375
|
|
Left = 1230
|
|
TabIndex = 3
|
|
ToolTipText = "ALLE Einbauplätze werden nach angeschlossenen Ultraschallzählern gescannt."
|
|
Top = 300
|
|
Width = 855
|
|
End
|
|
End
|
|
Begin MSComDlg.CommonDialog CommonDialog1
|
|
Left = 13860
|
|
Top = 240
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 393216
|
|
End
|
|
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
|
|
Height = 4005
|
|
Left = 120
|
|
TabIndex = 1
|
|
ToolTipText = "einige Felder reagieren auf Doppelklick"
|
|
Top = 1080
|
|
Width = 15165
|
|
_ExtentX = 26749
|
|
_ExtentY = 7064
|
|
_Version = 393216
|
|
Rows = 11
|
|
AllowUserResizing= 1
|
|
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
|
|
Name = "MS Sans Serif"
|
|
Size = 9.75
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
End
|
|
Begin VB.Label lblInfo
|
|
Caption = "lblInfo"
|
|
Height = 255
|
|
Left = 60
|
|
TabIndex = 41
|
|
Top = 120
|
|
Width = 4995
|
|
End
|
|
Begin VB.Label lblUeberschrift
|
|
Alignment = 2 'Zentriert
|
|
Caption = "Prüfvorbereitung der Ultraschallprüfung mit FW2"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 18
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 525
|
|
Left = 4980
|
|
TabIndex = 7
|
|
Top = 360
|
|
Width = 8865
|
|
End
|
|
Begin VB.Label lblAutosize
|
|
BorderStyle = 1 'Fest Einfach
|
|
Caption = "lblAutosize"
|
|
Height = 285
|
|
Left = 13920
|
|
TabIndex = 4
|
|
Top = 720
|
|
Visible = 0 'False
|
|
Width = 975
|
|
End
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmUSFW2Pruefzaehlerpruefung"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
'todo: DefaultMapfile, MapfileDir, Comparefiledir
|
|
|
|
|
|
Private mblnFormIsActivated As Boolean
|
|
|
|
Private mblnIsInTimer As Boolean
|
|
|
|
Private m_strMapfileDir As String
|
|
Private m_strDefaultMapfile As String
|
|
Private m_strCompareFileDir As String
|
|
|
|
|
|
Private miAnzahlerZuErkennenderZaehler As Integer
|
|
|
|
|
|
Private m_colEinbauplatz As Collection
|
|
Private m_colUniquePP As CPruefpunktCol
|
|
Private m_colUniqueVorPP As CVorpruefpunktCol
|
|
|
|
Private m_PruefungsArtWaage As Boolean
|
|
Private m_VorPruefungsArtWaage As Boolean
|
|
|
|
Private m_nRet As Integer
|
|
|
|
Private m_iZustand As Integer
|
|
Private m_Pruefgang As CPruefgang
|
|
Private m_SPS As CSPS
|
|
|
|
|
|
Const ZUSTAND_FW_UNBEKANNT = 0
|
|
Const ZUSTAND_FW_1 = 1
|
|
Const ZUSTAND_FW_2 = 2
|
|
|
|
'Spaltennamen: "Einbauplatz|COM|FW-Generation|Version|Revision|Mapfile|FabNr|SerienNr|Knd.eig-SNr|Auftrag Position|Typ NW||"
|
|
Const SPALTE_Einbauplatz = 0
|
|
Const SPALTE_Com = 1
|
|
Const SPALTE_FabNr = 2
|
|
Const SPALTE_SerienNr = 3
|
|
Const SPALTE_KundeneigeneSNr = 4
|
|
Const SPALTE_Auftragposition = 5
|
|
Const SPALTE_Typangaben = 6
|
|
Const SPALTE_Details = 7
|
|
Const SPALTE_Status = 8
|
|
Const SPALTE_Schloss = 9
|
|
Const SPALTE_FWGen = 10
|
|
Const SPALTE_FWVer = 11
|
|
Const SPALTE_FWRev = 12
|
|
Const SPALTE_Mapfile = 13
|
|
Const SPALTE_CompareFile = 14
|
|
|
|
Const TXT_FW1 = "FW 1"
|
|
Const TXT_FW2 = "FW 2"
|
|
Const TXT_FW_UNBEKANNT = "FW unbekannt"
|
|
|
|
Const TXT_SCHLOSS_CLOSED = "closed"
|
|
Const TXT_SCHLOSS_OPEN = "open"
|
|
|
|
Const TXT_BITTEAUSWAEHLEN = "..."
|
|
|
|
|
|
|
|
Private Sub chkBefundpruefung_Click()
|
|
If chkBefundpruefung.value = vbChecked Then
|
|
' Befundprüfung
|
|
'''''''''''''''
|
|
' Vorprüfung darf nicht durchgefßhrt werden
|
|
chkVorpruefung.value = vbUnchecked
|
|
chkVorpruefung.Enabled = False
|
|
|
|
' Konfig-Vergleich wird nicht durchgeführt
|
|
chkKonfigurationsvergleich.value = vbUnchecked
|
|
|
|
g_blnBefundpruefung = True
|
|
|
|
chkPruefungsabschluss.value = vbUnchecked
|
|
|
|
If Not m_colUniquePP Is Nothing Then
|
|
If m_colUniquePP.Count > 0 Then
|
|
m_colUniquePP.sortQ
|
|
|
|
m_colUniquePP.Vertausche 1, 2
|
|
m_colUniquePP.Vertausche 3, 2
|
|
End If
|
|
End If
|
|
|
|
|
|
|
|
UpdateLstPruefpunkte
|
|
Else
|
|
chkVorpruefung.value = vbChecked
|
|
chkPruefungsabschluss.value = vbChecked
|
|
chkKonfigurationsvergleich.value = vbChecked
|
|
g_blnBefundpruefung = False
|
|
If g_blnVersuch Then
|
|
chkVorpruefung.Enabled = True
|
|
End If
|
|
|
|
If Not m_colUniquePP Is Nothing Then
|
|
If m_colUniquePP.Count > 0 Then
|
|
m_colUniquePP.sortQ
|
|
End If
|
|
End If
|
|
UpdateLstPruefpunkte
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkGetrennteJustage_Click()
|
|
If chkGetrennteJustage.value = vbChecked And chkGetrennteJustage.Enabled = True Then
|
|
chkBedingteQminJustage.Enabled = True
|
|
Else
|
|
chkBedingteQminJustage.Enabled = False
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkHauptpruefung_Click()
|
|
lstPruefpunkte.Enabled = (chkHauptpruefung.value = vbChecked)
|
|
OptPrfArt(0).Enabled = (chkHauptpruefung.value = vbChecked)
|
|
OptPrfArt(1).Enabled = (chkHauptpruefung.value = vbChecked)
|
|
|
|
RecalcPruefpunkte
|
|
End Sub
|
|
|
|
|
|
Private Sub chkMittelwertQi_Click()
|
|
g_blnVorpruefung3malQiMittelwert = (chkMittelwertQi.value = vbChecked)
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
Private Sub chkOptimiertePPReihenfolge_Click()
|
|
If chkOptimiertePPReihenfolge.value = vbChecked Then
|
|
RecalcPruefpunkte
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkPositionenFertigmelden_Click()
|
|
g_blnFertigmelden = (chkPositionenFertigmelden.value = vbChecked)
|
|
End Sub
|
|
|
|
Private Sub chkProtokolldruck_Click()
|
|
If chkProtokolldruck.value = vbChecked Then
|
|
g_blnPruefprotokoll = True
|
|
g_App.Settings.saveStringValue "Vorbelegung", "Protokolldruck", "1"
|
|
Else
|
|
g_blnPruefprotokoll = False
|
|
g_App.Settings.saveStringValue "Vorbelegung", "Protokolldruck", "0"
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkScanCont_Click()
|
|
If chkScanCont.value = vbUnchecked Then
|
|
StopScan
|
|
Else
|
|
Timer1.Enabled = True
|
|
cmdStart_Click
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub chkVorpruefung_Click()
|
|
lstVorpruefpunkte.Enabled = (chkVorpruefung.value = vbChecked)
|
|
|
|
OptVorPrfArt(0).Enabled = (chkVorpruefung.value = vbChecked)
|
|
OptVorPrfArt(1).Enabled = (chkVorpruefung.value = vbChecked)
|
|
|
|
RecalcVorPruefpunkte
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub cmdClear_Click()
|
|
StopScan
|
|
|
|
MSFlexGrid1.Clear
|
|
Set m_colEinbauplatz = New Collection
|
|
Set m_colUniquePP = New CPruefpunktCol
|
|
Set m_colUniqueVorPP = New CVorpruefpunktCol
|
|
|
|
lstPruefpunkte.Clear
|
|
lstVorpruefpunkte.Clear
|
|
|
|
initFlexgrid
|
|
End Sub
|
|
|
|
Private Sub cmdCopy_Click()
|
|
Clipboard.setText MSFlexGrid1.text
|
|
StatusBar1.SimpleText = MSFlexGrid1.text & " wurde ein die Zwischenablage kopiert."
|
|
End Sub
|
|
|
|
Private Sub cmdKonfigVergleich_Click()
|
|
cmdKonfigVergleich.Enabled = False
|
|
Me.MousePointer = vbHourglass
|
|
|
|
Dim iEinbauplatz As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
|
|
g_blnFertigmelden = (chkPositionenFertigmelden.value = vbChecked)
|
|
|
|
iEinbauplatz = Val(cmbKonfigEbp.text)
|
|
|
|
If iEinbauplatz > 0 Then
|
|
Call Konfigurationsvergleich(iEinbauplatz)
|
|
End If
|
|
|
|
Me.MousePointer = vbNormal
|
|
cmdKonfigVergleich.Enabled = True
|
|
End Sub
|
|
|
|
Sub UpdateCmbEbp()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
cmbKonfigEbp.Clear
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
|
If Einbauplatz.m_strMapfile <> "" And Einbauplatz.m_strCompareFile <> "" Then
|
|
cmbKonfigEbp.AddItem Einbauplatz.getNr
|
|
If cmbKonfigEbp.ListIndex = -1 Then cmbKonfigEbp.ListIndex = 0
|
|
End If
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub KonfigVergleich_alle_Zaehler()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim EinbauplatzNr As Integer
|
|
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
If Einbauplatz.m_strMapfile <> "" And Einbauplatz.m_strCompareFile <> "" Then
|
|
StatusBar1.SimpleText = "Konfigurationsvergleich für Einbauplatz " & Einbauplatz.getNr
|
|
|
|
Konfigurationsvergleich Einbauplatz.getNr
|
|
|
|
End If
|
|
Next
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Konfigurationsvergleich(EinbauplatzNr As Integer)
|
|
Dim objForm As frmUSFW2Konfigurationsvergleich
|
|
|
|
|
|
|
|
Set objForm = New frmUSFW2Konfigurationsvergleich
|
|
Set objForm.m_Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
|
|
|
|
WriteToFW2Logfile objForm.m_Einbauplatz, "Konfigvergleich"
|
|
|
|
objForm.Show vbModal, Me
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
''''''''''''''''''''''''''''''''''
|
|
Private Sub cmdPP_Down_Click()
|
|
Dim Index As Integer
|
|
If lstPruefpunkte.ListIndex < 0 Then Exit Sub
|
|
Index = lstPruefpunkte.ListIndex + 1
|
|
|
|
If Index < m_colUniquePP.Count Then
|
|
m_colUniquePP.Vertausche Index, Index + 1
|
|
End If
|
|
|
|
UpdateLstPruefpunkte
|
|
If lstPruefpunkte.ListCount - 1 >= Index Then
|
|
lstPruefpunkte.ListIndex = Index
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdPP_Up_Click()
|
|
Dim Index As Integer
|
|
If lstPruefpunkte.ListIndex < 0 Then Exit Sub
|
|
Index = lstPruefpunkte.ListIndex + 1
|
|
|
|
If Index - 1 >= 1 Then
|
|
m_colUniquePP.Vertausche Index, Index - 1
|
|
End If
|
|
|
|
UpdateLstPruefpunkte
|
|
|
|
lstPruefpunkte.ListIndex = Index - 2
|
|
|
|
End Sub
|
|
|
|
Private Sub UpdateLstPruefpunkte()
|
|
Dim i As Integer
|
|
Dim strQ As String
|
|
If m_colUniquePP Is Nothing Then Exit Sub
|
|
If m_colUniquePP.Count = 0 Then Exit Sub
|
|
|
|
If lstPruefpunkte.ListIndex > -1 Then
|
|
strQ = lstPruefpunkte.List(lstPruefpunkte.ListIndex)
|
|
End If
|
|
|
|
lstPruefpunkte.Clear
|
|
For i = 1 To m_colUniquePP.Count
|
|
Debug.Print i & ": " & m_colUniquePP.Item(i).getQ & " (" & m_colUniquePP.Item(i).GetTime & " s = " & Format(m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ & " (" & m_colUniquePP.Item(i).GetTime & " s = " & Format(m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
|
|
If CStr(m_colUniquePP.Item(i).getQ) = strQ And strQ <> "" Then
|
|
lstPruefpunkte.ListIndex = i - 1
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdPruefungsinitialisierung_Click()
|
|
cmdPruefungsinitialisierung.Enabled = False
|
|
USPruefungInitialisierung
|
|
cmdPruefungsinitialisierung.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub cmdPruefungsabschluss_Click()
|
|
cmdPruefungsabschluss.Enabled = False
|
|
USPruefungAbschlussAlleZaehler False
|
|
cmdPruefungsabschluss.Enabled = True
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdQuit_Click()
|
|
Timer1.Enabled = False
|
|
If mblnIsInTimer Then
|
|
Exit Sub
|
|
End If
|
|
endDialog IDCANCEL
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Private Sub cmdRückläufer_Click()
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim intEinbauplatzNr As Integer
|
|
intEinbauplatzNr = Val(InputBox("Bitte geben Sie die EinbauplatzNr ein", "Rückläufer"))
|
|
If intEinbauplatzNr < 0 Then Exit Sub
|
|
If intEinbauplatzNr > 10 Then Exit Sub
|
|
|
|
Dim objForm As frmRuecklaeuferanalyse
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim Einbauplatz As CEinbauplatz
|
|
|
|
Set objForm = New frmRuecklaeuferanalyse
|
|
|
|
If intEinbauplatzNr > 0 Then
|
|
Set Einbauplatz = m_colEinbauplatz.Item(intEinbauplatzNr)
|
|
objForm.m_EinbauplatzNr = Einbauplatz.getNr
|
|
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
|
|
If Not Pruefzaehler Is Nothing Then
|
|
Set objForm.m_Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
End If
|
|
End If
|
|
|
|
Set objForm.m_Pruefgang = m_Pruefgang
|
|
objForm.Show vbModal, Me
|
|
|
|
Errorhandler:
|
|
End Sub
|
|
|
|
Private Sub cmdStart_Click()
|
|
cmdStart.Enabled = False
|
|
|
|
ScanAlleEinbauplaetze
|
|
|
|
cmdStart.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub Optionen_Voreinstellungen()
|
|
If g_blnVersuch = False Then
|
|
' Produktion
|
|
|
|
chkOptimiertePPReihenfolge.Enabled = False
|
|
|
|
' neu RH 6.2.2014: "bedingt und getrennt" als default
|
|
'chkBedingteQminJustage.value = vbChecked
|
|
|
|
' neu RH 6.2.2014: "bedingt und getrennt" als default
|
|
chkBedingteQminJustage.value = vbUnchecked
|
|
chkBedingteQminJustage.Enabled = False
|
|
|
|
chkGetrennteJustage.value = vbChecked
|
|
chkGetrennteJustage.Enabled = False
|
|
|
|
chkOffset_Qi.value = vbUnchecked
|
|
' Produktion darf auch Qmin-Offset eingeben
|
|
chkOffset_Qi.Enabled = True
|
|
|
|
''''''''' Vorprüfung gegen Referenzzähler
|
|
' Justage (Vorprüfung) nur gegen Waage (J.Lippold am 24.9.13)
|
|
chkVorpruefung.value = vbChecked
|
|
OptVorPrfArt(0).value = True
|
|
' Justage gegen Referenzzähler deaktivieren
|
|
OptVorPrfArt(1).Enabled = False
|
|
|
|
|
|
' Hauptprüfung gegen Waage
|
|
chkHauptpruefung.value = vbChecked
|
|
OptPrfArt(0).value = True
|
|
' Hauptprüfung gegen Refz deaktivieren
|
|
OptPrfArt(1).Enabled = False
|
|
|
|
' Mittelwertbildung ist noch nicht für Produktion freigegeben!
|
|
chkMittelwertQi.Enabled = False
|
|
chkMittelwertQi.Visible = False
|
|
|
|
txtAnzahlJustageDurchgaenge.text = "3"
|
|
txtAnzahlJustageDurchgaenge.Enabled = False
|
|
|
|
chkPositionenFertigmelden.value = vbChecked
|
|
chkPositionenFertigmelden.Enabled = False
|
|
|
|
chkJustagewerteNICHTschreiben.value = vbUnchecked
|
|
chkJustagewerteNICHTschreiben.Enabled = False
|
|
Else
|
|
chkOptimiertePPReihenfolge.value = vbUnchecked
|
|
chkOptimiertePPReihenfolge.Enabled = True
|
|
|
|
' Mittelwertbildung vorerst nur für Versuch
|
|
chkMittelwertQi.Enabled = True
|
|
chkMittelwertQi.Visible = True
|
|
|
|
chkPositionenFertigmelden.Enabled = True
|
|
chkPositionenFertigmelden.value = vbChecked
|
|
|
|
chkOffset_Qi.value = vbUnchecked
|
|
chkOffset_Qi.Enabled = True
|
|
|
|
chkGetrennteJustage.value = False
|
|
chkBedingteQminJustage.value = False
|
|
|
|
chkGetrennteJustage.Enabled = True
|
|
|
|
txtAnzahlJustageDurchgaenge.Enabled = True
|
|
txtAnzahlJustageDurchgaenge.text = "3"
|
|
|
|
chkJustagewerteNICHTschreiben.value = vbUnchecked
|
|
chkJustagewerteNICHTschreiben.Enabled = True
|
|
|
|
End If
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Activate()
|
|
If mblnFormIsActivated = False Then
|
|
mblnFormIsActivated = True
|
|
|
|
Optionen_Voreinstellungen
|
|
|
|
Test_For_MBUS_SMS_DLLs
|
|
End If
|
|
|
|
|
|
If g_App.Settings.readStringValue("Vorbelegung", "Protokolldruck", "") = "1" Then
|
|
chkProtokolldruck.value = vbChecked
|
|
Else
|
|
chkProtokolldruck.value = vbUnchecked
|
|
End If
|
|
|
|
ReformatFlexgrid
|
|
End Sub
|
|
|
|
Private Sub Test_For_MBUS_SMS_DLLs()
|
|
On Error Resume Next
|
|
tryagain_MBUS:
|
|
modMBUS_SMS.Init_MBUS_SMS
|
|
Select Case Err.Number
|
|
Case 0
|
|
Case 53
|
|
If MsgBox("Die Datei MBUS_SMS.dll für die Kommunikation mit FW2 Ultraschallzähler ist nicht installiert. Möchten Sie sie jetzt installieren?", vbYesNo Or vbDefaultButton1) = vbYes Then
|
|
|
|
Install_FW2_DLL "MBUS_SMS.dll"
|
|
Install_FW2_DLL "fw2_ieccom32.dll"
|
|
|
|
GoTo tryagain_MBUS
|
|
Else
|
|
Exit Sub
|
|
End If
|
|
Case Else
|
|
MsgBox "Fehler " & Err.Number & " in Test_For_MBUS_SMS_DLLs(): " & Err.Description
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub Install_FW2_DLL(strDatei As String)
|
|
Dim strSource As String
|
|
Dim strDest As String
|
|
|
|
Dim fso As FileSystemObject
|
|
Set fso = New FileSystemObject
|
|
|
|
On Error GoTo Errorhandler
|
|
Err.Clear
|
|
|
|
strSource = "\\sla12file\Auftrag\Pruefstation 2000 EXE\FW2\WINDOWS-SYSTEM32\" & strDatei
|
|
strDest = WinSysDir()
|
|
|
|
If fso.FileExists(strSource) And fso.FolderExists(WinSysDir()) Then
|
|
If Not fso.FileExists(strDest & "\" & strDatei) Then
|
|
fso.CopyFile strSource, strDest & "\"
|
|
End If
|
|
End If
|
|
Exit Sub
|
|
Errorhandler:
|
|
MsgBox Err.Number & " in Install_FW2_DLL(" & strSource & "): " & Err.Description
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Form_Load()
|
|
Dim i As Integer
|
|
Dim iCom As Integer
|
|
Dim j As Integer
|
|
|
|
Me.Width = Screen.Width
|
|
Me.Height = Screen.Height
|
|
Me.WindowState = vbMaximized
|
|
Me.caption = "Pruef2000 FW2 Ultraschallzähler Prüfung Version" & g_App.AppVersion
|
|
|
|
lblInfo.caption = g_App.AppVersion & " " & Format(Now(), "dd.mm.yyyy hh:mm") & " " & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName
|
|
|
|
g_frmMain.Visible = False
|
|
|
|
m_iZustand = ZUSTAND_FW_UNBEKANNT
|
|
|
|
' Todo in Settings definieren
|
|
m_strMapfileDir = g_App.Settings.readStringValue("USFirmware2", "Mapfiles", "")
|
|
If m_strMapfileDir = "" Then
|
|
MapfileError:
|
|
m_strMapfileDir = InputBox("In welchem Ordner werden die Mapfiles erwartet?", "INI Wert nicht vorhanden.", "\\sla12file\PolluStatDataExchangeLULA\Mapfiles\")
|
|
If m_strMapfileDir = "" Or Dir(m_strMapfileDir) = "" Then
|
|
GoTo MapfileError
|
|
Else
|
|
Call g_App.Settings.saveStringValue("USFirmware2", "Mapfiles", m_strMapfileDir)
|
|
End If
|
|
End If
|
|
|
|
m_strDefaultMapfile = g_App.Settings.readStringValue("USFirmware2", "DefaultMapfile", "")
|
|
If m_strDefaultMapfile = "" Then
|
|
DefaultMapfileError:
|
|
m_strDefaultMapfile = InputBox("Welches Mapfile wird zur Versionsbestimmung verwendet?", "INI Wert nicht vorhanden.", "\\sla12file\PolluStatDataExchangeLULA\Mapfiles\PSEV522_R268_P167.txt")
|
|
If m_strDefaultMapfile = "" Or Dir(m_strDefaultMapfile) = "" Then
|
|
MsgBox "Datei nicht vorhanden"
|
|
GoTo DefaultMapfileError
|
|
Else
|
|
Call g_App.Settings.saveStringValue("USFirmware2", "DefaultMapfile", m_strMapfileDir)
|
|
End If
|
|
End If
|
|
|
|
|
|
m_strCompareFileDir = g_App.Settings.readStringValue("USFirmware2", "Comparefiles", "")
|
|
If m_strCompareFileDir = "" Then
|
|
ComparefielError:
|
|
m_strCompareFileDir = InputBox("In welchem Ordner werden die Comparefiles erwartet?", "INI Wert nicht vorhanden.", "\\sla12file\PolluStatDataExchangeLULA\Comparefiles\")
|
|
If Dir(m_strCompareFileDir) = "" Or m_strCompareFileDir = "" Then
|
|
MsgBox "Datei nicht vorhanden"
|
|
GoTo ComparefielError
|
|
Else
|
|
Call g_App.Settings.saveStringValue("USFirmware2", "Comparefiles", m_strCompareFileDir)
|
|
End If
|
|
End If
|
|
|
|
g_strUSFW2logfileDir = g_App.Settings.readStringValue("USFirmware2", "Logfiles", "")
|
|
If g_strUSFW2logfileDir = "" Then
|
|
logfileError:
|
|
g_strUSFW2logfileDir = InputBox("In welchem Ordner werden die Logfiles erwartet?", "INI Wert nicht vorhanden.", "\\sla12file\PolluStatDataExchangeLULA\Logfiles\")
|
|
If g_strUSFW2logfileDir = "" Or Dir(g_strUSFW2logfileDir) = "" Then
|
|
MsgBox "Ordner '' nicht erlaubt."
|
|
GoTo logfileError
|
|
Else
|
|
Call g_App.Settings.saveStringValue("USFirmware2", "Logfiles", g_strUSFW2logfileDir)
|
|
End If
|
|
End If
|
|
|
|
g_strUSFW2logfile = g_strUSFW2logfileDir & ""
|
|
|
|
initFlexgrid
|
|
|
|
PrintStatus "Bitte Optoköpfe auflegen und rote Taste drücken!"
|
|
|
|
|
|
|
|
Select Case g_App.Settings.USPruefungsArt
|
|
Case "Waage"
|
|
OptPrfArt(0).value = True
|
|
OptPrfArt(1).value = False
|
|
m_PruefungsArtWaage = True
|
|
Case "Referenzzaehler"
|
|
OptPrfArt(0).value = False
|
|
OptPrfArt(1).value = True
|
|
m_PruefungsArtWaage = False
|
|
Case Else
|
|
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei für Prüfungsart"
|
|
exitInstance
|
|
End Select
|
|
|
|
' Initialisierung der RadioButtons "Vorprüfung PruefungsArt"
|
|
Select Case g_App.Settings.USVorPruefungsArt
|
|
Case "Waage"
|
|
OptVorPrfArt(0).value = True
|
|
OptVorPrfArt(1).value = False
|
|
m_VorPruefungsArtWaage = True
|
|
Case "Referenzzaehler"
|
|
OptVorPrfArt(0).value = False
|
|
OptVorPrfArt(1).value = True
|
|
m_VorPruefungsArtWaage = False
|
|
Case Else
|
|
ErrorMsg "keiner oder unbekannter Eintrag in ini-Datei für USPrüfungsart"
|
|
exitInstance
|
|
End Select
|
|
|
|
If g_ohneSPS Then
|
|
Set m_SPS = g_App.getSPS
|
|
End If
|
|
|
|
|
|
|
|
|
|
chkVorpruefung_Click
|
|
chkHauptpruefung_Click
|
|
chkBefundpruefung_Click
|
|
|
|
chkPruefungsabschluss.value = vbChecked
|
|
chkKonfigurationsvergleich.value = vbChecked
|
|
|
|
If g_blnVersuch Then
|
|
chkPruefungsabschluss.Enabled = True
|
|
chkExternalTemperatur.Enabled = True
|
|
chkRechenwerkSystemzeit.Enabled = True
|
|
chkKonfigurationsvergleich.Enabled = True
|
|
Else
|
|
chkPruefungsabschluss.Enabled = False
|
|
chkExternalTemperatur.Enabled = False
|
|
chkRechenwerkSystemzeit.Enabled = False
|
|
chkKonfigurationsvergleich.Enabled = False
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub initFlexgrid()
|
|
Dim iCom As Integer
|
|
Dim i As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim j As Integer
|
|
|
|
MSFlexGrid1.Clear
|
|
MSFlexGrid1.Cols = 15
|
|
MSFlexGrid1.Rows = 1
|
|
MSFlexGrid1.row = 0
|
|
|
|
MSFlexGrid1.col = SPALTE_Einbauplatz
|
|
MSFlexGrid1.text = "Ebp"
|
|
|
|
MSFlexGrid1.col = SPALTE_Com
|
|
MSFlexGrid1.text = "COM"
|
|
|
|
MSFlexGrid1.col = SPALTE_FWGen
|
|
MSFlexGrid1.text = "FW-Gen"
|
|
|
|
MSFlexGrid1.col = SPALTE_FWVer
|
|
MSFlexGrid1.text = "Ver"
|
|
|
|
MSFlexGrid1.col = SPALTE_FWRev
|
|
MSFlexGrid1.text = "Rev"
|
|
|
|
MSFlexGrid1.col = SPALTE_Mapfile
|
|
MSFlexGrid1.text = "Mapfile"
|
|
|
|
MSFlexGrid1.col = SPALTE_FabNr
|
|
MSFlexGrid1.text = "FabNr"
|
|
|
|
MSFlexGrid1.col = SPALTE_SerienNr
|
|
MSFlexGrid1.text = "Sensus SNr"
|
|
|
|
MSFlexGrid1.col = SPALTE_KundeneigeneSNr
|
|
MSFlexGrid1.text = "Knd.eig-SNr"
|
|
|
|
MSFlexGrid1.col = SPALTE_Auftragposition
|
|
MSFlexGrid1.text = "Auftrag Position"
|
|
|
|
MSFlexGrid1.col = SPALTE_Typangaben
|
|
MSFlexGrid1.text = "Typ NW"
|
|
|
|
MSFlexGrid1.col = SPALTE_Details
|
|
MSFlexGrid1.text = "Details"
|
|
|
|
MSFlexGrid1.col = SPALTE_Status
|
|
MSFlexGrid1.text = "Status"
|
|
|
|
MSFlexGrid1.col = SPALTE_CompareFile
|
|
MSFlexGrid1.text = "CompareFile"
|
|
|
|
MSFlexGrid1.col = SPALTE_Schloss
|
|
MSFlexGrid1.text = "Schloss"
|
|
|
|
'MSFlexGrid1.FormatString = "Ebp|COM|FW-Gen|Ver.|Rev.|Mapfile|FabNr|Sensus SNr|Knd.eig-SNr|Auftrag Position|Typ NW|Details|Status|CompareFile|Schloss"
|
|
|
|
Set m_colEinbauplatz = New Collection
|
|
|
|
For i = 1 To 10
|
|
If i <= g_App.Settings.EinbauplaetzeJeStrang Then
|
|
MSFlexGrid1.AddItem i
|
|
Set Einbauplatz = New CEinbauplatz
|
|
Einbauplatz.setNr i
|
|
|
|
m_colEinbauplatz.Add Einbauplatz
|
|
|
|
|
|
For j = 0 To MSFlexGrid1.Cols - 1
|
|
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
|
|
MSFlexGrid1.col = j
|
|
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
|
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Next
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(i))
|
|
If iCom > 0 Then
|
|
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = iCom
|
|
'Einbauplatz.m_iComport = iCom
|
|
Else
|
|
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = ""
|
|
End If
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
|
StopScan
|
|
End Sub
|
|
|
|
Private Sub StopScan()
|
|
Timer1.Enabled = False
|
|
cmdStart.Enabled = True
|
|
chkScanCont.value = vbUnchecked
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_Resize()
|
|
frMain.Left = 0
|
|
frMain.Top = 0
|
|
|
|
'frMain.Width = Me.Width
|
|
'frMain.Height = Me.Height
|
|
|
|
frMain.Width = TwipsPerPixelX(1024)
|
|
frMain.Height = TwipsPerPixelY(800)
|
|
|
|
|
|
MSFlexGrid1.Width = (frMain.Width - 2 * MSFlexGrid1.Left)
|
|
|
|
' Dim nLeft As Long
|
|
' Dim nTop As Long
|
|
'
|
|
' Call centerFormInScreen(Me)
|
|
'
|
|
' ' Datenanzeigebereich zentrieren
|
|
' ' ------------------------------
|
|
' nLeft = (Me.ScaleWidth - Me.frMain.Width) \ 2
|
|
' nTop = (Me.ScaleHeight - Me.frMain.Height) \ 2
|
|
' frMain.BorderStyle = 0
|
|
' frMain.Left = nLeft
|
|
' frMain.Top = nTop
|
|
|
|
|
|
' cmdWeiter.Left = frMain.Width - cmdWeiter.Width * 1.1
|
|
' cmdQuit.Left = cmdWeiter.Left - cmdQuit.Width * 1.1
|
|
' cmdQuit.Top = frMain.Height - StatusBar1.Height - cmdQuit.Height * 1.3
|
|
' cmdWeiter.Top = cmdQuit.Top
|
|
' cmdKonfigVergleich.Top = cmdQuit.Top
|
|
' cmdKonfigVergleich.Left = cmdQuit.Left - cmdKonfigVergleich.Width * 1.1
|
|
'
|
|
lblUeberschrift.Left = (frMain.Width - lblUeberschrift.Width) / 2
|
|
End Sub
|
|
|
|
Private Sub Einbauplatzleeren(EinbauplatzNr As Integer)
|
|
Dim Einbauplatz As CEinbauplatz
|
|
|
|
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
|
|
Einbauplatz.setPruefzaehler Nothing
|
|
|
|
Dim col As Integer
|
|
For col = 2 To MSFlexGrid1.Cols - 1
|
|
MSFlexGrid1.col = col
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.text = ""
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Next
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub lstVorpruefpunkte_DblClick()
|
|
Dim i As Integer
|
|
Dim strTemp As String
|
|
Dim time As Long
|
|
|
|
If Not g_blnVersuch Then Exit Sub
|
|
|
|
i = lstVorpruefpunkte.ListIndex + 1
|
|
time = m_colUniqueVorPP.Item(i).GetTime
|
|
|
|
strTemp = InputBox("Geben Sie die neue Zeit für den Prüfpunkt (Q=" & m_colUniqueVorPP.Item(i).getQ & ") in Sec an", "Zeit für Vorprüfpunkt ändern", time)
|
|
|
|
If IsNumeric(strTemp) Then
|
|
time = Val(strTemp)
|
|
m_colUniqueVorPP.Item(i).SetTime time
|
|
|
|
RecalcVorPruefpunkte
|
|
|
|
UpdateVorpruefpunkteListe
|
|
Else
|
|
MsgBox "Wert ist nicht numerisch. Keine Änderung."
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub MSFlexGrid1_Click()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim iCom As Integer
|
|
|
|
|
|
StopScan
|
|
If mblnIsInTimer Then
|
|
Exit Sub
|
|
End If
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(MSFlexGrid1.row))
|
|
If iCom = 0 Then Exit Sub
|
|
Set Einbauplatz = m_colEinbauplatz.Item(MSFlexGrid1.row)
|
|
|
|
If MSFlexGrid1.col = SPALTE_Com Or MSFlexGrid1.col = SPALTE_FWGen Then
|
|
' Klick auf COM-Port oder FW-Generation: einzelnen Zähler dieser Zeile erneut scannen
|
|
ClearUndScanneEinbauplatz Einbauplatz.getNr
|
|
End If
|
|
|
|
ReformatFlexgrid
|
|
End Sub
|
|
|
|
|
|
Private Sub ClearUndScanneEinbauplatz(EinbauplatzNr As Integer)
|
|
Dim intSpalte As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
|
|
For intSpalte = SPALTE_Com + 1 To MSFlexGrid1.Cols - 1
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = intSpalte
|
|
MSFlexGrid1.text = ""
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Next
|
|
DoEvents
|
|
|
|
Set Einbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
Einbauplatz.setPruefzaehler Nothing
|
|
ScanEinbauplatz MSFlexGrid1.row
|
|
|
|
End Sub
|
|
|
|
Private Sub MSFlexGrid1_DblClick()
|
|
Dim intSpalte As Integer
|
|
Dim intVersion As Integer
|
|
Dim intRevision As Integer
|
|
Dim strMapfile As String
|
|
Dim iret As Integer
|
|
Dim iCom As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim byteSchloss As Byte
|
|
|
|
StopScan
|
|
|
|
If mblnIsInTimer Then
|
|
Exit Sub
|
|
End If
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(MSFlexGrid1.row))
|
|
If iCom = 0 Then Exit Sub
|
|
Set Einbauplatz = m_colEinbauplatz.Item(MSFlexGrid1.row)
|
|
|
|
If MSFlexGrid1.col = SPALTE_Com Or MSFlexGrid1.col = SPALTE_FWGen Then
|
|
' Klick auf COM-Port oder FW-Generation: einzelnen Zähler dieser Zeile erneut scannen
|
|
For intSpalte = SPALTE_Com + 1 To MSFlexGrid1.Cols - 1
|
|
MSFlexGrid1.col = intSpalte
|
|
MSFlexGrid1.text = ""
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Next
|
|
DoEvents
|
|
ScanEinbauplatz MSFlexGrid1.row
|
|
|
|
ElseIf MSFlexGrid1.col = SPALTE_Mapfile Then
|
|
' Klick auf Mapfile
|
|
intVersion = Val(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, SPALTE_FWVer))
|
|
intRevision = Val(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, SPALTE_FWRev))
|
|
|
|
' kein passendes Mapfile vorhanden oder nicht das Ideale Mapfile wurde eingetragen
|
|
If MSFlexGrid1.text = TXT_BITTEAUSWAEHLEN Or (MSFlexGrid1.text <> GetMapfilePathFromVersionRevision(intVersion, intRevision) And intVersion > 0 And intRevision > 0) Then
|
|
CommonDialog1.filename = ""
|
|
CommonDialog1.InitDir = m_strMapfileDir
|
|
CommonDialog1.ShowOpen
|
|
If CommonDialog1.filename <> "" Then
|
|
strMapfile = CommonDialog1.filename
|
|
If Dir(strMapfile) <> "" Then
|
|
|
|
MSFlexGrid1.text = filename(strMapfile)
|
|
Set Einbauplatz = m_colEinbauplatz.Item(MSFlexGrid1.row)
|
|
Einbauplatz.m_strMapfile = strMapfile
|
|
|
|
ScanEinbauplatz Einbauplatz.getNr
|
|
|
|
' iret = modMBUS_SMS.fw2_open_comport(iCom, 2400, strMapfile, True)
|
|
' StatusBar1.SimpleText = "COM " & iCom & " geöffnet"
|
|
' If iret = 0 Then
|
|
' If UpdateFlexgridFabNrSerienr(MSFlexGrid1.row) Then
|
|
' UpdateFlexgridSerienNr (MSFlexGrid1.row)
|
|
' UeberpruefeEinbauplatz MSFlexGrid1.row
|
|
' End If
|
|
' Else
|
|
' MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
' End If
|
|
' iret = modMBUS_SMS.IECCOM_CloseCom
|
|
' StatusBar1.SimpleText = "COM geschlossen"
|
|
|
|
|
|
End If
|
|
|
|
|
|
ReformatFlexgrid
|
|
End If
|
|
End If
|
|
ElseIf MSFlexGrid1.col = SPALTE_SerienNr Then
|
|
Dim lngSerienNr As Long
|
|
Dim lngFabNr As Long
|
|
Dim lngAlteSerienNr As Long
|
|
Dim Aps As CAuftragPositionSerienNr
|
|
|
|
lngAlteSerienNr = Val(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, SPALTE_SerienNr))
|
|
'If lngAlteSerienNr > 0 Then Exit Sub
|
|
|
|
lngFabNr = Val(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, SPALTE_FabNr))
|
|
If lngFabNr = 0 Then Exit Sub
|
|
|
|
lngSerienNr = Val(GetSerienNrFromDialog())
|
|
|
|
If Not UeberpruefeSerienNr(lngSerienNr, Einbauplatz) Then
|
|
Exit Sub
|
|
End If
|
|
'lngSerienNr = Val(InputBox("Bitte geben Sie die SerienNr an, die zukünftig mit dieser FabNr " & lngFabNr & " verknüpft werden soll:"))
|
|
|
|
If lngSerienNr > 0 Then
|
|
' Eingabe der SerienNr wurde vorgenommen
|
|
|
|
'' FabNr bei der neuen SerienNr eintragen
|
|
Set Aps = New CAuftragPositionSerienNr
|
|
Aps.load lngSerienNr
|
|
If Aps.getAuftragNr = 0 Then
|
|
MsgBox "Auftrag nicht vorhanden"
|
|
Exit Sub
|
|
End If
|
|
|
|
If lngAlteSerienNr = lngSerienNr Then
|
|
MsgBox "Es wurden keine Änderungen vorgenommen."
|
|
Exit Sub
|
|
ElseIf lngAlteSerienNr > 0 Then
|
|
' SerienNr wurde schon festgelegt
|
|
If MsgBox("Sind Sie sicher, daß Sie das Rechenwerk mit der FabNr " & lngFabNr & " der neuen SerienNr " & lngSerienNr & " zuordnen wollen?" & vbCrLf & "Die bisherige Verknüpfung zur SerienNr " & lngAlteSerienNr & " wird gelöscht.", vbOKCancel Or vbDefaultButton2) = vbCancel Then
|
|
Exit Sub
|
|
Else
|
|
Dim strSQL As String
|
|
strSQL = "UPDATE AuftragPositionSerienNr set FabNr = NULL where FabNr = " & lngFabNr & " and SerienNr = " & lngAlteSerienNr
|
|
g_App.getDB.getConnection.Execute strSQL
|
|
End If
|
|
Else
|
|
' SerienNr wurde noch nicht zur FabNr festgelegt
|
|
If MsgBox("Sind Sie sicher, daß Sie das Rechenwerk mit der FabNr " & lngFabNr & " der SerienNr " & lngSerienNr & " zuordnen wollen?", vbOKCancel Or vbDefaultButton2) = vbCancel Then
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
' FabNr für diese SerienNr ist frei
|
|
MSFlexGrid1.TextMatrix(MSFlexGrid1.row, SPALTE_SerienNr) = lngSerienNr
|
|
Aps.setFabNr lngFabNr
|
|
Aps.save
|
|
|
|
If UpdateFlexgridSerienNr(MSFlexGrid1.row) Then
|
|
UeberpruefeEinbauplatz MSFlexGrid1.row
|
|
End If
|
|
Else
|
|
' Eingabe der SerienNr wurde abgebrochen
|
|
MsgBox "Es wurden keine Änderungen vorgenommen."
|
|
End If
|
|
ElseIf MSFlexGrid1.col = SPALTE_Details Then
|
|
Call ShowDetails(MSFlexGrid1.row)
|
|
CheckBefundpruefung Einbauplatz
|
|
ElseIf MSFlexGrid1.col = SPALTE_CompareFile Then
|
|
Dim strCompareFileDir As String
|
|
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
|
If g_blnVersuch Then
|
|
CommonDialog1.InitDir = m_strCompareFileDir
|
|
CommonDialog1.Filter = "*.cmp"
|
|
CommonDialog1.filename = MSFlexGrid1.text
|
|
CommonDialog1.ShowOpen
|
|
|
|
If CommonDialog1.filename <> "" Then
|
|
If Dir(CommonDialog1.filename) <> "" Then
|
|
MSFlexGrid1.text = filename(CommonDialog1.filename)
|
|
Einbauplatz.m_strCompareFile = CommonDialog1.filename
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Else
|
|
MsgBox "Die Datei " & CommonDialog1.filename & " ist nicht vorhanden!"
|
|
'MSFlexGrid1.text = ""
|
|
Einbauplatz.m_strCompareFile = ""
|
|
End If
|
|
Else
|
|
If Einbauplatz.m_strCompareFile <> "" Then
|
|
MSFlexGrid1.text = filename(Einbauplatz.m_strCompareFile)
|
|
Else
|
|
MSFlexGrid1.text = TXT_BITTEAUSWAEHLEN
|
|
MSFlexGrid1.CellBackColor = vbRed
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
ElseIf MSFlexGrid1.col = SPALTE_Status Then
|
|
'' hier z.B. anzeigen: Ergebnis letzter Prüfung
|
|
ElseIf MSFlexGrid1.col = SPALTE_Schloss Then
|
|
' Versuchprüfer können das Schloss öffnen und schliessen
|
|
' ebenso Produktiv-Prüfer bei einer Befundprüfung
|
|
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
|
If g_blnVersuch Or Einbauplatz.getPruefzaehler.getAuftragPosition.GetBefundpruefung Or g_blnBefundpruefung Then
|
|
DialogSchlossOeffnenSchliessen Einbauplatz
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
ReformatFlexgrid
|
|
End Sub
|
|
|
|
|
|
Private Function GetMapfilePathFromVersionRevision(intVersion As Integer, intRevision As Integer) As String
|
|
GetMapfilePathFromVersionRevision = m_strMapfileDir & "PSEV" & intVersion & "_R" & intRevision & ".txt"
|
|
End Function
|
|
|
|
|
|
Function GetSerienNrFromDialog() As String
|
|
Dim lngColor As Long
|
|
Dim frmDialog As frmSeriennrAuswahl
|
|
Dim i As Integer
|
|
Dim strSerienNr As String
|
|
|
|
Set frmDialog = New frmSeriennrAuswahl
|
|
' For i = 1 To 10
|
|
' g_Seriennr(i) = txtSerienNr(i)
|
|
' Next
|
|
|
|
frmDialog.Show vbModal, Me
|
|
'txtSerienNr(Index).BackColor = lngColor
|
|
|
|
strSerienNr = frmDialog.sSerienNr
|
|
If IsNumeric(strSerienNr) Then
|
|
'txtSerienNr(Index).text = Trim(frmDialog.sSerienNr)
|
|
'bTextChanged(Index) = True
|
|
'txtSerienNr(Index).SetFocus
|
|
'Call ueberpruefe(Index, Val(frmDialog.lngAuftrag))
|
|
GetSerienNrFromDialog = strSerienNr
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Private Sub Timer1_Timer()
|
|
If mblnIsInTimer = True Then Exit Sub
|
|
mblnIsInTimer = True
|
|
If Timer1.Enabled = True Then
|
|
'Scan
|
|
|
|
ScanAlleEinbauplaetze
|
|
|
|
If chkScanCont.value = vbUnchecked Then
|
|
StopScan
|
|
Else
|
|
Timer1.Interval = 5000
|
|
End If
|
|
|
|
End If
|
|
mblnIsInTimer = False
|
|
|
|
TestAufEinheitlicheFirmware
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
' automatisch beenden, wenn alle (!) Einbauplätze mit definiertem COMPort mit gleicher Firmware
|
|
' Mapfile-Vorhandensein testen
|
|
|
|
|
|
Private Sub ScanAlleEinbauplaetze()
|
|
Dim i As Integer
|
|
|
|
Me.MousePointer = vbHourglass
|
|
'' für alle Einbauplätze
|
|
For i = 1 To 10
|
|
'nur belegte Einbauplätze
|
|
If i <= g_App.Settings.EinbauplaetzeJeStrang Then
|
|
|
|
ScanEinbauplatz i
|
|
|
|
|
|
End If
|
|
Next
|
|
|
|
'''Timer1.Enabled = False
|
|
Me.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
|
|
Private Sub ScanEinbauplatz(EinbauplatzNr As Integer)
|
|
Dim iCom As Integer ' COMPOrt
|
|
Dim iret As Integer
|
|
Dim strMapfile As String
|
|
Dim strFWGeneration As String
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim byteSchloss As Byte
|
|
|
|
Set Einbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
|
|
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_Com
|
|
MSFlexGrid1.CellBackColor = RGB(255, 255, 129)
|
|
|
|
DoEvents
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
If iCom > 0 Then
|
|
Einbauplatz.m_iComport = iCom
|
|
|
|
' nur die Einbauplätze mit definiertem COM-Port
|
|
' Einbauplatz ist in der INI definiert und mit einem COM Port verknüpft
|
|
|
|
' markiere COM-Port, der gerade gescannt wird
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_Com
|
|
MSFlexGrid1.CellBackColor = vbYellow
|
|
|
|
MSFlexGrid1.col = SPALTE_FWGen
|
|
|
|
If UpdateFlexgridFWGeneration(EinbauplatzNr, strFWGeneration) Then
|
|
DoEvents
|
|
If strFWGeneration = TXT_FW2 Then
|
|
DoEvents
|
|
If UpdateFlexgridVersionReversionMapfile(EinbauplatzNr, strMapfile) Then
|
|
DoEvents
|
|
|
|
If InStr(1, strMapfile, m_strMapfileDir) = 0 And Dir(m_strMapfileDir & strMapfile) <> "" Then
|
|
strMapfile = m_strMapfileDir & strMapfile
|
|
End If
|
|
|
|
If Dir(strMapfile) <> "" Then
|
|
Einbauplatz.m_strMapfile = strMapfile
|
|
|
|
MSFlexGrid1.col = SPALTE_FabNr
|
|
If MSFlexGrid1.text = "" Then
|
|
' FabNr nicht vorhanden, Zähler wurde noch nicht erkannt
|
|
|
|
iret = modMBUS_SMS.fw2_open_comport(iCom, 2400, strMapfile, True)
|
|
DoEvents
|
|
If iret = 0 Then
|
|
' Schloss lesen
|
|
iret = modMBUS_SMS.ReadValue("u8_schloss", byteSchloss)
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_Schloss
|
|
Select Case byteSchloss
|
|
Case 90
|
|
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
|
|
MSFlexGrid1.text = TXT_SCHLOSS_CLOSED
|
|
Case 165
|
|
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
|
|
MSFlexGrid1.text = TXT_SCHLOSS_OPEN
|
|
End Select
|
|
|
|
If UpdateFlexgridFabNrSerienr(EinbauplatzNr) Then
|
|
'FabNr OK
|
|
DoEvents
|
|
If UpdateFlexgridSerienNr(EinbauplatzNr) Then
|
|
ReformatFlexgrid
|
|
UeberpruefeEinbauplatz EinbauplatzNr
|
|
End If
|
|
End If
|
|
' Open comport mit neuem Mapfile OK
|
|
End If
|
|
|
|
iret = modMBUS_SMS.IECCOM_CloseCom
|
|
End If
|
|
Else
|
|
' mapfile fehlt
|
|
MSFlexGrid1.col = SPALTE_Mapfile
|
|
MSFlexGrid1.CellBackColor = vbRed
|
|
MSFlexGrid1.text = TXT_BITTEAUSWAEHLEN
|
|
End If
|
|
'Version und Revision OK
|
|
End If
|
|
'FW2
|
|
Else
|
|
'FW1
|
|
End If
|
|
Else
|
|
'FW Fehler
|
|
End If
|
|
ReformatFlexgrid
|
|
DoEvents
|
|
Else
|
|
Sleep 50, True
|
|
End If
|
|
|
|
UpdateCmbEbp
|
|
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_Com
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
DoEvents
|
|
End Sub
|
|
|
|
|
|
'Private Sub SetMapfileToEinbauplatz(EinbauplatzNr As Integer)
|
|
' Dim strMapfile As String
|
|
' Dim objEinbauplatz As CEinbauplatz
|
|
'
|
|
' strMapfile = MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Mapfile)
|
|
' Set objEinbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
' If MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FWGen) = TXT_FW2 Then
|
|
' If strMapfile <> "" And strMapfile <> TXT_BITTEAUSWAEHLEN Then
|
|
' If Dir(strMapfile) <> "" Then
|
|
' objEinbauplatz.m_sMapfile = strMapfile
|
|
' objEinbauplatz.setNr EinbauplatzNr
|
|
' objEinbauplatz.m_iComport = g_App.Settings.getUSComPort(EinbauplatzNr)
|
|
' UeberpruefeEinbauplatz EinbauplatzNr
|
|
' End If
|
|
' End If
|
|
' End If
|
|
'End Sub
|
|
|
|
Private Function UpdateFlexgridFWGeneration(EinbauplatzNr As Integer, ByRef strFWGeneration As String) As Boolean
|
|
Dim strFWBytes As String
|
|
Dim iCom As Integer
|
|
Dim iret As Integer
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_FWGen
|
|
|
|
If MSFlexGrid1.text = TXT_FW1 Or MSFlexGrid1.text = TXT_FW2 Then
|
|
strFWGeneration = MSFlexGrid1.text
|
|
UpdateFlexgridFWGeneration = True
|
|
Exit Function
|
|
End If
|
|
|
|
strFWBytes = ""
|
|
|
|
' Sleep 1000, True
|
|
|
|
StatusBar1.SimpleText = "Get Firmware for COM " & iCom
|
|
|
|
|
|
iret = modMBUS_SMS.GetFWGeneration(iCom, strFWBytes)
|
|
StatusBar1.SimpleText = ""
|
|
|
|
If iret = 0 Then
|
|
Select Case LCase(strFWBytes)
|
|
Case "60", "61"
|
|
strFWGeneration = TXT_FW1
|
|
MSFlexGrid1.text = strFWGeneration
|
|
UpdateFlexgridFWGeneration = True
|
|
Case "08", "09", "0a", "0b", "0c", "0d", "0e", "0f", "10", "11", "12", "13", "1B"
|
|
strFWGeneration = TXT_FW2
|
|
MSFlexGrid1.text = strFWGeneration
|
|
UpdateFlexgridFWGeneration = True
|
|
Case Else
|
|
MSFlexGrid1.text = TXT_FW_UNBEKANNT & ": " & strFWBytes
|
|
End Select
|
|
Else
|
|
Select Case iret
|
|
Case modMBUS_SMS.MBUS_SMS_ERR_OPENCOMM
|
|
MSFlexGrid1.text = "COM Err"
|
|
Case modMBUS_SMS.MBUS_SMS_ERR_TIMEOUT
|
|
MSFlexGrid1.text = "Timeout"
|
|
Case Else
|
|
MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
End Select
|
|
End If
|
|
|
|
End Function
|
|
|
|
Private Function UpdateFlexgridVersionReversionMapfile(EinbauplatzNr As Integer, ByRef strMapfile As String) As Boolean
|
|
Dim iCom As Integer
|
|
Dim intVersion As Integer
|
|
Dim intRevision As Integer
|
|
Dim iret As Integer
|
|
|
|
MSFlexGrid1.col = SPALTE_Mapfile
|
|
If InStr(MSFlexGrid1.text, ".txt") <> 0 Then
|
|
strMapfile = MSFlexGrid1.text
|
|
UpdateFlexgridVersionReversionMapfile = True
|
|
Exit Function
|
|
End If
|
|
|
|
iCom = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
|
|
iret = modMBUS_SMS.fw2_open_comport(iCom, 2400, m_strDefaultMapfile, True)
|
|
If iret = 0 Then
|
|
MSFlexGrid1.col = SPALTE_FWVer
|
|
iret = modMBUS_SMS.ReadValue("u16_fw_version", intVersion)
|
|
If iret <> 0 Then
|
|
iret = modMBUS_SMS.ReadValue("u16_fw_version", intVersion)
|
|
End If
|
|
|
|
If iret = 0 Then
|
|
MSFlexGrid1.text = intVersion
|
|
|
|
MSFlexGrid1.col = SPALTE_FWRev
|
|
iret = modMBUS_SMS.ReadValue("u16_fw_revision", intRevision)
|
|
If iret = 0 Then
|
|
MSFlexGrid1.text = intRevision
|
|
strMapfile = GetMapfilePathFromVersionRevision(intVersion, intRevision)
|
|
MSFlexGrid1.col = SPALTE_Mapfile
|
|
MSFlexGrid1.text = filename(strMapfile)
|
|
UpdateFlexgridVersionReversionMapfile = True
|
|
Exit Function
|
|
Else
|
|
MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
Exit Function
|
|
End If
|
|
Else
|
|
MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
Exit Function
|
|
End If
|
|
Else
|
|
' com port Öffnen Fehler
|
|
Select Case iret
|
|
Case modMBUS_SMS.MBUS_SMS_ERR_OPENCOMM
|
|
MSFlexGrid1.text = "COM Err"
|
|
Case modMBUS_SMS.MBUS_SMS_ERR_TIMEOUT
|
|
MSFlexGrid1.text = "Timeout"
|
|
Case Else
|
|
MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
End Select
|
|
Exit Function
|
|
End If
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
StatusBar1.SimpleText = "COM geschlossen"
|
|
End Function
|
|
|
|
|
|
Private Function UpdateFlexgridFabNrSerienr(EinbauplatzNr As Integer) As Boolean
|
|
Dim iCom As Integer
|
|
Dim iret As Integer
|
|
Dim curFabNr As Currency
|
|
' Achtung: FabNr wird in dieser Funktion decimal behandelt.
|
|
' Was später aber die bekannte FabNr darstellt, ist in wirklichkeit der Hexwert dieser Funktion
|
|
|
|
' RH 10.1.2018: statt lngFab mit long-Datentyp) wird nun curFabNr mit Currency-Datentyp) verwendet
|
|
' da neuere FabNr > 2^32 / 2 = 2147483648 und dies mit long (-2147483648 bis 2147483647) nicht mehr handlebar ist
|
|
|
|
MSFlexGrid1.col = SPALTE_FabNr
|
|
iret = modMBUS_SMS.ReadValue("u32_fab_nr", curFabNr)
|
|
|
|
If iret = 0 Then
|
|
' RH 10.1.2018: statt Hex(FabNr) wird nun Currency2Hex(curFabNr) verwendet, da diese nur von -2^31 bis 2^31-1 wandeln kann
|
|
MSFlexGrid1.text = Currency2Hex(curFabNr)
|
|
UpdateFlexgridFabNrSerienr = True
|
|
Exit Function
|
|
Else
|
|
MSFlexGrid1.text = modMBUS_SMS.Errorstring(iret)
|
|
Exit Function
|
|
End If
|
|
End Function
|
|
|
|
Private Function UpdateFlexgridSerienNr(EinbauplatzNr As Integer) As Boolean
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim lngFabNr As Long
|
|
Dim strKatalogNr As String
|
|
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_FabNr
|
|
lngFabNr = Val(MSFlexGrid1.text)
|
|
|
|
MSFlexGrid1.col = SPALTE_SerienNr
|
|
If lngFabNr > 0 Then
|
|
Set AuftragpositionSerienNr = New CAuftragPositionSerienNr
|
|
|
|
If AuftragpositionSerienNr.loadFromFabNr(lngFabNr) Then
|
|
MSFlexGrid1.text = AuftragpositionSerienNr.getNr
|
|
MSFlexGrid1.col = SPALTE_KundeneigeneSNr
|
|
MSFlexGrid1.text = AuftragpositionSerienNr.getKundeneigeneSerienNr
|
|
MSFlexGrid1.col = SPALTE_Auftragposition
|
|
MSFlexGrid1.text = AuftragpositionSerienNr.getAuftragNr & " / " & AuftragpositionSerienNr.getPositionNr
|
|
|
|
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim IdentNrObject As CIdentNr
|
|
|
|
Set AuftragPosition = New CAuftragPosition
|
|
If AuftragPosition.load(AuftragpositionSerienNr.getAuftragNr, AuftragpositionSerienNr.getPositionNr) Then
|
|
Set IdentNrObject = AuftragPosition.getIdentNrObj
|
|
|
|
MSFlexGrid1.col = SPALTE_Typangaben
|
|
MSFlexGrid1.text = IdentNrObject.getTyp & " DN" & IdentNrObject.getNennweite & " " & IdentNrObject.GetTemperatur & "G / PN" & IdentNrObject.getDruck
|
|
|
|
MSFlexGrid1.col = SPALTE_CompareFile
|
|
strKatalogNr = IdentNrObject.GetKatalognummer
|
|
If strKatalogNr = "" Then
|
|
MSFlexGrid1.text = TXT_BITTEAUSWAEHLEN
|
|
MSFlexGrid1.CellBackColor = vbRed
|
|
Else
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Set Einbauplatz = m_colEinbauplatz(EinbauplatzNr)
|
|
Einbauplatz.m_strCompareFile = m_strCompareFileDir & strKatalogNr & ".cmp"
|
|
If Dir(Einbauplatz.m_strCompareFile) = "" Then
|
|
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
|
|
Else
|
|
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
|
|
End If
|
|
MSFlexGrid1.text = filename(Einbauplatz.m_strCompareFile)
|
|
End If
|
|
|
|
UpdateFlexgridSerienNr = True
|
|
End If
|
|
Else
|
|
MSFlexGrid1.text = TXT_BITTEAUSWAEHLEN
|
|
End If
|
|
Else
|
|
MSFlexGrid1.text = ""
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
|
|
Private Function TestAufEinheitlicheFirmware() As Boolean
|
|
Dim EinbauplatzNr As Integer
|
|
Dim cntFW1 As Integer
|
|
Dim cntFW2 As Integer
|
|
|
|
For EinbauplatzNr = 1 To 10
|
|
'nur belegte Einbauplätze
|
|
If EinbauplatzNr <= g_App.Settings.EinbauplaetzeJeStrang Then
|
|
If MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FWGen) = TXT_FW1 Then
|
|
cntFW1 = cntFW1 + 1
|
|
End If
|
|
If MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FWGen) = TXT_FW2 Then
|
|
If MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Mapfile) <> TXT_BITTEAUSWAEHLEN And MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Mapfile) <> "" Then
|
|
cntFW2 = cntFW2 + 1
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
If cntFW1 > 0 And cntFW2 > 0 Then
|
|
PrintStatus "Bitte nur Zähler einer gleichen Firmware-Generation per Optokopf verbinden!"
|
|
m_iZustand = ZUSTAND_FW_UNBEKANNT
|
|
TestAufEinheitlicheFirmware = False
|
|
ElseIf cntFW1 = 0 And cntFW2 > 0 Then
|
|
PrintStatus "FW2 Prüfung erkannt"
|
|
m_iZustand = ZUSTAND_FW_2
|
|
TestAufEinheitlicheFirmware = True
|
|
ElseIf cntFW1 > 0 And cntFW2 = 0 Then
|
|
PrintStatus "FW1 Prüfung erkannt"
|
|
m_iZustand = ZUSTAND_FW_1
|
|
TestAufEinheitlicheFirmware = True
|
|
Else
|
|
m_iZustand = ZUSTAND_FW_UNBEKANNT
|
|
PrintStatus "keine Firmware erkannt. Bitte die Zähler mit den Opto-Köpfen verbinden!"
|
|
TestAufEinheitlicheFirmware = False
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Private Function TestePruefbereitschaft() As Boolean
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim lngFabNr As Long
|
|
|
|
If TestAufEinheitlicheFirmware() = False Then
|
|
Exit Function
|
|
End If
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
' Comparefile
|
|
If g_blnVersuch = False And chkKonfigurationsvergleich.value = vbChecked Then
|
|
If Dir(Einbauplatz.m_strCompareFile) = "" Then
|
|
MsgBox "Das Comparefile '" & Einbauplatz.m_strCompareFile & "' für Einbauplatz " & EinbauplatzNr & " ist nicht vorhanden. Zähler bitte ausbauen."
|
|
TestePruefbereitschaft = False
|
|
'Einbauplatzleeren EinbauplatzNr
|
|
Exit Function
|
|
End If
|
|
End If
|
|
|
|
lngFabNr = Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr
|
|
If g_blnVersuch = False Then
|
|
If Not IstFabNrDruckGeprueft(lngFabNr) Then
|
|
MsgBox "Das Ergebnis der Druckprüfung des Zählers am Einbauplatz " & EinbauplatzNr & " mit der FabNr " & lngFabNr & " konnte nicht gefunden werden. Bitte in der PDA überprüfen und Zähler ggf. ausbauen."
|
|
If g_blnBefundpruefung Then
|
|
If MsgBox("Da Befundprüfung: Möchten Sie trotzdem mit der Prüfung fortfahren?", vbYesNo Or vbDefaultButton2) = vbNo Then
|
|
TestePruefbereitschaft = False
|
|
'Einbauplatzleeren EinbauplatzNr
|
|
Exit Function
|
|
End If
|
|
Else
|
|
TestePruefbereitschaft = False
|
|
'Einbauplatzleeren EinbauplatzNr
|
|
Exit Function
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If g_blnVersuch = False And chkVorpruefung.value = vbChecked Then
|
|
If UeberpruefeAufOffenesSchloss(Einbauplatz) = False Then
|
|
TestePruefbereitschaft = False
|
|
Exit Function
|
|
End If
|
|
End If
|
|
|
|
End If
|
|
Next
|
|
|
|
|
|
TestePruefbereitschaft = True
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Private Sub endDialog(nRet As Integer)
|
|
m_nRet = nRet
|
|
Unload Me
|
|
g_frmMain.Show
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Private Sub ZaehlerEntfernenDieNichtMehrAngeschlossenSind()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim EinbauplatzNr As Integer
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim comport As Integer
|
|
|
|
Dim strMsg As String
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
If Not Pruefzaehler Is Nothing And comport > 0 Then
|
|
If modMBUS_SMS.WarteAufOpto(EinbauplatzNr) = True Then
|
|
' OK
|
|
Else
|
|
MsgBox "Zähler an Einbauplatz " & EinbauplatzNr & " antwortet nicht und wird nicht für die Prüfung verwendet!"
|
|
ClearUndScanneEinbauplatz Einbauplatz.getNr
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Dim iPruefzaehlerCount As Integer
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
iPruefzaehlerCount = iPruefzaehlerCount + 1
|
|
End If
|
|
Next
|
|
PrintStatus iPruefzaehlerCount & " eingebaute Prüfzähler"
|
|
End Sub
|
|
|
|
|
|
Private Function UberpruefeZaehlerAufTemperatur(Einbauplatz As CEinbauplatz) As Boolean
|
|
Dim dblTemperatur As Double
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim strTemp As String
|
|
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
|
|
If g_blnVersuch = False Then
|
|
' Produktion
|
|
If Pruefzaehler.m_bNurKaltPruefbar = True Then
|
|
' Kältezähler
|
|
If Not g_ohneSPS Then
|
|
' SPS vorhanden
|
|
dblTemperatur = g_App.getSPS.GetEinlaufTemperatur
|
|
If dblTemperatur < 10 Or dblTemperatur > 20 Then
|
|
' Temperatur < 10°C oder Temperatur > 20°C
|
|
|
|
strTemp = "Der Kältezähler am Einbauplatz " & EinbauplatzNr & " ist nur zw. 10°C - 20°C prüfbar! Die Vorlauf-Temperatur ist " & Format(dblTemperatur, "0.0") & " °C."
|
|
MsgBox strTemp
|
|
WriteToFW2Logfile Einbauplatz, strTemp
|
|
|
|
Set Pruefzaehler = Nothing
|
|
Einbauplatzleeren EinbauplatzNr
|
|
UberpruefeZaehlerAufTemperatur = False
|
|
Exit Function
|
|
End If
|
|
Else
|
|
strTemp = "Der Kältezähler am Einbauplatz " & EinbauplatzNr & " ist nur zw. 10°C - 20°C prüfbar! Die Vorlauf-Temperatur konnte nicht ermittelt werden."
|
|
MsgBox strTemp
|
|
WriteToFW2Logfile Einbauplatz, strTemp
|
|
End If
|
|
Else
|
|
' Wärmezähler
|
|
If Not g_ohneSPS Then
|
|
' SPS vorhanden
|
|
dblTemperatur = g_App.getSPS.GetEinlaufTemperatur
|
|
If dblTemperatur < 50 Or dblTemperatur > 60 Then
|
|
strTemp = "Der Wärmezähler am Einbauplatz " & EinbauplatzNr & " ist nur zw. 50°C - 60°C prüfbar! Die Vorlauf-Temperatur ist " & Format(dblTemperatur, "0.0") & " °C."
|
|
|
|
MsgBox strTemp
|
|
WriteToFW2Logfile Einbauplatz, strTemp
|
|
|
|
Set Pruefzaehler = Nothing
|
|
Einbauplatzleeren EinbauplatzNr
|
|
UberpruefeZaehlerAufTemperatur = False
|
|
Exit Function
|
|
End If
|
|
Else
|
|
strTemp = "Der Wärmezähler am Einbauplatz " & EinbauplatzNr & " ist nur zw. 50°C - 60°C prüfbar! Die Vorlauf-Temperatur konnte nicht ermittelt werden."
|
|
MsgBox strTemp
|
|
WriteToFW2Logfile Einbauplatz, strTemp
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
UberpruefeZaehlerAufTemperatur = True
|
|
End Function
|
|
|
|
|
|
Private Sub cmdWeiter_Click()
|
|
cmdWeiter.Enabled = False
|
|
DoEvents
|
|
|
|
StopScan
|
|
|
|
If mblnIsInTimer Then
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
|
|
Call ZaehlerEntfernenDieNichtMehrAngeschlossenSind
|
|
|
|
|
|
If Not TestePruefbereitschaft() Then
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
If chkRechenwerkSystemzeit.value = vbChecked Then
|
|
g_blnFW2_Systemzeit_setzen = True
|
|
Else
|
|
g_blnFW2_Systemzeit_setzen = False
|
|
End If
|
|
|
|
If m_iZustand = ZUSTAND_FW_1 Then
|
|
cmdQuit_Click
|
|
|
|
Dim dlg As USPruefzaehlerPruefung
|
|
Set dlg = New USPruefzaehlerPruefung
|
|
bDummy = doNonModal(dlg, True)
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
|
|
|
|
ElseIf m_iZustand = ZUSTAND_FW_2 Then
|
|
|
|
|
|
Dim EinbauplatzNr As Integer
|
|
|
|
Dim objEinbauplatz As CEinbauplatz
|
|
Dim strMapfile As String
|
|
Dim countPZ As Integer
|
|
|
|
countPZ = 0
|
|
|
|
For EinbauplatzNr = 1 To MSFlexGrid1.Rows - 1
|
|
|
|
strMapfile = MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Mapfile)
|
|
Set objEinbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
|
|
objEinbauplatz.setAktiv True
|
|
|
|
If Not objEinbauplatz.getPruefzaehler Is Nothing Then
|
|
If chkOffset_Qi.value = vbChecked Then
|
|
objEinbauplatz.getPruefzaehler.getVorpruefpunkte.setOffsetQi (Val(Replace(txtOffset_Qi.text, ",", ".")))
|
|
End If
|
|
|
|
|
|
If MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FWGen) = TXT_FW1 Then
|
|
DebugMsg "Einbauplatz " & EinbauplatzNr & " :"
|
|
DebugMsg " FW1"
|
|
ElseIf MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FWGen) = TXT_FW2 Then
|
|
'''''''''''''''''''''''''''''''
|
|
'Initialiese Log File
|
|
Dim strDir As String
|
|
|
|
strDir = g_strUSFW2logfileDir
|
|
|
|
If strDir <> "" And MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FabNr) <> "" Then
|
|
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
|
|
|
|
objEinbauplatz.m_strFW2LogFile = FindeFreienLogDateiname(strDir, MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FabNr))
|
|
|
|
WriteToFW2Logfile objEinbauplatz, "Datum=" & vbTab & Format(Now(), "yyyy-mm-dd hh:mm:ss")
|
|
WriteToFW2Logfile objEinbauplatz, "Prüfstation=" & vbTab & g_App.PruefstationNr
|
|
WriteToFW2Logfile objEinbauplatz, "Prüfstationslogfile=" & vbTab & LogFilePath
|
|
|
|
WriteToFW2Logfile objEinbauplatz, "Prüfer=" & vbTab & g_App.Mitarbeiter.getAnfangsbuchstabeVornameundName & " (" & g_App.Mitarbeiter.getNr & ")"
|
|
WriteToFW2Logfile objEinbauplatz, "Einbauplatz=" & vbTab & EinbauplatzNr
|
|
WriteToFW2Logfile objEinbauplatz, "FabNr=" & vbTab & MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FabNr)
|
|
WriteToFW2Logfile objEinbauplatz, "Sensus SNr=" & vbTab & MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_SerienNr)
|
|
|
|
WriteToFW2Logfile objEinbauplatz, "Typ=" & vbTab & objEinbauplatz.getPruefzaehler.getIdentNrObj.getTyp & " " & objEinbauplatz.getPruefzaehler.getIdentNrObj.getTypzusatz & " " & objEinbauplatz.getPruefzaehler.getIdentNrObj.getNennweite
|
|
WriteToFW2Logfile objEinbauplatz, "IdentNr=" & vbTab & objEinbauplatz.getPruefzaehler.getIdentNr
|
|
|
|
If chkOffset_Qi.value = vbChecked And objEinbauplatz.getPruefzaehler.getVorpruefpunkte.getOffset_Qmin <> 0 Then
|
|
WriteToFW2Logfile objEinbauplatz, "Offset_Qmin=" & vbTab & objEinbauplatz.getPruefzaehler.getVorpruefpunkte.getOffset_Qmin
|
|
End If
|
|
|
|
If chkOffset_Qi.value = vbChecked And objEinbauplatz.getPruefzaehler.getVorpruefpunkte.getOffset_Qp <> 0 Then
|
|
WriteToFW2Logfile objEinbauplatz, "Offset_Qp=" & vbTab & objEinbauplatz.getPruefzaehler.getVorpruefpunkte.getOffset_Qp
|
|
End If
|
|
|
|
If g_blnBefundpruefung Then
|
|
WriteToFW2Logfile objEinbauplatz, "Befundprüfung"
|
|
End If
|
|
|
|
Dim strTemp As String
|
|
strTemp = objEinbauplatz.getPruefzaehler.getIdentNrObj.GetVakoCode
|
|
If strTemp <> "" Then
|
|
WriteToFW2Logfile objEinbauplatz, "Vako Code=" & vbTab & strTemp
|
|
End If
|
|
strTemp = objEinbauplatz.getPruefzaehler.getIdentNrObj.GetBestellcode
|
|
If strTemp <> "" Then
|
|
WriteToFW2Logfile objEinbauplatz, "Bestellcode=" & vbTab & strTemp
|
|
End If
|
|
|
|
If UberpruefeZaehlerAufTemperatur(objEinbauplatz) = False Then
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
'''''''''''''''''''''''''''''''
|
|
Else
|
|
Debug.Print EinbauplatzNr
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
Dim strEinbaulageNichtVorhanden As String
|
|
strEinbaulageNichtVorhanden = ""
|
|
If chkZulassung.value = vbChecked Then
|
|
|
|
' überprüfen ob die Einbaulage vergessen wurde
|
|
For Each objEinbauplatz In m_colEinbauplatz
|
|
If Not objEinbauplatz.getPruefzaehler Is Nothing Then
|
|
If objEinbauplatz.m_strEinbaulage = "" Then
|
|
'Einbaulage vergessen!
|
|
strEinbaulageNichtVorhanden = strEinbaulageNichtVorhanden & objEinbauplatz.getNr & " "
|
|
End If
|
|
End If
|
|
Next
|
|
If strEinbaulageNichtVorhanden <> "" Then
|
|
'mind. eine Einbaulage wurde vergessen
|
|
MsgBox "Für eine Zulassungsprüfung müssen noch die Einbaulagen aller Zähler im Prüfvorgaben-Formular angegeben werden." & vbCrLf & "Bitte klicken Sie auf 'Details...' für Einbauplatz " & Trim(strEinbaulageNichtVorhanden) & "."
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
''''''''''''''''''''''''''''''''''
|
|
|
|
g_Abbruch = False
|
|
|
|
If Not m_colUniquePP Is Nothing Then
|
|
If Not PruefpunkteZeitenVorhanden() Then
|
|
MsgBox ("Prüfpunktzeiten fehlen!" & vbCrLf & "Für alle Prüfpunkte müssen Zeiten definiert sein!")
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
Else
|
|
MsgBox "Die Prüfung kann nicht gestartet werden, da keine Prüfpunkte ermittelt werden können."
|
|
cmdWeiter.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
|
|
WriteToLog "Voreinstellungen:"
|
|
g_blnFertigmelden = (chkPositionenFertigmelden.value = vbChecked)
|
|
WriteToLog "Fertigmelden: " & IIf(g_blnFertigmelden, "ja", "nein")
|
|
|
|
g_intAnzahlFW2Justage = Val(txtAnzahlJustageDurchgaenge.text)
|
|
WriteToLog "Anzahl Justagen=" & g_intAnzahlFW2Justage
|
|
|
|
g_blnVorpruefung3malQiMittelwert = (chkMittelwertQi.value = vbChecked)
|
|
WriteToLog "Vorpruefung3malQiMittelwert=" & IIf(g_blnVorpruefung3malQiMittelwert, "ja", "nein")
|
|
|
|
g_bGetrennteJustage = (chkGetrennteJustage.value = vbChecked)
|
|
WriteToLog "GetrennteJustage=" & IIf(g_bGetrennteJustage, "ja", "nein")
|
|
|
|
g_bKonfigVergleichDurchfuehren = (chkKonfigurationsvergleich.value = vbChecked)
|
|
WriteToLog "KonfigVergleichDurchfuehren=" & IIf(g_bKonfigVergleichDurchfuehren, "ja", "nein")
|
|
|
|
' neu RH 18.11.2013
|
|
g_blnbedingteQiJustage = (chkBedingteQminJustage.value = vbChecked And chkGetrennteJustage.value = vbChecked)
|
|
WriteToLog "bedingteQiJustage=" & IIf(g_blnbedingteQiJustage, "ja", "nein")
|
|
|
|
g_blnJustageWerteNICHTschreiben = (chkJustagewerteNICHTschreiben.value = vbChecked)
|
|
WriteToLog "Justage Werte NICHT schreiben=" & IIf(g_blnJustageWerteNICHTschreiben, "ja", "nein")
|
|
|
|
'If MsgBox("Die Prüfung bzw. Justage wird gestartet", vbOKCancel Or vbDefaultButton1, "Bitte bestätigen") = vbOK Then
|
|
Call Hauptpruefung
|
|
'End If
|
|
|
|
cmdWeiter.Enabled = True
|
|
End Sub
|
|
|
|
|
|
Private Function FindeFreienLogDateiname(strDir As String, strFabnr As String) As String
|
|
Dim lngCount As Long
|
|
Dim strFund As String
|
|
|
|
lngCount = 0
|
|
|
|
Do
|
|
If strFund <> "" Then Debug.Print "schon vergeben" & strFund
|
|
strFund = strDir & strFabnr & "-" & Format(lngCount, "0000") & ".log"
|
|
lngCount = lngCount + 1
|
|
Loop While Dir(strFund) <> ""
|
|
|
|
FindeFreienLogDateiname = strFund
|
|
End Function
|
|
|
|
|
|
' Überprüft die Vollständigkeit der Daten des Prüfzählers und hängt ihn an das Einbauplatz-Objekt
|
|
' Abhängige Daten (Prüfpunkte) werden aktualisiert
|
|
|
|
Private Sub UeberpruefeEinbauplatz(EinbauplatzNr As Integer)
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim strMapfile As String
|
|
|
|
strMapfile = MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Mapfile)
|
|
If strMapfile = "" Then Exit Sub
|
|
|
|
If Val(MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FabNr)) = 0 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
If Val(MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_SerienNr)) = 0 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Set Pruefzaehler = New CPruefzaehler
|
|
|
|
|
|
If Pruefzaehler.loadForSerienNr(Val(MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_SerienNr))) Then
|
|
' Neu RH 5.6.2013 Produktion darf Kaeltezähler nicht mit warmen Wasser prüfen
|
|
'Merkmal "Funktion (Software), Stelle 4 "C" hat als einzige die Einschränkung Prüfwassertemperatur 10° < T < 20°. Das braucht dann auch nicht auf Merkmal "Logo/Zulassung" erweitert werden.
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Vorprüfpunkte aus den Prüfpunkten übernehmen (1. und 3. PP)
|
|
Dim Vorpruefpunkt As CVorpruefpunkt
|
|
Dim Vorpruefpunkte As CVorpruefpunkte
|
|
Dim VorpruefpunktCol As CVorpruefpunktCol
|
|
Set Vorpruefpunkte = New CVorpruefpunkte
|
|
Set VorpruefpunktCol = New CVorpruefpunktCol
|
|
Vorpruefpunkte.setPruefpunkte VorpruefpunktCol
|
|
|
|
Set Vorpruefpunkt = New CVorpruefpunkt
|
|
If Pruefzaehler.getPruefpunkte.GetQi Is Nothing Then
|
|
Vorpruefpunkt.copyFromPruefpunkt Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(1)
|
|
Else
|
|
Vorpruefpunkt.copyFromPruefpunkt Pruefzaehler.getPruefpunkte.GetQi
|
|
End If
|
|
|
|
Vorpruefpunkte.getPruefpunkte.Add Vorpruefpunkt
|
|
|
|
Set Vorpruefpunkt = New CVorpruefpunkt
|
|
If Pruefzaehler.getPruefpunkte.GetQp Is Nothing Then
|
|
If Pruefzaehler.getPruefpunkte.getPruefpunkteCount >= 3 Then
|
|
Vorpruefpunkt.copyFromPruefpunkt Pruefzaehler.getPruefpunkte.getPruefpunkte.Item(3)
|
|
Vorpruefpunkte.getPruefpunkte.Add Vorpruefpunkt
|
|
Pruefzaehler.setVorpruefpunkte Vorpruefpunkte
|
|
End If
|
|
Else
|
|
Vorpruefpunkt.copyFromPruefpunkt Pruefzaehler.getPruefpunkte.GetQp
|
|
Vorpruefpunkte.getPruefpunkte.Add Vorpruefpunkt
|
|
Pruefzaehler.setVorpruefpunkte Vorpruefpunkte
|
|
End If
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
Set Einbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
Einbauplatz.setPruefzaehler Pruefzaehler
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = SPALTE_Details
|
|
MSFlexGrid1.text = "Details..."
|
|
|
|
updatePruefpunkte
|
|
|
|
UpdateStatusFertigung Einbauplatz
|
|
|
|
DebugMsg "Prüfzähler mit SerienNr " & Pruefzaehler.getSerienNr & " und FabNr " & MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_FabNr) & " am Einbauplatz " & EinbauplatzNr
|
|
|
|
If g_blnVersuch = False Then
|
|
' SerienNr Update in Druckprüfung
|
|
UpdateInDruckpruefung Pruefzaehler.getAuftragPositionSerienNr.getFabNr, Pruefzaehler.getSerienNr
|
|
End If
|
|
|
|
CheckBefundpruefung Einbauplatz
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Sub CheckBefundpruefung(Einbauplatz As CEinbauplatz)
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim strMessage As String
|
|
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Pruefzaehler Is Nothing Then
|
|
Exit Sub
|
|
End If
|
|
|
|
If Pruefzaehler.getAuftragPosition.GetBefundpruefung Then
|
|
strMessage = "Der Zähler am Einbauplatz " & Einbauplatz.getNr & " soll einer Befundprüfung unterzogen werden. Die Befundprüfung ist noch in der Test- und Validierungsphase!" & vbCrLf
|
|
chkBefundpruefung.value = vbChecked
|
|
MsgBox strMessage
|
|
|
|
|
|
|
|
Call AlleNichtBefundpruefungenHerausnehmen
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub AlleNichtBefundpruefungenHerausnehmen()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Dim intSpalte As Integer
|
|
Dim EinbauplatzNr As Integer
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
If Pruefzaehler.getAuftragPosition.GetBefundpruefung = False Then
|
|
|
|
If MsgBox("Der Zähler an Einbauplatz " & EinbauplatzNr & " ist nicht für eine Befundprüfung vorgesehen. Soll er trotzdem einer Befundprüfung unterzogen werden?", vbYesNo) = vbNo Then
|
|
For intSpalte = SPALTE_Com + 1 To MSFlexGrid1.Cols - 1
|
|
MSFlexGrid1.row = EinbauplatzNr
|
|
MSFlexGrid1.col = intSpalte
|
|
MSFlexGrid1.text = ""
|
|
MSFlexGrid1.CellBackColor = vbWhite
|
|
Next
|
|
Einbauplatz.setPruefzaehler Nothing
|
|
End If
|
|
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
End Sub
|
|
|
|
Private Sub ShowDetails(EinbauplatzNr As Integer)
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim dlg As frmPruefvorgaben
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
|
|
Set Einbauplatz = m_colEinbauplatz.Item(EinbauplatzNr)
|
|
If Einbauplatz Is Nothing Then Exit Sub
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler()
|
|
If Pruefzaehler Is Nothing Then Exit Sub
|
|
|
|
Me.MousePointer = vbHourglass
|
|
|
|
Set dlg = New frmPruefvorgaben
|
|
|
|
Call dlg.setPruefzaehler(Pruefzaehler)
|
|
Call dlg.setEinbauplatz(Einbauplatz)
|
|
Set dlg.m_colEinbauplatz = m_colEinbauplatz
|
|
|
|
If doModal(dlg, True) = IDOK Then
|
|
' If g_MetrologAktualisieren = True Then
|
|
' 'AlleEinbauplaetzeDesGleichenAuftragesAktualisieren (index)
|
|
' Else
|
|
' 'Call ueberpruefe(index)
|
|
' End If
|
|
updatePruefpunkte
|
|
End If
|
|
Me.MousePointer = vbDefault
|
|
End Sub
|
|
|
|
|
|
|
|
Public Sub RecalcPruefpunkte()
|
|
On Error GoTo Errorhandler
|
|
'Prüfpunkt Zeiten erniedrigen, bis Volumen in den gröten Behälter passt
|
|
Dim Behaelter As CBehaelter
|
|
Dim i As Integer
|
|
Dim dblMaxVolumen As Double
|
|
Dim dblVolumen As Double
|
|
Dim blnGeaendert As Boolean
|
|
|
|
If m_colUniquePP.Count = 0 Then Exit Sub
|
|
|
|
Const FAKTOR = 0.95
|
|
|
|
|
|
|
|
dblMaxVolumen = g_dblVolumenGrosserBehaelter
|
|
|
|
If OptPrfArt(0).value = True Then
|
|
' Prüfung mit Waage
|
|
For i = 1 To m_colUniquePP.Count()
|
|
dblVolumen = m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6
|
|
If dblVolumen > dblMaxVolumen * FAKTOR Then
|
|
m_colUniquePP.Item(i).SetTime m_colUniquePP.Item(i).GetTime * dblMaxVolumen / dblVolumen * FAKTOR
|
|
blnGeaendert = True
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
If chkOptimiertePPReihenfolge.value = vbChecked Then
|
|
m_colUniquePP.sortQ
|
|
m_colUniquePP.Vertausche 3, 2
|
|
End If
|
|
|
|
UpdateHauptPruefPunktListe
|
|
If blnGeaendert = True Then
|
|
PrintStatus "Prüfzeiten wurde das größte Behältervolumen (" & dblMaxVolumen & ") angepasst!"
|
|
End If
|
|
|
|
Errorhandler:
|
|
End Sub
|
|
|
|
|
|
Public Sub RecalcVorPruefpunkte()
|
|
'Prüfpunkt Zeiten erniedrigen, bis Volumen in den gröten Behälter passt
|
|
Dim Behaelter As CBehaelter
|
|
Dim i As Integer
|
|
Dim dblMaxVolumen As Double
|
|
Dim dblVolumen As Double
|
|
Dim blnGeaendert As Boolean
|
|
Dim dblNeueZeit As Double
|
|
|
|
|
|
If m_colUniqueVorPP Is Nothing Then Exit Sub
|
|
|
|
Const FAKTOR = 0.95
|
|
|
|
dblMaxVolumen = g_dblVolumenGrosserBehaelter
|
|
|
|
If OptVorPrfArt(0).value = True Then
|
|
' Vorprüfung mit Waage
|
|
For i = 1 To m_colUniqueVorPP.Count
|
|
dblVolumen = m_colUniqueVorPP.Item(i).getQ * m_colUniqueVorPP.Item(i).GetTime / 3.6
|
|
If dblVolumen > dblMaxVolumen * FAKTOR Then
|
|
' Prüf-Volumen übersteigt Behälter: Zeit neu berechnen
|
|
m_colUniqueVorPP.Item(i).SetTime m_colUniqueVorPP.Item(i).GetTime * dblMaxVolumen / dblVolumen * FAKTOR
|
|
dblNeueZeit = m_colUniqueVorPP.Item(i).GetTime * dblMaxVolumen / dblVolumen * FAKTOR
|
|
blnGeaendert = True
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
|
|
UpdateVorpruefpunkteListe
|
|
If blnGeaendert = True Then
|
|
PrintStatus "Vorprüf-Zeiten wurden das größte Behältervolumen (" & dblMaxVolumen & ") angepasst!"
|
|
End If
|
|
End Sub
|
|
|
|
|
|
|
|
' Menge der eindeutigen Prüfpunkte neu bilden und
|
|
' Summe neu anzeigen
|
|
'
|
|
' TODO: Komplettieren
|
|
'
|
|
Public Sub updatePruefpunkte()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim i As Integer
|
|
|
|
|
|
|
|
Set m_colUniquePP = calcPruefpunkte(m_colEinbauplatz)
|
|
|
|
|
|
Set m_colUniqueVorPP = calcVorpruefpunkte(m_colEinbauplatz)
|
|
|
|
' Anzeige der eindeutigen Prüfpunkte aktualisieren
|
|
'lblUniquePP = m_colUniquePP.Count
|
|
|
|
'cmbPruefpunkte.Clear
|
|
|
|
' neu RH 29.1.2012
|
|
'' If chkVorpruefung.Value = vbChecked Then
|
|
RecalcVorPruefpunkte
|
|
'' End If
|
|
|
|
'' If chkHauptpruefung.Value = vbChecked Then
|
|
RecalcPruefpunkte
|
|
'' End If
|
|
|
|
If chkBefundpruefung.value = vbChecked Then
|
|
chkBefundpruefung_Click
|
|
End If
|
|
|
|
UpdateHauptPruefPunktListe
|
|
|
|
End Sub
|
|
|
|
'Public Sub UpdatePPListe()
|
|
' Dim i As Integer
|
|
'
|
|
' If m_colUniquePP Is Nothing Then Exit Sub
|
|
'
|
|
' ' Listboxen für Pruefpunkte aktualisieren
|
|
' lstPruefpunkte.Clear
|
|
' For i = 1 To m_colUniquePP.Count()
|
|
' lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ & " (" & m_colUniquePP.Item(i).GetTime & " s = " & Format(m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
' 'cmbPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
|
|
' Next i
|
|
'
|
|
'' If m_colUniquePP.Count() > 0 Then
|
|
'' cmbPruefpunkte.ListIndex = 0
|
|
'' End If
|
|
'
|
|
' lstVorpruefpunkte.Clear
|
|
' For i = 1 To m_colUniqueVorPP.Count
|
|
' lstVorpruefpunkte.AddItem m_colUniqueVorPP.Item(i).getQ & " (" & m_colUniqueVorPP.Item(i).GetTime & " s = " & Format(m_colUniqueVorPP.Item(i).getQ * m_colUniqueVorPP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
' Next i
|
|
'End Sub
|
|
|
|
|
|
Public Sub UpdateHauptPruefPunktListe()
|
|
Dim i As Integer
|
|
|
|
If m_colUniquePP Is Nothing Then Exit Sub
|
|
If m_colUniquePP.Count() = 0 Then Exit Sub
|
|
|
|
' Listboxen für Pruefpunkte aktualisieren
|
|
lstPruefpunkte.Clear
|
|
For i = 1 To m_colUniquePP.Count()
|
|
lstPruefpunkte.AddItem m_colUniquePP.Item(i).getQ & " (" & m_colUniquePP.Item(i).GetTime & " s = " & Format(m_colUniquePP.Item(i).getQ * m_colUniquePP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
'cmbPruefpunkte.AddItem m_colUniquePP.Item(i).getQ
|
|
Next i
|
|
End Sub
|
|
|
|
|
|
Public Sub UpdateVorpruefpunkteListe()
|
|
Dim i As Integer
|
|
|
|
If m_colUniquePP Is Nothing Then Exit Sub
|
|
|
|
' Listboxen für Vorpruefpunkte aktualisieren
|
|
If m_colUniqueVorPP.Count = 0 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
m_colUniqueVorPP.sortQ
|
|
lstVorpruefpunkte.Clear
|
|
For i = 1 To m_colUniqueVorPP.Count
|
|
lstVorpruefpunkte.AddItem m_colUniqueVorPP.Item(i).getQ & " (" & m_colUniqueVorPP.Item(i).GetTime & " s = " & Format(m_colUniqueVorPP.Item(i).getQ * m_colUniqueVorPP.Item(i).GetTime / 3.6, "0") & " l)"
|
|
Next i
|
|
End Sub
|
|
|
|
|
|
' Menge aller eindeutigen Prüfpunkte bilden
|
|
'
|
|
' @param Einbauplaetze Collection der Einbauplätze
|
|
'
|
|
' @return Collection mit allen eindeutigen CPruefpunkt-Objekten
|
|
'
|
|
' @see updatePruefpunkte
|
|
'
|
|
' geändert am 26.1.2000 von RH: arbeitet jetzt mit KopiePruefpunkt
|
|
|
|
Private Function calcPruefpunkte(Einbauplaetze As Collection) As CPruefpunktCol
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefpunkte As CPruefpunkte
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
Dim colUniquePP As New CPruefpunktCol
|
|
Dim nPos As Integer
|
|
Dim i As Integer
|
|
Dim KopiePruefpunkt As CPruefpunkt
|
|
|
|
For Each Einbauplatz In Einbauplaetze
|
|
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
|
|
Set Pruefpunkte = Einbauplatz.getPruefzaehler().getPruefpunkte()
|
|
If Not Pruefpunkte Is Nothing Then
|
|
If Not Pruefpunkte.getPruefpunkte Is Nothing Then
|
|
For Each Pruefpunkt In Pruefpunkte.getPruefpunkte().getCollection()
|
|
nPos = getEquivPruefpunktIndexFromCollection(Pruefpunkt, colUniquePP)
|
|
If nPos = 0 Then
|
|
' Prüfpunkt ist noch nicht in der PPCollection vorhanden
|
|
Call Pruefpunkt.setUseCount(1)
|
|
Set KopiePruefpunkt = New CPruefpunkt
|
|
KopiePruefpunkt.copyFrom Pruefpunkt
|
|
colUniquePP.Add KopiePruefpunkt
|
|
Else
|
|
' Prüfpunkt ist vorhanden
|
|
' Nur UseCount erhöhen
|
|
Call colUniquePP.Item(nPos).incUseCount
|
|
End If
|
|
Next
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
Set calcPruefpunkte = colUniquePP
|
|
End Function
|
|
|
|
|
|
|
|
|
|
' Menge aller eindeutigen Vorprüfpunkte bilden
|
|
'
|
|
' @param Einbauplaetze Collection der Einbauplätze
|
|
'
|
|
' @return Collection mit allen eindeutigen CVorpruefpunkt-Objekten
|
|
''
|
|
' geändert am 26.1.2000 von RH: arbeitet jetzt mit KopiePruefpunkt
|
|
' geändert am 12.12.2001 von RH: Vorpruefpunkte übernommen aus Pruefpunkte
|
|
|
|
Private Function calcVorpruefpunkte(Einbauplaetze As Collection) As CVorpruefpunktCol
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Vorpruefpunkt As CVorpruefpunkt
|
|
Dim Vorpruefpunkte As CVorpruefpunkte
|
|
|
|
Dim colUniqueVorPP As New CVorpruefpunktCol
|
|
|
|
|
|
For Each Einbauplatz In Einbauplaetze
|
|
If Not Einbauplatz.getPruefzaehler() Is Nothing Then
|
|
|
|
Set Vorpruefpunkte = Einbauplatz.getPruefzaehler().getVorpruefpunkte()
|
|
If Not Vorpruefpunkte Is Nothing Then
|
|
'If Not Vorpruefpunkte.getPruefpunkte Is Nothing Then
|
|
For Each Vorpruefpunkt In Vorpruefpunkte.getPruefpunkte().getCollection()
|
|
Debug.Print "---"
|
|
Debug.Print "Q: " & Vorpruefpunkt.getQ
|
|
Debug.Print "n: " & Vorpruefpunkt.getOrdnung
|
|
Debug.Print "t: " & Vorpruefpunkt.GetTime
|
|
Debug.Print "Ord:" & Vorpruefpunkt.getOrdnung
|
|
Debug.Print "Vol:" & Vorpruefpunkt.getQ * Vorpruefpunkt.GetTime / 3.6 & " liter"
|
|
|
|
If Vorpruefpunkt.getOrdnung <= 1 Then
|
|
Debug.Print "Ist dabei in Ordnung " & 1
|
|
colUniqueVorPP.Add Vorpruefpunkt
|
|
Else
|
|
Debug.Print "Ist NICHT dabei in Ordnung " & 1
|
|
End If
|
|
Next
|
|
|
|
Set calcVorpruefpunkte = colUniqueVorPP
|
|
Exit Function
|
|
'End If
|
|
End If
|
|
End If
|
|
Next
|
|
Set calcVorpruefpunkte = colUniqueVorPP
|
|
End Function
|
|
|
|
|
|
' Testet, ob der Durchfluss des uebergebenen Pruefpunkt-Objekts
|
|
' in der übergebenen Collection von Pruefpunkten enthalten ist.
|
|
'
|
|
Private Function getEquivPruefpunktIndexFromCollection(TestPruefpunkt As CPruefpunkt, colPruefpunkte As CPruefpunktCol) As Integer
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim i As Integer
|
|
|
|
For i = 1 To colPruefpunkte.Count
|
|
Set Pruefpunkt = colPruefpunkte.Item(i)
|
|
|
|
If Pruefpunkt.getQ() = TestPruefpunkt.getQ() Then
|
|
getEquivPruefpunktIndexFromCollection = i
|
|
Exit Function
|
|
End If
|
|
Next
|
|
End Function
|
|
|
|
|
|
Private Sub OptVorPrfArt_Click(Index As Integer)
|
|
Select Case Index
|
|
Case 0
|
|
m_VorPruefungsArtWaage = True
|
|
|
|
'updatePruefpunkte
|
|
|
|
RecalcVorPruefpunkte
|
|
UpdateVorpruefpunkteListe
|
|
|
|
Case 1
|
|
m_VorPruefungsArtWaage = False
|
|
|
|
Dim Einbauplatz As CEinbauplatz
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
|
UeberpruefeEinbauplatz Einbauplatz.getNr
|
|
End If
|
|
Next
|
|
End Select
|
|
|
|
End Sub
|
|
|
|
Private Sub OptPrfArt_Click(Index As Integer)
|
|
On Error Resume Next
|
|
Select Case Index
|
|
Case 0
|
|
m_PruefungsArtWaage = True
|
|
|
|
RecalcPruefpunkte
|
|
|
|
UpdateHauptPruefPunktListe
|
|
Case 1
|
|
m_PruefungsArtWaage = False
|
|
updatePruefpunkte
|
|
End Select
|
|
End Sub
|
|
|
|
|
|
|
|
Private Function PruefpunkteZeitenVorhanden() As Boolean
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim Zeit As Double
|
|
|
|
|
|
For Each Pruefpunkt In m_colUniquePP.getCollection
|
|
Zeit = Pruefpunkt.GetTime
|
|
Debug.Print "Prüfpunkt " & Pruefpunkt.getQ & ", Zeit: " & Zeit
|
|
|
|
If Zeit = 0 Then
|
|
' Für einen Pruefpunkt ist keine Zeit definiert: sofort False zurückgeben
|
|
PruefpunkteZeitenVorhanden = False
|
|
Exit Function
|
|
End If
|
|
Next
|
|
' Alle Prüfpunkte haben Zeiten
|
|
PruefpunkteZeitenVorhanden = True
|
|
End Function
|
|
|
|
|
|
|
|
Public Sub Hauptpruefung()
|
|
Dim i As Integer
|
|
Dim dlgHauptPruefung As frmUSFW2Hauptprf
|
|
Dim blnPruefungDurchfuehren As Boolean
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim EinbauplatzNr As Integer
|
|
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim StatusFertigung As Byte
|
|
Dim comport As Integer
|
|
|
|
Set dlgHauptPruefung = New frmUSFW2Hauptprf
|
|
|
|
Set m_Pruefgang = New CPruefgang
|
|
|
|
Set dlgHauptPruefung.m_ParentForm = Me
|
|
Set dlgHauptPruefung.m_colEinbauplatz = m_colEinbauplatz
|
|
|
|
Set dlgHauptPruefung.m_colUniquePP = m_colUniquePP
|
|
Set dlgHauptPruefung.m_colUniqueVorPP = m_colUniqueVorPP
|
|
|
|
Set dlgHauptPruefung.m_Pruefgang = m_Pruefgang
|
|
|
|
'''' Set dlgHauptPruefung.m_RegulierPruefpunkt = m_colUniquePP.getPP(cmbPruefpunkte.text)
|
|
'''''dlgHauptPruefung.m_AnzahlPZ = Val(txtAnzahl.text)
|
|
''''''dlgHauptPruefung.mbln_Vorjustage = chkVorjustage.Value
|
|
|
|
dlgHauptPruefung.mbln_Hauptpruefung = chkHauptpruefung.value
|
|
dlgHauptPruefung.mbln_Vorpruefung = chkVorpruefung.value
|
|
''''dlgHauptPruefung.mbln_Bereichsjustage = chkBereichsjustage.Value
|
|
''''dlgHauptPruefung.mbln_nachjustage = chkNachjustage.Value
|
|
''''dlgHauptPruefung.mbln_ZeroFlowMessung = chkZeroflow.Value
|
|
''''dlgHauptPruefung.mbln_Funktionspruefung = chkFunktionsprüfung.Value
|
|
''''dlgHauptPruefung.mbln_HeissKaltSpreizungBerechnen = chkHeissKaltSpreizungBerechnen.Value
|
|
''''dlgHauptPruefung.mbln_ZeroFlowJustage = chkZeroFlowJustage.Value
|
|
|
|
If g_Abbruch Then Exit Sub
|
|
|
|
' Flags
|
|
|
|
''''dlgHauptPruefung.m_bPruefgangLang = m_bPruefgangLang
|
|
''''dlgHauptPruefung.m_Regelart = m_Regelart
|
|
|
|
dlgHauptPruefung.m_PruefungsArtWaage = m_PruefungsArtWaage
|
|
dlgHauptPruefung.m_VorPruefungsArtWaage = m_VorPruefungsArtWaage
|
|
|
|
''''dlgHauptPruefung.m_NurMesseinsaetze = 0
|
|
|
|
dlgHauptPruefung.m_DauerpruefungAnzahl = CInt(txtAnzahlDauerPrf.text)
|
|
dlgHauptPruefung.m_bKontinuierlich = chkKontinuierlich.value
|
|
|
|
Timer1.Enabled = False
|
|
|
|
blnPruefungDurchfuehren = False
|
|
'''If chkNachjustage.Value = vbChecked Then blnPruefungDurchfuehren = True
|
|
'''If chkVorjustage.Value = vbChecked Then blnPruefungDurchfuehren = True
|
|
If chkVorpruefung.value = vbChecked Then blnPruefungDurchfuehren = True
|
|
If chkKontinuierlich.value = vbChecked Then blnPruefungDurchfuehren = True
|
|
If chkHauptpruefung.value = vbChecked Then blnPruefungDurchfuehren = True
|
|
''''If chkFunktionsprüfung.Value = vbChecked Then blnPruefungDurchfuehren = True
|
|
|
|
If g_blnBefundpruefung Then
|
|
Call BefundpruefungVorbereiten
|
|
End If
|
|
|
|
|
|
If blnPruefungDurchfuehren = True Then
|
|
|
|
PrintStatus "Init KEV1..."
|
|
DoEvents
|
|
Call USPruefungInitialisierung
|
|
|
|
If chkExternalTemperatur.value = vbChecked Then
|
|
dlgHauptPruefung.mblnExternalTemperatur = True
|
|
End If
|
|
|
|
DoEvents
|
|
|
|
''''''''''''''''''''''''''''''''''''
|
|
' FW2 Hauptprüfungsdialog anzeigen
|
|
Me.Visible = False
|
|
dlgHauptPruefung.Show vbModal
|
|
Me.Visible = True
|
|
PrintStatus "Prüfung abgeschlossen"
|
|
DoEvents
|
|
''''''''''''''''''''''''''''''''''''
|
|
|
|
' Anzahl der vergangenden Prüfungen anzeigen
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
UpdateStatusFertigung Einbauplatz
|
|
Next
|
|
|
|
If dlgHauptPruefung.getExitCode = IDOK Then
|
|
' Prüfung abgeschlossen
|
|
|
|
If g_blnBefundpruefung Then
|
|
BefundpruefungsAbschlussAlleZaehler
|
|
Else
|
|
' Prüfungsabschluss
|
|
Call USPruefungAbschlussAlleZaehler(False)
|
|
End If
|
|
|
|
If g_bKonfigVergleichDurchfuehren = True Then
|
|
' Konfigurationsvergleich
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
If Einbauplatz.getAktiv Then
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
If Not Pruefzaehler Is Nothing And comport > 0 Then
|
|
PrintStatus "Einbauplatz " & EinbauplatzNr
|
|
If Einbauplatz.m_strMapfile <> "" Then
|
|
If Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
|
|
PrintStatus "Konfig-Vergleich für Einbauplatz " & EinbauplatzNr & "..."
|
|
|
|
|
|
Konfigurationsvergleich Einbauplatz.getNr
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Fertigmelden vorbereiten
|
|
''''''''''''''''''' TLMenge_P aktualisieren und speichern
|
|
Dim AuftragPosition As CAuftragPosition
|
|
Set AuftragPosition = Einbauplatz.getPruefzaehler.getAuftragPosition
|
|
' Anzahl "geprüft" aktualiseren
|
|
AuftragPosition.UpdateTLMenge_P
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Anzahl "geschlossen" aktualiseren und an SAP Senden
|
|
'veraltet: AuftragPosition.updateTLMenge_G
|
|
AuftragPosition.save Einbauplatz.getPruefzaehler.getAuftrag
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Else
|
|
PrintStatus "kein Konfig-Vergleich für Einbauplatz " & EinbauplatzNr & "!"
|
|
MsgBox "Der Prüfzähler (SerienNr " & Einbauplatz.getPruefzaehler.getSerienNr & ", FabNr " & Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr & ") am Einbauplatz " & EinbauplatzNr & " wurde NICHT erfolgreich geprüft. Das Schloss wird nicht geschlossen!", vbInformation, "Hinweis"
|
|
End If
|
|
End If
|
|
End If
|
|
Else
|
|
MsgBox "Der Prüfzähler (SerienNr " & Einbauplatz.getPruefzaehler.getSerienNr & ", FabNr " & Einbauplatz.getPruefzaehler.getAuftragPositionSerienNr.getFabNr & ") am Einbauplatz " & EinbauplatzNr & " wurde NICHT erfolgreich geprüft. Es findet kein Konfigvergleich statt und das Schloss wird nicht geschlossen!", vbInformation, "Hinweis"
|
|
PrintStatus "Kein Konfig-Vergleich für Einbauplatz " & EinbauplatzNr & " da bei diesem Zähler bereits ein Fehler aufgetreten ist."
|
|
End If
|
|
Next
|
|
Else
|
|
PrintStatus "Konfig-Vergleich ist abgewählt."
|
|
End If
|
|
|
|
If g_blnFertigmelden Then
|
|
Call PruefungFertigmeldenDialog("Die Prüfung ist beendet.", m_colEinbauplatz)
|
|
End If
|
|
Else
|
|
' Prüfung abgebrochen
|
|
|
|
If g_blnBefundpruefung Then
|
|
BefundpruefungsAbschlussAlleZaehler
|
|
Else
|
|
Call USPruefungAbschlussAlleZaehler(True)
|
|
End If
|
|
|
|
MsgBox ("Die Prüfung wurde abgebrochen.")
|
|
End If
|
|
Else
|
|
' es fand keine Prüfung statt, da alle Checkbuttons ausgeschaltet sind
|
|
MsgBox "Bitte Vorprüfung und/oder Prüfung anwählen!"
|
|
|
|
End If
|
|
|
|
DoEvents
|
|
|
|
' Zähler entfernen, damit sie erneut eingelesen werden
|
|
'initFlexgrid
|
|
|
|
If Not g_ohneSPS Then
|
|
' beide Behälter Ablassventile wieder schließen
|
|
g_App.getSPS.WassserAblassen 0
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
Private Sub USPruefungInitialisierung()
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim comport As Integer
|
|
Dim iret As Integer
|
|
Dim byte_u8flagreg As Byte
|
|
Dim byte_Schloss As Byte
|
|
|
|
m_colUniqueVorPP.sortQ
|
|
'm_colUniquePP.sortQ
|
|
|
|
Dim strError As String
|
|
|
|
' todo: Auflistung, welcher Einbauplatz hat geklappt
|
|
' todo: Methode, einen Zähler auszuschliessen
|
|
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
If Not Pruefzaehler Is Nothing And comport > 0 Then
|
|
PrintStatus "Einbauplatz " & EinbauplatzNr
|
|
If Einbauplatz.m_strMapfile <> "" Then
|
|
|
|
iret = FW2_Init_KEV1(Einbauplatz)
|
|
If iret = 0 Then
|
|
WriteToFW2Logfile Einbauplatz, "INIT KEV1=" & vbTab & "OK"
|
|
PrintStatus "INIT KEV1 OK"
|
|
DoEvents
|
|
|
|
If g_blnFW2_Systemzeit_setzen = True Then
|
|
Call FW2_SetTimeToZero(Einbauplatz)
|
|
End If
|
|
|
|
|
|
Dim i As Integer
|
|
PrintStatus "u8_system_flags Wert merken und Bit0=0 setzen"
|
|
FW2_SetOptoTimeout Einbauplatz, False
|
|
DoEvents
|
|
|
|
If chkExternalTemperatur.value = vbChecked Then
|
|
' Temperaturübergabe vom Fühler sperren
|
|
If FW2_ReadVar(Einbauplatz, "u8_flagreg", byte_u8flagreg) = 0 Then
|
|
' Bit 6 einschalten
|
|
PrintStatus "byte_u8flagreg=" & byte_u8flagreg
|
|
WriteToFW2Logfile Einbauplatz, "lese u8_flagreg=" & vbTab & byte_u8flagreg
|
|
byte_u8flagreg = byte_u8flagreg Or 2 ^ 6
|
|
If FW2_writeVar(Einbauplatz, "u8_flagreg", byte_u8flagreg) = 0 Then
|
|
PrintStatus "schreibe byte_u8flagreg = " & byte_u8flagreg
|
|
Else
|
|
PrintStatus "byte_u8flagreg schreib Fehler " & iret & " :" & modMBUS_SMS.Errorstring(iret)
|
|
End If
|
|
End If
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "INIT KEV1 Fehler " & iret & ":" & modMBUS_SMS.Errorstring(iret)
|
|
MSFlexGrid1.TextMatrix(EinbauplatzNr, SPALTE_Status) = "INIT KEV1: " & modMBUS_SMS.Errorstring(iret)
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "kein Mapfile vorhanden."
|
|
PrintStatus " kein Mapfile"
|
|
End If
|
|
End If
|
|
|
|
ReformatFlexgrid
|
|
Next
|
|
Sleep 2000, True
|
|
End Sub
|
|
|
|
|
|
Private Function UeberpruefeAufOffenesSchloss(Einbauplatz As CEinbauplatz) As Boolean
|
|
Dim byte_Schloss As Byte
|
|
Dim iret As Integer
|
|
Wiederholen:
|
|
' Schloss überprüfen
|
|
iret = FW2_ReadVar(Einbauplatz, "u8_schloss", byte_Schloss, True)
|
|
If iret = 0 Then
|
|
PrintStatus "byte_Schloss = " & byte_Schloss
|
|
' was soll passieren, wenn Schloss geschlossen ist?
|
|
Select Case byte_Schloss
|
|
Case 165 ' offen
|
|
'OK
|
|
UeberpruefeAufOffenesSchloss = True
|
|
Case 90 ' geschlossen
|
|
MsgBox "Das Schloss für Einbauplatz " & Einbauplatz.getNr & " ist geschlossen! Dieser Zähler kann nicht justiert werden."
|
|
' hier könnte man den Zähler am Einbauplatz von der Justage ausnehmen
|
|
UeberpruefeAufOffenesSchloss = False
|
|
Case Else
|
|
MsgBox "Fehler beim Lesen des Schloss-Zustands für Einbauplatz " & Einbauplatz.getNr
|
|
UeberpruefeAufOffenesSchloss = False
|
|
End Select
|
|
Else
|
|
' Schloss konnte nicht gelesen werden
|
|
If MsgBox("Fehler beim Lesen des Schloss-Zustands für Einbauplatz " & Einbauplatz.getNr, vbRetryCancel) = vbRetry Then
|
|
GoTo Wiederholen
|
|
End If
|
|
UeberpruefeAufOffenesSchloss = False
|
|
End If
|
|
End Function
|
|
|
|
Private Sub USPruefungAbschlussAlleZaehler(blnPruefungAbgebochen As Boolean)
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim comport As Integer
|
|
Dim iret As Integer
|
|
|
|
If chkPruefungsabschluss.value = vbUnchecked Then
|
|
PrintStatus "KEV1 Reset durchführen ist abgwählt und wird nicht durchgeführt!"
|
|
Exit Sub
|
|
End If
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
comport = Val(g_App.Settings.getUSComPort(EinbauplatzNr))
|
|
If Not Pruefzaehler Is Nothing And comport > 0 Then
|
|
If Einbauplatz.m_strMapfile <> "" Then
|
|
PrintStatus "Einbauplatz " & EinbauplatzNr
|
|
|
|
' Wegen Optotimeout ggF. die Systemzeit zurück setzen
|
|
If g_blnFW2_Systemzeit_setzen = True Then
|
|
PrintStatus "Systemzeit_setzen..."
|
|
Call FW2_SetTime(Einbauplatz, time)
|
|
End If
|
|
|
|
'Opto Timeout Reset
|
|
If Pruefzaehler.m_b_u8_system_flags_saved = True Then
|
|
PrintStatus "Opto Timeout uReset: u8_system_flags wiederherstellen"
|
|
FW2_SetOptoTimeout Einbauplatz, True
|
|
End If
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Reset_KEV1_Wdh:
|
|
PrintStatus "Reset KEV1..."
|
|
iret = modMBUS_SMS.fw2_open_comport(comport, 2400, Einbauplatz.m_strMapfile, True, 3)
|
|
If iret = 0 Then
|
|
iret = modMBUS_SMS.Init_FW2(modMBUS_SMS.RESET_KEV1)
|
|
If iret = 0 Then
|
|
PrintStatus " Reset KEV1 OK"
|
|
WriteToFW2Logfile Einbauplatz, "Reset KEV1=" & vbTab & "OK"
|
|
Else
|
|
PrintStatus " Reset KEV1 Fehler " & iret & ": " & modMBUS_SMS.Errorstring(iret)
|
|
WriteToFW2Logfile Einbauplatz, "Reset KEV1=" & vbTab & "Fehler " & iret & ": " & modMBUS_SMS.Errorstring(iret)
|
|
|
|
iret = MsgBox("Reset KEV1 für Ebp " & EinbauplatzNr & " konnte nicht durchgeführt werden." & vbCrLf & "Fehler " & iret & ": " & modMBUS_SMS.Errorstring(iret) & vbCrLf & "Bitte Verbindung überprüfen und wiederholen." & vbCrLf & vbCrLf & "'Abbrechen' fährt ohne RESET KEV1 fort.", vbRetryCancel Or vbDefaultButton1)
|
|
If iret = vbRetry Then GoTo Reset_KEV1_Wdh
|
|
End If
|
|
Else
|
|
WriteToFW2Logfile Einbauplatz, "Reset KEV1=" & vbTab & " open_comport Fehler " & iret & ": " & modMBUS_SMS.Errorstring(iret)
|
|
iret = MsgBox("Reset KEV1 für Einbauplatz " & EinbauplatzNr & " konnte nicht durchgeführt werden." & vbCrLf & " open_comport Fehler " & iret & ": " & modMBUS_SMS.Errorstring(iret) & vbCrLf & "Bitte Verbindung überprüfen und wiederholen!" & vbCrLf, vbRetryCancel Or vbDefaultButton1)
|
|
If iret = vbRetry Then
|
|
GoTo Reset_KEV1_Wdh
|
|
Else
|
|
MsgBox ("Der KEV1 Reset wurde für Einbauplatz " & EinbauplatzNr & " nicht durchgeführt. Zähler wird später nicht geschlossen. Bitte informieren Sie den Linienleiter.")
|
|
End If
|
|
End If
|
|
modMBUS_SMS.IECCOM_CloseCom
|
|
StatusBar1.SimpleText = "COM geschlossen"
|
|
End If
|
|
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
'Private Sub ZaehlerGeschlossenAktualisieren(AuftragPosition As CAuftragPosition, lngMengeGeschlossen)
|
|
' On Error GoTo Errorhandler
|
|
' Dim Auftrag As CAuftrag
|
|
'
|
|
' Set Auftrag = New CAuftrag
|
|
' Auftrag.load AuftragPosition.getAuftragNr
|
|
'
|
|
' ' neu RH 20.6.2013
|
|
' AuftragPosition.updateTLMenge_G
|
|
' AuftragPosition.save Auftrag
|
|
'
|
|
' ' vergleiche diesen Wert mit der Auftragsmenge
|
|
' If lngMengeGeschlossen = Me.getMenge And blnAlleSindGeschlossen = True Then
|
|
' ' Menge erreicht: alle Zähler dieser Auftragposition sind geschlossen
|
|
'
|
|
' 'FertMeld_GTerm_Dat
|
|
' 'FertMeld_GTerm_MA
|
|
'
|
|
' Dim strSQL As String
|
|
' strSQL = "update AuftragPosition set FertMeld_GTerm_MA = " & g_App.Mitarbeiter.getNr & ", FertMeld_GTerm_Dat=getdate() where AuftragNr = " & Me.getAuftragNr & " and PositionNr = " & Me.getNr
|
|
' g_App.getDB.getConnection.Execute strSQL
|
|
'
|
|
' Fortschrittrueckmeldung "G"
|
|
' End If
|
|
' Exit Sub
|
|
'Errorhandler:
|
|
' LogIntoDB "Fehler " & Err.Number & " in ZaehlerGeschlossenAktualisieren(" & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & " ) " & Err.Description
|
|
'End Sub
|
|
|
|
Private Sub PrintStatus(sText As String)
|
|
If Len(txtStatus.text & sText) > 32768 Then
|
|
txtStatus.text = ""
|
|
End If
|
|
txtStatus.text = txtStatus.text & sText & vbCrLf
|
|
txtStatus.SelStart = Len(txtStatus.text)
|
|
DebugMsg sText
|
|
DoEvents
|
|
End Sub
|
|
|
|
Private Sub chkZulassung_Click()
|
|
Dim strTemp As String
|
|
|
|
If chkZulassung.value = vbChecked Then
|
|
g_blnZulassungspruefung = True
|
|
WriteToLog "Zulassungspruefung wurde ausgeschaltet"
|
|
If g_App.Settings.GetWetterstationURL <> "" Then
|
|
If GetWeatherData(g_dblLuftTemperatur, g_dblLuftFeuchte, g_dblLuftDruck, strTemp) = False Then
|
|
LogIntoDB strTemp, "Wetterstation"
|
|
' Es gab einen Fehler
|
|
ZeigePruefgangUmgebungForm
|
|
Else
|
|
If g_dblLuftTemperatur <> 0 And g_dblLuftFeuchte <> 0 And g_dblLuftDruck <> 0 Then
|
|
' alles OK
|
|
Exit Sub
|
|
Else
|
|
' Es müssen noch Werte eingetragen werden, weil sie 0 sind
|
|
ZeigePruefgangUmgebungForm
|
|
End If
|
|
End If
|
|
Else
|
|
' keine Wetterstatuin definiert
|
|
ZeigePruefgangUmgebungForm
|
|
End If
|
|
Else
|
|
' Zulassungsprüfung wurde abgeschaltet
|
|
WriteToLog "Zulassungspruefung wurde ausgeschaltet"
|
|
g_blnZulassungspruefung = False
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ZeigePruefgangUmgebungForm()
|
|
' ggF. Luftdruck, LuftFeuchte und LuftTemp abfragen
|
|
Dim objForm As frmPruefgangUmgebung
|
|
Set objForm = New frmPruefgangUmgebung
|
|
objForm.Show vbModal, Me
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub ReformatFlexgrid()
|
|
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
|
MSFlexGrid1.ColWidth(SPALTE_Mapfile) = 500
|
|
MSFlexGrid1.ColWidth(SPALTE_CompareFile) = 1500
|
|
End Sub
|
|
|
|
Private Sub UpdateStatusFertigung(Einbauplatz As CEinbauplatz)
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim AuftragpositionSerienNr As CAuftragPositionSerienNr
|
|
Dim StatusFertigung As Byte
|
|
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
MSFlexGrid1.row = Einbauplatz.getNr
|
|
MSFlexGrid1.col = SPALTE_Status
|
|
MSFlexGrid1.text = "?"
|
|
MSFlexGrid1.CellBackColor = RGB(255, 255, 255)
|
|
Set AuftragpositionSerienNr = Pruefzaehler.getAuftragPositionSerienNr
|
|
If Not AuftragpositionSerienNr Is Nothing Then
|
|
StatusFertigung = AuftragpositionSerienNr.getStatusFertigung
|
|
If StatusFertigung >= 30 Then
|
|
MSFlexGrid1.text = AuftragpositionSerienNr.getWiederholungen & " wdh"
|
|
' Grün
|
|
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
|
|
Else
|
|
' Rot
|
|
MSFlexGrid1.text = AuftragpositionSerienNr.getWiederholungen & " wdh"
|
|
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub chkOffset_Qi_Click()
|
|
Call EnableDisableOffset_qi
|
|
End Sub
|
|
|
|
Private Sub EnableDisableOffset_qi()
|
|
If chkOffset_Qi.value = vbChecked Then
|
|
txtOffset_Qi.text = "0"
|
|
txtOffset_Qi.Enabled = True
|
|
txtOffset_Qi.BackColor = &HFFFFFF
|
|
Else
|
|
txtOffset_Qi.BackColor = &H8000000B
|
|
txtOffset_Qi.text = "0"
|
|
txtOffset_Qi.Enabled = False
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub BefundpruefungsAbschlussAlleZaehler()
|
|
Dim iret As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim byteFlagReg As Byte
|
|
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
''''''''''''''''''''''''''''''''''
|
|
' Temperatur wieder auf interne Fühler setzen: u8_flagreg Bit 6 wieder ausschalten
|
|
NochmalLesen_u8_flagreg:
|
|
iret = FW2_ReadVar(Einbauplatz, "u8_flagreg", byteFlagReg)
|
|
If iret <> MBUS_SMS_ERR_OK Then
|
|
iret = MsgBox("Es gab einen Fehler beim Lesen von u8_flagreg: " & modMBUS_SMS.Errorstring(iret) & vbCrLf & "Bitte beheben Sie den Fehler und wiederholen Sie den Vorgang (Retry)", vbRetryCancel)
|
|
If iret = vbRetry Then
|
|
GoTo NochmalLesen_u8_flagreg
|
|
End If
|
|
End If
|
|
|
|
WriteToFW2Logfile Einbauplatz, "Temperatur wieder auf interne Fühler setzen: byteFlagReg Bit 6 löschen"
|
|
byteFlagReg = byteFlagReg And Not 2 ^ 6 ' Bit 6 Löschen
|
|
|
|
NochmalSchreiben_u8_flagreg:
|
|
iret = FW2_writeVar(Einbauplatz, "u8_flagreg", byteFlagReg)
|
|
|
|
If iret <> MBUS_SMS_ERR_OK Then
|
|
iret = MsgBox("Es gab einen Fehler beim Schreiben von u8_flagreg: " & modMBUS_SMS.Errorstring(iret) & vbCrLf & "Bitte beheben Sie den Fehler und wiederholen Sie den Vorgang (Retry)", vbRetryCancel)
|
|
If iret = vbRetry Then
|
|
GoTo NochmalSchreiben_u8_flagreg
|
|
End If
|
|
End If
|
|
''''''''''''''''''''''''''''''''''
|
|
|
|
' Wegen Optotimeout ggF. die Systemzeit zurück setzen
|
|
If g_blnFW2_Systemzeit_setzen = True Then
|
|
PrintStatus "Systemzeit zurück setzen..."
|
|
Call FW2_SetTime(Einbauplatz, time)
|
|
End If
|
|
|
|
'Opto Timeout Reset
|
|
PrintStatus "Opto Timeout Reset..."
|
|
FW2_SetOptoTimeout Einbauplatz, True
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Function BefundpruefungVorbereiten() As Boolean
|
|
Dim iret As Integer
|
|
Dim Einbauplatz As CEinbauplatz
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
Dim EinbauplatzNr As Integer
|
|
Dim byteSchloss As Byte
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' If m_colUniquePP.Count = 3 Then
|
|
' m_colUniquePP.sortQ
|
|
' m_colUniquePP.Vertausche 1, 3
|
|
' Else
|
|
' MsgBox "Da die Anzahl der Prüfpunkte <> 3 ist, wählen sie bitte die Prüfpunkt-Reihenfolge manuell."
|
|
' BefundpruefungVorbereiten = False
|
|
' Exit Function
|
|
' End If
|
|
|
|
'''''''''''''''' alle Schloesser öffnen ''''''''
|
|
For Each Einbauplatz In m_colEinbauplatz
|
|
EinbauplatzNr = Einbauplatz.getNr
|
|
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
|
If Not Pruefzaehler Is Nothing Then
|
|
|
|
Wiederholen_Lesen_1:
|
|
iret = modUSchall.FW2_ReadVar(Einbauplatz, "u8_schloss", byteSchloss)
|
|
If iret <> 0 Then
|
|
iret = MsgBox("Das Schloss konnte nicht überprüft werden. Bitte Fehler beheben." & modMBUS_SMS.Errorstring(iret), vbAbortRetryIgnore)
|
|
Select Case iret
|
|
Case vbRetry
|
|
GoTo Wiederholen_Lesen_1
|
|
Case vbIgnore
|
|
' egal, weitermachen!
|
|
Case vbAbort
|
|
BefundpruefungVorbereiten = False
|
|
Exit Function
|
|
End Select
|
|
Else
|
|
Select Case byteSchloss
|
|
Case 165
|
|
' Schloss ist offen, alles OK
|
|
Case 90
|
|
NochmalSchlossOeffnen:
|
|
PrintStatus "Schloss öffnen am Einbauplatz " & Einbauplatz.getNr
|
|
iret = FW2_SetzeSchloss(Einbauplatz, True)
|
|
If iret = MBUS_SMS_ERR_OK Then
|
|
WriteToFW2Logfile Einbauplatz, "Schloss wurde geöffnet"
|
|
UpdateSchlossAnzeige Einbauplatz
|
|
Else
|
|
iret = MsgBox("Beim Öffnen des Schlosses trat der Fehler " & iret & "=" & modMBUS_SMS.Errorstring(iret) & " auf." & vbCrLf & "Bitte beheben Sie den Fehler und versuchen Sie es nochmal.", vbRetryCancel)
|
|
DoEvents
|
|
If iret = vbCancel Then
|
|
' Vorbereitung ist fehlgeschlagen
|
|
BefundpruefungVorbereiten = False
|
|
MsgBox "Befundprüfung wurde abgebrochen, da nicht alle Schlösser geöffnet wurden."
|
|
Else
|
|
GoTo NochmalSchlossOeffnen
|
|
End If
|
|
End If ' SetzeSchloss
|
|
End Select
|
|
End If
|
|
End If ' Pruefzähler
|
|
Next ' EInbauplatz
|
|
''''''''''''''''''''''''''''''''''''''''''''
|
|
End Function
|
|
|
|
|
|
Private Sub DialogSchlossOeffnenSchliessen(Einbauplatz As CEinbauplatz)
|
|
Dim byte_Schloss As Byte
|
|
Dim iret As Integer
|
|
Dim lRet As Long
|
|
|
|
On Error GoTo Errorhandler
|
|
|
|
Me.MousePointer = vbHourglass
|
|
Wiederholen:
|
|
' Schloss überprüfen
|
|
iret = FW2_ReadVar(Einbauplatz, "u8_schloss", byte_Schloss, True)
|
|
If iret = 0 Then
|
|
' was soll passieren, wenn Schloss geschlossen ist?
|
|
Select Case byte_Schloss
|
|
Case 165 ' offen
|
|
PrintStatus "byte_Schloss = " & byte_Schloss & " = offen"
|
|
lRet = MsgBox("Möchten Sie das Schloss am Einbauplatz " & Einbauplatz.getNr & " jetzt schliessen?", vbYesNo Or vbDefaultButton1)
|
|
If lRet = vbYes Then
|
|
|
|
If FW2_Schloss_schliessen_und_Fortschrittrueckmeldung(Einbauplatz) Then
|
|
UpdateSchlossAnzeige Einbauplatz
|
|
MsgBox ("Schloss wurde geschlossen")
|
|
Else
|
|
UpdateSchlossAnzeige Einbauplatz
|
|
MsgBox ("Beim Schliessen des Schlosses trat der Fehler " & iret & "=" & modMBUS_SMS.Errorstring(iret) & " auf." & vbCrLf & "Bitte beheben Sie den Fehler und versuchen Sie es nochmal.")
|
|
End If
|
|
|
|
' iret = FW2_SetzeSchloss(Einbauplatz, False)
|
|
' If iret = MBUS_SMS_ERR_OK Then
|
|
' UpdateSchlossAnzeige Einbauplatz
|
|
' Else
|
|
' End If
|
|
End If
|
|
Case 90 ' geschlossen
|
|
PrintStatus "byte_Schloss = " & byte_Schloss & " = geschlossen"
|
|
lRet = MsgBox("Möchten Sie das Schloss am Einbauplatz " & Einbauplatz.getNr & " jetzt öffnen?", vbYesNo Or vbDefaultButton1)
|
|
If lRet = vbYes Then
|
|
iret = FW2_SetzeSchloss(Einbauplatz, True)
|
|
If iret = MBUS_SMS_ERR_OK Then
|
|
Schloss_Als_Geoeffnet_In_Datenbank_vermerken Einbauplatz.getPruefzaehler.getSerienNr
|
|
UpdateSchlossAnzeige Einbauplatz
|
|
MsgBox ("Schloss wurde geöffnet")
|
|
Else
|
|
Select Case iret
|
|
Case MBUS_SMS_ERR_NO_RECEIVED_DATA_ASSIGNMENT
|
|
MsgBox ("Beim Öffnen des Schlosses trat der Fehler " & iret & "=" & modMBUS_SMS.Errorstring(iret) & " auf. " & vbCrLf & "Bitte setzen Sie eine Steckbrücke ein und versuchen Sie es nochmal.")
|
|
Case Else
|
|
MsgBox ("Beim Öffnen des Schlosses trat der Fehler " & iret & "=" & modMBUS_SMS.Errorstring(iret) & " auf. " & vbCrLf & "Bitte beheben Sie den Fehler und versuchen Sie es nochmal.")
|
|
End Select
|
|
End If
|
|
End If
|
|
Case Else
|
|
PrintStatus "byte_Schloss = " & byte_Schloss & " = unbekannt "
|
|
MsgBox "Fehler beim Lesen des Schloss-Zustands für Einbauplatz " & Einbauplatz.getNr
|
|
End Select
|
|
Else
|
|
' Schloss konnte nicht gelesen werden
|
|
If MsgBox("Fehler beim Lesen des Schloss-Zustands für Einbauplatz " & Einbauplatz.getNr, vbRetryCancel) = vbRetry Then
|
|
GoTo Wiederholen
|
|
End If
|
|
End If
|
|
Me.MousePointer = vbNormal
|
|
Exit Sub
|
|
Errorhandler:
|
|
MsgBox "Es trat der Fehler " & Err.Number & " in DialogSchlossOeffnen() auf: " & Err.Description
|
|
End Sub
|
|
|
|
|
|
Private Sub UpdateSchlossAnzeige(Einbauplatz As CEinbauplatz)
|
|
Dim iret As Integer
|
|
Dim byteSchloss As Byte
|
|
iret = FW2_ReadVar(Einbauplatz, "u8_schloss", byteSchloss, True)
|
|
MSFlexGrid1.row = Einbauplatz.getNr
|
|
MSFlexGrid1.col = SPALTE_Schloss
|
|
Select Case byteSchloss
|
|
Case 90
|
|
MSFlexGrid1.CellBackColor = RGB(255, 128, 128)
|
|
MSFlexGrid1.text = TXT_SCHLOSS_CLOSED
|
|
Case 165
|
|
MSFlexGrid1.CellBackColor = RGB(128, 255, 128)
|
|
MSFlexGrid1.text = TXT_SCHLOSS_OPEN
|
|
End Select
|
|
End Sub
|
|
|
|
|
|
Private Function UeberpruefeSerienNr(lngSerienNr As Long, Einbauplatz As CEinbauplatz) As Boolean
|
|
Dim iret As Integer
|
|
Dim intQpRW As Integer
|
|
Dim intQpSNr As Integer
|
|
Dim strSQL As String
|
|
Dim VakoCode As CVakoCode
|
|
Dim Pruefzaehler As CPruefzaehler
|
|
|
|
UeberpruefeSerienNr = True
|
|
|
|
Set VakoCode = New CVakoCode
|
|
Set Pruefzaehler = New CPruefzaehler
|
|
If Pruefzaehler.loadForSerienNr(lngSerienNr) Then
|
|
If VakoCode.load(Pruefzaehler.getAuftragPosition.getIdentNrObj.GetVakoCode) Then
|
|
intQpSNr = VakoCode.GetWert("Qn")
|
|
If intQpSNr > 0 Then
|
|
iret = FW2_ReadVar(Einbauplatz, "u16_flow_nominal", intQpRW, True)
|
|
intQpRW = intQpRW / 10
|
|
If iret = 0 And intQpRW > 0 Then
|
|
If intQpRW = intQpSNr Then
|
|
' alles OK
|
|
PrintStatus "Qp = " & intQpSNr & " stimmen im Zählwerk und im Auftrag überein."
|
|
Else
|
|
MsgBox ("Der Nenndurchfluss Qp = " & intQpRW & " im Rechenwerk stimmt NICHT mit Qp = " & intQpSNr & " im Auftrag (FA-Nr:" & Pruefzaehler.getAuftragPosition.GetFertigungsauftragNr & ") überein." & vbCrLf & " Das Rechenwerk an Einbauplatz 2 kann nicht mit der SerienNr " & lngSerienNr & " geprüft werden. " & vbCrLf & "Bitte Rechenwerk tauschen!")
|
|
If g_blnVersuch = False Then
|
|
'für Produktivbetrieb relevant
|
|
UeberpruefeSerienNr = False
|
|
End If
|
|
End If
|
|
Else
|
|
PrintStatus "UeberpruefeSerienNr(): Qp (aus Rechenwerk) konnte nicht geladen werden!"
|
|
End If
|
|
Else
|
|
PrintStatus "UeberpruefeSerienNr(): Qp (zum Auftrag) konnte nicht geladen werden!"
|
|
End If
|
|
Else
|
|
PrintStatus "UeberpruefeSerienNr(): Vakocode konnte nicht geladen werden!"
|
|
End If
|
|
Else
|
|
MsgBox "UeberpruefeSerienNr(): Pruefzaehler Daten konnten nicht geladen werden!"
|
|
End If
|
|
Exit Function
|
|
Erorhandler:
|
|
MsgBox "Fehler " & Err.Number & " in UeberpruefeSerienNr(): " & Err.Description
|
|
UeberpruefeSerienNr = True
|
|
End Function
|