VERSION 5.00
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmDirektwahltasteVerwaltung 
   BackColor       =   &H000000FF&
   BorderStyle     =   0  'Kein
   Caption         =   "Form1"
   ClientHeight    =   5310
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   10695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   NegotiateMenus  =   0   'False
   ScaleHeight     =   5310
   ScaleWidth      =   10695
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Height          =   3855
      Left            =   1740
      TabIndex        =   0
      Top             =   600
      Width           =   7335
      Begin VB.PictureBox Picture1 
         Appearance      =   0  '2D
         BackColor       =   &H80000003&
         ForeColor       =   &H80000008&
         Height          =   3375
         Left            =   2400
         ScaleHeight     =   3345
         ScaleWidth      =   4185
         TabIndex        =   1
         Top             =   240
         Width           =   4215
         Begin VB.CommandButton cmdWG 
            BackColor       =   &H80000002&
            Caption         =   "Command1"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   9.75
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   435
            Index           =   0
            Left            =   360
            MaskColor       =   &H000000FF&
            Style           =   1  'Grafisch
            TabIndex        =   5
            Top             =   1080
            Visible         =   0   'False
            Width           =   1275
         End
         Begin VB.VScrollBar VScroll1 
            Height          =   1095
            LargeChange     =   10
            Left            =   1920
            Max             =   100
            SmallChange     =   10
            TabIndex        =   4
            Top             =   360
            Width           =   435
         End
         Begin VB.TextBox Text1 
            Appearance      =   0  '2D
            BackColor       =   &H8000000F&
            BorderStyle     =   0  'Kein
            Enabled         =   0   'False
            BeginProperty Font 
               Name            =   "Tahoma"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   195
            Index           =   0
            Left            =   240
            TabIndex        =   3
            Text            =   "Text1"
            Top             =   240
            Visible         =   0   'False
            Width           =   375
         End
         Begin VB.TextBox Text2 
            Appearance      =   0  '2D
            BackColor       =   &H8000000D&
            BorderStyle     =   0  'Kein
            Enabled         =   0   'False
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   300
            Left            =   1200
            TabIndex        =   2
            Text            =   "Text2"
            Top             =   600
            Visible         =   0   'False
            Width           =   540
         End
         Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
            Height          =   345
            Left            =   840
            TabIndex        =   6
            Top             =   120
            Width           =   825
            _ExtentX        =   1455
            _ExtentY        =   609
            _Version        =   393216
            BackColor       =   -2147483635
            Rows            =   1
            Cols            =   1
            FixedRows       =   0
            FixedCols       =   0
            WordWrap        =   -1  'True
            TextStyle       =   1
            ScrollBars      =   0
            Appearance      =   0
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Verdana"
               Size            =   9
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            _NumberOfBands  =   1
            _Band(0).Cols   =   1
            _Band(0).TextStyleBand=   1
         End
         Begin MSHierarchicalFlexGridLib.MSHFlexGrid mshflgrdSchnellwahltaste 
            Height          =   1275
            Left            =   120
            TabIndex        =   7
            Top             =   1680
            Width           =   1995
            _ExtentX        =   3519
            _ExtentY        =   2249
            _Version        =   393216
            BackColor       =   -2147483633
            ForeColor       =   0
            Rows            =   1
            Cols            =   1
            FixedRows       =   0
            FixedCols       =   0
            BackColorSel    =   -2147483646
            ForeColorSel    =   -2147483630
            WordWrap        =   -1  'True
            TextStyleFixed  =   1
            FocusRect       =   0
            HighLight       =   0
            GridLines       =   3
            GridLinesFixed  =   3
            ScrollBars      =   0
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Verdana"
               Size            =   9
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Tahoma"
               Size            =   9.75
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   -1  'True
               Strikethrough   =   0   'False
            EndProperty
            _NumberOfBands  =   1
            _Band(0).Cols   =   1
         End
         Begin MSDataGridLib.DataGrid DataGrid1 
            Height          =   975
            Left            =   2520
            TabIndex        =   8
            Top             =   240
            Visible         =   0   'False
            Width           =   1455
            _ExtentX        =   2566
            _ExtentY        =   1720
            _Version        =   393216
            HeadLines       =   1
            RowHeight       =   15
            BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Verdana"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "Verdana"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ColumnCount     =   2
            BeginProperty Column00 
               DataField       =   ""
               Caption         =   ""
               BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                  Type            =   0
                  Format          =   ""
                  HaveTrueFalseNull=   0
                  FirstDayOfWeek  =   0
                  FirstWeekOfYear =   0
                  LCID            =   1031
                  SubFormatType   =   0
               EndProperty
            EndProperty
            BeginProperty Column01 
               DataField       =   ""
               Caption         =   ""
               BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                  Type            =   0
                  Format          =   ""
                  HaveTrueFalseNull=   0
                  FirstDayOfWeek  =   0
                  FirstWeekOfYear =   0
                  LCID            =   1031
                  SubFormatType   =   0
               EndProperty
            EndProperty
            SplitCount      =   1
            BeginProperty Split0 
               BeginProperty Column00 
               EndProperty
               BeginProperty Column01 
               EndProperty
            EndProperty
         End
      End
      Begin VB.Shape shpSchnellwahltaste 
         BackColor       =   &H80000003&
         BorderColor     =   &H00808080&
         BorderWidth     =   5
         FillColor       =   &H000000FF&
         Height          =   1260
         Left            =   240
         Top             =   360
         Width           =   1695
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2640
      Top             =   3120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu mnuWahltasten 
      Caption         =   "Wahltasten"
      Visible         =   0   'False
      Begin VB.Menu mnuWahltasteBearbeiten 
         Caption         =   "Wahltaste Bearbeiten"
      End
      Begin VB.Menu mnuWahltasteLoeschen 
         Caption         =   "Wahltaste Löschen"
      End
      Begin VB.Menu mnuWahltasteTrennlinie1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHintergrundfarbeAuswaehlen 
         Caption         =   "Hintergrundfarbe auswählen"
      End
   End
   Begin VB.Menu mnuHaupttasten 
      Caption         =   "Haupttasten"
      Visible         =   0   'False
      Begin VB.Menu mnuHaupttasteBearbeiten 
         Caption         =   "Hauptaste Bearbeiten"
      End
      Begin VB.Menu mnuHaupttasteEntfernen 
         Caption         =   "Haupttaste entfernen"
      End
      Begin VB.Menu mnuHaupttasteTrennlinie1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuNeueHaupttaste 
         Caption         =   "Neue Haupttaste"
      End
   End
