frmcustomerform.frm

餐饮茶馆管理系统

  lCompany = Val(txtCompanyLen)
  
  Unload Me
  
End Sub

Private Sub cmdSelectType_Click()

   Load frmSelectType
   frmSelectType.Left = frmOption.cmdSelectType.Left + frmOption.Left + frmOption.cmdSelectType.Width + 50
   frmSelectType.Top = frmOption.cmdSelectType.Top + frmOption.Top + frmOption.cmdSelectType.Height + 1800

   frmSelectType.Show 1
   
   If sType <> "" Then
      cmbType.Text = sType
      If cmdAdd.Enabled = True Then cmdAdd.SetFocus
   End If

End Sub

Private Sub cmdSelectUnit_Click()

   Load frmSelectUnit
   frmSelectUnit.Left = frmOption.cmdSelectUnit.Left + frmOption.Left + frmOption.cmdSelectUnit.Width + 50
   frmSelectUnit.Top = frmOption.cmdSelectUnit.Top + frmOption.Top + frmOption.cmdSelectUnit.Height + 1800

   frmSelectUnit.Show 1
   
   If sUnit <> "" Then
      txtDW.Text = sUnit
      txtCode.SetFocus
   End If
   
End Sub

Private Sub cmbSite_Change()

   If Trim(cmbCode.Text) <> "" And Trim(cmbSite.Text) <> "" And Val(txtSL) > 0 Then
      cmdAdd.Enabled = True
    Else
      cmdAdd.Enabled = False
   End If
   
   If bDel = True Then Exit Sub
   
   Dim iStart As Integer
   Dim sString As String
   Static iLeftOff As Integer
   
   iStart = 1
   iStart = cmbSite.SelStart
   If iLeftOff <> 0 Then
      cmbSite.SelStart = iLeftOff
      iStart = iLeftOff
   End If
   sString = CStr(Left(cmbSite.Text, iStart))
   
   cmbSite.ListIndex = SendMessage(cmbSite.hwnd, CB_FINDSTRING, -1, ByVal CStr(Left(cmbSite.Text, iStart)))
   If cmbSite.ListIndex = -1 Then
      iLeftOff = Len(sString)
      cmbSite.Text = sString
      cmbSite.SelStart = iStart
   End If
    cmbSite.SelStart = iStart
   If Len(cmbSite) > 1 Then
      cmbSite.SelLength = Len(cmbSite) - iStart
     Else
      cmbSite.SelLength = 0
   End If

   iLeftOff = 0
   
   If Trim(cmbSite.Text) <> "" Then
      ConfigGrid2 Trim(cmbSite.Text)
   End If

End Sub

Private Sub cmbSite_KeyDown(KeyCode As Integer, Shift As Integer)

  If KeyCode = 8 Then  '退格键
     KeyCode = 0
     bDel = True
     Exit Sub
  End If
  If KeyCode = 46 Then  '删除
     bDel = True
     cmbSite.SelText = ""
     Exit Sub
  End If
  
  bDel = False

End Sub

Private Sub cmbSite_KeyPress(KeyAscii As Integer)
  
  If KeyAscii = 13 Then
     cmbCode.SetFocus
     Exit Sub
  End If
  
End Sub

Private Sub cmdPast_Click()
 
    Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(ConData, False, False, Constr)
    Set EF = DB.OpenRecordset("Select * From tmpSell Where 座位='" & Trim(cmbSite.Text) & "'", dbOpenDynaset)
    
  ' 没有数据
    If EF.EOF And EF.BOF Then
       EF.Close
       DB.Close
       MsgBox "对不起，没有消费不能付帐？   ", vbInformation
       cmbSite.SetFocus
       Exit Sub
    End If
    EF.Close
    DB.Close
    
   frmCash.Show 1

End Sub

Private Sub Form_Activate()

  cmbSite.SetFocus
  
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

  On Error Resume Next
  
  If KeyCode = 123 Then
     cmdPast.Value = True
  End If
  
End Sub

