frmcustomerform.frm

用vb写的饮食管理系统功能全面

     Exit Sub
     
Err_init:
    MsgBox "菜单类型错误，不能为数字 ？ " & err.Description, vbExclamation, "错误：By Yusilong."

End Sub

Private Sub Grid1_DblClick()

  If Grid1.Text <> "" Then
     If Trim(cmbSite.Text) = "" Then
        MsgBox "对不起，请注明该物品的座位号！    ", vbInformation, "提示：By Yusilong."
        cmbSite.SetFocus
        Exit Sub
     End If
     frmQuantly.Show 1
     If SureQuantly = True Then
        Dim lCurRow As Long
            lCurRow = Grid1.Row '当前行
            AddRecord Grid1.TextMatrix(lCurRow, 1), "名称", Grid1.TextMatrix(lCurRow, 2), "单价", Grid1.TextMatrix(lCurRow, 3), "单位", Grid1.TextMatrix(lCurRow, 4), "代码", Grid1.TextMatrix(lCurRow, 5), "MenuType", Grid1.TextMatrix(lCurRow, 2) * sSL, "金额", "tmpSell"
           ConfigGrid2 Trim(cmbSite.Text)
     End If
   Else
     Exit Sub
  End If
  
End Sub

Private Sub Grid2_Click()

  If Grid2.Text <> "" Then
     cmdDel.Enabled = True
    Else
     cmdDel.Enabled = False
  End If
  
End Sub

Private Sub Grid2_DblClick()

    If Grid2.Text <> "" Then
       cmdDel.Enabled = True
       mnuDel.Enabled = True

      Else
       cmdDel.Enabled = False
       mnuDel.Enabled = False
     End If
       PopupMenu mnuControl
       
End Sub

Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

 If Button = 2 Then
    PopupMenu mnuControl
 End If
 
End Sub

Private Sub mnuCheck_Click()

  cmdPast_Click
  
End Sub

Private Sub mnuControl_Click()

    If Grid2.Text <> "" Then
       cmdDel.Enabled = True
       mnuDel.Enabled = True
      Else
       cmdDel.Enabled = False
       mnuDel.Enabled = False
     End If
     
End Sub

Private Sub mnuDel_Click()

  cmdDel_Click
  
End Sub

Private Sub mnuExit_Click()

  cmdCancel_Click
  
End Sub

Private Sub Strip1_Click()
  
  '选择类别
  sGlobalType = Strip1.SelectedItem.Key
  ConfigGrid

End Sub

Private Sub ConfigSite()

   '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 SiteName From site"
   Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
     If EF.EOF And EF.BOF Then
        EF.Close
        DB.Close
        Exit Sub
      Else
        EF.MoveFirst
        Dim x As Integer
           x = 0
        Do While Not EF.EOF
           cmbSite.AddItem EF.Fields(0), x
           x = x + 1
           EF.MoveNext
        Loop
        cmbSite.ListIndex = 0  '默认值
     End If
     EF.Close
     DB.Close
 If cmbSite.ListCount > 1 Then
    cmbSite.ListIndex = 0
 End If
     Exit Sub
     
Err_init:
    MsgBox "装载（座位）未知错误！" & err.Description, vbExclamation, "错误：By Yusilong."

End Sub

Private Sub ConfigCode()

   '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 代码 From EatList"
   Set EF = DB.OpenRecordset(sEXE, dbOpenDynaset)
     If EF.EOF And EF.BOF Then
        EF.Close
        DB.Close
        Exit Sub
      Else
        EF.MoveFirst
        Dim x As Integer
           x = 0
        Do While Not EF.EOF
           cmbCode.AddItem EF.Fields(0), x
           x = x + 1
           EF.MoveNext
        Loop
       'cmbCode.ListIndex = 0  '默认值
     End If
     EF.Close
     DB.Close
     Exit Sub
     
Err_init:
    MsgBox "装载（代码）未知错误！" & err.Description, vbExclamation, "错误：By Yusilong."

End Sub

Private Sub txtSl_Change()

   If Trim(cmbCode.Text) <> "" And Trim(cmbSite.Text) <> "" And Val(txtSl) > 0 Then
      cmdAdd.Enabled = True
    Else
      cmdAdd.Enabled = False
   End If
   
End Sub

Private Sub txtSl_GotFocus()

  SetItFocus txtSl
  
End Sub

Public Sub ConfigGrid2(sCod As String)

'On Error GoTo Err_init
Grid2.Visible = False
Grid2.Clear
Grid2.Cols = 7
Grid2.FormatString = "^ .. |^ 物品名称 |^ 单价 |^ 单位 |^ 数量 |^ 金额 |上台时间 "
Grid2.ColWidth(0) = 300
Grid2.ColWidth(1) = 1200
Grid2.ColWidth(2) = 700
Grid2.ColWidth(3) = 800
Grid2.ColWidth(4) = 820
Grid2.ColWidth(5) = 1100
Grid2.ColWidth(6) = 1300

