frmbackit.frm

星级酒店管理系统（附带系统自写控件源码）

      Index           =   3
      Left            =   7485
      TabIndex        =   17
      Top             =   1860
      Width           =   540
   End
   Begin VB.Label lbStatus 
      AutoSize        =   -1  'True
      Caption         =   "《 后台退单 》"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00008000&
      Height          =   210
      Left            =   6960
      TabIndex        =   16
      Top             =   780
      Width           =   1470
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      Index           =   2
      X1              =   7005
      X2              =   9960
      Y1              =   510
      Y2              =   510
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   3
      X1              =   7005
      X2              =   9960
      Y1              =   495
      Y2              =   495
   End
End
Attribute VB_Name = "frmBackIt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sName As String, lDJ As Currency, sDW As String, lSL As Long, sType As String, sCode As String
Dim AddIt As Boolean
Dim sGlobalType As String

Private Sub cmbCode_LostFocus()

 If AddIt = True Then Exit Sub
 '检测编码是否正确
 If Trim(cmbCode.Text) = "" Then Exit Sub
 GetItem "ID"
 
End Sub

Private Sub cmdAdd_Click()

 AddItItem
 
End Sub

Private Sub cmdClose_Click()

 'If AddIt = True Then
 '   If MsgBox("已经有菜名列入，是否保存该菜单(是/否)！   ", vbInformation + vbYesNo) = vbNo Then
 '      Unload Me
 '   Else
 '      '保存菜单
 '      Call cmdSave_Click
 '      Unload Me
 '   End If
 ' Else
   Unload Me
 'End If
 
End Sub

Private Sub cmdDel_Click()

  On Error GoTo Err_del
  If Grid1.Text = "" Then
     MsgBox "请先选择一种物品后,再按删除按钮。    ", vbExclamation
     Exit Sub
  End If
  If Grid1.Text = "*****  合计 ****" Then
     Exit Sub
  End If
  
  ' 删除
    If MsgBox("真的删除 [ " & Grid1.Text & " ] 吗？    ", vbYesNo + vbCritical) = vbNo Then
       Exit Sub
    End If
    
    DelRecord Grid1.TextMatrix(Grid1.Row, 0), "ID", "tmpTodayCust"
    
  ' 刷新数据
    Grid1.RemoveItem Grid1.Row
    
    Exit Sub
Err_del:
 MsgBox "记录删除错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
  
End Sub

Private Sub Form_Activate()

  Strip1.Enabled = True
  
End Sub

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

 Select Case KeyCode
 
  Case 120  'F9
    If cmdAdd.Enabled = True Then cmdAdd.Value = True
  Case 121  'F10
    If cmdDel.Enabled = True Then cmdDel.Value = True
  Case 122  'F11
    If cmdClose.Enabled = True Then cmdClose.Value = True
  Case Else
    '...
    
End Select
  
End Sub

Private Sub Form_Load()

 GetFormSet Me, Screen
 sGlobalType = ""
 txtDH = sDNumber
 ConfigType
 'Strip1.Tabs.Item("ALL").Selected = True
 
 ConfigGridX ""
 '配置类别
 ConfigGrid1 ""

End Sub

Private Sub ConfigGridX(sCode As String)

On Error GoTo Err_init
Grid1X.Visible = False
Grid1X.Clear
Grid1X.Cols = 7
Grid1X.FormatString = "^ .. |^ 编码 |^ 拼音 |^ 菜名 |^ 单价 |^ 单位 |^ 类型"
Grid1X.ColWidth(0) = 300
Grid1X.ColWidth(1) = 1200
Grid1X.ColWidth(2) = 1200
Grid1X.ColWidth(3) = 1200
Grid1X.ColWidth(4) = 1000
Grid1X.ColWidth(5) = 600
Grid1X.ColWidth(6) = 1000

