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

750 lines
24 KiB
Plaintext

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmAuftraege
Caption = "Pruef2000"
ClientHeight = 9495
ClientLeft = 60
ClientTop = 345
ClientWidth = 12150
LinkTopic = "Form1"
ScaleHeight = 9495
ScaleWidth = 12150
StartUpPosition = 3 'Windows-Standard
Begin VB.CommandButton cmdCancel
Caption = "Zurück"
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 = 9360
TabIndex = 7
Top = 0
Width = 1935
End
Begin VB.CommandButton cmdOK
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 = 7320
TabIndex = 6
Top = 0
Width = 1935
End
Begin VB.Frame frMain
Height = 8535
Left = 0
TabIndex = 4
Top = 720
Width = 12015
Begin VB.Frame Frame2
Caption = "Anzeigen"
Height = 2475
Left = 480
TabIndex = 13
Top = 2700
Width = 3135
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 7
Left = 180
TabIndex = 26
Top = 2100
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 6
Left = 180
TabIndex = 24
Top = 1800
Value = 1 'Aktiviert
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 1
Left = 180
TabIndex = 18
Top = 300
Value = 1 'Aktiviert
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 2
Left = 180
TabIndex = 17
Top = 600
Value = 1 'Aktiviert
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 3
Left = 180
TabIndex = 16
Top = 900
Value = 1 'Aktiviert
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 4
Left = 180
TabIndex = 15
Top = 1200
Value = 1 'Aktiviert
Width = 255
End
Begin VB.CheckBox CheckStatus
Caption = "Check1"
Height = 255
Index = 5
Left = 180
TabIndex = 14
Top = 1500
Value = 1 'Aktiviert
Width = 255
End
Begin VB.Label Label6
Caption = "(Status unbekannt)"
Height = 255
Index = 7
Left = 540
TabIndex = 27
Top = 2100
Width = 1635
End
Begin VB.Label Label6
Caption = "Auftrag ausgeliefert"
Height = 255
Index = 6
Left = 540
TabIndex = 25
Top = 1800
Width = 1635
End
Begin VB.Label Label6
Caption = "Zähler ausgeliefert"
Height = 255
Index = 5
Left = 540
TabIndex = 23
Top = 1500
Width = 1515
End
Begin VB.Label Label6
Caption = "Prüfstation geprüft"
Height = 255
Index = 4
Left = 540
TabIndex = 22
Top = 1200
Width = 1455
End
Begin VB.Label Label6
Caption = "Montage Fertig"
Height = 255
Index = 3
Left = 540
TabIndex = 21
Top = 900
Width = 1335
End
Begin VB.Label Label6
Caption = "Vorfertigug OK"
Height = 255
Index = 2
Left = 540
TabIndex = 20
Top = 600
Width = 1335
End
Begin VB.Label Label6
Caption = "ohne Bearbeitung"
Height = 255
Index = 1
Left = 540
TabIndex = 19
Top = 300
Width = 1335
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 4140
Top = 3720
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 7
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":0000
Key = "Icon1"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":0452
Key = "Icon2"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":07B0
Key = "Icon3"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":0B0E
Key = "Icon4"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":0C40
Key = "Icon5"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":0F98
Key = "Icon6"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAuftraege.frx":55DF
Key = "Icon7"
EndProperty
EndProperty
End
Begin MSComctlLib.ListView LstViewAuftraege
Height = 7935
Left = 7680
TabIndex = 12
Top = 660
Width = 4035
_ExtentX = 7117
_ExtentY = 13996
LabelWrap = -1 'True
HideSelection = -1 'True
GridLines = -1 'True
_Version = 393217
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = 16777215
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Frame Frame1
Caption = "Auftragsposition suchen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1935
Left = 480
TabIndex = 8
Top = 600
Width = 6975
Begin VB.CommandButton cmdSuchen
Caption = "Suchen"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5700
TabIndex = 3
Top = 1260
Width = 1095
End
Begin VB.TextBox txtPosition
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 4320
MaxLength = 3
TabIndex = 1
Top = 600
Width = 615
End
Begin VB.TextBox txtAuftragNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 1680
MaxLength = 9
TabIndex = 0
Top = 600
Width = 1455
End
Begin VB.TextBox txtSerienNr
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 1710
MaxLength = 10
TabIndex = 2
Top = 1200
Width = 1935
End
Begin VB.Label Label3
Caption = "Position:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
TabIndex = 11
Top = 600
Width = 1095
End
Begin VB.Label Label2
Caption = "AuftragNr:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 10
Top = 600
Width = 1335
End
Begin VB.Label Label1
Caption = "SerienNr.:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 9
Top = 1200
Width = 1335
End
End
Begin VB.Label lblAuftrag
BorderStyle = 1 'Fest Einfach
Caption = "Auftragsdaten...."
Height = 2295
Left = 480
TabIndex = 28
Top = 5580
Width = 4095
End
End
Begin VB.Label lblTitle
Caption = "Auftragsdaten"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 0
TabIndex = 5
Top = 0
Width = 12015
End
End
Attribute VB_Name = "frmAuftraege"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Private Member
' --------------
Private m_nRet As Integer
Private m_Auftrag As CAuftrag
Private m_AuftragPosition As CAuftragPosition
Private m_AuftragPositionSerienNr As CAuftragPositionSerienNr
Private m_AuftragGefunden As Boolean
Private m_ErsteSerienNr As Long
' @return Code, mit dem endDialog aufgerufen wurde
'
Public Function getExitCode() As Integer
getExitCode = m_nRet
End Function
'------------------------------------------------------------------------------
' Private Funktionalität
'------------------------------------------------------------------------------
' Dialog beenden
'
' @param nRet Returncode des Dialogs
'
Private Sub endDialog(nRet As Integer)
m_nRet = nRet
Unload Me
End Sub
Private Sub CheckStatus_Click(Index As Integer)
If m_AuftragGefunden = True Then
Screen.MousePointer = vbHourglass
Call sucheAuftragsdaten
Screen.MousePointer = vbNormal
End If
End Sub
Private Sub cmdSuchen_Click()
Screen.MousePointer = vbHourglass
Call sucheAuftragsdaten
Screen.MousePointer = vbNormal
End Sub
Private Sub sucheAuftragsdaten()
On Error GoTo Fehler
Screen.MousePointer = vbHourglass
m_AuftragGefunden = False
Dim AuftragNr As Long
Dim Position As Integer
Dim SerienNr As Long
Dim sMsg As String
If txtSerienNr.text <> "" Then
' Suche nach Seriennr
SerienNr = txtSerienNr.text
Set m_AuftragPositionSerienNr = New CAuftragPositionSerienNr
If m_AuftragPositionSerienNr.load(SerienNr) Then
AuftragNr = m_AuftragPositionSerienNr.getAuftragNr
Position = m_AuftragPositionSerienNr.getPositionNr
Else
MsgBox ("Diese Serien-Nr. konnte nicht gefunden werden")
Exit Sub
End If
Else
If txtAuftragNr.text = "" Then
MsgBox ("Bitte geben Sie eine Auftragsnummer an")
txtAuftragNr.SetFocus
Exit Sub
End If
If txtPosition.text = "" Then
MsgBox ("Bitte geben Sie eine Positionsnummer an")
txtPosition.SetFocus
Exit Sub
End If
AuftragNr = Val(txtAuftragNr.text)
Position = Val(txtPosition.text)
End If
' Auftrag und Position sind hier bekannt
Set m_AuftragPosition = New CAuftragPosition
Set m_Auftrag = New CAuftrag
sMsg = ""
sMsg = sMsg & "Auftrag: " & AuftragNr & " / " & Position & vbCrLf
If 1 Then
If m_Auftrag.load(AuftragNr, False) Then
Call ZeigeAuftragsdaten(AuftragNr, Position)
Dim Auftrag As CAuftrag
Dim Pruefzaehler As CPruefzaehler
' m_AuftragPosition.load(AuftragNr, Position) Or m_StatistikAuftragPos.load(AuftragNr, Position)
Set Pruefzaehler = New CPruefzaehler
Pruefzaehler.loadForSerienNr m_ErsteSerienNr
If Pruefzaehler.getIdentNrObj.GetKurzBezeichnung <> "ME" Then
sMsg = sMsg & "Nur Meßeinsätze" & vbCrLf
End If
sMsg = sMsg & "Typ: " & Trim(Pruefzaehler.getIdentNrObj.getTyp & _
" " & Pruefzaehler.getIdentNrObj.getTypzusatz) & vbCrLf
sMsg = sMsg & "Nennweite: " & Pruefzaehler.getIdentNrObj.getNennweite & vbCrLf
sMsg = sMsg & "Nenntemperatur: " & Pruefzaehler.getIdentNrObj.GetTemperatur & "G" & vbCrLf
sMsg = sMsg & "Nenndruck: " & Pruefzaehler.getIdentNrObj.getDruck & vbCrLf
sMsg = sMsg & "PruefklasseKZ: " & Pruefzaehler.getPruefklasseKZ & vbCrLf
lblAuftrag.Caption = sMsg
m_AuftragGefunden = True
Else
Screen.MousePointer = vbNormal
ErrorMsg ("Dieser Auftrag konnte nicht gefunden werden.")
End If
Else
Screen.MousePointer = vbNormal
ErrorMsg ("Diese Auftrags-Position konnte nicht gefunden werden.")
End If
Exit Sub
Fehler:
Screen.MousePointer = vbNormal
ErrorMsg ("Diese Auftrags-Position konnte nicht gefunden werden: " & vbCrLf & Err.Description)
End Sub
' Sortieren in der ListView
Private Sub LstViewAuftraege_ColumnClick(ByVal ColumnHeader As ColumnHeader)
LstViewAuftraege.SortKey = ColumnHeader.Index - 1
LstViewAuftraege.Sorted = True
End Sub
Private Sub ZeigeAuftragsdaten(AuftragNr, Position)
Dim sSQL As String
Dim rs As CRecordset
Dim i As Integer
Dim subitem As ListItem
Dim bStatus As Byte
Dim sStatus As String
Dim sIcon As String
Dim StatusNr As Integer
LstViewAuftraege.ListItems.Clear
txtAuftragNr.text = AuftragNr
txtPosition.text = Position
Screen.MousePointer = vbHourglass
' Alle Seriennummern mit der Positionsnr und AuftragsNummer
' ------------------------------------------------
' sSQL = "SELECT AuftragNr, SerienNr, Max(StatusFertigung), Wiederholungen AS myStatusFertigung From AuftragPositionSerienNr "
' sSQL = sSQL & "WHERE AuftragNr = " & AuftragNr & " and PositionNr = " & Position & " GROUP BY AuftragNr, SerienNr ORDER BY AuftragPositionSerienNr.Wiederholungen DESC;"
sSQL = "SELECT AuftragNr, SerienNr, Max(StatusFertigung) AS myStatusFertigung, AuftragPositionSerienNr.PositionNr "
sSQL = sSQL & " From AuftragPositionSerienNr "
sSQL = sSQL & " GROUP BY AuftragNr, AuftragPositionSerienNr.SerienNr, AuftragPositionSerienNr.PositionNr "
sSQL = sSQL & " HAVING (((AuftragPositionSerienNr.AuftragNr)=" & AuftragNr & ") AND ((AuftragPositionSerienNr.PositionNr)=" & Position & "));"
' sSQL = "SELECT AuftragPositionSerienNr.AuftragNr, AuftragPositionSerienNr.SerienNr, Max(AuftragPositionSerienNr.StatusFertigung) AS myStatusFertigung, AuftragPositionSerienNr.PositionNr "
' sSQL = sSQL & " From AuftragPositionSerienNr "
' sSQL = sSQL & " GROUP BY AuftragPositionSerienNr.AuftragNr, AuftragPositionSerienNr.SerienNr, AuftragPositionSerienNr.PositionNr "
' sSQL = sSQL & " HAVING (((AuftragPositionSerienNr.AuftragNr)=" & AuftragNr & ") AND ((AuftragPositionSerienNr.PositionNr)=" & Position & "));"
' sSQL = "SELECT * FROM AuftragPositionSerienNr "
' sSQL = sSQL & "WHERE "
' sSQL = sSQL & "AuftragNr = " & AuftragNr & ""
' sSQL = sSQL & " and PositionNr = " & Position & " "
' sSQL = sSQL & "ORDER BY AuftragPositionSerienNr.Wiederholungen DESC;"
' sSQL = sSQL & "WHERE AuftragNr = " & AuftragNr & " and PositionNr = " & Position & " ORDER BY AuftragPositionSerienNr.Wiederholungen DESC;"
Set rs = New CRecordset
If Not rs.openRS(sSQL, True) Then
MsgBox ("Datenbank Fehler")
Exit Sub
End If
i = 0
If Not rs.EOF Then
m_ErsteSerienNr = rs.getLongValue("SerienNr")
Do While Not rs.EOF()
m_AuftragGefunden = True
i = i + 1
bStatus = rs.getByteValue("myStatusFertigung")
Select Case bStatus
Case 0
sStatus = "ohne Bearbeitung"
StatusNr = 1
Case 10
sStatus = "Vorfertigung OK"
StatusNr = 2
Case 20
sStatus = "Montage fertig"
StatusNr = 3
Case 30
sStatus = "Prüfstation geprüft"
StatusNr = 4
Case 40
sStatus = "Zähler ausgeliefert"
StatusNr = 5
Case 50
sStatus = "Auftrag ausgeliefert"
StatusNr = 6
Case Else
sStatus = "unbekannt"
StatusNr = 7
End Select
sIcon = "Icon" & StatusNr
If CheckStatus(StatusNr) = vbChecked Then
Set subitem = LstViewAuftraege.ListItems.Add(, "key" & i, Str(rs.getLongValue("SerienNr")))
' Todo: Status ermitteln
subitem.SubItems(1) = sStatus
subitem.SmallIcon = sIcon
End If
rs.MoveNext
Loop
End If
Screen.MousePointer = vbNormal
End Sub
'------------------------------------------------------------------------------
' Event-Handling
'------------------------------------------------------------------------------
Private Sub Form_Load()
Dim colx As ColumnHeader
Call setupStdDlg(Me)
LstViewAuftraege.View = lvwReport
Set colx = LstViewAuftraege.ColumnHeaders.Add()
colx.text = "Serien-Nr."
colx.Width = LstViewAuftraege.Width * 0.49
Set colx = LstViewAuftraege.ColumnHeaders.Add()
colx.text = "Status"
colx.Width = LstViewAuftraege.Width * 0.49
End Sub
Private Sub cmdOK_Click()
Call endDialog(IDOK)
End Sub
Private Sub cmdCancel_Click()
Call endDialog(IDCANCEL)
End Sub
Private Sub txtAuftragNr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Screen.MousePointer = vbHourglass
Call sucheAuftragsdaten
Screen.MousePointer = vbNormal
Else
txtSerienNr.text = ""
End If
End Sub
Private Sub txtPosition_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Screen.MousePointer = vbHourglass
Call sucheAuftragsdaten
Screen.MousePointer = vbNormal
Else
txtSerienNr.text = ""
End If
End Sub
Private Sub txtSerienNr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Screen.MousePointer = vbHourglass
Call sucheAuftragsdaten
Screen.MousePointer = vbNormal
Else
txtAuftragNr.text = ""
txtPosition.text = ""
End If
End Sub
Private Sub txtSerienNr_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtAuftragNr_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub
Private Sub txtPosition_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr$(KeyAscii)) Then
If KeyAscii <> 8 Then KeyAscii = 0
End If
End Sub