VERSION 5.00
Begin VB.Form frmHaupttaste 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "Hauptaste"
   ClientHeight    =   2835
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5385
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2835
   ScaleWidth      =   5385
   StartUpPosition =   3  'Windows-Standard
   Begin VB.Frame Frame2 
      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          =   1560
      Left            =   525
      TabIndex        =   2
      Top             =   225
      Width           =   4485
      Begin VB.TextBox txtReihe 
         BackColor       =   &H00FFFFFF&
         ForeColor       =   &H00000000&
         Height          =   350
         Left            =   1700
         TabIndex        =   6
         Top             =   825
         Width           =   2500
      End
      Begin VB.TextBox txtHaupttaste 
         BackColor       =   &H00FFFFFF&
         ForeColor       =   &H00000000&
         Height          =   350
         Left            =   1700
         TabIndex        =   3
         Top             =   375
         Width           =   2500
      End
      Begin VB.Label lblReihe 
         Caption         =   "Reihe"
         Height          =   255
         Left            =   150
         TabIndex        =   5
         Top             =   900
         Width           =   1455
      End
      Begin VB.Label lblHaupttasteWahltaste 
         Caption         =   "Text der Haupttaste"
         Height          =   255
         Left            =   150
         TabIndex        =   4
         Top             =   450
         Width           =   1455
      End
   End
   Begin VB.CommandButton cmdSpeichern 
      Caption         =   "Speichern"
      Height          =   600
      Left            =   2175
      TabIndex        =   1
      Top             =   2025
      Width           =   1200
   End
   Begin VB.CommandButton cmdBeenden 
      Caption         =   "Beenden"
      Height          =   600
      Left            =   3825
      TabIndex        =   0
      Top             =   2025
      Width           =   1200
   End
End
Attribute VB_Name = "frmHaupttaste"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim VarSpeichern As Boolean
Dim VarWGNameAlt, VarWGNameNeu, VarTastenreiheAlt As Integer, VarTastenreiheNeu As Integer

'========================= FORMULAR EREIGNISSE ==============================
'============================================================================
Private Sub Form_Load()
VarSpeichern = False
Me.Top = frmDirektwahltasteVerwaltung.Top + frmDirektwahltasteVerwaltung.Height / 2 - Me.Height / 2
Me.Left = frmDirektwahltasteVerwaltung.Left + frmDirektwahltasteVerwaltung.Picture1.Left + frmDirektwahltasteVerwaltung.VScroll1.Left
End Sub
'========================= TEXT EREIGNISSE ==============================
'============================================================================
Private Sub txtHaupttaste_Change()
Me.cmdSpeichern.Enabled = True
End Sub
Private Sub txtReihe_Change()
Me.cmdSpeichern.Enabled = True
End Sub
'========================= COMMANDBUTTON EREIGNISSE ========================
'============================================================================
Private Sub cmdLoeschen_Click()
Me.txtHaupttaste = ""
End Sub
Private Sub CmdSpeicherhzgtffn_Click()

If Me.txtHaupttaste.Text = "" Then
 MsgBox "Das Feld darf nicht Leer sein"
Exit Sub
End If

If Int(Me.txtReihe.Text) > frmDirektwahltasteVerwaltung.cmdWG.Count - 1 Then
 MsgBox "Anzahl der Hauptasten ist kleiner als " & Me.txtReihe.Text
Exit Sub
End If


If VarSpeichern = False Then
    VarWGNameAlt = frmDirektwahltasteVerwaltung.Wertuebergeben("VarWarengruppeAktuell")
    VarTastenreiheAlt = frmDirektwahltasteVerwaltung.Wertuebergeben("VarcmdIndexAktuell")
    VarWGNameNeu = Me.txtHaupttaste.Text
    VarTastenreiheNeu = Me.txtReihe.Text
Else
    VarWGNameNeu = Me.txtHaupttaste.Text
    VarTastenreiheNeu = Me.txtReihe.Text