Dim sSQL As String
    sSQL = "Select * From tmpSell Where 座位='" & sCod & "'"
        
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 = 0
        cmdDel.Enabled = False
      Else
        cmdDel.Enabled = True '删除有效
        EF.MoveFirst
        Do While Not EF.EOF
           DelNO = DelNO + 1
           EF.MoveNext
        Loop
     End If
        Grid2.Rows = DelNO + 2
        
        If Grid2.Rows < 21 Then
           Grid2.Rows = 21
        End If
        
     If DelNO > 0 Then
        EF.MoveFirst  '返回第一
        
        HH = 1
        Do While Not EF.EOF()
           Grid2.Row = HH
           Grid2.Col = 0
           Grid2.CellAlignment = 4
        If Not IsNull(EF.Fields(0).Value) Then
           Grid2.Text = EF.Fields(0).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 1
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(4).Value) Then
           Grid2.Text = EF.Fields(4).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 2
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(5).Value) Then
           Grid2.Text = EF.Fields(5).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 3
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(6).Value) Then
           Grid2.Text = EF.Fields(6).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 4
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(7).Value) Then
           Grid2.Text = EF.Fields(7).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 5
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(8).Value) Then
           Grid2.Text = EF.Fields(8).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 6
           Grid2.CellAlignment = 1
        If Not IsNull(EF.Fields(12).Value) Then
           Grid2.Text = EF.Fields(12).Value
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        DB.Close
        
        '合计：
        Grid2.Col = 5
        Dim lAmount As Currency
        Dim x As Integer
        For x = 1 To Grid2.Rows - 2
            Grid2.Row = x
            lAmount = lAmount + Val(Grid2.Text)
        Next
        
        cJE = lAmount '金额合计
        
        Grid2.Row = Grid2.Rows - 1
        Grid2.Col = 1
        Grid2.CellAlignment = 1
        Grid2.CellForeColor = RGB(255, 0, 0)
        Grid2.Text = "*****  合计 ****"
        Grid2.Col = 5
        Grid2.CellAlignment = 1
        Grid2.CellForeColor = RGB(255, 0, 0)
        Grid2.Text = Format(lAmount, "Currency")
    End If
 Grid2.Col = 1
 Grid2.Row = 1
 Grid2.ColSel = 6
 Grid2.Visible = True
   Exit Sub
Err_init:
 MsgBox "网络配置错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub

Private Sub cmbCode_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 iLeftOff1 As Integer
   
   iStart = 1
   iStart = cmbCode.SelStart
   If iLeftOff1 <> 0 Then
      cmbCode.SelStart = iLeftOff1
      iStart = iLeftOff1
   End If
   sString = CStr(Left(cmbCode.Text, iStart))
   
   cmbCode.ListIndex = SendMessage(cmbCode.hwnd, CB_FINDSTRING, -1, ByVal CStr(Left(cmbCode.Text, iStart)))
   If cmbCode.ListIndex = -1 Then
      iLeftOff1 = Len(sString)
      cmbCode.Text = sString
      cmbCode.SelStart = iStart
   End If
    cmbCode.SelStart = iStart
   If Len(cmbCode) > 1 Then
      cmbCode.SelLength = Len(cmbCode) - iStart
     Else
      cmbCode.SelLength = 0
   End If

   iLeftOff1 = 0
   

   
End Sub

Private Sub cmbCode_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
     cmbCode.SelText = ""
     Exit Sub
  End If
  
  bDel = False

End Sub

Private Sub cmbCode_KeyPress(KeyAscii As Integer)
  
  If KeyAscii = 13 Then
     txtSl.SetFocus
     Exit Sub
  End If
  
End Sub

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

  DirectFocus cmbCode, cmdAdd, txtSl, txtSl, KeyCode
  
End Sub

Private Sub txtSl_KeyPress(KeyAscii As Integer)

  If KeyAscii = 8 Then Exit Sub
  
  If KeyAscii < 48 Or KeyAscii > 57 Then
     KeyAscii = 0
  End If
  
End Sub

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

  '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
        lDJ = 0: sName = "": sDJ = "": sDW = "": stype = ""
      Else
        lDJ = EF.Fields("单价").Value
        sName = EF.Fields("名称").Value
        sDW = EF.Fields("单位").Value
        sCode = sWP
        stype = EF.Fields("MenuType")
     End If
     EF.Close
     DB.Close
     Exit Sub
     
Err_init:
 MsgBox "添加记录错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub