VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmArtikelgruppetaste 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "Wahltaste"
   ClientHeight    =   3690
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9720
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3690
   ScaleWidth      =   9720
   Begin VB.CommandButton cmdLoeschen 
      Caption         =   "Löschen"
      Height          =   600
      Left            =   5025
      TabIndex        =   19
      Top             =   2850
      Width           =   1200
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   225
      Top             =   2325
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdBeenden 
      Caption         =   "Beenden"
      Height          =   600
      Left            =   8325
      TabIndex        =   5
      Top             =   2850
      Width           =   1200
   End
   Begin VB.CommandButton cmdSpeichern 
      Caption         =   "Speichern"
      Height          =   600
      Left            =   6675
      TabIndex        =   6
      Top             =   2850
      Width           =   1200
   End
   Begin VB.CommandButton cmdSuchen 
      Caption         =   "Suchen"
      Height          =   600
      Left            =   2775
      TabIndex        =   4
      Top             =   2850
      Width           =   1200
   End
   Begin VB.Frame Frame2 
      Caption         =   "Wahltaste"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   2460
      Left            =   5025
      TabIndex        =   2
      Top             =   150
      Width           =   4485
      Begin VB.CommandButton cmdFarbe 
         Appearance      =   0  '2D
         Caption         =   "Farbe"
         Height          =   375
         Left            =   3150
         TabIndex        =   18
         Top             =   1800
         Width           =   675
      End
      Begin VB.TextBox txtFarbe 
         Appearance      =   0  '2D
         Enabled         =   0   'False
         Height          =   495
         Left            =   1700
         TabIndex        =   17
         Top             =   1725
         Width           =   1140
      End
      Begin VB.TextBox txtGerichtWahltaste 
         Appearance      =   0  '2D
         Height          =   350
         Left            =   1700
         TabIndex        =   3
         Top             =   1275
         Width           =   2500
      End
      Begin VB.TextBox txtPLUWahltaste 
         Appearance      =   0  '2D
         BackColor       =   &H80000011&
         Enabled         =   0   'False
         ForeColor       =   &H00FFFFFF&
         Height          =   350
         Left            =   1700
         Locked          =   -1  'True
         TabIndex        =   7
         Top             =   825
         Width           =   2500
      End
      Begin VB.TextBox txtderHaupttasteWahltaste 
         Appearance      =   0  '2D
         BackColor       =   &H80000011&
         Enabled         =   0   'False
         ForeColor       =   &H00FFFFFF&
         Height          =   350
         Left            =   1680
         Locked          =   -1  'True
         TabIndex        =   8
         Top             =   375
         Width           =   2500
      End
      Begin VB.Label lblFarbe 
         Caption         =   "Hintergrundfarbe"
         Height          =   255
         Left            =   150
         TabIndex        =   16
         Top             =   1875
         Width           =   1215
      End
      Begin VB.Label lblGerichtWahltaste 
         Caption         =   "Text der Wahltaste"
         Height          =   255
         Left            =   150
         TabIndex        =   15
         Top             =   1350
         Width           =   1455
      End
      Begin VB.Label lblPLUWahltaste 
         Caption         =   "PLU"
         Height          =   255
         Left            =   150
         TabIndex        =   14
         Top             =   900
         Width           =   375
      End
      Begin VB.Label lblHaupttasteWahltaste 
         Caption         =   "Text der Haupttaste"
         Height          =   255
         Left            =   150
         TabIndex        =   13
         Top             =   450
         Width           =   1455
      End
   End
   Begin VB.CommandButton cmdPfeil 
      Caption         =   "=>"
      BeginProperty Font 
         Name            =   "Tw Cen MT Condensed"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4125
      TabIndex        =   12
      Top             =   1050
      Width           =   735
   End
   Begin VB.Frame Frame1 
      Caption         =   "Speisekarte"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   2010
      Left            =   225
      TabIndex        =   0
      Top             =   150
      Width           =   3735
      Begin VB.TextBox txtGerichtSpeisekarte 
         Appearance      =   0  '2D
         BackColor       =   &H80000011&
         Enabled         =   0   'False
         Height          =   350
         Left            =   900
         Locked          =   -1  'True
         TabIndex        =   9
         Top             =   1275
         Width           =   2500
      End
      Begin VB.TextBox txtPLUSpeisekarte 
         Appearance      =   0  '2D
         Height          =   350
         Left            =   900
         TabIndex        =   1
         Top             =   825
         Width           =   2500
      End
      Begin VB.Label lblGerichtSpeisekarte 
         Alignment       =   1  'Rechts
         AutoSize        =   -1  'True
         Caption         =   "Gericht"
         Height          =   195
         Left            =   225
         TabIndex        =   11
         Top             =   1350
         Width           =   510
      End
      Begin VB.Label lblPLUSpeisekarte 
         Alignment       =   1  'Rechts
         AutoSize        =   -1  'True
         Caption         =   "PLU"
         Height          =   195
         Left            =   225
         TabIndex        =   10
         Top             =   900
         Width           =   315
      End
   End
