VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmExtra 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000003&
   BorderStyle     =   3  'Fester Dialog
   Caption         =   "Extra"
   ClientHeight    =   7275
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   9270
   FillStyle       =   0  'Ausgefüllt
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   10.5
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7275
   ScaleWidth      =   9270
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdOk 
      Caption         =   "Ok"
      Height          =   615
      Left            =   7320
      Style           =   1  'Grafisch
      TabIndex        =   3
      Top             =   5160
      Width           =   1300
   End
   Begin VB.Frame Frame1 
      Height          =   2895
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   7575
      Begin MSComctlLib.ListView ListViewExtra 
         Height          =   2445
         Left            =   360
         TabIndex        =   2
         Top             =   240
         Width           =   2055
         _ExtentX        =   3625
         _ExtentY        =   4313
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Arial"
            Size            =   14.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   0
      End
   End
   Begin VB.CommandButton cmdAbbrechen 
      Caption         =   "Abbrechen"
      Height          =   600
      Left            =   5400
      Style           =   1  'Grafisch
      TabIndex        =   0
      Top             =   5160
      Width           =   1300
   End
End
Attribute VB_Name = "frmExtra"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim VarcmdTastenIndex
'====================   FORMS EREIGNISSE  ====================
'=============================================================
Private Sub Form_Load()
 Me.Height = 0.6 * MDIHauptmenu.ScaleHeight
 Me.Width = 0.4 * MDIHauptmenu.ScaleWidth
 Me.Left = MDIHauptmenu.ScaleWidth / 2 - Me.Width / 2
 Me.Top = MDIHauptmenu.ScaleHeight / 2 - Me.Height / 2

AbstandRand = Me.Height / 40

Me.Frame1.Top = AbstandRand
Me.Frame1.Left = AbstandRand
Me.Frame1.Width = Me.ScaleWidth - 2 * AbstandRand
Me.Frame1.Height = Me.ScaleHeight - 8 * AbstandRand

Me.ListViewExtra.Top = 0
Me.ListViewExtra.Left = 0
Me.ListViewExtra.Width = Me.Frame1.Width
Me.ListViewExtra.Height = Me.Frame1.Height

Me.cmdOk.Top = Me.Frame1.Top + Me.Frame1.Height + AbstandRand
Me.cmdOk.Left = Me.Frame1.Left + Me.Frame1.Width - Me.cmdOk.Width
Me.cmdOk.Height = 4 * AbstandRand

Me.cmdAbbrechen.Top = Me.cmdOk.Top
Me.cmdAbbrechen.Left = Me.cmdOk.Left - Me.cmdAbbrechen.Width - AbstandRand
Me.cmdAbbrechen.Height = Me.cmdOk.Height

Me.BackColor = &H80000003
Me.cmdOk.BackColor = &H80000002
Me.cmdAbbrechen.BackColor = &H80000002
Call Me.ListViewExtraFuelen
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.cmdOk.BackColor = &H80000002
Me.cmdAbbrechen.BackColor = &H80000002
End Sub


'====================   COMMANDBUTTON EREIGNISSE  ====================
'=====================================================================
Private Sub cmdAbbrechen_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Me.cmdOk.BackColor = &H80000002
  Me.cmdAbbrechen.BackColor = &H80C0FF
End Sub

Private Sub cmdOk_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Me.cmdOk.BackColor = &H80C0FF
  Me.cmdAbbrechen.BackColor = &H80000002
End Sub
Private Sub cmdAbbrechen_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Call Me.ExtraEintragen
Unload Me
End Sub

'====================== LIST VIEW EREIGNISSE ==========================
'======================================================================

Private Sub ListViewExtra_BeforeLabelEdit(Cancel As Integer)
For I = 1 To 5
 SendKeys "{ESC}"
Next I
End Sub

Private Sub ListViewExtra_ItemCheck(ByVal Item As MSComctlLib.ListItem)

If ListViewExtraPrueffenPLU(Item.Tag) = True Then
 MsgBox "'" & Item.ListSubItems.Item(1).Text & "'" & " ist für dieses Gericht bereits gewählt"
 Item.Checked = False
End If
End Sub

Private Sub ListViewExtra_ItemClick(ByVal Item As MSComctlLib.ListItem)
If ListViewExtraPrueffenPLU(Item.Tag) = True Then
 MsgBox "'" & Item.ListSubItems.Item(1).Text & "'" & " ist für dieses Gericht bereits gewählt"
 Item.Checked = False
 Exit Sub
End If

If Item.Checked = True Then
 Item.Checked = False
Else
 Item.Checked = True
End If
End Sub
'====================   PROZEDUREN  ====================
'=====================================================================
Sub ListViewExtraFuelen()

Dim objConn As ADODB.Connection
Dim rsArtikelgruppe As ADODB.Recordset
  
Set objConn = New ADODB.Connection
Set rsArtikelgruppe = New ADODB.Recordset

Dim strPath As String

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsArtikelgruppe
    .ActiveConnection = objConn
    '.CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select PLU,Gericht FROM Artikelgruppe where WG = 'Extra'"
    '.Open "Select PLU,Gericht FROM Artikelgruppe where WG = '" & VarMitarbeiterLokal & "'"

  
  End With
  
   
   ListViewExtra.ColumnHeaders.Clear
   ListViewExtra.ListItems.Clear
   
   ListViewExtra.View = lvwReport
   ListViewExtra.GridLines = True
   ListViewExtra.FullRowSelect = True
   ListViewExtra.Checkboxes = True
      
      
   ListViewExtra.ColumnHeaders.Add , , "", 0.08 * ListViewExtra.Width
   ListViewExtra.ColumnHeaders.Add , , "Extra", 0.9 * ListViewExtra.Width 'lvwColumnCenter


