Attribute VB_Name = "mdlAPI"
'Variablen für Tastaturüberwachung mit API Deklarieren
Private Declare Function GetAsyncKeyState Lib "user32" _
        (ByVal vKey As Long) As Integer

'Variablen für Fenster max. und min ausblenden mit API Deklarieren
Private Declare Function GetWindowLong Lib "user32" Alias _
      "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex _
      As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias _
      "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex _
      As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetSystemMenu Lib "user32" (ByVal _
      Hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function RemoveMenu Lib "user32" (ByVal Hmenu _
      As Long, ByVal nPosition As Long, ByVal wFlags As Long) _
      As Long

Private Declare Function GetMenuItemCount Lib "user32" (ByVal _
      Hmenu As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal Hwnd _
      As Long) As Long

Private Const GWL_STYLE = (-16)

Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000

Private Const SC_CLOSE = &HF060
Private Const SC_MAXIMIZE = &HF030
Private Const SC_MINIMIZE = &HF020
Private Const SC_MOVE = &HF010
Private Const SC_RESTORE = &HF120

Private Const MF_BYCOMMAND = &H0
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000&

'Variablen für Windows Taskleiste aus- und einblenden mit API Deklarieren
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
'Code für Tastaturüberwachung txtTischauswahl Textbox mit API
Public Function txtTischauswahlTasten(KCode As Long, KText As String) As Boolean
    Dim Result As Integer
    
  Result = GetAsyncKeyState(KCode)
  If Result = -32767 Then
     If KCode >= 96 And KCode < 106 Then
          frmRaum.txtTischauswahl.Text = frmRaum.txtTischauswahl.Text & KText
      ElseIf KCode = 46 Then
          frmRaum.txtTischauswahl.Text = ""
      ElseIf KCode = 13 And frmRaum.Visible = True Then
          
          For I = 1 To frmRaum.picTisch.Count - 1
            If frmRaum.txtTischauswahl.Text = frmRaum.picTisch(I).Tag Then
              VarTisch = frmRaum.picTisch(I).Tag
              Call frmRaum.Tischoeffne
            End If
          Next I
          frmRaum.txtTischauswahl.Text = ""
      End If
      txtTischauswahlTasten = True
  Else
      txtTischauswahlTasten = False
  End If

End Function
'Code für Tastaturüberwachung Formular frmTastenMenu2 mit API
Public Function CompKey(KCode As Long, KText As String) As Boolean
Dim Result As Integer
Result = GetAsyncKeyState(KCode)

If Result = -32767 Then
    
    Select Case KCode
        Case 38, 40 'pfeiltasten 'oben' 'unten' von frmtisch.dgrTisch überprüfen
            frmTisch.dgrTisch.SetFocus
            SendKeys "{ESC}"
        Case 65, 79, 82, 84, 85, 90 'TastenMenu1 Formular
           frmTastenMenu1.TastenMenu1 (KCode)
        Case 71, 75, 83  'TastenMenu2 Steuerelement
           frmTastenMenu2.TastenMenu2 (KCode)
        Case 96, 97, 98, 99, 100, 101, 102, 103, 104, 105 'TastenMenu2 Steuerelement
           frmTastenMenu2.TastenMenu2 (KCode)
           'frmTastenMenu2.txtPLU.Text = frmTastenMenu2.txtPLU.Text & KText
        Case 106
           frmTastenMenu2.txtPLU.Text = frmTastenMenu2.txtPLU.Text & "x"
        Case 46
           frmTastenMenu2.txtPLU.Text = ""
        Case 8
           frmTastenMenu2.txtPLU.Text = ""
        Case 13
           frmTastenMenu2.DatenFinden
           frmTastenMenu2.txtPLU.Text = ""
           Exit Function
        End Select
    CompKey = True
Else
    CompKey = False
End If

End Function
'*****************************************************************'
'--Code für Tastaturüberwachung Formular frmTastenBasis mit API--*'
'*****************************************************************'
Public Function CompKeyfrmTastenBasis(KCode As Long, KText As String) As Boolean
    Dim Result As Integer
    
    Result = GetAsyncKeyState(KCode)
    If Result = -32767 Then
        
       
        If KCode >= 96 And KCode < 106 Then
           frmTastenBasis.txtFeld.Text = frmTastenBasis.txtFeld.Text & KText
        ElseIf KCode = 46 Then
           frmTastenBasis.txtFeld.Text = ""
        ElseIf KCode = 13 Then
           MDIHauptmenu.Tag = frmTastenBasis.txtFeld.Text
           Unload frmTastenBasis
        ElseIf KCode = 27 Then
        MDIHauptmenu.Tag = "Abbrechen"
        Unload frmTastenBasis
        End If
        CompKeyfrmTastenBasis = True
    Else
        CompKeyfrmTastenBasis = False
    End If

End Function

'Code für Windows Taskleiste aus- und einblenden mit API
'*****************************************************************'
'--Code für Tastaturüberwachung Formular frmTischUmbuchen mit API--*'
'*****************************************************************'
Public Function CompKeyTimerTischUmbuchen(KCode As Long, KText As String) As Boolean
    Dim Result As Integer
    
    Result = GetAsyncKeyState(KCode)
    If Result = -32767 Then
        
        If KCode >= 37 And KCode <= 40 Then
          If frmTischUmbuchen.Visible = True Then
            Select Case KCode
            Case 37
             frmTischUmbuchen.DataGrid1.SetFocus
            Case 39
             frmTischUmbuchen.DataGrid2.SetFocus
            End Select
           End If
        End If
        
        CompKeyTimerTischUmbuchen = True
    Else
        CompKeyTimerTischUmbuchen = False
    End If

End Function

Public Sub ShowStartmenue(bJa As Boolean)

 Dim Ret         As Long
 Dim ClassName   As String
 Dim StartWindow As Long

 ClassName = Space(256)
 ClassName = "Shell_TrayWnd"
 StartWindow = FindWindow(ClassName, vbNullString)

 If bJa = False Then
  Ret = ShowWindow(StartWindow, SW_HIDE)
 Else
  Ret = ShowWindow(StartWindow, SW_SHOWNORMAL)
 End If

End Sub
'Code für Fenster max. und min ausblenden mit API
Public Sub SetFormStyle(ByVal frm As Object)
  Dim nStyle  As Long
  Dim nMenu   As Long
  Dim nCount  As Long

  With frm
    nStyle = GetWindowLong(frm.Hwnd, GWL_STYLE)
    nStyle = nStyle And Not (WS_MAXIMIZEBOX Or WS_MINIMIZEBOX _
           Or WS_THICKFRAME)
    SetWindowLong frm.Hwnd, GWL_STYLE, nStyle

    nMenu = GetSystemMenu(frm.Hwnd, 0)

    RemoveMenu nMenu, SC_MAXIMIZE, MF_REMOVE Or MF_BYCOMMAND
    RemoveMenu nMenu, SC_MINIMIZE, MF_REMOVE Or MF_BYCOMMAND
    RemoveMenu nMenu, SC_MOVE, MF_REMOVE Or MF_BYCOMMAND
    RemoveMenu nMenu, SC_RESTORE, MF_REMOVE Or MF_BYCOMMAND

    nCount = GetMenuItemCount(nMenu)
    RemoveMenu nMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION
    DrawMenuBar frm.Hwnd
  End With
End Sub
'Code für Standarddrucker systemweit festlegen
Public Function SetDefaultPrinter(ByVal sPrinterName As String) As Boolean
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrHandler

  ' Verweis auf das Windows-Scripting-Objekt
  Dim oWScript As Object
  Set oWScript = CreateObject("WScript.Network")

  ' Standarddrucker neu festlegen
  oWScript.SetDefaultPrinter sPrinterName

  ' Objekt wieder zerstören
  Set oWScript = Nothing

  ' Druckerwechsel erfolgreich!
  On Error GoTo 0
  SetDefaultPrinter = True
  Exit Function

ErrHandler:
  ' Druckerwechsel konnte nicht durchgeführt werden
  ' Entweder konnte das WScript-Objekt nicht instanziert werden
  ' oder es wurde ein ungültiger Druckername angegeben
  On Error GoTo 0
  SetDefaultPrinter = False
End Function