End
Attribute VB_Name = "frmDirektwahltasteVerwaltung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VarcmdTastenIndex, Zwischenabstand, VarHauptasteMarkierung
Dim VarcmdIndexAktuell, VarIDAktuell, VarSpalteAktuell, VarWarengruppeAktuell, VarGerichtAktuell, VarPLUAktuell, VarFarbeAktuell

'====================   FORMS EREIGNISSE  ====================
'=============================================================
Private Sub Form_Load()

AbstandInnen = MDIHauptmenu.ScaleHeight / 60
'Positionieren von Me Formular

Me.Width = frmSchnellwahltaste.Width + 2 * AbstandInnen
Me.Left = (Screen.Width - frmLink.Width) / 2 - Me.Width / 2
Me.Top = Screen.Height / 2 - Me.Height / 2

Me.Height = frmSchnellwahltaste.Height + 2 * AbstandInnen


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

Me.shpSchnellwahltaste.Left = AbstandInnen
Me.shpSchnellwahltaste.Top = AbstandInnen
Me.shpSchnellwahltaste.Width = frmSchnellwahltaste.Width
Me.shpSchnellwahltaste.Height = frmSchnellwahltaste.Height

Me.Picture1.Top = 2 * AbstandInnen
Me.Picture1.Left = 2 * AbstandInnen
Me.Picture1.Width = Me.shpSchnellwahltaste.Width - 2 * AbstandInnen
Me.Picture1.Height = Me.shpSchnellwahltaste.Height - 2 * AbstandInnen


