VERSION 5.00 Begin VB.Form frmRaum BackColor = &H80000004& BorderStyle = 0 'Kein Caption = "Form1" ClientHeight = 5640 ClientLeft = 0 ClientTop = 0 ClientWidth = 7290 LinkTopic = "Form1" MaxButton = 0 'False MDIChild = -1 'True MinButton = 0 'False ScaleHeight = 5640 ScaleWidth = 7290 ShowInTaskbar = 0 'False Begin VB.PictureBox PicLeisteOben BorderStyle = 0 'Kein Height = 990 Left = 75 ScaleHeight = 990 ScaleWidth = 7215 TabIndex = 1 Top = 1440 Width = 7215 Begin VB.TextBox txtTischauswahl BackColor = &H80000016& Enabled = 0 'False Height = 510 Left = 2100 TabIndex = 3 Top = 150 Width = 795 End Begin VB.CommandButton cmdkellnerAnmeldung Caption = "Abmelden" Height = 615 Left = 5475 Style = 1 'Grafisch TabIndex = 2 TabStop = 0 'False Top = 75 Width = 1590 End Begin VB.Label lblTischauswahl AutoSize = -1 'True Caption = "Tischauswahl:" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 375 TabIndex = 4 Top = 375 Width = 1515 End End Begin VB.PictureBox picTisch Appearance = 0 '2D BackColor = &H00C0E0FF& ClipControls = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000007& Height = 600 Index = 0 Left = 1680 ScaleHeight = 570 ScaleWidth = 600 TabIndex = 0 TabStop = 0 'False Top = 3810 Visible = 0 'False Width = 630 End Begin VB.Timer TimerTischauswahl Enabled = 0 'False Interval = 50 Left = 5280 Top = 4320 End Begin VB.Image imgLokal Appearance = 0 '2D Height = 1065 Left = 2700 Stretch = -1 'True Top = 3900 Width = 1800 End End Attribute VB_Name = "frmRaum" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '========================= FORMULAR EREIGNISSE =================== '================================================================= Private Sub Form_Load() Me.BesetzteTische Me.TimerTischauswahl.Enabled = True Set frmRaum.imgLokal.Picture = LoadPicture(App.Path & "\image\Gastraum.emf") End Sub Private Sub Form_Activate() frmTastenMenu2.TimerMenu2.Enabled = False Me.TimerTischauswahl.Enabled = True Me.txtTischauswahl.Text = "" End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) frmSchnellwahltaste.MSHFlexGrid1.Visible = False End Sub Private Sub Form_Paint() Call Me.BesetzteTische End Sub '========================= COMMANDBUTTON EREIGNISSE =================== '====================================================================== Private Sub cmdkellnerAnmeldung_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.Visible = False frmPin.Show 1 End Sub '========================= PICTURE EREIGNISSE =================== '================================================================ Private Sub picTisch_Paint(Index As Integer) For I = 1 To frmRaum.picTisch.Count - 1 frmRaum.picTisch(I).CurrentX = (frmRaum.picTisch(I).Width - frmRaum.picTisch(I).TextWidth(frmRaum.picTisch(I).Tag)) / 2 frmRaum.picTisch(I).CurrentY = (frmRaum.picTisch(I).Height - frmRaum.picTisch(I).TextHeight(frmRaum.picTisch(I).Tag)) / 2 frmRaum.picTisch(I).Print frmRaum.picTisch(I).Tag Next I End Sub Private Sub picTisch_Click(Index As Integer) VarTisch = picTisch(Index).Tag Call Me.Tischoeffne End Sub '========================= TIMER EREIGNISSE =================== '============================================================== Private Sub TimerTischauswahl_Timer() Dim X As Long For X = 48 To 90 If txtTischauswahlTasten(X, UCase(Chr$(X))) Then Exit Sub If txtTischauswahlTasten(X + 48, UCase(Chr$(X))) Then Exit Sub Next X If txtTischauswahlTasten(8, "BACKSPACE") Then Exit Sub If txtTischauswahlTasten(9, "TAB") Then Exit Sub If txtTischauswahlTasten(13, "ENTER") Then Exit Sub If txtTischauswahlTasten(16, "SHIFT") Then Exit Sub If txtTischauswahlTasten(17, "STRG") Then Exit Sub If txtTischauswahlTasten(18, "ALT") Then Exit Sub If txtTischauswahlTasten(19, "PAUSE") Then Exit Sub If txtTischauswahlTasten(27, "ESC") Then Exit Sub If txtTischauswahlTasten(33, "PAGE UP") Then Exit Sub If txtTischauswahlTasten(34, "PAGE DOWN") Then Exit Sub If txtTischauswahlTasten(35, "ENDE") Then Exit Sub If txtTischauswahlTasten(36, "POS1") Then Exit Sub If txtTischauswahlTasten(37, "LEFT") Then Exit Sub If txtTischauswahlTasten(38, "UP") Then Exit Sub If txtTischauswahlTasten(39, "RIGHT") Then Exit Sub If txtTischauswahlTasten(40, "DOWN") Then Exit Sub If txtTischauswahlTasten(44, "DRUCK") Then Exit Sub If txtTischauswahlTasten(45, "INSERT") Then Exit Sub If txtTischauswahlTasten(46, "DEL") Then Exit Sub If txtTischauswahlTasten(144, "NUM") Then Exit Sub If txtTischauswahlTasten(145, "ROLLEN") Then Exit Sub For X = 112 To 127 If txtTischauswahlTasten(X, "F" & CStr(X - 111)) Then Exit Sub Next X ' usw... usw... End Sub '========================= PROZEDUREN =================== '========================================================= Sub BesetzteTische() Dim objConn As ADODB.Connection Dim rsBesetzteTische As ADODB.Recordset Dim strPath As String Set objConn = New ADODB.Connection Set rsBesetzteTische = 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 .Properties("Jet OLEDB:Database Password") = VarPasswordDatenbank .ConnectionString = "Data Source=" & strPath & "asql.mdb" .CursorLocation = adUseClient .Open End With 'Tabelle OffeneTische öffnen With rsBesetzteTische .ActiveConnection = objConn .CursorLocation = adUseClient .LockType = adLockOptimistic '.Open "Select Tisch from OffeneTische Group by Tisch" .Open "Select Tisch from OffeneTische Where Station = '" & VarStation & "' Group by Tisch " End With 'Recordset prüfen welche Tische sind besetzt. If rsBesetzteTische.EOF = False Then While Not rsBesetzteTische.EOF For I = 1 To frmRaum.picTisch.UBound If frmRaum.picTisch(I).Tag = rsBesetzteTische.Fields("Tisch") Then Set frmRaum.picTisch(I).Picture = LoadPicture(App.Path & "\icons\family.ico") End If Next I rsBesetzteTische.MoveNext Wend End If 'Objekte aus dem Speicher leeren Set rsBesetzteTische = Nothing Set objConn = Nothing exit_Sub: On Error GoTo 0 Set rsBesetzteTische = Nothing Set objConn = Nothing Exit Sub err_Handler: MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _ vbCritical, "Fehler" Resume exit_Sub Set rsBesetzteTische = Nothing Set objConn = Nothing End Sub Sub Tischoeffne() 'For I = 1 To picTisch.UBound 'If picTisch(I).Tag = VarTisch Then 'prüffen ob stationsrechte vorhanden sind If modRechte.MitarbeiterStationRecht(VarKellner, VarStation) = False Then MsgBox "Sie haben nicht die nötigen Rechte, um auf diese Station zuzugreifen" Exit Sub End If 'prüffen ob Tisch existiert und ob angemeldeter Kellner ihn geöffnet hat If modRechte.TischNummerAbfrage(VarTisch) = True Then If modRechte.TischKellnerAbfrage(VarTisch, VarKellner) = True Then 'Ween Ja dann Tisch öffne GoTo 10 Else 'Wenn ihn nich geöffnet hat prüffen ob fremde-Tische-Rechte vorhanden sind If modRechte.MitarbeiterRecht(VarKellner, "FremdeTische") = False Then MsgBox "Sie haben nicht die nötigen Rechte, um auf diesen Tisch zuzugreifen" Exit Sub End If End If End If 10 Call Me.FensterZustanddefinieren Exit Sub 'End If 'Next I End Sub Sub FensterZustanddefinieren() frmRaum.TimerTischauswahl.Enabled = False frmTastenMenu2.TimerMenu2.Enabled = True MDIHauptmenu.imgMenu.Visible = False Me.Visible = False frmLink.Visible = False frmTisch.Visible = True Call mdlDatenbanken.TischAktualisieren(VarTisch, "Alt") frmTastenMenu1.Visible = True frmTastenMenu2.txtPLU.Text = "" frmTastenMenu2.Visible = True If frmTastenMenu2.cmdTastenMenu2(0).Caption = "Speise&karte" Then frmSchnellwahltaste.Visible = True frmkarteAuswahl.Visible = False Else frmkarteAuswahl.Visible = True frmSchnellwahltaste.Visible = False End If End Sub