frmcustomer.frm

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

           Grid1.Text = EF.Fields(4).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(EF.Fields(5).Value) Then
           Grid1.Text = EF.Fields(5).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(EF.Fields(6).Value) Then
           Grid1.Text = EF.Fields(6).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 6
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(EF.Fields(7).Value) Then
           Grid1.Text = EF.Fields(7).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 7
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(EF.Fields(8).Value) Then
           Grid1.Text = EF.Fields(8).Value
        End If
        
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        DB.Close
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 7
 Grid1.Visible = True
 Exit Sub
Err_grid:
 MsgBox "网格 配置错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub

Private Sub cmdDel_Click()
 
  'On Error GoTo Err_del
  If Grid1.Text = "" Then
     MsgBox "请选定要删除的物品！    ", vbInformation
     Exit Sub
  End If
    
  If MsgBox("真的要删除 [ " & Grid1.TextMatrix(Grid1.Row, 2) & " ] 吗（Y/N）？    ", vbYesNo + vbCritical) = vbYes Then
     DelRecord Grid1.TextMatrix(Grid1.Row, 0), "ID", "tmpEnterList"
     sJE = sJE - Val(Grid1.TextMatrix(Grid1.Row, 4))  '金额下调
     Grid1.RemoveItem Grid1.Row
  End If
  
  txtDW = ""
  txtDJ = ""
  cmbPM.SetFocus
  
  Exit Sub
Err_del:
 MsgBox "删除记录错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub

Private Sub cmdPast_Click()

  'On Error GoTo Err_
  
  If MsgBox("真的将此单入帐吗？(Y/N)   ", vbInformation + vbYesNo) = vbNo Then Exit Sub
  
   Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(ConData, False, False, Constr)
    Set EF = DB.OpenRecordset("Select * From tmpEnterList", dbOpenDynaset)
    
  ' 没有数据
    If EF.EOF And EF.BOF Then
       EF.Close
       DB.Close
       MsgBox "对不起，没有进货数据不能过帐？   ", vbInformation
       cmbPM.SetFocus
       Exit Sub
    End If
    
  ' 事务处理
    DBEngine.BeginTrans
    
    Dim sSql1 As String, sSql2 As String
        sSql1 = "Insert into EnterList Select * From tmpEnterList"
        sSql2 = "Delete * From tmpEnterList"
  ' 有数据时
    Dim sCode As String, HG As Recordset
    Dim sTmp As String, sTmp1 As String
    
    Set HG = DB.OpenRecordset("Select * From StoreList", dbOpenDynaset)
    Do While Not EF.EOF
       ' 增加库存记录，首先查找是否存在库存中，然后更新
         sCode = EF.Fields(2).Value
         sTmp = "代码='" & sCode & "'"
            HG.FindFirst sTmp
            If HG.NoMatch Then
               '播入记录
               sTmp1 = "Insert into StoreList Select Menutype,名称,单位,单价,金额,代码,数量 From tmpEnterList Where 代码='" & sCode & "'"
             Else
               '更新记录
               sTmp1 = "Update StoreList Set 数量=数量+" & EF.Fields("数量") & ",金额=金额+" & EF.Fields("金额") & " Where 代码='" & sCode & "'"
            End If
            DB.Execute sTmp1
      EF.MoveNext   '记录下翻
    Loop
    
      DB.Execute sSql1
      DB.Execute sSql2
    DBEngine.CommitTrans
    EF.Close
    DB.Close
    
   '清空
    cmbPM = "": txtDJ = "": txtDW = ""
    ConfigGrid
    cmbPM.SetFocus
    Exit Sub
    
Err_:
    MsgBox "未知错误：" & vbCrLf & vbCrLf & err.Description, vbOKOnly
    
End Sub


Private Sub cmdSelectUnit_Click()

  picCatalog.Visible = True
  Grid1Type.SetFocus
  
End Sub

Private Sub Form_Activate()

  txtCatalog.SetFocus
  
End Sub

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

  If KeyCode = 27 Then 'ESC
     If picCatalog.Visible = True Then
        picCatalog.Visible = False
     End If
     If picPM.Visible = True Then
        picPM.Visible = False
     End If
     Exit Sub
  End If
  If KeyCode = 46 Then 'Del
  
     If Grid1.Text = "" Then Exit Sub
     
     If Shift = 1 Then  'Shift按下时,直接删除
        DelRecord Grid1.TextMatrix(Grid1.Row, 0), "ID", "Customer"
        sJE = sJE - Val(Grid1.TextMatrix(Grid1.Row, 4))  '金额下调
        Grid1.RemoveItem Grid1.Row
        Exit Sub
     End If
     
       '执行删除询问
       cmdDel.Value = True

  End If
  
  If KeyCode = 123 Then  '确认
     cmdPast.Value = True
  End If
  
End Sub

Private Sub Form_Load()

 FCT = True
 
 'On Error GoTo Err_init
  Screen.MousePointer = 11
  Dim L As Long, t As Long
  L = Val(GetSetting(App.EXEName, "Option", "Customer_L", 2000))
  t = Val(GetSetting(App.EXEName, "Option", "Customer_T", 2000))
  Me.Left = L
  Me.Top = t
  Me.Caption = sJH & " 进货列表 ： 现在是 [ " & Format(Date, "yyyy/mm/dd") & "  " & Time & " ] "
  
  ConfigGrid
  ConfigPM txtCatalog.Text        '配置品名
  ConfigType     '配置类型
  tpDate.Value = Date
  
  Screen.MousePointer = 0
  
  Exit Sub
