VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSpeisekarte 
   BorderStyle     =   0  'Kein
   Caption         =   "Form1"
   ClientHeight    =   4035
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9990
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4035
   ScaleWidth      =   9990
   ShowInTaskbar   =   0   'False
   Begin MSComctlLib.TreeView TreeViewWarengruppe 
      Height          =   2850
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   3225
      _ExtentX        =   5689
      _ExtentY        =   5027
      _Version        =   393217
      LineStyle       =   1
      Style           =   7
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.ListView ListViewArtikelgruppe 
      Height          =   3285
      Left            =   4080
      TabIndex        =   1
      Top             =   600
      Width           =   3735
      _ExtentX        =   6588
      _ExtentY        =   5794
      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            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   0
   End
   Begin VB.Menu mnuGericht 
      Caption         =   "Gericht"
      Visible         =   0   'False
      Begin VB.Menu mnuNeuesGericht 
         Caption         =   "Neues Gericht"
      End
      Begin VB.Menu mnuGerichtBearbeiten 
         Caption         =   "Bearbeiten"
      End
      Begin VB.Menu mnuLinie1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuGerichtLoeschen 
         Caption         =   "Löschen"
      End
   End
   Begin VB.Menu mnuWarengruppen 
      Caption         =   "Warengruppen"
      Visible         =   0   'False
      Begin VB.Menu mnuNeueWarengruppe 
         Caption         =   "Neue Warengruppe"
      End
      Begin VB.Menu mnuWGBearbeiten 
         Caption         =   "Bearbeiten"
      End
      Begin VB.Menu mnuLinie3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuWGLoeschen 
         Caption         =   "Warengruppe Löschen"
      End
   End
End
Attribute VB_Name = "frmSpeisekarte"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'====================== FORMULAR EREIGNISSE ===================
'==============================================================
Private Sub Form_Load()
'mnuGericht.Visible = False
'Toolbar1.Visible = False
Call mdlVerwalltung.SpeisekartePos
Call Warengruppe
End Sub
'====================== MENU GERICHT EREIGNISSE ===================
'==================================================================
Private Sub mnuNeuesGericht_Click()
frmGericht.txtWarengruppe.Text = TreeViewWarengruppe.SelectedItem.Text
frmGericht.Show 1
End Sub
Private Sub mnuGerichtBearbeiten_Click()
frmGericht.txtWarengruppe = TreeViewWarengruppe.SelectedItem.Text
frmGericht.ArtikelBearbeitenZeigen
frmGericht.Show 1
End Sub
Private Sub mnuGerichtLoeschen_Click()
Call frmGericht.ArtikelLoeschen
Call frmSpeisekarte.Artikelgruppe(TreeViewWarengruppe.SelectedItem.Text)
End Sub
'====================== MENU WARENGRUPPE EREIGNISSE ===================
'==================================================================
Private Sub mnuNeueWarengruppe_Click()
Me.TreeViewWarengruppe.SelectedItem.Expanded = True
If Me.TreeViewWarengruppe.SelectedItem.Children <> 0 Then
 Me.TreeViewWarengruppe.SelectedItem.Child.Selected = True
End If
frmWarengruppe.txtHauptwarengruppen.Text = Me.TreeViewWarengruppe.SelectedItem.Parent
frmWarengruppe.Show 1
End Sub
Private Sub mnuWGBearbeiten_Click()
Me.TreeViewWarengruppe.SelectedItem.Expanded = True
If Me.TreeViewWarengruppe.SelectedItem.Children <> 0 Then
 Me.TreeViewWarengruppe.SelectedItem.Child.Selected = True
End If
frmWarengruppe.txtHauptwarengruppen.Text = Me.TreeViewWarengruppe.SelectedItem.Parent
frmWarengruppe.WarengruppeBearbeitenZeigen
frmWarengruppe.Show 1
End Sub
Private Sub mnuWGLoeschen_Click()
Call frmWarengruppe.AllesLoeschen
Call Artikelgruppe(frmWarengruppe.txtWarengruppe.Text)
Call Me.Warengruppe
End Sub
'=======================  TreeView EREIGNISSE =======================
'==================================================================================
Private Sub TreeViewWarengruppe_BeforeLabelEdit(Cancel As Integer)
For I = 1 To 5
 SendKeys "{ESC}"
Next I
End Sub
Private Sub TreeViewWarengruppe_LostFocus()
TreeViewWarengruppe.SelectedItem.BackColor = &H8000000D
End Sub
Private Sub TreeViewWarengruppe_NodeClick(ByVal Node As MSComctlLib.Node)
For I = 1 To TreeViewWarengruppe.Nodes.Count
      ' Alle Knoten durchlaufen lassen
       TreeViewWarengruppe.Nodes(I).BackColor = &H80000005
       TreeViewWarengruppe.Nodes(I).ForeColor = &H80000012
   Next I
Call Me.Artikelgruppe(TreeViewWarengruppe.SelectedItem.Text)
End Sub
Private Sub TreeViewWarengruppe_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
  Set_MenuColor mMenuColor, MDIHauptmenu.Hwnd, &H80000016, 1, False
  Set_MenuColor mMenuBarColor, MDIHauptmenu.Hwnd, vbRed
  Set_MenuColor mSysMenuColor, MDIHauptmenu.Hwnd, vbYellow
 End If
End Sub
Private Sub TreeViewWarengruppe_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
  If TreeViewWarengruppe.HitTest(X, Y) Is Nothing Or Me.TreeViewWarengruppe.SelectedItem.Children <> 0 Then
   mnuNeueWarengruppe.Enabled = True
   mnuWGBearbeiten.Enabled = False
   mnuWGLoeschen.Enabled = False
  Else
   mnuNeueWarengruppe.Enabled = True
   mnuWGBearbeiten.Enabled = True
   mnuWGLoeschen.Enabled = True