Me.mshflgrdSchnellwahltaste.Top = 0
Me.mshflgrdSchnellwahltaste.Left = 0.25 * Me.Picture1.Width
Me.mshflgrdSchnellwahltaste.Height = Me.Picture1.Height
Me.mshflgrdSchnellwahltaste.Width = Me.Picture1.Width - Me.mshflgrdSchnellwahltaste.Left


Me.VScroll1.Top = 0
Me.VScroll1.Left = Me.mshflgrdSchnellwahltaste.Left - Me.VScroll1.Width
Me.VScroll1.Height = Me.mshflgrdSchnellwahltaste.Height

Me.cmdWG.Item(0).Top = 0
Me.cmdWG.Item(0).Left = AbstandInnen / 2
Me.cmdWG.Item(0).Height = Me.mshflgrdSchnellwahltaste.Height / 8
Me.cmdWG.Item(0).Width = Me.VScroll1.Left - AbstandInnen


Call Me.HaupttastenAktualliseren   'Aktualisiert alle Haupttasten aus der Datenbank

VarWarengruppeAktuell = Me.cmdWG.Item(1).Caption
Call Me.WahltastenAktualisieren(VarWarengruppeAktuell)

Me.MSHFlexGrid1.Visible = False



End Sub
'====================   FRAME EREIGNISSE  ====================
'===================================================================
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MSHFlexGrid1.Visible = False
For I = 0 To Me.cmdWG.Count - 1
 If Me.cmdWG.Item(I).BackColor = &H80C0FF Then
    Me.cmdWG.Item(I).BackColor = &H80000002
 End If
Next I
End Sub

'====================   Picture EREIGNISSE  ====================
'===================================================================
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MSHFlexGrid1.Visible = False
VarcmdTastenIndex = ""
For I = 0 To Me.cmdWG.Count - 1
 If Me.cmdWG.Item(I).BackColor = &H80C0FF Then
    Me.cmdWG.Item(I).BackColor = &H80000002
 End If
Next I
End Sub
'====================   COMMANDBUTTONS EREIGNISSE  ====================
'======================================================================
Private Sub cmdWG_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If VarcmdTastenIndex = Index Then Exit Sub ' focus vorhanden Wegen Bildzittern gehe raus

For I = 0 To Me.cmdWG.Count - 1
  
  If I = Index Then
    Me.cmdWG.Item(I).BackColor = &H80C0FF '&H80C0FF
    Me.cmdWG.Item(I).MousePointer = 99
    Set Me.cmdWG.Item(I).MouseIcon = LoadPicture(App.Path & "\Cursors\harrow.cur")
  Else
    Me.cmdWG.Item(I).BackColor = &H80000002
  End If
 
  If I = VarHauptasteMarkierung Then
    Me.cmdWG.Item(I).BackColor = &H46A3FF
  End If

Next I
 VarcmdTastenIndex = Index
End Sub
Private Sub cmdWG_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
MSHFlexGrid1.Visible = False
'Aktualisiert alle Wahltasten aus der Datenbank (Gericht, PLU, Hintergrunfarbe)
Call Me.WahltastenAktualisieren(Me.cmdWG(Index).Caption)
VarWarengruppeAktuell = Me.cmdWG(Index).Caption 'Aktuelle Warrengruppe wird gespeichert
VarcmdIndexAktuell = Index
If Button = 2 And Me.cmdWG.Item(Index).BackColor = &H46A3FF Then
    PopupMenu Me.mnuHaupttasten
End If

End Sub
Private Sub cmdWG_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
For I = 0 To Me.cmdWG.Count - 1
 Me.cmdWG.Item(I).BackColor = &H80000002
Next I
Me.cmdWG.Item(Index).BackColor = &H46A3FF '&H8000000D
VarHauptasteMarkierung = Index
End Sub
'====================   MENU WAHLTASTE EREIGNISSE  ====================
'============================================================
Private Sub mnuWahltasteBearbeiten_Click()
'Aktuelle PLU und Farbe wird in VarPLUAktuell, VarFarbeAktuell gespeichert
Call Me.PLTAblesen(VarIDAktuell)