End
Attribute VB_Name = "frmArtikelgruppetaste"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===================== FORMULAR EREIGNISSE ====================
'==============================================================
Private Sub Form_Load()
frmDirektwahltasteVerwaltung.MSHFlexGrid1.Visible = False
Me.Left = (MDIHauptmenu.ScaleWidth - frmLink.Width) / 2 - Me.Width / 2
Me.Top = 200
End Sub
'===================== COMMANDBUTTON EREIGNISSE ====================
'===================================================================
Private Sub cmdSuchen_Click()
frmSpeisekarteSuchen.Show 1
End Sub
Private Sub cmdPfeil_Click()
If txtPLUSpeisekarte = "" Then
    MsgBox "Das Feld 'PLU' ist Leer. Bitte wähllen Sie ein Gericht aus!"
    Exit Sub
ElseIf (Me.PLUDatenbankAbfrage) = True Then
    Me.txtPLUWahltaste = Me.txtPLUSpeisekarte
    Me.txtGerichtWahltaste = Me.txtGerichtSpeisekarte
ElseIf (Me.PLUDatenbankAbfrage) = False Then
    MsgBox "Dieser 'PLU' ist nicht vorhanden. Bitte erstellen Sie zuerst eine neue PLU-Nummer!"
End If
End Sub
Private Sub cmdFarbe_Click()
Call HintergrundfarbeAuswaehlen
End Sub
Private Sub CmdSpeichern_Click()
'Werte übergeben
VarIDLokal = frmDirektwahltasteVerwaltung.Wertuebergeben("VarIDAktuell")
VarSpalteLokal = frmDirektwahltasteVerwaltung.Wertuebergeben("VarSpalteAktuell")
VarWGLokal = frmDirektwahltasteVerwaltung.Wertuebergeben("VarWarengruppeAktuell")

'Werte in der Datenbank speichern
Call Me.Datenbankaktualisieren(VarIDLokal, VarSpalteLokal, Me.txtGerichtWahltaste.Text, Me.txtPLUWahltaste.Text, Me.txtFarbe.BackColor)
'Alle tasten werden aktuallisiert
Call frmDirektwahltasteVerwaltung.WahltastenAktualisieren(VarWGLokal)
End Sub
Private Sub cmdLoeschen_Click()
Me.txtGerichtWahltaste.Text = ""
Me.txtPLUWahltaste.Text = ""
Me.txtFarbe.BackColor = &H8000000F
End Sub
Private Sub cmdBeenden_Click()
Unload Me
End Sub
'===================== TEXT ====================
'===============================================
Private Sub txtPLUSpeisekarte_Change()
X = Me.PLUDatenbankAbfrage
End Sub
'===================== FARBE STEUERELEMENT ====================
'==============================================================
Sub HintergrundfarbeAuswaehlen()
   ' "Abbrechen" auf "True" setzen.
   CommonDialog1.CancelError = True
   On Error GoTo ErrHandler
   ' Flags-Eigenschaft setzen.
   CommonDialog1.Flags = cdlCCRGBInit
   ' Dialogfeld "Farbe" anzeigen.
   CommonDialog1.Color = &H80C0FF
   CommonDialog1.ShowColor
   ' Hintergrundfarbe des Formulars auf die
   ' ausgewählte Farbe einstellen.
   
   'mshflgrdSchnellwahltaste.CellBackColor = CommonDialog1.Color
   Me.txtFarbe.BackColor = CommonDialog1.Color
Text1.Text = Hex(CommonDialog1.Color)

ErrHandler:
   ' Benutzer hat auf Abbrechen-Schaltfläche geklickt.
   Exit Sub
End Sub
'===================== PROZEDUREN ====================
'=====================================================
Function PLUDatenbankAbfrage()

Dim objConn As ADODB.Connection
Dim rsDirektwahltaste As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsDirektwahltaste = 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=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With


  With rsDirektwahltaste
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select PLU,Gericht FROM Artikelgruppe Where PLU='" & Me.txtPLUSpeisekarte.Text & "'"
 End With

 If rsDirektwahltaste.EOF = False Then
  Me.txtGerichtSpeisekarte.Text = rsDirektwahltaste.Fields("Gericht").Value
  PLUDatenbankAbfrage = True
 Else
  Me.txtGerichtSpeisekarte = "PLU ='" & Me.txtPLUSpeisekarte & "' ist nicht vorhanden"
  PLUDatenbankAbfrage = False
 End If
 

Set rsDirektwahltaste = 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 rsDirektwahltaste = Nothing
Set objConn = Nothing
End Function
'----------- Daten speichern --------------


Sub Datenbankaktualisieren(VarlokalID, VarLokalSpalte, VarLokalGericht, VarLokalPLU, VarLokalFarbe)
Dim objConn As ADODB.Connection
Dim rsArtikeltasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsArtikeltasten = New ADODB.Recordset
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=" & VarDatenbank
    .CursorLocation = adUseClient
    .Open
  End With

With rsArtikeltasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM ArtikelTasten Where ID =" & VarlokalID & ""
End With

If Not rsArtikeltasten.EOF Then
 rsArtikeltasten.Fields("SP" & VarLokalSpalte).Value = VarLokalGericht
 rsArtikeltasten.Fields("SP" & VarLokalSpalte & "PLU").Value = VarLokalPLU
 rsArtikeltasten.Fields("SP" & VarLokalSpalte & "Farbe").Value = VarLokalFarbe
End If

rsArtikeltasten.Update


exit_Sub:
  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
    
  Resume exit_Sub

Set objConn = Nothing
Set rsArtikeltasten = Nothing
End Sub