End If
  PopupMenu mnuWarengruppen
End If
End Sub

'=======================  ListView EREIGNISSE =======================
'====================================================================================
Private Sub ListViewArtikelgruppe_BeforeLabelEdit(Cancel As Integer)
For I = 1 To 5
 SendKeys "{ESC}"
Next I
End Sub
Private Sub ListViewArtikelgruppe_DblClick()
frmGericht.txtWarengruppe = TreeViewWarengruppe.SelectedItem.Text
frmGericht.ArtikelBearbeitenZeigen
frmGericht.Show 1
End Sub
Private Sub ListViewArtikelgruppe_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 2 Then
  'Set_MenuColor mMenuColor, MDIHauptmenu.Hwnd, &H80000016, 1, False
  'Set_MenuColor mMenuBarColor, MDIHauptmenu.Hwnd, vbRed
  'Set_MenuColor mSysMenuColor, MDIHauptmenu.Hwnd, vbYellow
  PopupMenu mnuGericht
 End If
End Sub

'============================  PROZEDUREN ===============================
'=========================================================================
'-------Tabelle Warengruppe abfragen-------------

Sub Warengruppe()
Dim objConn As ADODB.Connection
Dim rsWarengruppe As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsWarengruppe = 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
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsWarengruppe
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    rsWarengruppe.Source = "Select *FROM Warengruppe ORDER BY WG"
    .Open
  
   End With
 
 TreeViewWarengruppe.Nodes.Clear
 'TreeViewWarengruppe.Nodes.Add , , "C", "Alle Warengruppe"

 TreeViewWarengruppe.Nodes.Add , , "G", "Getränke"
 
 TreeViewWarengruppe.Nodes.Add , , "S", "Speise"

  While Not rsWarengruppe.EOF
     If rsWarengruppe.Fields("IDWG").Value = "Getränke" Then
       TreeViewWarengruppe.Nodes.Add "G", tvwChild, , rsWarengruppe.Fields("WG").Value
    Else
     TreeViewWarengruppe.Nodes.Add "S", tvwChild, , rsWarengruppe.Fields("WG").Value
    End If
     rsWarengruppe.MoveNext
  Wend
 
 

Set rsWarengruppe = 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 rsWarengruppe = Nothing
Set objConn = Nothing


End Sub
'---------Tabelle Artikelgruppe abfragen-------------
Sub Artikelgruppe(VarWG)
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
    .ConnectionString = "Data Source=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With


  With rsArtikelgruppe
    .ActiveConnection = objConn
    '.CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open "SELECT WG,PLU,Gericht,EPREIS FROM Artikelgruppe where WG = '" & VarWG & "' ORDER by PLU"
  End With
  
  If rsArtikelgruppe.EOF = False Then
  mnuGerichtBearbeiten.Enabled = True
  mnuGerichtLoeschen.Enabled = True
  Else
  mnuGerichtBearbeiten.Enabled = False
  mnuGerichtLoeschen.Enabled = False
  End If
  
  
 
   ' Erstellen einer Variablen zum Hinzufügen
   ' von ListItem-Objekten.
   Dim itmX As ListItem
ListViewArtikelgruppe.ColumnHeaders.Clear
ListViewArtikelgruppe.ListItems.Clear
 ' Hinzufügen der Spaltenköpfe. Die Breite der
   ' Spalten entspricht der Breite des Steuerelements
   ' dividiert durch die Anzahl der Spalten.
   ListViewArtikelgruppe.ColumnHeaders.Add , , "PLU", 0.15 * ListViewArtikelgruppe.Width
   ListViewArtikelgruppe.ColumnHeaders.Add , , "Gericht", 0.65 * ListViewArtikelgruppe.Width 'lvwColumnCenter
   ListViewArtikelgruppe.ColumnHeaders.Add , , "EPREIS", 0.2 * ListViewArtikelgruppe.Width 'lvwColumnCenter

   ' View-Eigenschaft auf ReportKellnerBericht setzen.
   ListViewArtikelgruppe.View = lvwReport
    ListViewArtikelgruppe.GridLines = True
   ListViewArtikelgruppe.FullRowSelect = True


   ' Solange der aktuelle Datensatz nicht dem letzten
   ' Datensatz entspricht, werden weiter
   ' ListItem-Objekte hinzugefügt.
   ' Für Text des ListItem-Objekts wird das Feld
   ' "Name" verwendet.
   ' Für Unterelement 1 des ListItem-Objekts wird das
   ' Feld "Vorname" verwendet.
   ' Für Unterelement 2 des ListItem-Objekts wird das
   ' Feld "Year Born" verwendet.

   
   While Not rsArtikelgruppe.EOF
     
      Set itmX = ListViewArtikelgruppe.ListItems.Add(, , rsArtikelgruppe.Fields("PLU").Value)
      itmX.Tag = itmX.Index
      ' Wenn das Feld "Name" ungleich Null ist,
      ' Unterelement 1 auf dieses Feld setzen.

      If Not IsNull(rsArtikelgruppe.Fields("Gericht").Value) Then
         itmX.SubItems(1) = rsArtikelgruppe.Fields("Gericht").Value
      End If
      ' Wenn das Feld "Year Born" ungleich Null ist,
      ' Unterelement 2 auf dieses Feld setzen.
      If Not IsNull(rsArtikelgruppe.Fields("EPREIS").Value) Then
         itmX.SubItems(2) = Format(rsArtikelgruppe.Fields("EPREIS").Value, "####.00")
      'itmX.SubItems(2).Text =
     'ListViewArtikelgruppe.ListItems.Item(1).ListSubItems(2).Text = Format(rsArtikelgruppe.Fields("EPREIS").Value, "###,##0.00")
      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