'Werte übergeben

frmArtikelgruppetaste.txtderHaupttasteWahltaste.Text = Wertuebergeben("VarWarengruppeAktuell")
frmArtikelgruppetaste.txtPLUWahltaste.Text = Wertuebergeben("VarPLUAktuell")
frmArtikelgruppetaste.txtGerichtWahltaste.Text = MSHFlexGrid1.Text 'Wertuebergeben("VarGerichtAktuell")
frmArtikelgruppetaste.txtFarbe.BackColor = Wertuebergeben("VarFarbeAktuell")

frmArtikelgruppetaste.Show 1
End Sub
Private Sub mnuWahltasteLoeschen_Click()
Call Me.ArtikelTasteLoeschen(VarIDAktuell, VarSpalteAktuell)
Call Me.WahltastenZahlAktualisieren(VarWarengruppeAktuell)
Call Me.WahltastenInhaltAktualisieren(VarWarengruppeAktuell)
End Sub
Private Sub mnuHintergrundfarbeAuswaehlen_Click()
Call Me.HintergrundfarbeAuswaehlen
End Sub
'====================== MENU HAUPTASTEN EREIGNISSE ===================
'==================================================================
Private Sub mnuHaupttasteBearbeiten_Click()
frmHaupttaste.txtHaupttaste.Text = VarWarengruppeAktuell
frmHaupttaste.txtReihe.Text = VarcmdIndexAktuell
frmHaupttaste.Show 1
End Sub
Private Sub mnuHaupttasteEntfernen_Click()
If MsgBox("Sind Sie Sicher. Soll die Hauptaste entfernt werden?", vbYesNo) = vbYes Then
    'entfernen
    Call Me.Hauptastenentfernen(VarWarengruppeAktuell)
    'Aktualisieren
    Call Me.HaupttastenAktualliseren   'Aktualisiert alle Haupttasten aus der Datenbank
    Call Me.WahltastenAktualisieren(Me.cmdWG(1).Caption)
End If
End Sub
Private Sub mnuNeueHaupttaste_Click()
Call HauptastenNeu
 'Aktualisieren
  Call Me.HaupttastenAktualliseren   'Aktualisiert alle Haupttasten aus der Datenbank
  Call Me.WahltastenAktualisieren(VarWarengruppeAktuell)
End Sub


'====================   VScroll EREIGNISSE  ====================
'===============================================================
Private Sub VScroll1_Change()
Me.cmdWG(1).Top = -(Me.VScroll1.Value + Me.VScroll1.Top)
For I = 2 To Me.cmdWG.Count - 1
 Me.cmdWG(I).Top = Me.cmdWG(I - 1).Top + Me.cmdWG(I - 1).Height + Zwischenabstand
Next I
End Sub
'====================   MSHFlexGrid EREIGNISSE  ====================
'===================================================================
'--------- MSHFlexGrid1 Steuerelement -------------
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

   If Button = 2 And mnuWahltasten.Visible = False Then
   'Set_MenuColor mMenuColor, MDIHauptmenu.Hwnd, &H80000016, 1, False
   'Set_MenuColor mMenuBarColor, MDIHauptmenu.Hwnd, vbRed
   'Set_MenuColor mSysMenuColor, MDIHauptmenu.Hwnd, vbYellow
    VarIDAktuell = Me.mshflgrdSchnellwahltaste.TextMatrix(mshflgrdSchnellwahltaste.MouseRow, 0)
    VarSpalteAktuell = Me.mshflgrdSchnellwahltaste.MouseCol

    PopupMenu mnuWahltasten
    'If Y > mshflgrdSchnellwahltaste.RowPos(mshflgrdSchnellwahltaste.MouseRow) + mshflgrdSchnellwahltaste.RowHeight(mshflgrdSchnellwahltaste.MouseRow) Then
    'mnuNeueArtikel.Enabled = False
    'Else
    'mnuNeueArtikel.Enabled = True
    'End If
    
  End If
