2086 lines
68 KiB
Plaintext
2086 lines
68 KiB
Plaintext
VERSION 5.00
|
||
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
|
||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
|
||
Begin VB.Form frmRegulierung
|
||
Caption = "Pruef2000"
|
||
ClientHeight = 10440
|
||
ClientLeft = 60
|
||
ClientTop = 345
|
||
ClientWidth = 15240
|
||
ControlBox = 0 'False
|
||
KeyPreview = -1 'True
|
||
LinkTopic = "Form1"
|
||
ScaleHeight = 10440
|
||
ScaleWidth = 15240
|
||
StartUpPosition = 1 'Fenstermitte
|
||
Begin VB.CommandButton cmdOK
|
||
Cancel = -1 'True
|
||
Caption = "OK"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 615
|
||
Left = 7890
|
||
TabIndex = 0
|
||
Top = 9270
|
||
Width = 1935
|
||
End
|
||
Begin VB.CommandButton cmdSPSInfo
|
||
Caption = "Schaubild"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 615
|
||
Left = 5640
|
||
TabIndex = 5
|
||
Top = 60
|
||
Width = 1935
|
||
End
|
||
Begin VB.CommandButton cmdCancel
|
||
Caption = "Abbruch"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 615
|
||
Left = 5490
|
||
TabIndex = 3
|
||
Top = 9270
|
||
Width = 1935
|
||
End
|
||
Begin VB.Frame frMain
|
||
Height = 8595
|
||
Left = 210
|
||
TabIndex = 1
|
||
Top = 570
|
||
Width = 14835
|
||
Begin VB.Frame frameBemerkung
|
||
Caption = "Bemerkungen"
|
||
Height = 915
|
||
Left = 150
|
||
TabIndex = 36
|
||
Top = 1770
|
||
Width = 4845
|
||
Begin VB.CommandButton cmdBemerkungen
|
||
Height = 465
|
||
Left = 225
|
||
TabIndex = 37
|
||
Top = 270
|
||
Width = 1305
|
||
End
|
||
Begin VB.Shape Shape2
|
||
FillColor = &H000000FF&
|
||
FillStyle = 0 'Ausgef<65>llt
|
||
Height = 105
|
||
Left = 4200
|
||
Top = 660
|
||
Width = 225
|
||
End
|
||
Begin VB.Shape Shape1
|
||
FillColor = &H000000FF&
|
||
FillStyle = 0 'Ausgef<65>llt
|
||
Height = 345
|
||
Left = 4200
|
||
Top = 270
|
||
Width = 225
|
||
End
|
||
Begin VB.Label lblBemerkung
|
||
BorderStyle = 1 'Fest Einfach
|
||
Height = 465
|
||
Left = 2310
|
||
TabIndex = 38
|
||
Top = 270
|
||
Width = 1395
|
||
End
|
||
End
|
||
Begin VB.Frame FrameKennlinie
|
||
Caption = "ideale Pr<50>fkennlinie"
|
||
Height = 4035
|
||
Left = 150
|
||
TabIndex = 29
|
||
Top = 2670
|
||
Width = 7005
|
||
Begin VB.Image Image1
|
||
BorderStyle = 1 'Fest Einfach
|
||
Height = 3765
|
||
Left = 90
|
||
Top = 210
|
||
Width = 6885
|
||
End
|
||
End
|
||
Begin VB.Frame Frame4
|
||
Caption = "Voreinstellwert"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 1455
|
||
Left = 150
|
||
TabIndex = 26
|
||
Top = 210
|
||
Width = 7155
|
||
Begin VB.TextBox txtSollwert
|
||
Alignment = 1 'Rechts
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 26.25
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 720
|
||
Left = 120
|
||
Locked = -1 'True
|
||
TabIndex = 33
|
||
Text = "-1.23"
|
||
Top = 300
|
||
Width = 1755
|
||
End
|
||
Begin VB.CommandButton cmdSollwertAendern
|
||
Caption = "Historie / <20>ndern...."
|
||
Enabled = 0 'False
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 4695
|
||
TabIndex = 28
|
||
Top = 930
|
||
Width = 2145
|
||
End
|
||
Begin VB.Label Label14
|
||
Alignment = 1 'Rechts
|
||
Caption = "Bemerkung:"
|
||
Height = 195
|
||
Left = 2190
|
||
TabIndex = 35
|
||
Top = 240
|
||
Width = 855
|
||
End
|
||
Begin VB.Label lblVoreinstellwertBemerkung
|
||
BorderStyle = 1 'Fest Einfach
|
||
Height = 285
|
||
Left = 3180
|
||
TabIndex = 34
|
||
Top = 240
|
||
Width = 3645
|
||
End
|
||
Begin VB.Label Label12
|
||
Alignment = 1 'Rechts
|
||
Caption = "am"
|
||
Height = 195
|
||
Left = 4440
|
||
TabIndex = 32
|
||
Top = 660
|
||
Width = 375
|
||
End
|
||
Begin VB.Label Label2
|
||
Alignment = 1 'Rechts
|
||
Caption = "von"
|
||
Height = 195
|
||
Left = 2100
|
||
TabIndex = 31
|
||
Top = 630
|
||
Width = 375
|
||
End
|
||
Begin VB.Label lblGeaendertMitarbeiter
|
||
BorderStyle = 1 'Fest Einfach
|
||
Height = 285
|
||
Left = 2550
|
||
TabIndex = 30
|
||
Top = 600
|
||
Width = 1815
|
||
End
|
||
Begin VB.Label lblGeaendertDatum
|
||
BorderStyle = 1 'Fest Einfach
|
||
Height = 285
|
||
Left = 4890
|
||
TabIndex = 27
|
||
Top = 600
|
||
Width = 1935
|
||
End
|
||
End
|
||
Begin VB.Frame Frame3
|
||
Caption = "D<>mpfung"
|
||
Height = 5235
|
||
Left = 7380
|
||
TabIndex = 18
|
||
Top = 270
|
||
Width = 1485
|
||
Begin MSComctlLib.Slider Slider1
|
||
Height = 3675
|
||
Left = 210
|
||
TabIndex = 20
|
||
Top = 1380
|
||
Width = 630
|
||
_ExtentX = 1111
|
||
_ExtentY = 6482
|
||
_Version = 393216
|
||
Orientation = 1
|
||
Min = 1
|
||
Max = 9
|
||
SelStart = 1
|
||
Value = 1
|
||
End
|
||
Begin VB.Label Label1
|
||
Caption = "9"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 13.5
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 870
|
||
TabIndex = 25
|
||
Top = 4620
|
||
Width = 315
|
||
End
|
||
Begin VB.Label Label6
|
||
Caption = "7"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 13.5
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 870
|
||
TabIndex = 24
|
||
Top = 3870
|
||
Width = 315
|
||
End
|
||
Begin VB.Label Label4
|
||
Caption = "5"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 13.5
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 840
|
||
TabIndex = 23
|
||
Top = 3030
|
||
Width = 255
|
||
End
|
||
Begin VB.Label Label5
|
||
Caption = "3"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 13.5
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 840
|
||
TabIndex = 22
|
||
Top = 2220
|
||
Width = 315
|
||
End
|
||
Begin VB.Label Label3
|
||
Caption = "1"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 13.5
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 840
|
||
TabIndex = 21
|
||
Top = 1380
|
||
Width = 315
|
||
End
|
||
Begin VB.Label lblDaempfung
|
||
BorderStyle = 1 'Fest Einfach
|
||
Caption = "3"
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 48
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 1035
|
||
Left = 210
|
||
TabIndex = 19
|
||
Top = 270
|
||
Width = 645
|
||
End
|
||
End
|
||
Begin VB.Frame Frame2
|
||
Caption = "Me<4D>wertabweichung in % bei letzter Pr<50>fung des Z<>hlers"
|
||
Height = 5235
|
||
Left = 8940
|
||
TabIndex = 16
|
||
Top = 270
|
||
Width = 5745
|
||
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
|
||
Height = 4935
|
||
Left = 120
|
||
TabIndex = 17
|
||
Top = 240
|
||
Width = 5505
|
||
_ExtentX = 9710
|
||
_ExtentY = 8705
|
||
_Version = 393216
|
||
End
|
||
End
|
||
Begin VB.CommandButton Command1
|
||
Caption = "Neu Initialisierung [Dislplay / FM85]"
|
||
Height = 495
|
||
Left = 7350
|
||
TabIndex = 15
|
||
Top = 7440
|
||
Width = 1485
|
||
End
|
||
Begin VB.Frame Frame1
|
||
Caption = "Messung"
|
||
Height = 1305
|
||
Left = 7380
|
||
TabIndex = 6
|
||
Top = 5550
|
||
Width = 3525
|
||
Begin VB.TextBox txtFehler
|
||
Enabled = 0 'False
|
||
Height = 315
|
||
Left = 1920
|
||
TabIndex = 8
|
||
Top = 300
|
||
Width = 1155
|
||
End
|
||
Begin VB.CommandButton Command2
|
||
Caption = "einzelne Messung "
|
||
Height = 465
|
||
Left = 1860
|
||
TabIndex = 7
|
||
Top = 750
|
||
Width = 1575
|
||
End
|
||
Begin VB.Label Label7
|
||
Alignment = 1 'Rechts
|
||
Caption = "gemessener Fehlerwert"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 975
|
||
Left = 120
|
||
TabIndex = 9
|
||
Top = 240
|
||
Width = 1545
|
||
End
|
||
End
|
||
Begin VB.Timer Timer1
|
||
Left = 11400
|
||
Top = 7410
|
||
End
|
||
Begin VB.TextBox txtDaten
|
||
Height = 1095
|
||
Left = 150
|
||
MultiLine = -1 'True
|
||
ScrollBars = 2 'Vertikal
|
||
TabIndex = 4
|
||
Top = 6810
|
||
Width = 7005
|
||
End
|
||
Begin VB.Timer TimerDisplay
|
||
Left = 11130
|
||
Top = 7530
|
||
End
|
||
Begin VB.Label Label11
|
||
BackStyle = 0 'Transparent
|
||
Caption = "Einbauplatz:"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 9.75
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 315
|
||
Left = 11250
|
||
TabIndex = 14
|
||
Top = 6240
|
||
Width = 1275
|
||
End
|
||
Begin VB.Label lblAdr
|
||
BorderStyle = 1 'Fest Einfach
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 36
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 885
|
||
Left = 12720
|
||
TabIndex = 13
|
||
Top = 6090
|
||
Width = 885
|
||
End
|
||
Begin VB.Label Label8
|
||
Alignment = 1 'Rechts
|
||
Caption = "m<>/h"
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 255
|
||
Left = 14100
|
||
TabIndex = 12
|
||
Top = 5610
|
||
Width = 555
|
||
End
|
||
Begin VB.Label Label10
|
||
Alignment = 1 'Rechts
|
||
Caption = "Durchflu<6C>:"
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 285
|
||
Left = 10920
|
||
TabIndex = 11
|
||
Top = 5640
|
||
Width = 1545
|
||
End
|
||
Begin VB.Label lblQIst
|
||
BorderStyle = 1 'Fest Einfach
|
||
BeginProperty Font
|
||
Name = "Arial"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 400
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 345
|
||
Left = 12720
|
||
TabIndex = 10
|
||
Top = 5610
|
||
Width = 1215
|
||
End
|
||
End
|
||
Begin VB.Label lblAutosize
|
||
BorderStyle = 1 'Fest Einfach
|
||
Caption = "autosize"
|
||
Height = 255
|
||
Left = 9270
|
||
TabIndex = 39
|
||
Top = 360
|
||
Visible = 0 'False
|
||
Width = 735
|
||
End
|
||
Begin VB.Label lblTitle
|
||
Caption = "[ <20> b e r s c h r i f t ]"
|
||
BeginProperty Font
|
||
Name = "MS Sans Serif"
|
||
Size = 12
|
||
Charset = 0
|
||
Weight = 700
|
||
Underline = 0 'False
|
||
Italic = 0 'False
|
||
Strikethrough = 0 'False
|
||
EndProperty
|
||
Height = 615
|
||
Left = 300
|
||
TabIndex = 2
|
||
Top = 240
|
||
Width = 12015
|
||
End
|
||
End
|
||
Attribute VB_Name = "frmRegulierung"
|
||
Attribute VB_GlobalNameSpace = False
|
||
Attribute VB_Creatable = False
|
||
Attribute VB_PredeclaredId = True
|
||
Attribute VB_Exposed = False
|
||
Option Explicit
|
||
|
||
' von aufrufender Form zu setzende Member
|
||
Public m_Regulierdaten As New CRegulierdaten
|
||
Public m_colUniquePP As CPruefpunktCol
|
||
Public m_colEinbauplatz As Collection
|
||
Public m_bAutomatik As Boolean
|
||
Public m_Referenzzaehler As CRefzaehler
|
||
Public m_ImpulswertigkeitPZ As Long
|
||
|
||
Private m_dblTemperatur As Double
|
||
|
||
Private m_lngIdentNrGruppe As Long
|
||
Private m_strIdentNrGruppeName As String
|
||
Private m_strMetrolog As String
|
||
|
||
|
||
Public m_Durchfluss As Double
|
||
|
||
' f<>r die Regulierung verwendeter Einbauplatz
|
||
Private m_Einbauplatz As Integer
|
||
Private nRefEinbauplatzNr As Integer
|
||
|
||
Private nRegulierungsphase As Integer
|
||
Private m_FMBus As CFMBus
|
||
Private m_FM85 As CFM85P
|
||
Private m_SPS As CSPS
|
||
|
||
|
||
Private WithEvents m_Display As CEAKIT
|
||
Attribute m_Display.VB_VarHelpID = -1
|
||
|
||
Private m_Pruefzaehler As CPruefzaehler
|
||
Private m_ColRefZaehler As Collection
|
||
Private m_ColPumpen As Collection
|
||
Private m_Pumpe As CPumpe
|
||
|
||
' Voreinstellungen
|
||
Private m_Multiplikator As Integer
|
||
Private m_Daempfung1 As Integer
|
||
Private m_Daempfung2 As Integer
|
||
Private m_Daempfung3 As Integer
|
||
Private m_Steigung1 As Double
|
||
Private m_Steigung2 As Double
|
||
Private m_Steigung3 As Double
|
||
|
||
Private lStartzeit As Long
|
||
Private SteigungIst As Double
|
||
Private DaempfungAlt As Integer
|
||
Private Daempfung As Integer
|
||
Private nAlterFehler, nFehler As Double
|
||
Private lPruefzeit As Long
|
||
Private FormActivated As Boolean
|
||
|
||
Private m_RegulierungFertig As Boolean
|
||
|
||
' Private Member
|
||
' --------------
|
||
Private m_nRet As Integer
|
||
Private m_KWert As Double
|
||
|
||
|
||
Private m_letztesDisplay As Integer
|
||
Private m_letzteDaempfung As Integer
|
||
|
||
Private DFehlerzeiger(10)
|
||
Private DFehler(10, 10)
|
||
|
||
Private lngTime As Long
|
||
Private m_strBemerkung As String
|
||
|
||
' @return Code, mit dem endDialog aufgerufen wurde
|
||
'
|
||
Public Function getExitCode() As Integer
|
||
getExitCode = m_nRet
|
||
End Function
|
||
|
||
'------------------------------------------------------------------------------
|
||
' Private Funktionalit<69>t
|
||
'------------------------------------------------------------------------------
|
||
|
||
|
||
' Dialog beenden
|
||
'
|
||
' @param nRet Returncode des Dialogs
|
||
'
|
||
Private Sub endDialog(nRet As Integer)
|
||
m_nRet = nRet
|
||
Unload Me
|
||
End Sub
|
||
|
||
|
||
|
||
'------------------------------------------------------------------------------
|
||
' Event-Handling
|
||
'------------------------------------------------------------------------------
|
||
Private Sub cmdOk_Click()
|
||
'Call SaveRegulierdaten
|
||
|
||
|
||
If IsNumeric(lblDaempfung.Caption) Then
|
||
g_App.Settings.RegulierungDaempfung1 = lblDaempfung.Caption
|
||
End If
|
||
|
||
Timer1.Enabled = False
|
||
Screen.MousePointer = vbNormal
|
||
Call RegulierungBeenden
|
||
Call endDialog(IDOK)
|
||
End Sub
|
||
|
||
Private Sub cmdCancel_Click()
|
||
Screen.MousePointer = vbNormal
|
||
g_Abbruch = True
|
||
Call endDialog(IDCANCEL)
|
||
End Sub
|
||
|
||
|
||
|
||
Private Sub cmdSPSInfo_Click()
|
||
Call g_App.getSPS().ActivateProTool
|
||
End Sub
|
||
|
||
|
||
Private Sub Command1_Click()
|
||
StartRegulierung
|
||
End Sub
|
||
|
||
Private Sub Command2_Click()
|
||
' 'Messung' Button
|
||
Command2.Enabled = False
|
||
Call DoMessung
|
||
Command2.Enabled = True
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
Private Sub DoMessung()
|
||
PrintStatus "-----MESSUNG-----"
|
||
|
||
Dim sAnswer As String
|
||
Dim sZaehler As String
|
||
Dim count1
|
||
|
||
m_FM85.sendAttention
|
||
|
||
' m_FM85.send ("U")
|
||
' If m_FM85.receive Then
|
||
' sAnswer = m_FM85.getLastAnswer
|
||
' count1 = CLng("&H" & sAnswer)
|
||
' txtPZcount.Text = Str(count1)
|
||
' End If
|
||
|
||
m_FM85.send ("Z")
|
||
If m_FM85.receive Then
|
||
sAnswer = m_FM85.getLastAnswer
|
||
nFehler = Val(Mid(sAnswer, 1, 1) + Str(CLng("&H0" & Mid(sAnswer, 2, 4)))) * 0.012941176
|
||
|
||
txtFehler.text = Str(nFehler)
|
||
PrintStatus "Fehlerwert:" & nFehler
|
||
Else
|
||
ErrorMsg "Fehler: " & m_FM85.getErrorDesc
|
||
End If
|
||
|
||
SteigungIst = Abs(nFehler - nAlterFehler)
|
||
|
||
PrintStatus "Steigung:" & Int(SteigungIst * 100) / 100
|
||
|
||
lPruefzeit = Int((GetTickCount() - lStartzeit) / 1000)
|
||
|
||
If SteigungIst < m_Steigung1 And nRegulierungsphase = 0 Then
|
||
Daempfung = m_Daempfung1
|
||
nRegulierungsphase = 1
|
||
PrintStatus "-> Regulierungsphase 1"
|
||
End If
|
||
|
||
If SteigungIst < m_Steigung2 And nRegulierungsphase = 1 Then
|
||
Daempfung = m_Daempfung2
|
||
nRegulierungsphase = 2
|
||
PrintStatus "-> Regulierungsphase 2"
|
||
End If
|
||
|
||
If SteigungIst < m_Steigung3 And nRegulierungsphase = 2 Then
|
||
Daempfung = m_Daempfung3
|
||
nRegulierungsphase = 3
|
||
PrintStatus "-> Regulierungsphase 3"
|
||
End If
|
||
|
||
If SteigungIst = 0 And nRegulierungsphase = 3 Then
|
||
m_RegulierungFertig = True
|
||
Exit Sub
|
||
End If
|
||
|
||
If DaempfungAlt <> Daempfung Then
|
||
setzeDaempfung Daempfung, True
|
||
End If
|
||
|
||
DaempfungAlt = Daempfung
|
||
nAlterFehler = nFehler
|
||
End Sub
|
||
|
||
|
||
Private Sub cmdSollwertAendern_Click()
|
||
Dim objfrmVoreinstellwerteAendern As frmVoreinstellwerteAendern
|
||
Set objfrmVoreinstellwerteAendern = New frmVoreinstellwerteAendern
|
||
|
||
objfrmVoreinstellwerteAendern.m_lngIdentNrGruppe = m_lngIdentNrGruppe
|
||
objfrmVoreinstellwerteAendern.m_strMetrolog = m_strMetrolog
|
||
objfrmVoreinstellwerteAendern.m_dblOriginalwert = m_Regulierdaten.getSPSSollwertRegulierung
|
||
objfrmVoreinstellwerteAendern.m_strIdentNrGruppeName = m_strIdentNrGruppeName
|
||
|
||
g_varReturn.Bemerkung = ""
|
||
g_varReturn.Datum = 0
|
||
g_varReturn.Pruefer = 0
|
||
g_varReturn.Wert = -99
|
||
g_varReturn.IstLetzter = False
|
||
|
||
' Parent Form ist auch Modal
|
||
objfrmVoreinstellwerteAendern.Show vbModal, Me
|
||
|
||
If g_varReturn.Wert = -99 Then
|
||
' Abbruch
|
||
Else
|
||
' Voreinstellwert aus Historie gew<65>hlt und OK geklickt
|
||
txtSollwert.text = g_varReturn.Wert
|
||
lblGeaendertDatum = g_varReturn.Datum
|
||
lblGeaendertMitarbeiter = g_varReturn.Pruefer
|
||
lblVoreinstellwertBemerkung = g_varReturn.Bemerkung
|
||
End If
|
||
|
||
Set objfrmVoreinstellwerteAendern = Nothing
|
||
End Sub
|
||
|
||
Private Sub Command3_Click()
|
||
InitialisiereBemerkungen
|
||
End Sub
|
||
|
||
Private Sub Form_Activate()
|
||
If FormActivated = False Then
|
||
FormActivated = True
|
||
|
||
|
||
Call StartRegulierung
|
||
|
||
|
||
If m_lngIdentNrGruppe < 0 Then
|
||
' cmdSollwertAendern.Enabled = False
|
||
' cmdBemerkungen.Enabled = False
|
||
'neu RH: 12.2.2009
|
||
' cmdSollwertAendern.Enabled = True
|
||
' cmdBemerkungen.Enabled = True
|
||
Else
|
||
cmdSollwertAendern.Enabled = True
|
||
cmdBemerkungen.Enabled = True
|
||
End If
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub Form_KeyPress(KeyAscii As Integer)
|
||
If Me.ActiveControl <> txtSollwert Then
|
||
If KeyAscii > 48 And KeyAscii <= 57 Then
|
||
|
||
If CStr(Slider1.value) = Chr$(KeyAscii) Then
|
||
setzeDaempfung Chr$(KeyAscii), False
|
||
Else
|
||
setzeDaempfung Chr$(KeyAscii), True
|
||
End If
|
||
|
||
End If
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub Form_Load()
|
||
Dim tmpEinbauplatz As CEinbauplatz
|
||
|
||
Call setupStdDlg(Me)
|
||
FormActivated = False
|
||
|
||
If m_bAutomatik Then
|
||
lblTitle = "Automatische Regulierung"
|
||
Else
|
||
lblTitle = "manuelle Regulierung"
|
||
End If
|
||
|
||
|
||
' ersten Pr<50>fzaehler und Daten bestimmen
|
||
For Each tmpEinbauplatz In m_colEinbauplatz
|
||
If Not tmpEinbauplatz.getPruefzaehler Is Nothing Then
|
||
m_Einbauplatz = tmpEinbauplatz.getNr
|
||
If nRefEinbauplatzNr = 0 Then
|
||
nRefEinbauplatzNr = m_Einbauplatz
|
||
Set m_Pruefzaehler = tmpEinbauplatz.getPruefzaehler
|
||
m_strMetrolog = m_Pruefzaehler.getPruefklasseKZ
|
||
|
||
If m_strMetrolog = "" Or m_Pruefzaehler.getAuftragPosition.getPrf_nach_MID = True Then
|
||
If m_Pruefzaehler.getPruefpunkte.m_dblRatio > 0 Then
|
||
m_strMetrolog = "MID-R" & m_Pruefzaehler.getPruefpunkte.m_dblRatio
|
||
End If
|
||
End If
|
||
|
||
Dim strSQL As String
|
||
Dim rs As CRecordset
|
||
strSQL = "SELECT GruppenID FROM IdentNrGruppierung WHERE IdentNr=" & m_Pruefzaehler.getAuftragPosition.getIdentNr
|
||
Set rs = New CRecordset
|
||
rs.openRS strSQL, True
|
||
If Not rs.EOF Then
|
||
m_lngIdentNrGruppe = rs.getLongValue("GruppenID")
|
||
strSQL = "SELECT Name FROM IdentNr_Gruppendetail WHERE ID=" & m_lngIdentNrGruppe
|
||
Set rs = New CRecordset
|
||
rs.openRS strSQL, True
|
||
If Not rs.EOF Then
|
||
m_strIdentNrGruppeName = rs.getStringValue("Name")
|
||
Else
|
||
m_strIdentNrGruppeName = ""
|
||
End If
|
||
Else
|
||
m_lngIdentNrGruppe = -1
|
||
m_strIdentNrGruppeName = ""
|
||
LogIntoDB "Sollwert der Regulierung: Keine Gruppierung f<>r IdentNr " & m_Pruefzaehler.getAuftragPosition.getIdentNr, "IdentNr-Gruppierung"
|
||
End If
|
||
End If
|
||
End If
|
||
Next
|
||
|
||
'-----------------------
|
||
Dim dblSollwert As Double
|
||
Dim strPruefer As String
|
||
Dim dateDatum As Date
|
||
Dim strBemerkung As String
|
||
|
||
' neu RH 30.7.2012
|
||
If m_lngIdentNrGruppe <> -1 Then
|
||
' If m_strMetrolog <> "" And m_lngIdentNrGruppe <> -1 Then
|
||
If GetLetzteAenderungSollwert(dblSollwert, strPruefer, dateDatum, strBemerkung) Then
|
||
' es gibt eine <20>nderung
|
||
txtSollwert.text = dblSollwert
|
||
lblVoreinstellwertBemerkung.Caption = strBemerkung
|
||
lblGeaendertMitarbeiter.Caption = strPruefer
|
||
lblGeaendertDatum.Caption = Format(dateDatum, "dd.mm.yyyy hh:mm:ss")
|
||
|
||
cmdSollwertAendern.Caption = "Historie / <20>ndern...."
|
||
Else
|
||
cmdSollwertAendern.Caption = "<22>ndern...."
|
||
lblVoreinstellwertBemerkung.Caption = "(Originalwert)"
|
||
txtSollwert.text = m_Regulierdaten.getSPSSollwertRegulierung
|
||
End If
|
||
Else
|
||
lblVoreinstellwertBemerkung.Caption = "(Originalwert) VAKO"
|
||
cmdSollwertAendern.Caption = "nicht <20>nderbar"
|
||
cmdSollwertAendern.Enabled = False
|
||
lblVoreinstellwertBemerkung.Caption = "(Originalwert)"
|
||
txtSollwert.text = m_Regulierdaten.getSPSSollwertRegulierung
|
||
End If
|
||
'-----------------------
|
||
|
||
Set m_FMBus = g_App.getFMBus
|
||
Set m_FM85 = m_FMBus.getFM85P(nRefEinbauplatzNr)
|
||
PrintStatus "verwendeter FM85 f<>r Referenzzaehler: " & nRefEinbauplatzNr
|
||
|
||
Set m_ColPumpen = g_App.Settings.getPumpen
|
||
Set m_SPS = g_App.getSPS
|
||
|
||
Set m_Display = g_App.GetDisplay
|
||
|
||
If Not m_Display Is Nothing Then
|
||
m_Display.Adressierung 255
|
||
m_Display.CallMakro 0
|
||
End If
|
||
|
||
InitialisiereBemerkungen
|
||
|
||
cmdOK.Enabled = False
|
||
End Sub
|
||
|
||
'Private Sub StartRegulierung_alt()
|
||
' cmdOK.Enabled = False
|
||
'
|
||
' Screen.MousePointer = vbHourglass
|
||
'
|
||
' Dim Einbauplatz As CEinbauplatz
|
||
' Dim Pruefzaehler As CPruefzaehler
|
||
'
|
||
' Dim Pruefpunkt As CPruefpunkt
|
||
' Dim RefZaehler As CRefzaehler
|
||
' Dim SPS_Sollwert As Integer
|
||
' Dim Temperatur As Double
|
||
' Dim letzterFehlerRZ As Double
|
||
'
|
||
' If Not g_ohneSPS Then
|
||
' PrintStatus "Warten bis Solldurchflu<6C> erreicht..."
|
||
' Do While Not m_SPS.SolldurchflussErreicht
|
||
' lblQIst.Caption = Format(m_SPS.getQIst, "0.000")
|
||
' Sleep 500, True
|
||
' If g_Abbruch = True Then
|
||
' Screen.MousePointer = vbNormal
|
||
' Exit Sub
|
||
' End If
|
||
' Loop
|
||
' PrintStatus "Solldurchfluss f<>r Regulierung erreicht bei Q=" & Format(m_SPS.getQIst, "0.000")
|
||
' End If ' ohne SPS
|
||
'
|
||
' lblQIst.Visible = False
|
||
' Label10.Visible = False
|
||
' Label8.Visible = False
|
||
' DoEvents
|
||
'
|
||
' nRegulierungsphase = 0
|
||
'
|
||
' PrintStatus "Initialisierung ..."
|
||
'
|
||
' ' Todo: Woher ?
|
||
' m_Multiplikator = 1
|
||
'
|
||
' PrintStatus "Multiplikator: " & m_Multiplikator
|
||
'
|
||
' ' Bestimmung der Einstellungen
|
||
' m_Daempfung1 = m_Regulierdaten.getDaempfung(1)
|
||
' m_Daempfung2 = m_Regulierdaten.getDaempfung(2)
|
||
' m_Daempfung3 = m_Regulierdaten.getDaempfung(3)
|
||
' m_Steigung1 = m_Regulierdaten.getSteigung(1)
|
||
' m_Steigung2 = m_Regulierdaten.getSteigung(2)
|
||
' m_Steigung3 = m_Regulierdaten.getSteigung(3)
|
||
'
|
||
' PrintStatus "D1: " & m_Daempfung1
|
||
' PrintStatus "D2: " & m_Daempfung2
|
||
' PrintStatus "D3: " & m_Daempfung3
|
||
' PrintStatus "S1: " & m_Steigung1
|
||
' PrintStatus "S2: " & m_Steigung2
|
||
' PrintStatus "S3: " & m_Steigung3
|
||
'
|
||
' SPS_Sollwert = Int((m_Regulierdaten.getSPSSollwertRegulierung + 3) * 100 / 6)
|
||
'
|
||
' If Not g_ohneSPS Then
|
||
' ' Sollwertweitergabe an SPS
|
||
' PrintStatus "Sollwertvorgabe an SPS " & SPS_Sollwert
|
||
' m_SPS.SetRegulierungsSollwert SPS_Sollwert
|
||
' Temperatur = m_SPS.GetEinlaufTemperatur
|
||
' End If ' ohne SPS
|
||
' ' Todo K Wert bestimmen
|
||
'
|
||
'
|
||
' m_KWert = m_Referenzzaehler.ImpulseQM / m_ImpulswertigkeitPZ
|
||
'
|
||
' DebugMsg "RZ-Impulse/qm = " & m_Referenzzaehler.ImpulseQM
|
||
' DebugMsg "PZ-Impulse/qm = " & m_ImpulswertigkeitPZ
|
||
'
|
||
' letzterFehlerRZ = m_Referenzzaehler.letzterFehler(m_Durchfluss, Temperatur)
|
||
' DebugMsg "interpolierter Fehler: " & letzterFehlerRZ & " % "
|
||
' DebugMsg "unkorrigierter K Wert: " & m_KWert
|
||
' m_KWert = m_Referenzzaehler.ImpulseQM * (1 + letzterFehlerRZ / 100) / m_ImpulswertigkeitPZ
|
||
'
|
||
' DebugMsg "korrigierter K Wert: " & m_KWert
|
||
'
|
||
' If Not g_ohneSPS Then
|
||
' ' Regulierungs Motoren starten
|
||
' m_SPS.StartRegulierung
|
||
' End If
|
||
'
|
||
' ' Voreinstellung der FM85
|
||
' Call initFM85
|
||
'
|
||
' m_RegulierungFertig = False
|
||
' Screen.MousePointer = vbNormal
|
||
'
|
||
' If cmdOK.Enabled = True Then cmdOK.SetFocus
|
||
'
|
||
'
|
||
' lStartzeit = GetTickCount()
|
||
'
|
||
' If Not m_Display Is Nothing Then
|
||
' PrintStatus "Displays initialisieren..."
|
||
' m_letztesDisplay = 0
|
||
' m_Display.Adressierung 255
|
||
'
|
||
' ' Bildschirm Aufbau
|
||
' m_Display.CallMakro 0
|
||
' Sleep 400
|
||
' m_Display.CallMakro 1
|
||
' Sleep 400
|
||
'
|
||
'
|
||
' For Each Einbauplatz In m_colEinbauplatz
|
||
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
' If Pruefzaehler Is Nothing Then
|
||
' Debug.Print "Licht aus bei " & Einbauplatz.getNr
|
||
' m_Display.Adressierung Einbauplatz.getNr
|
||
' m_Display.Licht 0
|
||
' Sleep 100
|
||
' Else
|
||
' Debug.Print "Licht an lassen bei " & Einbauplatz.getNr
|
||
' m_Display.Adressierung Einbauplatz.getNr
|
||
'
|
||
' m_Display.Licht 1
|
||
'
|
||
' End If
|
||
' Next
|
||
'
|
||
'
|
||
' ''''''''''''''''''''''''''''''''''''''''''''''
|
||
'
|
||
'
|
||
' For Each Einbauplatz In m_colEinbauplatz
|
||
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
' If Not Pruefzaehler Is Nothing Then
|
||
'
|
||
' m_Display.Adressierung Einbauplatz.getNr
|
||
' Sleep 50
|
||
' m_Display.PlaceAusgabe "Auftrag:" & Pruefzaehler.getAuftragPositionSerienNr.getAuftragNr & "/" & Pruefzaehler.getAuftragPositionSerienNr.getPositionNr, 10, 30, 160, 38
|
||
' Sleep 50
|
||
'
|
||
' If Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
|
||
' m_Display.PlaceKeineWdh
|
||
' End If
|
||
'
|
||
'
|
||
' m_Display.PlaceEinbauplatz Einbauplatz.getNr
|
||
' Sleep 50
|
||
' m_Display.PlaceSeriennr Pruefzaehler.getSerienNr
|
||
' End If
|
||
' Next
|
||
'
|
||
'
|
||
'
|
||
' ''''''''''''''''''''''''''''''''''''''''''''''
|
||
' m_Display.SetzeAlleDaempfungen g_App.Settings.RegulierungDaempfung1
|
||
' setzeDaempfung g_App.Settings.RegulierungDaempfung1, False
|
||
' End If
|
||
'
|
||
' If m_bAutomatik Then
|
||
' Timer1.Interval = 3000
|
||
' Timer1.Enabled = True
|
||
' Command2.Enabled = True
|
||
' Else
|
||
' Command2.Enabled = True
|
||
' End If
|
||
'
|
||
' PrintStatus "Initialisierung abgeschlossen."
|
||
' cmdOK.Enabled = True
|
||
'
|
||
'End Sub
|
||
|
||
Private Sub StartRegulierung()
|
||
On Error GoTo Errorhandler
|
||
|
||
cmdOK.Enabled = False
|
||
|
||
Screen.MousePointer = vbHourglass
|
||
|
||
Dim Einbauplatz As CEinbauplatz
|
||
Dim Pruefzaehler As CPruefzaehler
|
||
|
||
Dim Pruefpunkt As CPruefpunkt
|
||
Dim RefZaehler As CRefzaehler
|
||
Dim SPS_Sollwert As Integer
|
||
|
||
|
||
'''''''''''''' Grafik anzeigen''''''''''''''''''''''
|
||
' ersten eingebauten Pr<50>fz<66>hler bestimmen
|
||
Dim strFileName As String
|
||
Dim strDir As String
|
||
|
||
strDir = Trim(g_App.Settings.KennlinienGrafikenPathname())
|
||
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
|
||
|
||
If strDir = "" Then
|
||
Image1.ToolTipText = "Es kann hier noch keine Kennlinie angezeigt werden:" & vbCrLf & "Verzeichniss ist in der INI Datei nicht definiert."
|
||
PrintStatus "Es kann hier noch keine Kennlinie angezeigt werden:" & vbCrLf & "Verzeichniss ist in der INI Datei nicht definiert."
|
||
Else
|
||
|
||
Dim strSQL As String
|
||
Dim rs As CRecordset
|
||
|
||
If m_lngIdentNrGruppe >= 0 Then
|
||
|
||
Set rs = New CRecordset
|
||
strSQL = "SELECT KennlinienGrafik FROM Regulierungs_Bemerkungen WHERE IdentNrGruppenID = " & m_lngIdentNrGruppe & " AND Metrolog = N'" & Replace(m_strMetrolog, "'", "''") & "'"
|
||
Debug.Print strSQL
|
||
rs.openRS strSQL, True
|
||
If Not rs.EOF And rs.isFieldNull("KennlinienGrafik") = False Then
|
||
strFileName = strDir & rs.getStringValue("KennlinienGrafik")
|
||
|
||
If Dir(strFileName) = "" Then
|
||
Image1.ToolTipText = "Die Kennlinie dieses Z<>hlers kann nicht angezeigt werden. Die Datei '" & strDir & strFileName & "'" & vbCrLf & " ist nicht vorhanden."
|
||
PrintStatus "Die Kennlinie dieses Z<>hlers kann nicht angezeigt werden. Die Datei '" & strDir & strFileName & "'" & vbCrLf & " ist nicht vorhanden."
|
||
Else
|
||
Image1.Enabled = True
|
||
Image1.Stretch = True
|
||
Image1.Picture = LoadPicture(strFileName)
|
||
Image1.Visible = True
|
||
Image1.ToolTipText = "Klicken Sie hier f<>r eine vergr<67><72>erte Darstellung der Kennlinie '" & m_strIdentNrGruppeName & "', '" & m_strMetrolog & "'"
|
||
DoEvents
|
||
End If
|
||
Else
|
||
Image1.ToolTipText = "Es ist keine Kennlinie definiert f<>r '" & m_strIdentNrGruppeName & "' / Metrolog '" & m_strMetrolog & "'"
|
||
PrintStatus "Es ist keine Kennlinie definiert f<>r '" & m_strIdentNrGruppeName & "' (Gruppe " & m_lngIdentNrGruppe & ")/ Metrolog '" & m_strMetrolog & "'"
|
||
LogIntoDB "Es ist keine Kennlinie definiert f<>r '" & m_strIdentNrGruppeName & "' (Gruppe " & m_lngIdentNrGruppe & ")/ Metrolog '" & m_strMetrolog & "'", "Kennlinie"
|
||
End If ' rs.eof
|
||
Else 'm_lngIdentNrGruppe >= 0
|
||
Image1.ToolTipText = "Die IdentNr " & m_Pruefzaehler.getIdentNr & " ist keiner Gruppe zugeordnet. Deshalb kann die Kennlinie nicht angezeigt und die Bemerkung und der Voreinstellwert nicht ge<67>ndert werden."
|
||
PrintStatus "Die IdentNr " & m_Pruefzaehler.getIdentNr & " ist keiner Gruppe zugeordnet." & vbCrLf & "Deshalb kann die Kennlinie nicht angezeigt und die Bemerkung und der Voreinstellwert nicht ge<67>ndert werden."
|
||
End If 'm_lngIdentNrGruppe < 0
|
||
End If ' nicht strDir = ""
|
||
''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||
|
||
''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||
lblQIst.Visible = True
|
||
Label10.Visible = True
|
||
Label8.Visible = True
|
||
|
||
If Not g_ohneSPS Then
|
||
PrintStatus "Warten bis Solldurchflu<6C> erreicht..."
|
||
Do While Not m_SPS.SolldurchflussErreicht
|
||
lblQIst.Caption = Format(m_SPS.getQIst, "0.000")
|
||
Sleep 500, True
|
||
If g_Abbruch = True Then
|
||
Screen.MousePointer = vbNormal
|
||
Exit Sub
|
||
End If
|
||
Loop
|
||
PrintStatus "Solldurchfluss f<>r Regulierung erreicht bei Q=" & Format(m_SPS.getQIst, "0.000")
|
||
End If ' ohne SPS
|
||
|
||
lblQIst.Visible = False
|
||
Label10.Visible = False
|
||
Label8.Visible = False
|
||
DoEvents
|
||
|
||
nRegulierungsphase = 0
|
||
|
||
PrintStatus "Initialisierung ..."
|
||
|
||
' Todo: Woher ?
|
||
m_Multiplikator = 1
|
||
|
||
PrintStatus "Multiplikator: " & m_Multiplikator
|
||
|
||
' Bestimmung der Einstellungen
|
||
m_Daempfung1 = m_Regulierdaten.getDaempfung(1)
|
||
m_Daempfung2 = m_Regulierdaten.getDaempfung(2)
|
||
m_Daempfung3 = m_Regulierdaten.getDaempfung(3)
|
||
m_Steigung1 = m_Regulierdaten.getSteigung(1)
|
||
m_Steigung2 = m_Regulierdaten.getSteigung(2)
|
||
m_Steigung3 = m_Regulierdaten.getSteigung(3)
|
||
|
||
PrintStatus "D1: " & m_Daempfung1
|
||
PrintStatus "D2: " & m_Daempfung2
|
||
PrintStatus "D3: " & m_Daempfung3
|
||
PrintStatus "S1: " & m_Steigung1
|
||
PrintStatus "S2: " & m_Steigung2
|
||
PrintStatus "S3: " & m_Steigung3
|
||
|
||
SPS_Sollwert = Int((m_Regulierdaten.getSPSSollwertRegulierung + 3) * 100 / 6)
|
||
|
||
If Not g_ohneSPS Then
|
||
' Sollwertweitergabe an SPS
|
||
PrintStatus "Sollwertvorgabe an SPS " & SPS_Sollwert
|
||
m_SPS.SetRegulierungsSollwert SPS_Sollwert
|
||
m_dblTemperatur = m_SPS.GetEinlaufTemperatur
|
||
|
||
' Regulierungs Motoren starten
|
||
m_SPS.StartRegulierung
|
||
End If
|
||
|
||
|
||
' Voreinstellung der FM85
|
||
Call InitFM85
|
||
|
||
m_RegulierungFertig = False
|
||
Screen.MousePointer = vbNormal
|
||
|
||
If cmdOK.Enabled = True Then cmdOK.SetFocus
|
||
|
||
|
||
lStartzeit = GetTickCount()
|
||
|
||
If Not m_Display Is Nothing Then
|
||
PrintStatus "Displays initialisieren..."
|
||
m_letztesDisplay = 0
|
||
m_Display.Adressierung 255
|
||
|
||
' Bildschirm Aufbau
|
||
m_Display.CallMakro 0
|
||
Sleep 400, True
|
||
m_Display.CallMakro 1
|
||
Sleep 400, True
|
||
End If
|
||
|
||
Call ShowLetzteFehler
|
||
|
||
If Not m_Display Is Nothing Then
|
||
For Each Einbauplatz In m_colEinbauplatz
|
||
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
If Pruefzaehler Is Nothing Then
|
||
Debug.Print "Licht aus bei " & Einbauplatz.getNr
|
||
m_Display.Adressierung Einbauplatz.getNr
|
||
m_Display.Licht 0
|
||
Sleep 100, True
|
||
Else
|
||
Debug.Print "Licht an lassen bei " & Einbauplatz.getNr
|
||
m_Display.Adressierung Einbauplatz.getNr
|
||
m_Display.Licht 1
|
||
Sleep 100, True
|
||
End If
|
||
Next
|
||
|
||
|
||
''''''''''''''''''''''''''''''''''''''''''''''
|
||
|
||
|
||
For Each Einbauplatz In m_colEinbauplatz
|
||
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
If Not Pruefzaehler Is Nothing Then
|
||
|
||
m_Display.Adressierung Einbauplatz.getNr
|
||
Sleep 50
|
||
|
||
'm_Display.PlaceAusgabe "Auftrag:" & Pruefzaehler.getAuftragPositionSerienNr.getAuftragNr & "/" & Pruefzaehler.getAuftragPositionSerienNr.getPositionNr, 10, 30, 160, 38
|
||
'Sleep 50
|
||
|
||
If Pruefzaehler.getAuftragPositionSerienNr.getStatusFertigung >= 30 Then
|
||
m_Display.PlaceKeineWdh
|
||
Sleep 100, True
|
||
End If
|
||
|
||
|
||
m_Display.PlaceEinbauplatz Einbauplatz.getNr
|
||
Sleep 50
|
||
m_Display.PlaceSeriennr FormatSerienNr(Pruefzaehler.getSerienNr)
|
||
End If
|
||
Next
|
||
|
||
' ''''''''''''''''''''''''''''''''''''''''''''''
|
||
' m_Display.SetzeAlleDaempfungen g_App.Settings.RegulierungDaempfung1
|
||
'
|
||
' Slider1.Enabled = False
|
||
' Slider1.Value = g_App.Settings.RegulierungDaempfung1
|
||
' Slider1.Enabled = True
|
||
|
||
|
||
End If
|
||
|
||
setzeDaempfung g_App.Settings.RegulierungDaempfung1, True
|
||
|
||
If m_bAutomatik Then
|
||
Timer1.Interval = 3000
|
||
Timer1.Enabled = True
|
||
Command2.Enabled = True
|
||
Else
|
||
Command2.Enabled = True
|
||
End If
|
||
|
||
PrintStatus "Initialisierung abgeschlossen."
|
||
|
||
cmdOK.Enabled = True
|
||
Exit Sub
|
||
Errorhandler:
|
||
Dim strErrDesc As String
|
||
Dim lngErrNum As Long
|
||
Dim strMsg As String
|
||
|
||
strErrDesc = Err.Description
|
||
lngErrNum = Err.Number
|
||
|
||
LogIntoDB "Fehler " & lngErrNum & " in StartRegulierung:" & vbCrLf & strErrDesc & vbCrLf, "unbekannt"
|
||
|
||
strMsg = strMsg & "Funktion: StartRegulierung" & vbCrLf
|
||
strMsg = strMsg & "Fehler-Beschreibung: " & strErrDesc & vbCrLf
|
||
strMsg = strMsg & "M<>chten Sie den Befehl, der den Fehler verursacht hat wiederholen ?" & vbCrLf & vbCrLf
|
||
|
||
strMsg = strMsg & "Klicken Sie 'Nein' um den Fehler zu ignorieren und fortzufahren" & vbCrLf
|
||
strMsg = strMsg & "oder 'Abbrechen' die ganze Funktion abzubrechen."
|
||
|
||
Select Case MsgBox(strMsg, vbYesNoCancel Or vbDefaultButton2, "Es trat ein Fehler auf!")
|
||
Case vbYes
|
||
Resume
|
||
Case vbNo
|
||
Resume Next
|
||
Case vbCancel
|
||
End Select
|
||
cmdOK.Enabled = True
|
||
End Sub
|
||
|
||
|
||
|
||
'Ge<47>ndert Andreas Pfeiffer am 17.05.2004 "NOT" eingef<65>gt,
|
||
'da sonst an den Stationen, die ohne Display arbeiten, das Programm abst<73>rzt
|
||
Private Sub Form_Unload(Cancel As Integer)
|
||
If Not m_Display Is Nothing Then
|
||
m_Display.Adressierung 255
|
||
m_Display.CallMakro 0
|
||
Sleep 100
|
||
m_Display.Licht 0
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub Image1_Click()
|
||
If Image1.Picture.Height = 0 Then Exit Sub
|
||
|
||
Dim objForm As frmImageViewer
|
||
Set objForm = New frmImageViewer
|
||
|
||
objForm.Caption = "Kennlinie " & m_Pruefzaehler.getAuftragPosition.getIdentNrObj.getTyp & "_" & m_Pruefzaehler.getAuftragPosition.getIdentNrObj.getNennweite & "_" & m_Pruefzaehler.getIdentNrObj.GetTemperatur & "_" & m_Pruefzaehler.getPruefklasseKZ
|
||
|
||
objForm.Picture1.Picture = Image1.Picture
|
||
objForm.Show vbModal, Me
|
||
End Sub
|
||
|
||
Private Sub m_Display_DaempfungChange(ByVal bytadresse As Byte, ByVal intDaempfung As Integer)
|
||
Set m_FM85 = m_FMBus.getFM85P(CInt(bytadresse))
|
||
m_FM85.sendAttention
|
||
m_FMBus.send intDaempfung & "T"
|
||
PrintStatus "D<>mpfung=" & intDaempfung & " f<>r FM85 " & m_Display.intAktivesDisplay
|
||
End Sub
|
||
|
||
|
||
Private Sub Timer1_Timer()
|
||
If Not m_RegulierungFertig Then
|
||
Call DoMessung
|
||
Else
|
||
Timer1.Enabled = False
|
||
Call RegulierungBeenden
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub RegulierungBeenden()
|
||
|
||
|
||
' m_Regulierdaten.setSPSSollwertRegulierung
|
||
|
||
If Not g_ohneSPS Then
|
||
' Servo-Motoren stoppen
|
||
m_SPS.StopRegulierung
|
||
End If
|
||
|
||
' Reguliervorgang beendet
|
||
PrintStatus "Reguliervorgang beendet "
|
||
|
||
|
||
If m_bAutomatik = True Then
|
||
endDialog IDOK
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub sendonly(text)
|
||
m_FMBus.send (text)
|
||
m_FMBus.receive (500)
|
||
End Sub
|
||
|
||
Private Function GetKWert(ImpulswertigkeitPZ As Long, ImpulswertigkeitRZ As Long, letzterFehlerRZ As Double) As Double
|
||
' K Wert bestimmen
|
||
GetKWert = ImpulswertigkeitRZ / ImpulswertigkeitPZ
|
||
PrintStatus "PZ-Impulse/qm = " & ImpulswertigkeitPZ
|
||
PrintStatus "RZ-Impulse/qm = " & ImpulswertigkeitRZ
|
||
PrintStatus "interpolierter Fehler RZ: " & letzterFehlerRZ & " % "
|
||
|
||
PrintStatus "unkorrigierter K Wert (" & ImpulswertigkeitRZ & "/" & ImpulswertigkeitPZ & "): " & GetKWert
|
||
GetKWert = ImpulswertigkeitRZ * (1 + letzterFehlerRZ / 100) / ImpulswertigkeitPZ
|
||
PrintStatus "mit RZ Fehler korrigierter K Wert: " & GetKWert
|
||
End Function
|
||
|
||
Private Sub InitFM85()
|
||
Dim TmpStr As String
|
||
Dim i As Integer
|
||
Dim Einbauplatz As CEinbauplatz
|
||
Dim letzterFehlerRZ As Double
|
||
|
||
If m_Referenzzaehler Is Nothing Then
|
||
' falls dieses Formular nicht aus frmHauptprf aufgerufen wurde,
|
||
' k<>nnen auch keine FM85 initialisert werden!
|
||
Exit Sub
|
||
End If
|
||
|
||
|
||
sendonly "**0@"
|
||
sendonly "R"
|
||
|
||
Sleep 1000, True
|
||
|
||
sendonly "**0@"
|
||
sendonly "1s" ' Multiplikator
|
||
' keine Doppelimpulssprerre
|
||
sendonly "G"
|
||
' Doppelimpulssperre
|
||
sendonly "0000S"
|
||
|
||
Dim Temperatur As Double
|
||
|
||
If Not g_ohneSPS Then
|
||
Temperatur = m_SPS.GetEinlaufTemperatur
|
||
Else
|
||
Temperatur = 20
|
||
End If
|
||
|
||
|
||
letzterFehlerRZ = m_Referenzzaehler.letzterFehler(m_Durchfluss, Temperatur)
|
||
If letzterFehlerRZ = -99 Then
|
||
ErrorMsg "Der Fehler des Referenzz<7A>hlers konnte nicht bestimmt werden und wird als 0 angenommen. Bitte pr<70>fen Sie, ob eine Referenzz<7A>hlermessung vorliegt."
|
||
letzterFehlerRZ = 0
|
||
PrintStatus "angenommener Fehler des RZ: " & letzterFehlerRZ & " % "
|
||
Else
|
||
PrintStatus "interpolierter Fehler des RZ: " & letzterFehlerRZ & " % "
|
||
End If
|
||
|
||
|
||
If m_ImpulswertigkeitPZ > 0 Then
|
||
' gleiche Impulswertigkeit f<>r alle Z<>hler
|
||
'######################################
|
||
' Todo K Wert bestimmen
|
||
m_KWert = GetKWert(m_ImpulswertigkeitPZ, m_Referenzzaehler.ImpulseQM, letzterFehlerRZ)
|
||
|
||
TmpStr = ValToKString(m_KWert)
|
||
sendonly TmpStr
|
||
PrintStatus "K-Wert FM85-Befehl: " & TmpStr
|
||
|
||
If g_App.GetDisplay Is Nothing Then
|
||
m_FM85.send "**1@"
|
||
m_FMBus.receive (500)
|
||
m_FM85.send "42 "
|
||
TmpStr = Mid(m_FMBus.receive(500), 6, 2)
|
||
If TmpStr <> "00" Then
|
||
PrintStatus ("Regulierung: FM85-1 Fehlerbyte ist nicht '00' sondern '" & TmpStr & "'")
|
||
End If
|
||
Else
|
||
For Each Einbauplatz In m_colEinbauplatz
|
||
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
||
Set m_FM85 = m_FMBus.getFM85P(Einbauplatz.getNr)
|
||
m_FM85.sendAttention
|
||
m_FM85.send "42 "
|
||
TmpStr = Mid(m_FMBus.receive(500), 6, 2)
|
||
If TmpStr <> "00" Then
|
||
PrintStatus ("Regulierung: FM85-" & i & " Fehlerbyte ist nicht '00' sondern '" & TmpStr & "'")
|
||
End If
|
||
End If
|
||
Next
|
||
End If
|
||
Else
|
||
' individuelle Impulswertigkeit
|
||
For Each Einbauplatz In m_colEinbauplatz
|
||
If Not Einbauplatz.getPruefzaehler Is Nothing Then
|
||
m_KWert = GetKWert(Einbauplatz.m_ImpulseQM, m_Referenzzaehler.ImpulseQM, letzterFehlerRZ)
|
||
TmpStr = ValToKString(m_KWert)
|
||
Set m_FM85 = m_FMBus.getFM85P(Einbauplatz.getNr)
|
||
m_FM85.sendAttention
|
||
sendonly TmpStr
|
||
PrintStatus "korrigierter K-Wert als Befehl an FM85-" & Einbauplatz.getNr & ": " & TmpStr
|
||
|
||
m_FM85.send "42 "
|
||
TmpStr = Mid(m_FMBus.receive(500), 6, 2)
|
||
If TmpStr <> "00" Then
|
||
PrintStatus ("Regulierung: FM85-" & Einbauplatz.getNr & " Fehlerbyte ist nicht '00' sondern '" & TmpStr & "'")
|
||
End If
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
'######################################
|
||
' Reset des RZ-Vergleichs-FM85 zum Vergleich beider Referenzz<7A>hler
|
||
If g_App.Settings.getAnzahlMIDGruppen > 1 Then
|
||
m_FMBus.send "**" & g_FM85RefZAdresse & "@"
|
||
m_FMBus.receive (500)
|
||
|
||
m_FMBus.send "R"
|
||
m_FMBus.receive (500)
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub Slider1_Change()
|
||
If Slider1.Enabled = True Then
|
||
setzeDaempfung Slider1.value, False
|
||
DoEvents
|
||
m_letztesDisplay = 0
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub PrintStatus(sText As String)
|
||
txtDaten.text = txtDaten.text & sText & vbCrLf
|
||
txtDaten.SelStart = Len(txtDaten.text)
|
||
Debug.Print sText
|
||
End Sub
|
||
|
||
|
||
Private Sub setzeDaempfung(Wert As Integer, bUpdateslider As Boolean)
|
||
|
||
If bUpdateslider = True Then
|
||
Slider1.value = Wert
|
||
Exit Sub
|
||
End If
|
||
|
||
Daempfung = Wert
|
||
|
||
If nRegulierungsphase = 0 Then
|
||
m_Regulierdaten.setDaempfung 1, CLng(Wert)
|
||
End If
|
||
|
||
lblDaempfung.Caption = Slider1.value
|
||
lblDaempfung.ForeColor = &H202020
|
||
DoEvents
|
||
|
||
If Not m_Display Is Nothing Then
|
||
' Setzt Daempfung f<>r alle FM85P
|
||
m_Display.SetzeAlleDaempfungen Wert
|
||
m_letztesDisplay = 0
|
||
End If
|
||
|
||
sendonly "**0@"
|
||
m_FMBus.SetLastFM 0
|
||
|
||
' D<>mpfung
|
||
sendonly Trim(Wert & "T")
|
||
|
||
lblDaempfung.ForeColor = vbBlack
|
||
PrintStatus "D<>mpfung f<>r alle: " & Wert
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub DisplayDaempfung(Wert As Integer)
|
||
lblDaempfung.Caption = Wert
|
||
lblDaempfung.ForeColor = &H202020
|
||
End Sub
|
||
|
||
|
||
Private Function SollwertFormatOK(StringSollwert)
|
||
SollwertFormatOK = False
|
||
If IsNumeric(StringSollwert) Then
|
||
If Abs(CDbl(StringSollwert)) <= 3 Then
|
||
SollwertFormatOK = True
|
||
End If
|
||
End If
|
||
End Function
|
||
|
||
Private Sub SaveRegulierdaten()
|
||
If SollwertFormatOK(txtSollwert) Then
|
||
m_Regulierdaten.setSPSSollwertRegulierung CDbl(txtSollwert.text)
|
||
End If
|
||
m_Regulierdaten.save
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
Private Sub txtSollwert_Change()
|
||
If SollwertFormatOK(txtSollwert) Or txtSollwert.text = "" Then
|
||
txtSollwert.BackColor = vbWhite
|
||
Else
|
||
txtSollwert.BackColor = vbRed
|
||
End If
|
||
End Sub
|
||
|
||
Private Function GetDFehler(neuerFehler As Double, bDaempfung As Byte, Einbauplatz As Integer) As Double
|
||
Dim neuarray(10)
|
||
Dim Mittel1 As Double
|
||
Dim AnzahlGut As Integer
|
||
Dim Summe As Double
|
||
Dim i As Integer
|
||
|
||
DFehlerzeiger(Einbauplatz) = DFehlerzeiger(Einbauplatz) + 1
|
||
If DFehlerzeiger(Einbauplatz) > bDaempfung Then
|
||
DFehlerzeiger(Einbauplatz) = 1
|
||
End If
|
||
DFehler(DFehlerzeiger(Einbauplatz), Einbauplatz) = neuerFehler
|
||
|
||
For i = 1 To bDaempfung
|
||
Summe = Summe + DFehler(i, Einbauplatz)
|
||
Debug.Print i & "; .summant = " & DFehler(i, Einbauplatz); ""
|
||
Next
|
||
Mittel1 = Summe / bDaempfung
|
||
Summe = 0
|
||
|
||
AnzahlGut = 0
|
||
|
||
For i = 1 To bDaempfung
|
||
If Abs(DFehler(i, Einbauplatz) - Mittel1) > 3 Then
|
||
'Ausreisser
|
||
Debug.Print "Ausreisser:" & DFehler(i, Einbauplatz)
|
||
Else
|
||
AnzahlGut = AnzahlGut + 1
|
||
|
||
Summe = Summe + DFehler(i, Einbauplatz)
|
||
End If
|
||
Next
|
||
|
||
If AnzahlGut > 1 Then
|
||
GetDFehler = Summe / AnzahlGut
|
||
End If
|
||
Debug.Print "mittel1:" & Mittel1
|
||
Debug.Print "neuerFehler:" & neuerFehler
|
||
Debug.Print "Ged<65>mpft (" & bDaempfung & "): " & GetDFehler
|
||
Debug.Print "DFehlerzeiger:" & DFehlerzeiger(Einbauplatz)
|
||
End Function
|
||
|
||
'Private Sub ShowLetzteFehler_alt()
|
||
' Dim Pruefzaehler As CPruefzaehler
|
||
' Dim Pruefpunkt As CPruefpunkt
|
||
' Dim Einbauplatz As CEinbauplatz
|
||
' Dim Fehler As Double
|
||
' Dim PPNr As Integer
|
||
' Dim strAlleFehler As String
|
||
' Dim blnZaehlerWurdeGeprueft As Boolean
|
||
' Dim lngPruefgangNr As Long
|
||
'
|
||
' On Error GoTo Errorhandler
|
||
'
|
||
' MSFlexGrid1.Clear
|
||
' ' <20>berschrift (0.Zeile) + f<>r jeden Einbauplatz eine Zeile
|
||
' MSFlexGrid1.Rows = m_colEinbauplatz.Count + 1
|
||
'
|
||
' ' Seriennr (0.Spalte) + f<>r alle aktuellen Pr<50>fpunkte eine Spalte
|
||
' MSFlexGrid1.Cols = m_colUniquePP.Count + 1
|
||
'
|
||
' MSFlexGrid1.RowHeight(0) = 600 ' H<>he Tabellenhaeder Durchfl<66>sse
|
||
' MSFlexGrid1.ColWidth(0) = 1600 ' Breite Tabellenhaeder SerienNr
|
||
'
|
||
' MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
' MSFlexGrid1.AllowUserResizing = flexResizeBoth
|
||
'
|
||
' ' linke Obere Ecke
|
||
' MSFlexGrid1.Row = 0
|
||
' MSFlexGrid1.Col = 0
|
||
' MSFlexGrid1.Font.Size = 10
|
||
' MSFlexGrid1.text = "SerienNr \ Q [m<>/h]"
|
||
'
|
||
' For Each Einbauplatz In m_colEinbauplatz
|
||
' Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
' If Not Pruefzaehler Is Nothing Then
|
||
'
|
||
' strAlleFehler = ""
|
||
' blnZaehlerWurdeGeprueft = False
|
||
'
|
||
' PPNr = 0
|
||
' For Each Pruefpunkt In m_colUniquePP.getCollection
|
||
' PPNr = PPNr + 1
|
||
'
|
||
' ' Durchfl<66>sse anzeigen
|
||
' MSFlexGrid1.Col = PPNr
|
||
' MSFlexGrid1.Row = 0
|
||
' MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
' MSFlexGrid1.Font.Bold = True
|
||
' MSFlexGrid1.text = Pruefpunkt.getQ
|
||
'
|
||
'
|
||
' Dim Datum As Date
|
||
'
|
||
' If GetLetzterFehlerFuerDurchfluss(Pruefpunkt.getQ, Pruefzaehler.getSerienNr, Fehler, Datum) Then
|
||
' MSFlexGrid1.Col = PPNr
|
||
' MSFlexGrid1.ColWidth(PPNr) = 900
|
||
' MSFlexGrid1.Row = Einbauplatz.getNr
|
||
' MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
' MSFlexGrid1.Font.Size = 12
|
||
' MSFlexGrid1.Font.Bold = True
|
||
' MSFlexGrid1.text = Format(Fehler, "0.0")
|
||
'
|
||
' blnZaehlerWurdeGeprueft = True
|
||
' strAlleFehler = strAlleFehler & Format(Fehler, "0.0") & " "
|
||
' End If
|
||
' Next
|
||
'
|
||
' If blnZaehlerWurdeGeprueft = True Then
|
||
' ' SerienNr anzeigen
|
||
' MSFlexGrid1.Col = 0
|
||
' MSFlexGrid1.Row = Einbauplatz.getNr
|
||
' MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
' MSFlexGrid1.text = Einbauplatz.getNr & ": " & Pruefzaehler.getSerienNr
|
||
'
|
||
' If Not m_Display Is Nothing Then
|
||
' m_Display.Adressierung Einbauplatz.getNr
|
||
' m_Display.PlaceAusgabe strAlleFehler, 10, 30, 160, 38
|
||
' End If
|
||
' End If
|
||
' End If
|
||
' Next
|
||
'Exit Sub
|
||
'
|
||
'Errorhandler:
|
||
' LogIntoDB "Fehler " & Err.Number & " in ShowLetzteFehler: " & Err.Description
|
||
'End Sub
|
||
|
||
Private Sub ShowLetzteFehler()
|
||
Dim Pruefzaehler As CPruefzaehler
|
||
Dim Pruefpunkt As CPruefpunkt
|
||
Dim Einbauplatz As CEinbauplatz
|
||
Dim Fehler As Double
|
||
Dim PPNr As Integer
|
||
Dim strAlleFehler As String
|
||
|
||
On Error GoTo Errorhandler
|
||
|
||
MSFlexGrid1.Clear
|
||
' <20>berschrift (0.Zeile) + f<>r jeden Einbauplatz eine Zeile
|
||
MSFlexGrid1.Rows = m_colEinbauplatz.Count + 1
|
||
|
||
' Seriennr (0.Spalte) + f<>r alle aktuellen Pr<50>fpunkte eine Spalte
|
||
MSFlexGrid1.Cols = m_colUniquePP.Count + 1
|
||
|
||
MSFlexGrid1.RowHeight(0) = 600 ' H<>he Tabellenhaeder Durchfl<66>sse
|
||
MSFlexGrid1.ColWidth(0) = 1600 ' Breite Tabellenhaeder SerienNr
|
||
|
||
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
MSFlexGrid1.AllowUserResizing = flexResizeBoth
|
||
|
||
' linke Obere Ecke
|
||
MSFlexGrid1.row = 0
|
||
MSFlexGrid1.col = 0
|
||
MSFlexGrid1.Font.Size = 10
|
||
MSFlexGrid1.FormatString = "SerNr\Q"
|
||
'MSFlexGrid1.text = "SerienNr \ Q [m<>/h]"
|
||
|
||
' Durchfl<66>sse im Tabellenkopf anzeigen
|
||
PPNr = 0
|
||
For Each Pruefpunkt In m_colUniquePP.getCollection
|
||
PPNr = PPNr + 1
|
||
' Durchfl<66>sse anzeigen
|
||
MSFlexGrid1.col = PPNr
|
||
MSFlexGrid1.row = 0
|
||
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
MSFlexGrid1.Font.Bold = True
|
||
MSFlexGrid1.text = Pruefpunkt.getQ
|
||
Next
|
||
|
||
|
||
For Each Einbauplatz In m_colEinbauplatz
|
||
Set Pruefzaehler = Einbauplatz.getPruefzaehler
|
||
If Not Pruefzaehler Is Nothing Then
|
||
|
||
strAlleFehler = ""
|
||
|
||
Dim lngPruefgangNr As Long
|
||
If GetLetztenPruefgangFuerZaehler(Pruefzaehler.getSerienNr, lngPruefgangNr) = True Then
|
||
' Pr<50>fgangNr der letzen Pr<50>fung dieses Z<>hlers ist nun bekannt
|
||
|
||
' SerienNr anzeigen im linken Tabellenheader
|
||
MSFlexGrid1.col = 0
|
||
MSFlexGrid1.row = Einbauplatz.getNr
|
||
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
MSFlexGrid1.text = Einbauplatz.getNr & ": " & FormatSerienNr(Pruefzaehler.getSerienNr)
|
||
|
||
PPNr = 0
|
||
For Each Pruefpunkt In m_colUniquePP.getCollection
|
||
'F<>r alle Pr<50>fpunkte der aktuellen Pr<50>fung
|
||
PPNr = PPNr + 1
|
||
|
||
MSFlexGrid1.col = PPNr
|
||
MSFlexGrid1.ColWidth(PPNr) = 900
|
||
MSFlexGrid1.row = Einbauplatz.getNr
|
||
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
|
||
MSFlexGrid1.Font.Size = 12
|
||
MSFlexGrid1.Font.Bold = True
|
||
|
||
' Wurde dieser Z<>hler in seinem letzten Pr<50>fgang bereits mit diesem Durchfluss gepr<70>ft ?
|
||
|
||
If GetLetzterFehlerDesZaehlers(lngPruefgangNr, Pruefzaehler.getSerienNr, Pruefpunkt.getQ, Fehler) Then
|
||
' wenn ja, den Fehler anzeigen
|
||
|
||
MSFlexGrid1.text = Format(Fehler, "0.0")
|
||
|
||
strAlleFehler = strAlleFehler & Format(Fehler, "0.0") & " "
|
||
Else
|
||
MSFlexGrid1.text = "?"
|
||
strAlleFehler = strAlleFehler & "?" & " "
|
||
' Dieser Z<>hler hatte diesen Pr<50>fpunkt nicht im letzten Pr<50>fgang
|
||
End If
|
||
Next
|
||
|
||
If Not m_Display Is Nothing Then
|
||
m_Display.Adressierung Einbauplatz.getNr
|
||
Sleep 100, True
|
||
m_Display.PlaceAusgabe strAlleFehler, 10, 30, 160, 38
|
||
Sleep 100, True
|
||
End If
|
||
Else
|
||
' Dieser Z<>hler wurde noch nicht gepr<70>ft
|
||
End If
|
||
Else
|
||
' Einbauplatz ist leer
|
||
End If
|
||
Next
|
||
|
||
If Not g_blnVersuch Then
|
||
MSFlexGrid1.Rows = 12
|
||
MSFlexGrid1.TextMatrix(11, 0) = "FG"
|
||
PPNr = 0
|
||
MSFlexGrid1.row = MSFlexGrid1.Rows - 1
|
||
|
||
For Each Pruefpunkt In m_colUniquePP.getCollection
|
||
'F<>r alle Pr<50>fpunkte der aktuellen Pr<50>fung
|
||
PPNr = PPNr + 1
|
||
MSFlexGrid1.col = PPNr
|
||
If Pruefpunkt.getFGo = -Pruefpunkt.getFGu Then
|
||
MSFlexGrid1.text = MSFlexGrid1.text & " +/-" & Format(Pruefpunkt.getFGo, "0.##")
|
||
Else
|
||
MSFlexGrid1.text = MSFlexGrid1.text & " " & Format(Pruefpunkt.getFGo, "0.##") & "/" & Format(Pruefpunkt.getFGu, "0.##")
|
||
End If
|
||
Next
|
||
End If
|
||
AutoSpaltenBreite MSFlexGrid1, lblAutosize
|
||
Exit Sub
|
||
|
||
|
||
Errorhandler:
|
||
LogIntoDB "Fehler " & Err.Number & " in ShowLetzteFehler: " & Err.Description
|
||
End Sub
|
||
|
||
Private Function GetLetzterFehlerDesZaehlers(ByVal lngPruefgangNr As Long, ByVal lngSerienNr As Long, ByVal dblDurchfluss As Double, ByRef Fehler As Double) As Boolean
|
||
Dim strSQL As String
|
||
Dim i As Integer
|
||
Dim rs As CRecordset
|
||
Const PP_MAX = 10
|
||
|
||
strSQL = "SELECT * From Prueffehler INNER JOIN Pruefgang ON Prueffehler.PruefgangNr = Pruefgang.PruefgangNr Where SerienNr = " & lngSerienNr & " AND Prueffehler.PruefgangNr = " & lngPruefgangNr
|
||
Set rs = New CRecordset
|
||
rs.openRS strSQL, True
|
||
If Not rs.EOF Then
|
||
For i = 1 To PP_MAX
|
||
If Round(rs.getDoubleValue("PP" & i & "_Soll"), 3) = Round(dblDurchfluss, 3) Then
|
||
' Dieser Pruefpunkt ist gemeint
|
||
If Not rs.isFieldNull("PP" & i & "_Fehler") Then
|
||
Fehler = rs.getDoubleValue("PP" & i & "_Fehler")
|
||
GetLetzterFehlerDesZaehlers = True
|
||
Else
|
||
' Fehler in DB ist NULL
|
||
Fehler = -99
|
||
GetLetzterFehlerDesZaehlers = False
|
||
End If
|
||
Exit Function
|
||
End If
|
||
Next
|
||
End If
|
||
Exit Function
|
||
Errorhandler:
|
||
LogIntoDB "Fehler " & Err.Number & " in GetLetzterFehlerDesZaehlers: " & Err.Description, "neue Funktion"
|
||
End Function
|
||
|
||
|
||
'Private Function GetLetzterFehlerFuerDurchfluss(dblDurchfluss As Double, lngSerienNr As Long, ByRef Fehler As Double, ByRef Datum As Date) As Boolean
|
||
' Dim strSQL As String
|
||
' Dim i As Integer
|
||
' Dim rs As CRecordset
|
||
' Const PP_MAX = 10
|
||
' strSQL = "SELECT * From Prueffehler INNER JOIN Pruefgang ON Prueffehler.PruefgangNr = Pruefgang.PruefgangNr Where (SerienNr = " & lngSerienNr & ") ORDER BY Prueffehler.PruefgangNr DESC"
|
||
' Set rs = New CRecordset
|
||
' rs.openRS strSQL, True
|
||
' If Not rs.EOF Then
|
||
' Datum = rs.getDateValue("Datum")
|
||
' For i = 1 To PP_MAX
|
||
' If Round(rs.getDoubleValue("PP" & i & "_Soll"), 3) = Round(dblDurchfluss, 3) Then
|
||
' ' Dieser Pruefpunkt ist gemeint
|
||
' Fehler = rs.getDoubleValue("PP" & i & "_Fehler")
|
||
' GetLetzterFehlerFuerDurchfluss = True
|
||
' Exit For
|
||
' End If
|
||
' Next
|
||
' End If
|
||
' Exit Function
|
||
'Errorhandler:
|
||
' LogIntoDB "Fehler " & Err.Number & " in GetLetzterFehlerFuerDurchfluss: " & Err.Description, "neue Funktion"
|
||
'End Function
|
||
|
||
|
||
Private Function GetLetztenPruefgangFuerZaehler(ByVal lngSerienNr As Long, ByRef lngPruefgangNr As Long) As Boolean
|
||
Dim strSQL As String
|
||
Dim rs As CRecordset
|
||
|
||
strSQL = "SELECT Top 1 * From AuftragPositionSerienNr Where (PruefgangNr > 0) And (Wiederholungen > -1) And (SerienNr = " & lngSerienNr & ") ORDER BY Wiederholungen DESC"
|
||
Set rs = New CRecordset
|
||
rs.openRS strSQL, True
|
||
If Not rs.EOF Then
|
||
lngPruefgangNr = rs.getLongValue("PruefgangNr")
|
||
GetLetztenPruefgangFuerZaehler = True
|
||
Else
|
||
lngPruefgangNr = 0
|
||
GetLetztenPruefgangFuerZaehler = False
|
||
End If
|
||
Set rs = Nothing
|
||
Exit Function
|
||
Errorhandler:
|
||
LogIntoDB "Fehler " & Err.Number & " in GetLetztenPruefgangFuerZaehler: " & Err.Description, "neue Funktion"
|
||
Set rs = Nothing
|
||
End Function
|
||
|
||
|
||
Private Function GetLetzteAenderungSollwert(ByRef dblOutSollwert As Double, ByRef strOutPruefername As String, ByRef dateOutDatum As Date, ByRef strOutBemerkung As String) As Boolean
|
||
Dim strSQL As String
|
||
Dim rs As CRecordset
|
||
Dim Mitarbeiter As CMitarbeiter
|
||
Set rs = New CRecordset
|
||
|
||
|
||
strSQL = "SELECT * FROM SollwertAenderungen WHERE (Metrolog = '" & m_strMetrolog & "') AND (IdentNrGruppe = " & m_lngIdentNrGruppe & ") order by Datum desc"
|
||
rs.openRS strSQL, True
|
||
Debug.Print strSQL
|
||
|
||
If Not rs.EOF Then
|
||
GetLetzteAenderungSollwert = True
|
||
dblOutSollwert = Round(rs.getDoubleValue("Sollwert"), 1)
|
||
strOutBemerkung = rs.getStringValue("Bemerkung")
|
||
|
||
'----
|
||
Set Mitarbeiter = New CMitarbeiter
|
||
Mitarbeiter.loadForNr rs.getLongValue("Pruefer")
|
||
strOutPruefername = Mitarbeiter.getAnfangsbuchstabeVornameundName
|
||
Set Mitarbeiter = Nothing
|
||
'----
|
||
dateOutDatum = rs.getDateValue("Datum")
|
||
End If
|
||
|
||
End Function
|
||
|
||
Private Sub InitialisiereBemerkungen()
|
||
frameBemerkung.Caption = "Bemerkungen zu " & m_strIdentNrGruppeName & " /Metrolog= " & m_strMetrolog
|
||
|
||
m_strBemerkung = LoadBemerkungen()
|
||
If m_strBemerkung = "" Then
|
||
lblBemerkung.Caption = ""
|
||
cmdBemerkungen.Caption = "neu..."
|
||
Shape1.Visible = False
|
||
Shape2.Visible = False
|
||
Else
|
||
cmdBemerkungen.Caption = "anzeigen..."
|
||
Shape1.Visible = True
|
||
Shape2.Visible = True
|
||
End If
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
Private Sub cmdBemerkungen_Click()
|
||
Dim objForm As frmTexteingabe
|
||
cmdBemerkungen.Enabled = False
|
||
Set objForm = New frmTexteingabe
|
||
objForm.mstrText = m_strBemerkung
|
||
objForm.Caption = "Bemerkungen f<>r " & m_strIdentNrGruppeName & ", '" & m_strMetrolog & "'"
|
||
|
||
objForm.Show vbModal, Me
|
||
m_strBemerkung = objForm.mstrText
|
||
If objForm.mblnGeaendert Then
|
||
SaveBemerkungen m_strBemerkung
|
||
End If
|
||
InitialisiereBemerkungen
|
||
cmdBemerkungen.Enabled = True
|
||
End Sub
|
||
|
||
|
||
Private Function LoadBemerkungen() As String
|
||
Dim strSQL As String
|
||
Dim strSQLmitPstation As String
|
||
|
||
Dim rs As CRecordset
|
||
Dim Mitarbeiter As CMitarbeiter
|
||
Dim strName As String
|
||
|
||
strSQL = "SELECT * from Regulierungs_bemerkungen "
|
||
strSQL = strSQL & "WHERE IdentNrGruppenID=" & m_lngIdentNrGruppe
|
||
strSQL = strSQL & " AND (Metrolog = '" & Replace(m_strMetrolog, "'", "''") & "'"
|
||
|
||
'If m_strMetrolog = "" Then
|
||
' strSQL = strSQL & " or Metrolog = 'MID' "
|
||
'End If
|
||
|
||
strSQL = strSQL & " ) ORDER BY ID desc"
|
||
|
||
Set rs = New CRecordset
|
||
Debug.Print strSQL
|
||
rs.openRS strSQL
|
||
|
||
If Not rs.EOF Then
|
||
If Len(rs.getStringValue("Bemerkung")) > 0 Then
|
||
LoadBemerkungen = Trim(rs.getStringValue("Bemerkung"))
|
||
Set Mitarbeiter = New CMitarbeiter
|
||
If Mitarbeiter.loadForNr(rs.getIntValue("Pruefer")) Then
|
||
strName = Mitarbeiter.getAnfangsbuchstabeVornameundName
|
||
lblBemerkung.Caption = Format(rs.getDateValue("Datum"), "d.m.yy hh:mm") & vbCrLf & strName
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
End Function
|
||
|
||
Private Sub SaveBemerkungen(strBemerkung As String)
|
||
Dim strSQL As String
|
||
Dim rs As CRecordset
|
||
|
||
Debug.Print "Save Bemerkungen: " & strBemerkung
|
||
|
||
strSQL = "SELECT * from Regulierungs_bemerkungen "
|
||
strSQL = strSQL & " WHERE IdentNrGruppenID= " & m_lngIdentNrGruppe
|
||
strSQL = strSQL & " AND Metrolog = '" & Replace(m_strMetrolog, "'", "''") & "'"
|
||
|
||
Set rs = New CRecordset
|
||
rs.openRS strSQL, False
|
||
If rs.EOF Then
|
||
rs.addNew
|
||
End If
|
||
|
||
' Schl<68>ssel
|
||
rs.setValue "Metrolog", m_strMetrolog
|
||
rs.setValue "IdentNrGruppenID", m_lngIdentNrGruppe
|
||
'
|
||
rs.setValue "Bemerkung", strBemerkung
|
||
'
|
||
rs.setValue "Pruefer", g_App.Mitarbeiter.getNr
|
||
rs.setValue "Datum", Now
|
||
|
||
If strBemerkung <> "" Then
|
||
rs.update
|
||
Else
|
||
Do While Not rs.EOF
|
||
rs.delete
|
||
rs.MoveNext
|
||
Loop
|
||
End If
|
||
LogIntoDB "Regulierungs_Bemerkungen ge<67>ndert f<>r Metrolog=" & m_strMetrolog & ", IdentNrGruppe=" & m_lngIdentNrGruppe & ": " & Left(strBemerkung, 20), "Daten<65>nderung"
|
||
End Sub
|