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"
Begin VB.Form frmSchnellwahltaste 
   BackColor       =   &H000000FF&
   BorderStyle     =   0  'Kein
   Caption         =   "Form1"
   ClientHeight    =   4485
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   9060
   BeginProperty Font 
      Name            =   "Verdana"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000007&
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4485
   ScaleWidth      =   9060
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox Picture1 
      Appearance      =   0  '2D
      BackColor       =   &H80000002&
      ForeColor       =   &H80000008&
      Height          =   3615
      Left            =   2160
      ScaleHeight     =   3585
      ScaleWidth      =   6705
      TabIndex        =   0
      Top             =   600
      Width           =   6735
      Begin VB.CommandButton cmdWG 
         BackColor       =   &H80000003&
         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          =   1425
         LargeChange     =   10
         Left            =   3000
         Max             =   100
         SmallChange     =   10
         TabIndex        =   4
         Top             =   480
         Width           =   405
      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        =   2
         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            =   2160
         TabIndex        =   1
         Text            =   "Text2"
         Top             =   480
         Visible         =   0   'False
         Width           =   540
      End
      Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
         Height          =   345
         Left            =   4320
         TabIndex        =   3
         Top             =   720
         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            =   960
         TabIndex        =   6
         Top             =   1440
         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            =   5160
         TabIndex        =   7
         Top             =   1800
         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            =   360
      Top             =   240
      Width           =   1695
   End
End
Attribute VB_Name = "frmSchnellwahltaste"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VarcmdTastenIndex, Zwischenabstand
Dim VarAktuelleWarengruppe, VarAktuellerPLU, VarHauptasteMarkierung
'====================   FORMS EREIGNISSE  ====================
'=============================================================
Private Sub Form_Load()
Me.Picture1.BackColor = &H80000003
Me.BackColor = &H80000003
For I = 0 To Me.cmdWG.Count - 1
 Me.cmdWG.Item(I).BackColor = &H80000002
Next I
VarHauptasteMarkierung = 1
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
VarcmdTastenIndex = ""
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)
If VarcmdTastenIndex = "" Then Exit Sub
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
VarcmdTastenIndex = ""
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)

VarTastenFarbeAbheben = False ' in MDI-Formular benutzt

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
For I = 1 To Text1.Count - 1
Unload Text1(I)
Next

Call TabelleArtikelTasten(frmSchnellwahltaste.cmdWG(Index).Caption)

Call FarbeAblesen(frmSchnellwahltaste.cmdWG(Index).Caption)
VarAktuelleWarengruppe = frmSchnellwahltaste.cmdWG(Index).Caption
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

'====================   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  ====================
'===================================================================
Private Sub MSHFlexGrid1_Click()
'frmTastenMenu2.txtPLU.Text = ""
If MSHFlexGrid1.Text = "" Then Exit Sub
'Call GerichtEintragen("Gericht='" & MSHFlexGrid1.Text & "'", VarStation, VarTisch, 1)

Call PLTAblesen(Me.mshflgrdSchnellwahltaste.TextMatrix(Me.mshflgrdSchnellwahltaste.Row, 0))

frmTastenMenu2.txtPLU = frmTastenMenu2.txtPLU & VarAktuellerPLU
frmTastenMenu2.DatenFinden

'frmTastenMenu2.txtPLU.Text = ""
End Sub
Private Sub mshflgrdSchnellwahltaste_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MDIHauptmenu.TastenFarbeAbheben 'Hebt die Tastenfarben auf
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 WGFuehlen()
Call WarengroupeLaden(frmSchnellwahltaste)
Call TabelleArtikelTasten(frmSchnellwahltaste.cmdWG(1).Caption)

 frmSchnellwahltaste.mshflgrdSchnellwahltaste.RowHeightMin = mshflgrdSchnellwahltaste.Height / 6
 For I = 1 To mshflgrdSchnellwahltaste.Cols
 mshflgrdSchnellwahltaste.ColWidth(I) = mshflgrdSchnellwahltaste.Width / 5.02
 Next I