End Sub
Private Sub MSHFlexGrid1_DblClick()
'Aktuelle PLU,Farbe wird in VarPLUAktuell, VarFarbeAktuell gespeichert
Call PLTAblesen(Me.mshflgrdSchnellwahltaste.TextMatrix(Me.mshflgrdSchnellwahltaste.Row, 0))

VarSpalteAktuell = mshflgrdSchnellwahltaste.MouseCol
VarIDAktuell = mshflgrdSchnellwahltaste.TextMatrix(mshflgrdSchnellwahltaste.MouseRow, 0)
VarGerichtAktuell = Me.MSHFlexGrid1.Text

'Werte übergeben
frmArtikelgruppetaste.txtderHaupttasteWahltaste.Text = Wertuebergeben("VarWarengruppeAktuell")
frmArtikelgruppetaste.txtPLUWahltaste.Text = Wertuebergeben("VarPLUAktuell")
frmArtikelgruppetaste.txtGerichtWahltaste.Text = Wertuebergeben("VarGerichtAktuell")
frmArtikelgruppetaste.txtFarbe.BackColor = Wertuebergeben("VarFarbeAktuell")

frmArtikelgruppetaste.Show 1
End Sub
'--------- mshflgrdSchnellwahltaste Steuerelement -------------
Private Sub mshflgrdSchnellwahltaste_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Me.mshflgrdSchnellwahltaste.MouseCol < 1 Then Exit Sub
mshflgrdSchnellwahltaste.Row = mshflgrdSchnellwahltaste.MouseRow
mshflgrdSchnellwahltaste.Col = mshflgrdSchnellwahltaste.MouseCol

MSHFlexGrid1.ColWidth(0) = mshflgrdSchnellwahltaste.ColWidth(1)
MSHFlexGrid1.RowHeight(0) = mshflgrdSchnellwahltaste.RowHeight(1)
MSHFlexGrid1.CellAlignment = flexAlignCenterCenter

MSHFlexGrid1.Text = mshflgrdSchnellwahltaste.Text

MSHFlexGrid1.Top = mshflgrdSchnellwahltaste.Top + mshflgrdSchnellwahltaste.CellTop
MSHFlexGrid1.Left = mshflgrdSchnellwahltaste.Left + mshflgrdSchnellwahltaste.CellLeft
MSHFlexGrid1.Height = mshflgrdSchnellwahltaste.CellHeight

If mshflgrdSchnellwahltaste.CellWidth < 0 Then
    MSHFlexGrid1.Width = mshflgrdSchnellwahltaste.CellWidth + 15
Else
    MSHFlexGrid1.Width = mshflgrdSchnellwahltaste.CellWidth
End If


MSHFlexGrid1.Visible = True
mshflgrdSchnellwahltaste.ZOrder 1
End Sub
'====================   PROZEDUREN  ====================
'=======================================================
Sub WahltastenAktualisieren(VarWGLokal)
Call Me.WahltastenZahlAktualisieren(VarWGLokal) 'Aktualisiert Anzahl von Wahltasten
    Me.mshflgrdSchnellwahltaste.RowHeightMin = Me.mshflgrdSchnellwahltaste.Height / 6
    For I = 0 To Me.mshflgrdSchnellwahltaste.Cols
        Me.mshflgrdSchnellwahltaste.ColWidth(I) = Me.mshflgrdSchnellwahltaste.Width / 5.02
    Next I
    Me.mshflgrdSchnellwahltaste.ColWidth(0) = 0
Call Me.WahltastenInhaltAktualisieren(VarWGLokal)  'Aktualisiert INHALT von  Wahltasten
End Sub
Sub HaupttastenAktualliseren() 'Aktualisiert alle Haupttasten aus der Datenbank
Dim objConn As ADODB.Connection
Dim rsWGDirekwahltaste As ADODB.Recordset
Set objConn = New ADODB.Connection
Set rsWGDirekwahltaste = 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 rsWGDirekwahltaste
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM WarengruppeTasten ORDER BY Tastenreihe"
  
   End With