End If


    VarIDAlt = frmDirektwahltasteVerwaltung.cmdWG(VarTastenreiheAlt).Tag
    VarIDNeu = frmDirektwahltasteVerwaltung.cmdWG(Me.txtReihe.Text).Tag

    Call HauptastenReiheAenderungAlt(VarIDAlt, VarWGNameAlt, VarWGNameNeu, VarTastenreiheNeu)
    Call HauptastenReiheAenderungNeu(VarIDNeu, VarTastenreiheAlt)
    
    Call frmDirektwahltasteVerwaltung.HaupttastenAktualliseren

VarSpeichern = True
VarWGNameAlt = VarWGNameNeu
VarTastenreiheAlt = VarTastenreiheNeu
Me.cmdSpeichern.Enabled = False
End Sub
Private Sub bshwsvCmdSpeichern_Click()
End Sub

Private Sub cmdBeenden_Click()
Unload Me
End Sub
Private Sub cmdSpeichern_Click()
If Me.txtHaupttaste.Text = "" Then
 MsgBox "Das Feld darf nicht Leer sein"
Exit Sub
End If

If Int(Me.txtReihe.Text) > frmDirektwahltasteVerwaltung.cmdWG.Count - 1 Then
 MsgBox "Anzahl der Hauptasten ist kleiner als " & Me.txtReihe.Text
Exit Sub
End If
If VarSpeichern = False Then
    VarWGNameAlt = frmDirektwahltasteVerwaltung.Wertuebergeben("VarWarengruppeAktuell")
    VarTastenreiheAlt = frmDirektwahltasteVerwaltung.Wertuebergeben("VarcmdIndexAktuell")
    VarWGNameNeu = Me.txtHaupttaste.Text
    VarTastenreiheNeu = Me.txtReihe.Text
Else
    VarWGNameNeu = Me.txtHaupttaste.Text
    VarTastenreiheNeu = Me.txtReihe.Text
End If

    
    If VarTastenreiheAlt < VarTastenreiheNeu Then
     Call HauptasteSpeichern1(VarWGNameAlt, VarWGNameNeu, VarTastenreiheAlt, VarTastenreiheNeu)
     Call HauptasteSpeichernEintragen(VarWGNameAlt, VarTastenreiheNeu)
    ElseIf VarTastenreiheAlt > VarTastenreiheNeu Then
     Call HauptasteSpeichern2(VarWGNameAlt, VarWGNameNeu, VarTastenreiheAlt, VarTastenreiheNeu)
     Call HauptasteSpeichernEintragen(VarWGNameAlt, VarTastenreiheNeu)
    Else
    Exit Sub
    End If
    
    Call frmDirektwahltasteVerwaltung.HaupttastenAktualliseren

VarSpeichern = True
VarWGNameAlt = VarWGNameNeu
VarTastenreiheAlt = VarTastenreiheNeu
Me.cmdSpeichern.Enabled = False