While Not rsArtikelgruppe.EOF
    Index = rsArtikelgruppe.AbsolutePosition
    ListViewExtra.ListItems.Add  'Hauptelemente einfügen
    ListViewExtra.ListItems(Index).Tag = rsArtikelgruppe.Fields("PLU").Value

    If Not IsNull(rsArtikelgruppe.Fields("Gericht").Value) And Not IsNull(rsArtikelgruppe.Fields("PLU").Value) Then
      ListViewExtra.ListItems(Index).ListSubItems.Add , , rsArtikelgruppe.Fields("Gericht").Value
      'ListViewExtra.ListItems(Index).ListSubItems.Item(0).Tag = rsArtikelgruppe.Fields("EPREIS").Value
    End If
  rsArtikelgruppe.MoveNext   ' Nächster Datensatz.
Wend


Set rsArtikelgruppe = Nothing
Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsArtikelgruppe = Nothing
Set objConn = Nothing

End Sub
Function ListViewExtraPrueffenPLU(VarPLULokal)

Dim objConn As ADODB.Connection
Dim rsListViewExtraPrueffenPLU As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsListViewExtraPrueffenPLU = New ADODB.Recordset

Dim strPath As String

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

  VarRegIDLokal = frmTisch.dgrTisch.Columns("RegID").Text
  
  
  With rsListViewExtraPrueffenPLU
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select *FROM OffeneTische where RegID = " & VarRegIDLokal & " and PLU_ID = '" & VarPLULokal & "'"
    '.Open "Select PLU,Gericht FROM Artikelgruppe where WG = '" & VarMitarbeiterLokal & "'"
 End With


If Not rsListViewExtraPrueffenPLU.EOF Then
 ListViewExtraPrueffenPLU = True
End If
  

Set rsListViewExtraPrueffenPLU = Nothing
Set rsArtikelgruppe = Nothing
Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Function

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsListViewExtraPrueffenPLU = Nothing
Set rsArtikelgruppe = Nothing
Set objConn = Nothing

End Function
Sub ExtraEintragen()

Dim objConn As ADODB.Connection
Dim rsArtikelgruppe As ADODB.Recordset
Dim rsOffeneTische As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsArtikelgruppe = New ADODB.Recordset
Set rsOffeneTische = New ADODB.Recordset

Dim strPath As String

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

 
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

  VarIDLokal = frmTisch.dgrTisch.Columns("ID").Text
  VarIDMenge = frmTisch.dgrTisch.Columns("Menge").Text
  
  With rsOffeneTische
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "Select *FROM OffeneTische where ID = " & VarIDLokal & " "
    '.Open "Select PLU,Gericht FROM Artikelgruppe where WG = '" & VarMitarbeiterLokal & "'"
 End With

rsOffeneTische.Fields("Extra").Value = "Ja"




For I = 1 To ListViewExtra.ListItems.Count
  If ListViewExtra.ListItems.Item(I).Checked = True Then
    With rsArtikelgruppe
      .ActiveConnection = objConn
      .CursorLocation = adUseClient
      .LockType = adLockPessimistic
      .Open "Select *FROM Artikelgruppe where PLU = '" & ListViewExtra.ListItems.Item(I).Tag & "'"
    End With
    rsOffeneTische.AddNew
    rsOffeneTische.Fields("RegID").Value = frmTisch.dgrTisch.Columns("ID").Text
   
    rsOffeneTische.Fields("Kellner").Value = VarKellner
    rsOffeneTische.Fields("Station").Value = VarStation
    rsOffeneTische.Fields("Tisch") = VarTisch
    rsOffeneTische.Fields("TischDetails") = "Neu"
    rsOffeneTische.Fields("Stationsdrucker").Value = rsArtikelgruppe.Fields("Stationsdrucker").Value
    rsOffeneTische.Fields("Bondrucker").Value = rsArtikelgruppe.Fields("Bondrucker").Value
    rsOffeneTische.Fields("IDWG").Value = rsArtikelgruppe.Fields("IDWG").Value
    rsOffeneTische.Fields("WG").Value = rsArtikelgruppe.Fields("WG").Value
    rsOffeneTische.Fields("PLU_ID").Value = rsArtikelgruppe.Fields("PLU").Value
    rsOffeneTische.Fields("Extra").Value = "Ja"
    rsOffeneTische.Fields("Kommentar").Value = "Nein"
    rsOffeneTische.Fields("Menge").Value = VarIDMenge
    rsOffeneTische.Fields("Gericht").Value = "+ " & VarIDMenge & "x " & rsArtikelgruppe.Fields("Gericht").Value
    rsOffeneTische.Fields("EPREIS").Value = rsArtikelgruppe.Fields("EPREIS").Value
    rsOffeneTische.Fields("GPREIS").Value = Format(VarIDMenge * rsOffeneTische.Fields("EPREIS"), "#####0.00")
    
    If Time < "04:00:00" Then
        VarDatumAktuel = CStr(Date - 1)
    Else
        VarDatumAktuel = CStr(Date)
    End If
    rsOffeneTische.Fields("Datum").Value = VarDatumAktuel
    rsOffeneTische.Fields("Zeit") = Time

    
    rsOffeneTische.Update 'Recordset Aktualisieren
    rsOffeneTische.Requery 'Datenbank Aktualisieren
    rsArtikelgruppe.Close
  End If
Next I
   Call mdlDatenbanken.TischAktualisieren(VarTisch, "Neu")
   frmTisch.cmdTisch.Caption = "Neu"

Set rsOffeneTische = Nothing
Set rsArtikelgruppe = Nothing
Set objConn = Nothing
exit_Sub:
  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub
Set rsOffeneTische = Nothing
Set rsArtikelgruppe = Nothing
Set objConn = Nothing

End Sub