'Aktuelle Steuerelemente entladen

If Me.cmdWG.UBound > 0 Then
For I = 1 To Me.cmdWG.Count - 1
Unload Me.cmdWG(I)
Next I
End If

Zwischenabstand = Me.cmdWG(0).Height / 6
 While Not rsWGDirekwahltaste.EOF

 VarIndex = rsWGDirekwahltaste.AbsolutePosition
'Alle WG-Steuerelemente laden und zeigen sowie Positionieren
 Load Me.cmdWG(VarIndex)
 If VarIndex = 1 Then
 Me.cmdWG(VarIndex).Top = Me.cmdWG(0).Top
 Else
 Me.cmdWG(VarIndex).Top = Me.cmdWG(VarIndex - 1).Top + Me.cmdWG(VarIndex - 1).Height + Zwischenabstand
 End If
 
 Me.cmdWG(VarIndex).Left = Me.cmdWG(0).Left
 Me.cmdWG(VarIndex).Width = Me.cmdWG(0).Width
 Me.cmdWG(VarIndex).Height = Me.cmdWG(0).Height

 Me.cmdWG(VarIndex).Caption = rsWGDirekwahltaste.Fields("WG").Value
Me.cmdWG(VarIndex).Tag = rsWGDirekwahltaste.Fields("ID").Value

 Me.cmdWG(VarIndex).Visible = True
 'Me.cmdWG(VarIndex).ZOrder 1
  'rsWGDirekwahltaste.Fields("Tastenreihe").Value = VarIndex
 rsWGDirekwahltaste.MoveNext
Wend
 


Me.VScroll1.Max = (Me.cmdWG.Count - 1) * Me.cmdWG(0).Height + (Me.cmdWG.Count - 2) * Zwischenabstand - Me.VScroll1.Height
If Me.VScroll1.Max < 0 Then
    Me.VScroll1.Max = 0
End If

Me.VScroll1.Min = 0
Me.VScroll1.SmallChange = Me.cmdWG(0).Height / 2
Me.VScroll1.LargeChange = Me.cmdWG(0).Height / 2

For I = 0 To Me.cmdWG.Count - 1
 Me.cmdWG.Item(I).FontName = "Tahoma"
 Me.cmdWG.Item(I).FontSize = "9"
Next I

Set rsWGDirekwahltaste = 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 rsWGDirekwahltaste = Nothing
Set objConn = Nothing