Dim sSQL As String
   
  If sGlobalType = "" Then
    If sCode <> "" Then
       sSQL = "Select * From EatList Where (代码 Like '" & sCode & "*') Order By 代码"
    Else
       sSQL = "Select * From EatList Order By 代码"
    End If
  Else
    If sCode <> "" Then
       sSQL = "Select * From EatList Where (代码 Like '" & sCode & "*' And MenuType='" & sGlobalType & "') Order By 代码"
    Else
       sSQL = "Select * From EatList Where MenuType='" & sGlobalType & "' Order By 代码"
    End If
  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 = 0
      Else
        Do While Not Ef.EOF
           DelNO = DelNO + 1
           Ef.MoveNext
        Loop
     End If
        Grid1X.Rows = DelNO + 3
        
        If Grid1X.Rows < 28 Then
           Grid1X.Rows = 28
        End If
        
     If DelNO > 0 Then
        Ef.MoveFirst  '返回第一
        HH = 1
        Do While Not Ef.EOF()
           Grid1X.Row = HH
           Grid1X.Col = 0
           Grid1X.CellAlignment = 4
        If Not IsNull(Ef.Fields("ID").Value) Then
           Grid1X.Text = Ef.Fields("ID").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 1
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("代码").Value) Then
           Grid1X.Text = Ef.Fields("代码").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 2
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("Pingyin").Value) Then
           Grid1X.Text = Ef.Fields("Pingyin").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 3
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("名称").Value) Then
           Grid1X.Text = Ef.Fields("名称").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 4
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("单价").Value) Then
           Grid1X.Text = Ef.Fields("单价").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 5
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("单位").Value) Then
           Grid1X.Text = Ef.Fields("单位").Value
        End If
           Grid1X.Row = HH
           Grid1X.Col = 6
           Grid1X.CellAlignment = 1
        If Not IsNull(Ef.Fields("MenuType").Value) Then
           Grid1X.Text = Ef.Fields("MenuType").Value
        End If
        
          Ef.MoveNext
          HH = HH + 1
        Loop
        Ef.Close
        DB.Close
    End If
 Grid1X.Col = 1
 Grid1X.Row = 1
 Grid1X.ColSel = 6
 Grid1X.Visible = True
   Exit Sub
Err_init:
 MsgBox "网络配置错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub Form_Resize()

    Strip1.Width = Me.ScaleWidth - 60

End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  '保存单据实质
  '-----------------------------------------------------------------
  SaveIt ""
  
End Sub

Private Sub cmbCode_Change()
   
 If Trim(cmbCode.Text) <> "" And Val(txtSL) <> 0 Then
     cmdAdd.Enabled = True
   Else
     cmdAdd.Enabled = False
 End If
 If AddIt = False Then
    sGlobalType = ""
    'Strip1.Tabs.Item("ALL").Selected = True
    ConfigGridX Trim(cmbCode.Text)
 End If
   
End Sub

Public Sub ConfigGrid1(sCod As String)

On Error GoTo Err_init
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 9
Grid1.FormatString = "^ .. |^ 物品编码 |^ 物品名称 |^ 单位 |^ 单价 |^ 数量 |^ 加工费 |^ 金额 |^ 座位"
Grid1.ColWidth(0) = 300
Grid1.ColWidth(1) = 1400
Grid1.ColWidth(2) = 1400
Grid1.ColWidth(3) = 1000
Grid1.ColWidth(4) = 1000
Grid1.ColWidth(5) = 1000
Grid1.ColWidth(6) = 1000
Grid1.ColWidth(7) = 1300
Grid1.ColWidth(8) = 1180

Dim sSQL As String
    sSQL = "Select * From tmpTodayCust"
        
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
      Else
        Ef.MoveFirst
        Do While Not Ef.EOF
           DelNO = DelNO + 1
           Ef.MoveNext
        Loop
     End If
        Grid1.Rows = DelNO + 2
        If Grid1.Rows < 21 Then
           Grid1.Rows = 21
        End If
        
     If DelNO > 0 Then
        Ef.MoveFirst  '返回第一
        HH = 1
        Do While Not Ef.EOF()
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 1
        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("CID").Value) Then
           Grid1.Text = Ef.Fields("CID").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Name").Value) Then
           Grid1.Text = Ef.Fields("Name").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Unit").Value) Then
           Grid1.Text = Ef.Fields("Unit").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Price").Value) Then
           Grid1.Text = Ef.Fields("Price").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Quanty").Value) Then
           Grid1.Text = Ef.Fields("Quanty").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 6
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("JGF").Value) Then
           Grid1.Text = Ef.Fields("JGF").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 7
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Amos").Value) Then
           Grid1.Text = Ef.Fields("Amos").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 8
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields("Site").Value) Then
           Grid1.Text = Ef.Fields("Site").Value
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        Ef.Close
        DB.Close
   End If
 Grid1.Col = 1
 Grid1.Row = 1
 Grid1.ColSel = 8
 Grid1.Visible = True
   Exit Sub
Err_init:
 MsgBox "网络配置错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub Grid1_SelChange()
  
  If Grid1.Text = "" Then
     cmdDel.Enabled = False
    Else
     cmdDel.Enabled = True
  End If

End Sub

Private Sub Grid1X_Click()

  '双击将该值送给详细项目
  If Trim(Grid1X.Text) <> "" Then '有物品时
     AddIt = True
     cmbCode.Text = Grid1X.TextMatrix(Grid1X.Row, 1)
     txtPingyin = Grid1X.TextMatrix(Grid1X.Row, 2)
     txtName = Grid1X.TextMatrix(Grid1X.Row, 3)
     txtSL = 1