343 lines
8.9 KiB
Plaintext
343 lines
8.9 KiB
Plaintext
VERSION 5.00
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmRefZFehler
|
|
Caption = "Referenzzähler-Fehler"
|
|
ClientHeight = 7635
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 11640
|
|
LinkTopic = "Form2"
|
|
ScaleHeight = 7635
|
|
ScaleWidth = 11640
|
|
StartUpPosition = 3 'Windows-Standard
|
|
Begin VB.ComboBox cmbPruefstation
|
|
Height = 315
|
|
Left = 1260
|
|
Style = 2 'Dropdown-Liste
|
|
TabIndex = 0
|
|
Top = 420
|
|
Width = 1365
|
|
End
|
|
Begin VB.CommandButton cmdClose
|
|
Caption = "Schließen"
|
|
Default = -1 'True
|
|
Height = 735
|
|
Left = 8850
|
|
TabIndex = 2
|
|
Top = 390
|
|
Width = 1725
|
|
End
|
|
Begin VB.VScrollBar VscrollBar
|
|
Height = 5955
|
|
Left = 11370
|
|
Max = 100
|
|
TabIndex = 9
|
|
Top = 1320
|
|
Width = 285
|
|
End
|
|
Begin VB.PictureBox picRahmen
|
|
Height = 5775
|
|
Left = 30
|
|
ScaleHeight = 5715
|
|
ScaleWidth = 11145
|
|
TabIndex = 7
|
|
Top = 1320
|
|
Width = 11205
|
|
Begin VB.PictureBox picScroll
|
|
AutoRedraw = -1 'True
|
|
BackColor = &H00FFFFFF&
|
|
Height = 5805
|
|
Left = 3060
|
|
ScaleHeight = 5745
|
|
ScaleWidth = 11895
|
|
TabIndex = 8
|
|
Top = 120
|
|
Width = 11955
|
|
End
|
|
End
|
|
Begin MSComctlLib.StatusBar StatusBar1
|
|
Align = 2 'Unten ausrichten
|
|
Height = 285
|
|
Left = 0
|
|
TabIndex = 6
|
|
Top = 7350
|
|
Width = 11640
|
|
_ExtentX = 20532
|
|
_ExtentY = 503
|
|
_Version = 393216
|
|
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
|
|
NumPanels = 1
|
|
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
|
|
EndProperty
|
|
EndProperty
|
|
End
|
|
Begin VB.ComboBox cmbTemperatur
|
|
Height = 315
|
|
Left = 1230
|
|
Style = 2 'Dropdown-Liste
|
|
TabIndex = 1
|
|
Top = 840
|
|
Width = 1365
|
|
End
|
|
Begin VB.CommandButton cmdShow
|
|
Caption = "Ducken"
|
|
Height = 735
|
|
Left = 4950
|
|
TabIndex = 4
|
|
Top = 420
|
|
Width = 1725
|
|
End
|
|
Begin VB.Label Label2
|
|
Caption = "Temperatur"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 5
|
|
Top = 840
|
|
Width = 975
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Prüfstation"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 3
|
|
Top = 480
|
|
Width = 975
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmRefZFehler"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Public m_blnIsActivated As Boolean
|
|
|
|
Private Sub cmbPruefstation_Change()
|
|
fillCmbTemperatur
|
|
If m_blnIsActivated Then
|
|
Call RefreshScreen
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmbPruefstation_click()
|
|
fillCmbTemperatur
|
|
If m_blnIsActivated Then
|
|
Call RefreshScreen
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdClose_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub cmdShow_Click()
|
|
Screen.MousePointer = vbHourglass
|
|
cmdShow.Enabled = False
|
|
|
|
Call RZFehlerDruck(Val(cmbPruefstation.Text), Val(cmbTemperatur.Text))
|
|
|
|
cmdShow.Enabled = True
|
|
Screen.MousePointer = vbNormal
|
|
End Sub
|
|
|
|
Private Sub cmbTemperatur_Change()
|
|
|
|
If m_blnIsActivated Then
|
|
RefreshScreen
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub cmbTemperatur_Click()
|
|
|
|
If m_blnIsActivated Then
|
|
RefreshScreen
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
If m_blnIsActivated = False Then
|
|
RefreshScreen
|
|
m_blnIsActivated = True
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub RefreshScreen()
|
|
On Error GoTo Errorhandler
|
|
|
|
Me.MousePointer = vbHourglass
|
|
picScroll.Cls
|
|
DoEvents
|
|
|
|
picRahmen.AutoRedraw = True
|
|
picScroll.AutoRedraw = True
|
|
|
|
Call RZFehlerDruck(Val(cmbPruefstation.Text), Val(cmbTemperatur.Text), picScroll)
|
|
|
|
BerechneScrollBar
|
|
|
|
Me.MousePointer = vbNormal
|
|
|
|
cmdClose.Default = True
|
|
Exit Sub
|
|
Errorhandler:
|
|
Me.MousePointer = vbNormal
|
|
|
|
LogIntoDB "Fehler " & Err.Number & " in frmRefZFehler.RefreshScreen(): " & Err.Description, "SoftwareFehler"
|
|
|
|
End Sub
|
|
|
|
Private Sub FillcmbPruefstation()
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim intNr As Integer
|
|
|
|
cmbPruefstation.Clear
|
|
Set rs = New CRecordset
|
|
strSQL = "SELECT DISTINCT Referenzzaehler.PruefstationNr FROM Referenzzaehler INNER JOIN ReferenzzaehlerFehler ON Referenzzaehler.SerienNr = ReferenzzaehlerFehler.SerienNr order by Referenzzaehler.PruefstationNr"
|
|
rs.openRS strSQL, True
|
|
Do While Not rs.EOF
|
|
intNr = rs.getIntValue("PruefstationNr")
|
|
cmbPruefstation.AddItem intNr
|
|
If intNr = g_App.PruefstationNr Then
|
|
cmbPruefstation.ListIndex = cmbPruefstation.ListCount - 1
|
|
End If
|
|
rs.MoveNext
|
|
Loop
|
|
|
|
fillCmbTemperatur
|
|
End Sub
|
|
|
|
Private Sub fillCmbTemperatur()
|
|
On Error GoTo Errorhandler
|
|
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim SPS As CSPS
|
|
Dim Temperatur As Double
|
|
|
|
cmbTemperatur.Clear
|
|
strSQL = "SELECT DISTINCT MAX(ReferenzzaehlerFehler.PP1_WasserTemp) AS MaxTemp "
|
|
strSQL = strSQL & "FROM ReferenzzaehlerFehler INNER JOIN Referenzzaehler ON ReferenzzaehlerFehler.SerienNr = Referenzzaehler.SerienNr "
|
|
strSQL = strSQL & "WHERE (Referenzzaehler.PruefstationNr = " & Val(cmbPruefstation.Text) & ")"
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
cmbTemperatur.Clear
|
|
cmbTemperatur.AddItem "25 (kalt)"
|
|
cmbTemperatur.ListIndex = 0
|
|
|
|
|
|
If Not rs.EOF Then
|
|
If rs.getDoubleValue("MaxTemp") >= 40 Then
|
|
cmbTemperatur.AddItem "55 (warm)"
|
|
End If
|
|
If rs.getDoubleValue("MaxTemp") >= 70 Then
|
|
cmbTemperatur.AddItem "85 (heiss)"
|
|
End If
|
|
End If
|
|
|
|
If g_ohneSPS Then
|
|
cmbTemperatur.ListIndex = 0
|
|
Else
|
|
Set SPS = g_App.getSPS
|
|
Temperatur = SPS.GetEinlaufTemperatur
|
|
If Temperatur < 40 Then
|
|
cmbTemperatur.ListIndex = 0
|
|
'kalt
|
|
ElseIf Temperatur < 70 And cmbTemperatur.ListCount > 1 Then
|
|
'warm
|
|
cmbTemperatur.ListIndex = 1
|
|
ElseIf Temperatur >= 70 And cmbTemperatur.ListCount > 2 Then
|
|
'heiss
|
|
cmbTemperatur.ListIndex = 2
|
|
Else
|
|
cmbTemperatur.ListIndex = 0
|
|
End If
|
|
End If
|
|
Exit Sub
|
|
Errorhandler:
|
|
LogIntoDB "Fehler " & Err.Number & " in frmRefZFehler.fillCmbTemperatur: " & Err.Description, "SoftwareFehler"
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Dim Temperatur As Double
|
|
Dim SPS As CSPS
|
|
|
|
m_blnIsActivated = False
|
|
|
|
FillcmbPruefstation
|
|
|
|
cmdClose.Default = True
|
|
End Sub
|
|
|
|
Private Sub Form_Resize()
|
|
On Error Resume Next
|
|
|
|
picRahmen.Left = 0
|
|
picRahmen.Height = Me.ScaleHeight - picRahmen.Top - StatusBar1.Height
|
|
picRahmen.Width = Me.ScaleWidth - VscrollBar.Width
|
|
|
|
VscrollBar.Left = picRahmen.Left + picRahmen.Width
|
|
VscrollBar.Top = picRahmen.Top
|
|
VscrollBar.Height = picRahmen.Height
|
|
|
|
picScroll.Top = 0
|
|
picScroll.Left = 0
|
|
picScroll.Width = picRahmen.ScaleWidth * 1.95
|
|
picScroll.Height = Printer.Height
|
|
|
|
End Sub
|
|
|
|
Private Sub txtPruefstation_Change()
|
|
|
|
If m_blnIsActivated Then
|
|
RefreshScreen
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub VscrollBar_Change()
|
|
picScroll.Move picScroll.Left, -VscrollBar.Value
|
|
End Sub
|
|
|
|
Private Sub VscrollBar_Scroll()
|
|
picScroll.Move picScroll.Left, -VscrollBar.Value
|
|
End Sub
|
|
|
|
|
|
Private Sub BerechneScrollBar()
|
|
|
|
VscrollBar.Min = 0
|
|
|
|
If (picScroll.Height - picRahmen.ScaleHeight) <= 0 Then
|
|
VscrollBar.Visible = False
|
|
VscrollBar.Value = 0
|
|
Exit Sub
|
|
End If
|
|
VscrollBar.Max = (picScroll.Height - picRahmen.ScaleHeight)
|
|
|
|
VscrollBar.Visible = True
|
|
|
|
|
|
VscrollBar.LargeChange = VscrollBar.Max / 1
|
|
VscrollBar.SmallChange = VscrollBar.Max / 10
|
|
|
|
|
|
' Dim lngNewChange As Long
|
|
'
|
|
' lngNewChange = VscrollBar.Max * (1 - (picScroll.Height - picRahmen.ScaleHeight) / picScroll.ScaleHeight)
|
|
' If lngNewChange <= 0 Then lngNewChange = 1
|
|
' VscrollBar.LargeChange = lngNewChange
|
|
'
|
|
' lngNewChange = VscrollBar.Max / (mlngAnzahlSerienNr + 1)
|
|
' If lngNewChange <= 0 Then lngNewChange = 1
|
|
' VscrollBar.SmallChange = lngNewChange
|
|
'
|
|
End Sub
|
|
|
|
|