Private Sub Form_Load()
  
  FO = True
  On Error GoTo Err_Load
  Dim L As Long, T As Long
  L = Val(GetSetting(App.EXEName, "Option", "Option_L", 2000))
  T = Val(GetSetting(App.EXEName, "Option", "Option_T", 2000))
  Me.Left = L
  Me.Top = T

  '配置类别
    ConfigType
  '配置代码
    ConfigCode
  '配置Eat
    ConfigGrid2 Trim(cmbSite.Text)
    
    Screen.MousePointer = 11
  ' 配置网格
    ConfigGrid
  
  ' 配置名称
    txtCompany = sCompany
    txtCompanyLen = lCompany
      
  ' 配置添加安钮
    Call cmbSite_Change
  '配置座位
    ConfigSite
    
   Screen.MousePointer = 0
  Exit Sub
Err_Load:
 MsgBox "表单加载错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub Form_Resize()

  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
   
    Frame1.Height = Me.Height - 950
    picEatList.Height = Frame1.Height - 240
    Grid1.Width = picEatList.Width - 50
    Grid1.Height = picEatList.Height - 50
    Strip1.Width = Me.ScaleWidth - 60
    Frame2.Left = Frame1.Width + 80
    Frame2.Width = Me.ScaleWidth - 150 - Frame1.Width
    Frame3.Left = Frame2.Left
    Frame3.Width = Frame2.Width
    Frame3.Height = Me.Height - Frame2.Height - 1000
    Grid2.Width = Frame3.Width - 50
    Grid2.Height = Frame3.Height - 240

End Sub

Private Sub Form_Unload(Cancel As Integer)

 FO = False
 SaveSetting App.EXEName, "Option", "Option_L", Me.Left
 SaveSetting App.EXEName, "Option", "Option_T", Me.Top
 
End Sub

Private Sub ConfigGrid()

On Error GoTo Err_init
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 6
Grid1.FormatString = "^ .. |^ 物品名称 |^ 单价 |^ 单位 |   代码|^ 类型"
Grid1.ColWidth(0) = 300
Grid1.ColWidth(1) = 2040
Grid1.ColWidth(2) = 800
Grid1.ColWidth(3) = 1000
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1200

Dim sSQL As String
   
    If Trim(sGlobalType) <> "" Then
       sSQL = "Select * From EatList Where MenuType='" & Trim(sGlobalType) & "'"
    Else
       sSQL = "Select * From EatList"
    End If
    
Dim DB As Database, EF As Recordset, HH As Integer, DelNO As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, SureStr As String, Qy As Integer
    Set DB = OpenDatabase(ConData, False, False, Constr)
    
    Set EF = DB.OpenRecordset(sSQL, dbOpenDynaset)
        
     If EF.EOF And EF.BOF Then
        DelNO = 1
      Else
        Do While Not EF.EOF
           DelNO = DelNO + 1
           EF.MoveNext
        Loop
     End If
        Grid1.Rows = DelNO + 1
        
        If Grid1.Rows < 28 Then
           Grid1.Rows = 28
        End If
        
     If DelNO > 1 Then
        EF.MoveFirst  '返回第一
        
        HH = 1
        Do While Not EF.EOF()
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 4
        If Not IsNull(EF.Fields(0).Value) Then
           Grid1.Text = EF.Fields(0).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(1).Value) Then
           Grid1.Text = EF.Fields(1).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(3).Value) Then
           Grid1.Text = EF.Fields(3).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(2).Value) Then
           Grid1.Text = EF.Fields(2).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(4).Value) Then
           Grid1.Text = EF.Fields(4).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
        If Not IsNull(EF.Fields(5).Value) Then
           Grid1.Text = EF.Fields(5).Value
        End If
        
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        DB.Close
    End If
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 5
 Grid1.Visible = True
   Exit Sub
Err_init:
 MsgBox "网络配置错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub DelRecord(sWP As String, sFields As String, sTable As String)

   On Error GoTo Err_init
   Dim DB As Database
   Dim sEXE As String
   
   Set DB = OpenDatabase(ConData, False, False, Constr)
   'Set DB = OpenConnection(ConData, dbDriverNoPrompt, False, ConStr)
   
   ' SQL语言删除
     sEXE = "Delete * From " & sTable & " Where " & sFields & "=" & sWP
     DBEngine.BeginTrans     ' 进行事务操作
     DB.Execute sEXE
     DBEngine.CommitTrans
     DB.Close
          Exit Sub