End Sub
'========================= PROZEDUREN ==============================
'===================================================================
Sub HauptasteSpeichern1(VarWGNameAltLokal, VarWGNameNeuLokal, VarTastenreiheAltLokal, VarTastenreiheNeuLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsHauptasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsHauptasten = 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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsHauptasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten order by Tastenreihe"
End With
While Not rsHauptasten.EOF

   If rsHauptasten.Fields("Tastenreihe").Value > VarTastenreiheAltLokal And rsHauptasten.Fields("Tastenreihe").Value < VarTastenreiheNeuLokal + 1 Then
     rsHauptasten.Fields("Tastenreihe").Value = rsHauptasten.Fields("Tastenreihe").Value - 1
   ElseIf rsHauptasten.Fields("Tastenreihe").Value = VarTastenreiheAltLokal Then
     rsHauptasten.Delete
   End If
   rsHauptasten.MoveNext
Wend

Set objConn = Nothing
Set rsHauptasten = Nothing
End Sub
Sub HauptasteSpeichern2(VarWGNameAltLokal, VarWGNameNeuLokal, VarTastenreiheAltLokal, VarTastenreiheNeuLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsHauptasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsHauptasten = 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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsHauptasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten order by Tastenreihe"
End With
While Not rsHauptasten.EOF

   If rsHauptasten.Fields("Tastenreihe").Value > VarTastenreiheNeuLokal - 1 And rsHauptasten.Fields("Tastenreihe").Value < VarTastenreiheAltLokal Then
     rsHauptasten.Fields("Tastenreihe").Value = rsHauptasten.Fields("Tastenreihe").Value + 1
   ElseIf rsHauptasten.Fields("Tastenreihe").Value = VarTastenreiheAltLokal Then
     rsHauptasten.Delete
   End If
   rsHauptasten.MoveNext
Wend




Set objConn = Nothing
Set rsHauptasten = Nothing
End Sub
Sub HauptasteSpeichernEintragen(VarWGNameAltLokal, VarTastenreiheNeuLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsHauptasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsHauptasten = 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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsHauptasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten"
End With

   rsHauptasten.AddNew
   rsHauptasten.Fields("Tastenreihe").Value = VarTastenreiheNeuLokal
   rsHauptasten.Fields("WG").Value = VarWGNameAltLokal
   rsHauptasten.Update

Set objConn = Nothing
Set rsHauptasten = Nothing
End Sub
Sub HauptasteSpeichern(VarWGNameNeuLokal, VarWGNameAltLokal, VarTastenreiheNeuLokal, VarTastenreiheAltLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsHauptasten As ADODB.Recordset

Set objConn = New ADODB.Connection
Set rsHauptasten = 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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsHauptasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten"
End With

While Not rsHauptasten.EOF
   If rsHauptasten.AbsolutePosition > VarTastenreiheAltLokal And rsHauptasten.AbsolutePosition < VarTastenreiheNeuLokal Then
     rsHauptasten.Fields("Tastenreihe").Value = rsHauptasten.Fields("Tastenreihe").Value - 1
   ElseIf rsHauptasten.AbsolutePosition = VarTastenreiheAltLokal Then
     rsHauptasten.Delete
   End If
   rsHauptasten.Update
   rsHauptasten.MoveNext
Wend



Set objConn = Nothing
Set rsHauptasten = Nothing
End Sub
Sub HauptastenReiheAenderungAlt(VarIDLokal, VarWGNameAltLokal, VarWGNameNeuLokal, VarTastenreiheNeuLokal)
'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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
With rsArtikeltasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM ArtikelTasten Where WG='" & VarWGNameAltLokal & "'"
End With

While Not rsArtikeltasten.EOF
    rsArtikeltasten.Fields("WG").Value = VarWGNameNeuLokal
    rsArtikeltasten.MoveNext
Wend


With rsWarengruppeTasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten where ID = " & VarIDLokal & ""
End With
 

If Not rsWarengruppeTasten.EOF Then
    rsWarengruppeTasten.Fields("WG").Value = VarWGNameNeuLokal
    rsWarengruppeTasten.Fields("Tastenreihe").Value = VarTastenreiheNeuLokal
End If
rsWarengruppeTasten.Update


Set objConn = Nothing
Set rsArtikeltasten = Nothing
Set rsWarengruppeTasten = Nothing
End Sub
Sub HauptastenReiheAenderungNeu(VarIDLokal, VarTastenreiheAltLokal)
'Lädt neue Wahltasten bzw bestimt Anzahl von Spalten/Zeilen in Mshflexgrid
Dim objConn As ADODB.Connection
Dim rsWarengruppeTasten As ADODB.Recordset

Set objConn = New ADODB.Connection
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=" & strPath & "asql.mdb"
    .CursorLocation = adUseClient
    .Open
  End With

With rsWarengruppeTasten
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
   .Open "Select *FROM WarengruppeTasten where ID = " & VarIDLokal & ""
End With

If Not rsWarengruppeTasten.EOF Then
    rsWarengruppeTasten.Fields("Tastenreihe").Value = VarTastenreiheAltLokal
    rsWarengruppeTasten.Update
End If

Set objConn = Nothing
Set rsArtikeltasten = Nothing
Set rsWarengruppeTasten = Nothing
End Sub