End Sub
Sub WahltastenZahlAktualisieren(VarWGLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsArtikeltasten As ADODB.Recordset

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


  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
    .Source = "Select ID,SP1,SP2,SP3,SP4,SP5 FROM ArtikelTasten Where WG='" & VarWGLokal & "' ORDER BY  ID"
    .Open
 
End With

Set mshflgrdSchnellwahltaste.DataSource = rsArtikeltasten
mshflgrdSchnellwahltaste.ColAlignment(-1) = flexAlignCenterCenter

Set objConn = Nothing
Set rsArtikeltasten = Nothing
End Sub
Sub WahltastenInhaltAktualisieren(VarWGLokal)
'füllt alle Vorhandenen Wahltasten für eine bestimten Haupttaste mit neuen Daten aus
Dim objConn As ADODB.Connection
Dim rsFarbe As ADODB.Recordset

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

  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 rsFarbe
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Source = "Select *FROM ArtikelTasten Where WG='" & VarWGLokal & "' ORDER BY  ID"
    .Open
End With
'allte ETextelemente entfernen
For I = 1 To Text1.Count - 1
Unload Text1(I)
Next

M = 1 'Textelemente
While Not rsFarbe.EOF
IndexRow = rsFarbe.AbsolutePosition - 1
IndexCol = 1 'Anzahl der Spalten 5(von 1 bis 5, da ID=0 Spalte)

Me.mshflgrdSchnellwahltaste.Row = IndexRow
  
    For I = 2 To rsFarbe.Fields.Count - 1 'alle recordfelder durchlaufen lassen
        'Gericht wird eingetragen
     Me.mshflgrdSchnellwahltaste.Col = IndexCol
     If IsNull(rsFarbe.Fields(I).Value) Then rsFarbe.Fields(I).Value = ""
     Me.mshflgrdSchnellwahltaste.TextMatrix(IndexRow, IndexCol) = rsFarbe.Fields(I).Value
     
     'PLU wird eingetragen
     Load Me.Text1(M)
     Set Me.Text1(M).Container = Me.mshflgrdSchnellwahltaste.Container
      If IsNull(rsFarbe.Fields(I + 1).Value) Then rsFarbe.Fields(I + 1).Value = ""
      Me.Text1(M).Text = rsFarbe.Fields(I + 1).Value
            'Farbe wird eingetragen
      If IsNull(rsFarbe.Fields(I + 2).Value) Then rsFarbe.Fields(I + 2).Value = ""
      Me.Text1(M).BackColor = rsFarbe.Fields(I + 2).Value
      Me.mshflgrdSchnellwahltaste.CellBackColor = rsFarbe.Fields(I + 2).Value
       
     
     Me.Text1(M).Left = mshflgrdSchnellwahltaste.Left + Me.mshflgrdSchnellwahltaste.ColPos(IndexCol) + 50
     Me.Text1(M).Top = Me.mshflgrdSchnellwahltaste.Top + Me.mshflgrdSchnellwahltaste.RowPos(IndexRow) + 50
     Me.Text1(M).Visible = True
     
     IndexCol = IndexCol + 1 'nächste Spalte
     M = M + 1
     I = I + 2
   Next I
rsFarbe.MoveNext
Wend


Set objConn = Nothing
Set rsFarbe = Nothing
End Sub
Sub PLTAblesen(VarIDLokal)
Dim objConn As ADODB.Connection
Dim rsPLTAblesen As ADODB.Recordset

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

  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 rsPLTAblesen
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open "Select *FROM ArtikelTasten Where ID =" & VarIDLokal & ""
End With
    
    If Not rsPLTAblesen.EOF Then
     VarPLUAktuell = rsPLTAblesen.Fields("SP" & mshflgrdSchnellwahltaste.Col & "PLU").Value
     VarFarbeAktuell = rsPLTAblesen.Fields("SP" & mshflgrdSchnellwahltaste.Col & "Farbe").Value
    End If
 Set objConn = Nothing
Set rsPLTAblesen = Nothing
End Sub

Sub ArtikelTasteLoeschen(VarIDLokal, VarSpalteLokal)
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 *FROM ArtikelTasten Where ID =" & VarIDLokal & ""
 End With
 
   rsDirektwahltaste.Fields("SP" & VarSpalteLokal).Value = ""
   rsDirektwahltaste.Fields("SP" & VarSpalteLokal & "PLU").Value = ""
   
   
   If MsgBox("Möchten Sie auch die Hintergrundsfarbe entfernen?", vbYesNo) = vbYes Then
      rsDirektwahltaste.Fields("SP" & VarSpalteLokal & "Farbe").Value = &H8000000F
   End If
   
   
   rsDirektwahltaste.Update
   


Set rsDirektwahltaste = 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 rsDirektwahltaste = Nothing
Set objConn = Nothing


End Sub
Sub HintergrundfarbeAuswaehlen()
   ' "Abbrechen" auf "True" setzen.
   CommonDialog1.CancelError = True
   On Error GoTo ErrHandler
   ' Flags-Eigenschaft setzen.
   CommonDialog1.Flags = cdlCCRGBInit
   ' Dialogfeld "Farbe" anzeigen.
   
   CommonDialog1.ShowColor
   ' Hintergrundfarbe des Formulars auf die
   ' ausgewählte Farbe einstellen.
   
   Me.mshflgrdSchnellwahltaste.CellBackColor = Me.CommonDialog1.Color
    
 Call Me.HintergrundfarbeEintragen(VarIDAktuell, VarSpalteAktuell, Me.CommonDialog1.Color)

 Call Me.WahltastenZahlAktualisieren(VarWarengruppeAktuell)
 
 Call Me.WahltastenInhaltAktualisieren(VarWarengruppeAktuell)
  

ErrHandler:
   ' Benutzer hat auf Abbrechen-Schaltfläche geklickt.
   Exit Sub
End Sub
Sub HintergrundfarbeEintragen(VarIDLokal, VarSpalteLokal, VarFarbeLokal)
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 =" & VarIDLokal & ""
End With

If Not rsArtikeltasten.EOF Then
 rsArtikeltasten.Fields("SP" & VarSpalteLokal & "Farbe").Value = VarFarbeLokal
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
Sub Hauptastenentfernen(VarWGLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsArtikeltasten As ADODB.Recordset
Dim rsWarengruppeTasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsArtikeltasten = New ADODB.Recordset
Set rsWarengruppeTasten = New ADODB.Recordset


  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 WG='" & VarWGLokal & "' ORDER  BY ID"
End With

While Not rsArtikeltasten.EOF
     rsArtikeltasten.Delete
     rsArtikeltasten.Update
     rsArtikeltasten.MoveNext
Wend


With rsWarengruppeTasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten Where WG='" & VarWGLokal & "'ORDER  BY ID"
End With


While Not rsWarengruppeTasten.EOF
     rsWarengruppeTasten.Delete
     rsWarengruppeTasten.Update
     rsWarengruppeTasten.MoveNext
Wend


Set objConn = Nothing
Set rsArtikeltasten = Nothing
Set rsWarengruppeTasten = Nothing
End Sub
Sub HauptastenNeu()
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsArtikeltasten As ADODB.Recordset
Dim rsWarengruppeTasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsArtikeltasten = New ADODB.Recordset
Set rsWarengruppeTasten = New ADODB.Recordset


  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 rsWarengruppeTasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten"
End With

    rsWarengruppeTasten.AddNew
    rsWarengruppeTasten.Fields("WG").Value = "Hapttaste " & rsWarengruppeTasten.RecordCount
    rsWarengruppeTasten.Fields("Tastenreihe").Value = rsWarengruppeTasten.RecordCount
    
    VarWGLokal = rsWarengruppeTasten.Fields("WG").Value
    rsWarengruppeTasten.Update

With rsArtikeltasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM ArtikelTasten"
End With

For O = 1 To 6
  rsArtikeltasten.AddNew
  rsArtikeltasten.Fields("WG") = VarWGLokal
  IndexCol = 1 'Anzahl der Spalten 5(von 1 bis 5, da ID=0 Spalte)
 
   For I = 2 To rsArtikeltasten.Fields.Count - 1 'alle recordfelder durchlaufen lassen
        'Gericht wird eingetragen
      rsArtikeltasten.Fields(I).Value = ""
        'PLU wird eingetragen
      rsArtikeltasten.Fields(I + 1).Value = ""
        'Farbe wird eingetragen
     rsArtikeltasten.Fields(I + 2).Value = &H8000000F
    
     IndexCol = IndexCol + 1 'nächste Spalte
     I = I + 2
   Next I

rsArtikeltasten.Update

Next O









Set objConn = Nothing
Set rsArtikeltasten = Nothing
Set rsWarengruppeTasten = Nothing
End Sub
Function Wertuebergeben(VarLokal)

Select Case VarLokal
    Case "VarIDAktuell"
    Wertuebergeben = VarIDAktuell
    Case "VarSpalteAktuell"
    Wertuebergeben = VarSpalteAktuell
    Case "VarWarengruppeAktuell"
    Wertuebergeben = VarWarengruppeAktuell
    Case "VarGerichtAktuell"
    Wertuebergeben = VarGerichtAktuell
    Case "VarPLUAktuell"
    Wertuebergeben = VarPLUAktuell
    Case "VarFarbeAktuell"
    Wertuebergeben = VarFarbeAktuell
    Case "VarcmdIndexAktuell"
    Wertuebergeben = VarcmdIndexAktuell

End Select
End Function