Err_init:
 MsgBox "记录删除错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub AddRecord(sWP1 As String, sFields1 As String, sWP2 As Currency, sFields2 As String, sWP3 As String, sFields3 As String, sWP4 As String, sFields4 As String, sWP5 As String, sFields5 As String, sWP6 As Currency, sFields6 As String, sTable As String)

   On Error GoTo Err_init
   Dim DB As Database, EF As Recordset
   Dim sEXE As String
   
   Set DB = OpenDatabase(ConData, False, False, Constr)
       Dim SF As Recordset, sPP As String
       'AddRecord , Grid1.TextMatrix(lCurRow, 5), "MenuType", Grid1.TextMatrix(lCurRow, 2) * sSL, "金额", "tmpSell"

       sPP = " (代码='" & sWP4 & "')"
   Set SF = DB.OpenRecordset("StoreList", dbOpenDynaset)
       SF.FindFirst sPP
       If SF.NoMatch Then  '没有时
          MsgBox "很抱歉，物品还没有进货，不能销售。 " & sSL, vbInformation
          SF.Close
          DB.Close
          Exit Sub
         ElseIf SF.Fields("数量") < sSL Then   '不足时
          MsgBox "对不起，数量不足 " & sSL & " ，请进货后再销售。   " & vbCrLf & vbCrLf & "现在库存只有：" & SF.Fields("数量"), vbInformation
          SF.Close
          DB.Close
          Exit Sub
       End If
       SF.Close
   Set EF = DB.OpenRecordset("tmpSell", dbOpenDynaset)
       Dim sTmp As String, sTime As Date
       sTmp = "座位='" & Trim(cmbSite.Text) & "'"
       EF.FindFirst sTmp
     If EF.NoMatch Then
        sTime = Format(Time(), "Short Time")
      Else
        sTime = EF.Fields("上台时间")
     End If
     EF.Close
     sEXE = "Insert into " & sTable & " (" & sFields1 & "," & sFields2 & "," & sFields3 & "," & sFields4 & "," & sFields5 & "," & sFields6 & ",座位,时间,日期,数量,上台时间) values('" & sWP1 & "'," & sWP2 & ",'" & sWP3 & "','" & sWP4 & "','" & sWP5 & "'," & sWP6 & ",'" & Trim(cmbSite.Text) & "'," & Val(Time()) & ",#" & Date & "#," & sSL & ",#" & sTime & "#)"
     DBEngine.BeginTrans     ' 进行事务操作
     DB.Execute sEXE
     DBEngine.CommitTrans
     DB.Close
          Exit Sub
Err_init:
 MsgBox "添加记录错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Function GetCode(sWP As String, sFields As String, sTable As String) As Boolean

  On Error GoTo Err_init
   Dim DB As Database
   Dim EF As Recordset
   Dim sEXE As String
   
   Set DB = OpenDatabase(ConData, False, False, Constr)
   
   ' SQL语言删除
     sEXE = "Select * From " & sTable & " Where " & sFields & "='" & sWP & "'"
   Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
     If EF.EOF And EF.BOF Then
        GetCode = False
      Else
        GetCode = True
     End If
     EF.Close
     DB.Close
     Exit Function
     
Err_init:
 MsgBox "添加记录错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 GetCode = False
 
End Function

Private Sub ConfigType()

   On Error GoTo Err_init
   Dim DB As Database
   Dim EF As Recordset, sEXE As String
   
   Set DB = OpenDatabase(ConData, False, False, Constr)
   
   ' SQL语言删除
     sEXE = "Select MenuName From MenuType"
   Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
     If EF.EOF And EF.BOF Then
        Strip1.SelectedItem.Key = "Null"
        sGlobalType = ""
      Else
        EF.MoveFirst
        Dim X As Integer
           X = 1
        Do While Not EF.EOF
           Strip1.Tabs.Add X, EF.Fields(0), EF.Fields(0) & "&" & Chr(64 + X)
           X = X + 1
           EF.MoveNext
        Loop
        sGlobalType = Strip1.SelectedItem.Key
     End If
     EF.Close