Err_init:
 MsgBox "表单初始化错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub

Private Sub ConfigPM(sPM As String)

   '配置网格
Grid1PM.Visible = False
Grid1PM.Cols = 1
Grid1PM.Clear
Grid1PM.FormatString = "^ 分 类 名 称 "
Grid1PM.ColWidth(0) = 2000

Dim DB As Database, EF As Recordset, HH As Integer
      
  
  Set DB = OpenDatabase(ConData, False, False, Constr)

    Set EF = DB.OpenRecordset("EatList", dbOpenTable)
        Grid1PM.Rows = EF.RecordCount + 2
        
        If Grid1PM.Rows < 20 Then
           Grid1PM.Rows = 20
        End If
        
    If Trim(sPM) = "" Then
        Set EF = DB.OpenRecordset("Select * From EatList", dbOpenDynaset)
     Else
        Set EF = DB.OpenRecordset("Select * From EatList Where Menutype='" & sPM & "'", dbOpenDynaset)
    End If
    
        HH = 0
        Grid1PM.Col = 0
        Grid1PM.CellAlignment = 4  '居中
        Grid1PM.Text = "新建..."
        HH = 1
        Do While Not EF.EOF()
           Grid1PM.Row = HH
           Grid1PM.Col = 0
           Grid1PM.CellAlignment = 1
        If Not IsNull(EF.Fields(1).Value) Then
           Grid1PM.Text = EF.Fields(1).Value
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        DB.Close
 Grid1PM.Col = 0
 Grid1PM.Row = 1
 Grid1PM.ColSel = 0
 Grid1PM.Visible = True

End Sub

Private Function GetDJ(sPM As String, stype As String) As Currency

   'On Error GoTo Err_dj
   Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(ConData, False, False, Constr)
    
    Set EF = DB.OpenRecordset("Select * From EatList Where 名称='" & sPM & "' and MenuType='" & stype & "'", dbOpenDynaset)
        
        If EF.BOF And EF.EOF Then
           GetDJ = 0
         Else
           If Not IsNull(EF.Fields(3)) Then GetDJ = EF.Fields(3)
           If Not IsNull(EF.Fields(2)) Then sDW = EF.Fields(2)  '给出单位
        End If
         
    EF.Close
    DB.Close
      Exit Function
Err_dj:
 MsgBox "给出单价错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Function

Private Sub Form_Resize()

  If Me.WindowState = 1 Then Exit Sub
  
  'On Error Resume Next
  Frame1.Width = Me.ScaleWidth - 100
  Grid1.Width = Me.ScaleWidth - 100
  Grid1.Height = Me.Height - Frame1.Height - 500
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  FCT = False
          
  SaveSetting App.EXEName, "Option", "Customer_L", Me.Left
  SaveSetting App.EXEName, "Option", "Customer_T", Me.Top
  Exit Sub
Err_Load:
 MsgBox "表单御载错误!    " & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Sub

Private Sub Grid1_Click()

  If Grid1.Text = "" Then
     cmdDel.Enabled = False
     mnuDel.Enabled = False
    Else
     cmdDel.Enabled = True
     mnuDel.Enabled = True
  End If
  
End Sub

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

  If Button = 2 Then
     PopupMenu mnuOperater
  End If
  
End Sub

Private Sub Grid1PM_LostFocus()

  picPM.Visible = False
  
End Sub

Private Sub Grid1Type_Click()
  
  If Grid1Type.Text = "" Then Exit Sub
 ' 新建类别
   If Grid1Type.Text = "新建..." Then
      CunstomType1.Show 1
      '刷新数据
      ConfigType
      txtCatalog.Text = stype
      picCatalog.Visible = False
      Exit Sub
    Else
      txtCatalog.Text = Grid1Type.Text
      picCatalog.Visible = False
   End If
  
End Sub

Private Sub Grid1Type_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
    '关闭
    Grid1Type_Click
    picCatalog.Visible = False
 End If
 If KeyAscii = 27 Then
    picCatalog.Visible = False
 End If
 
End Sub

Private Sub Grid1Type_LostFocus()

  picCatalog.Visible = False
  
End Sub

Private Sub Frame1_DragDrop(Source As Control, x As Single, y As Single)

End Sub

Private Sub MnuClose_Click()

  Call cmdCancel_Click
  
End Sub

Private Sub mnuDel_Click()

   Call cmdDel_Click
   
End Sub

Private Sub mnuOperater_Click()

  If Grid1.Text = "" Then
     cmdDel.Enabled = False
     mnuDel.Enabled = False
    Else
     cmdDel.Enabled = True
     mnuDel.Enabled = True
  End If
  
End Sub

Private Sub picCatalog_LostFocus()

  picCatalog.Visible = False
  
End Sub

Private Sub Text1_Change()

End Sub

Private Sub SSCommand1_Click()

 picPM.Visible = True