mshflgrdSchnellwahltaste.ColWidth(0) = 0.01
End Sub
Sub WarengroupeLaden(frm)
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 ID,WG FROM WarengruppeTasten"
  
   End With

'Aktuelle Steuerelemente entladen

If frm.cmdWG.UBound > 0 Then
For I = 1 To frm.cmdWG.Count - 1
Unload frm.cmdWG(I)
Next I
End If

Zwischenabstand = frm.cmdWG(0).Height / 6
 While Not rsWGDirekwahltaste.EOF

 VarIndex = rsWGDirekwahltaste.AbsolutePosition
'Alle WG-Steuerelemente laden und zeigen sowie Positionieren
 Load frm.cmdWG(VarIndex)
 If VarIndex = 1 Then
 frm.cmdWG(VarIndex).Top = frm.cmdWG(0).Top
 Else
 frm.cmdWG(VarIndex).Top = frm.cmdWG(VarIndex - 1).Top + frm.cmdWG(VarIndex - 1).Height + Zwischenabstand
 End If
 frm.cmdWG(VarIndex).Left = frm.cmdWG(0).Left
 frm.cmdWG(VarIndex).Width = frm.cmdWG(0).Width
 frm.cmdWG(VarIndex).Height = frm.cmdWG(0).Height

 frm.cmdWG(VarIndex).Caption = rsWGDirekwahltaste.Fields("WG").Value
 frm.cmdWG(VarIndex).Visible = True
 'frm.cmdWG(VarIndex).ZOrder 1
 
 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 TabelleArtikelTasten(VarWG)
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='" & VarWG & "' ORDER BY ID"
    .Open
 
End With

Set mshflgrdSchnellwahltaste.DataSource = rsArtikeltasten
mshflgrdSchnellwahltaste.ColAlignment(-1) = flexAlignCenterCenter

Set objConn = Nothing
Set rsArtikeltasten = Nothing
End Sub
Sub FarbeAblesen(VarWG)
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='" & VarWG & "' ORDER BY ID"
    .Open
End With


M = 1
While Not rsFarbe.EOF
mshflgrdSchnellwahltaste.Row = rsFarbe.AbsolutePosition - 1
    k = 1 'Da 0 ID spalte
    
    For I = 4 To rsFarbe.Fields.Count - 1
            mshflgrdSchnellwahltaste.Col = k
        Load Text1(M)
        Set Text1(M).Container = mshflgrdSchnellwahltaste.Container
        'Text1(M).Text = rsFarbe.Fields(I - 1).Value
        If IsNull(rsFarbe.Fields(I - 1).Value) Then 'wegen datenbankfehler --> Laufzeitfehler 94 ungültige Verwendung von Null
          Text1(M).Text = Empty
        Else
          Text1(M).Text = rsFarbe.Fields(I - 1).Value
        End If


        
        Text1(M).Left = mshflgrdSchnellwahltaste.Left + mshflgrdSchnellwahltaste.ColPos(k) + 50
        Text1(M).Top = mshflgrdSchnellwahltaste.Top + mshflgrdSchnellwahltaste.RowPos(mshflgrdSchnellwahltaste.Row) + 50
        Text1(M).BackColor = rsFarbe.Fields(I).Value
        Text1(M).Visible = True
        mshflgrdSchnellwahltaste.CellBackColor = rsFarbe.Fields(I).Value
      
        k = k + 1
        M = M + 1
        I = I + 2
   
   Next I
rsFarbe.MoveNext
Wend


Set objConn = Nothing
Set rsFarbe = Nothing
End Sub
Sub PLTAblesen(VarID)
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 =" & VarID & " ORDER BY ID"
End With
    
    If Not rsPLTAblesen.EOF Then
     VarAktuellerPLU = rsPLTAblesen.Fields("SP" & mshflgrdSchnellwahltaste.Col & "PLU").Value
    End If

Set objConn = Nothing
Set rsPLTAblesen = Nothing
End Sub




