176 lines
8.0 KiB
Plaintext
176 lines
8.0 KiB
Plaintext
' ===================================================================================================================================
|
|
' === Prßfgang & Prßffehler =========================================================================================================
|
|
' ===================================================================================================================================
|
|
Dim recordset As CRecordset
|
|
Dim evaluationsQuery As String
|
|
Set recordset = New CRecordset
|
|
|
|
evaluationsQuery = " SELECT ROW_NUMBER() OVER (ORDER BY [PG].[Datum]) AS [Id]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PruefgangNr] AS [Nr]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP1_Soll] AS [P1]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP1_Fehler] AS [E1]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP2_Soll] AS [P2]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP2_Fehler] AS [E2]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP3_Soll] AS [P3]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP3_Fehler] AS [E3]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP4_Soll] AS [P4]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP4_Fehler] AS [E4]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP5_Soll] AS [P5]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP5_Fehler] AS [E5]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP6_Soll] AS [P6]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP6_Fehler] AS [E6]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP7_Soll] AS [P7]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP7_Fehler] AS [E7]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP8_Soll] AS [P8]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP8_Fehler] AS [E8]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP9_Soll] AS [P9]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP9_Fehler] AS [E9]"
|
|
evaluationsQuery = evaluationsQuery & " , [PG].[PP10_Soll] AS [P10]"
|
|
evaluationsQuery = evaluationsQuery & " , [PF].[PP10_Fehler] AS [E10]"
|
|
evaluationsQuery = evaluationsQuery & " FROM [Pruefgang] AS [PG]"
|
|
evaluationsQuery = evaluationsQuery & " LEFT JOIN [Prueffehler] AS [PF]"
|
|
evaluationsQuery = evaluationsQuery & " ON [PF].[PruefgangNr] = [PG].[PruefgangNr]"
|
|
evaluationsQuery = evaluationsQuery & " WHERE [PF].[SerienNr] = " & m_Pruefzaehler.getSerienNr
|
|
|
|
recordset.openRS evaluationsQuery
|
|
|
|
Dim col As Integer
|
|
Dim row As Integer
|
|
Dim ID As Integer
|
|
Dim x As Integer
|
|
Dim p As Double
|
|
Dim e As Double
|
|
Dim cols(10) As Double
|
|
Dim soll(10) As String
|
|
Dim evaluations() As Variant
|
|
Dim Length As Integer
|
|
Const offsetX = 0.5
|
|
|
|
Length = recordset.RecordCount
|
|
ReDim evaluations(Length)
|
|
|
|
|
|
Printer.FontSize = 9
|
|
Printer.FontBold = True
|
|
|
|
Do While Not recordset.EOF
|
|
Dim ist(10) As String
|
|
ID = recordset.getIntValue("Id")
|
|
ist(0) = recordset.getLongValue("Nr")
|
|
|
|
If cols(0) < Printer.TextWidth(ist(0)) + 2 * offsetX Then
|
|
cols(0) = Printer.TextWidth("PrüfgangNr\Q[m³]") + 2 * offsetX
|
|
End If
|
|
|
|
soll(0) = "Püfgang"
|
|
|
|
For col = 1 To 10
|
|
p = recordset.getDoubleValue("P" & col)
|
|
e = recordset.getDoubleValue("E" & col)
|
|
|
|
If p <> 0 Then
|
|
soll(col) = Replace(Format(p, "#,##0.000") & "", ".000", "")
|
|
End If
|
|
|
|
If e <> 0 Then
|
|
ist(col) = Format(e, "#,##0.00") & "%"
|
|
|
|
If cols(col) < Printer.TextWidth(ist(col)) Then
|
|
cols(col) = Printer.TextWidth(ist(col)) + 2 * offsetX
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
evaluations(ID) = ist
|
|
recordset.MoveNext
|
|
Loop
|
|
|
|
evaluations(0) = soll
|
|
|
|
If Length > 0 Then
|
|
Dim offsetY As Double
|
|
Dim initX As Double
|
|
Dim initY As Double
|
|
Dim px As Double
|
|
Dim py As Double
|
|
Dim width As Double
|
|
Dim lineH As Double
|
|
Dim text As String
|
|
Dim h As Double
|
|
Dim tw As Double
|
|
Dim mw As Double
|
|
|
|
offsetY = 0.75
|
|
initX = 22 + 5 ' is the left border X coordinate of the previous element
|
|
initY = mdblCurrentY ' is the bottom border Y coordinate of the previous element
|
|
px = initX
|
|
py = initY
|
|
width = Printer.ScaleWidth - 9.7 ' width between inner frames
|
|
lineH = Printer.TextHeight("|")
|
|
h = initY + (lineH * (Length + 1)) + (offsetY * (Length + 1) * 2) + (0.1 * (Length + 1))
|
|
|
|
Printer.Line (initX, initY)-(width, initY), vbActiveBorder
|
|
|
|
For row = 0 To Length
|
|
py = py + offsetY
|
|
px = initX + 0.1
|
|
|
|
If row > 0 Then
|
|
Printer.FontBold = False
|
|
End If
|
|
|
|
For col = 0 To 10
|
|
text = evaluations(row)(col)
|
|
tw = Printer.TextWidth(text)
|
|
px = px + offsetX + 0.1
|
|
mw = cols(col)
|
|
|
|
If row = 0 And col = 0 Then
|
|
Printer.FontSize = 7
|
|
Printer.CurrentY = py - offsetY + 0.1
|
|
Printer.CurrentX = px + (mw - Printer.TextWidth("Q[m³/h]"))
|
|
Printer.Print "Q[m³/h]"
|
|
|
|
Printer.CurrentY = (py + lineH + offsetY) - Printer.TextHeight("|")
|
|
Printer.CurrentX = px
|
|
Printer.Print "PrüfgangNr"
|
|
Else
|
|
Printer.FontSize = 9
|
|
Printer.CurrentX = px + (mw - tw) / 2
|
|
Printer.CurrentY = py - 0.1
|
|
Printer.Print text
|
|
End If
|
|
|
|
px = px + mw + offsetX
|
|
Next
|
|
|
|
py = py + lineH + offsetY
|
|
|
|
If row = 0 Then
|
|
' py = py + lineH * 0.25
|
|
|
|
Printer.Line (initX, initY)-(initX + cols(0) + offsetX + 0.1, py), vbActiveBorder
|
|
End If
|
|
|
|
Printer.Line (initX, py)-(width, py), vbActiveBorder
|
|
Next
|
|
|
|
px = initX
|
|
|
|
For col = 0 To 10
|
|
On Error Resume Next
|
|
text = evaluations(0)(col)
|
|
If text <> "" Then
|
|
Printer.Line (px, initY)-(px, h), vbActiveBorder
|
|
px = px + cols(col) + offsetX * 2 + 0.1
|
|
End If
|
|
Next
|
|
|
|
Printer.Line (width, initY)-(width, h), vbActiveBorder
|
|
|
|
mdblCurrentY = py
|
|
End If
|
|
' ===================================================================================================================================
|
|
' === Ende Prßfgang & Prßffehler ====================================================================================================
|
|
' ===================================================================================================================================
|