input.frm

订餐的一个软件 ,美食档案 订餐点菜 销量查询 用于各级酒店餐饮部门的订餐点菜及收费管理

Private Sub Image1_Click()
lblImage = ""
Image1.Picture = LoadPicture("")
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Image1
  If lblImage <> "" Then
    .MousePointer = 99
    .ToolTipText = "单击删除图片"
  Else
    .MousePointer = 0
    .ToolTipText = ""
  End If
End With
End Sub

Private Sub imgTool_Click(Index As Integer)
Select Case Index
  Case 0
    MnuFileNew_Click
  Case 1
    MnuFileModi_Click
  Case 2
    MnuFileSave_Click
  Case 3
    MnuFileDelete_Click
  Case 4
    MnuFileFind_Click
  Case 5
    MnuFileExit_Click
End Select
End Sub

Private Sub imgTool_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Line2(Index * 4 + 2).BorderColor = &HFFFFFF
    Line2(Index * 4 + 3).BorderColor = &HFFFFFF
    Line2(Index * 4 + 0).BorderColor = &H808080
    Line2(Index * 4 + 1).BorderColor = &H808080
End Sub

Private Sub imgTool_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not blnOnImage Then
    blnOnImage = True
    Line2(Index * 4 + 0).BorderColor = &HFFFFFF
    Line2(Index * 4 + 1).BorderColor = &HFFFFFF
    Line2(Index * 4 + 2).BorderColor = &H808080
    Line2(Index * 4 + 3).BorderColor = &H808080
End If
End Sub

Private Sub imgTool_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Line2(Index * 4 + 0).BorderColor = &HFFFFFF
    Line2(Index * 4 + 1).BorderColor = &HFFFFFF
    Line2(Index * 4 + 2).BorderColor = &H808080
    Line2(Index * 4 + 3).BorderColor = &H808080
End Sub

Private Sub lblImage_Click()
File1.Visible = Not File1.Visible
If File1.Visible = True Then
  File1.SetFocus
End If
End Sub

Private Sub lstMenu_Click()
Rec.FindFirst "Name='" & lstMenu.Text & "'"
InputFromDB
End Sub

Private Sub MnuAboutTele_Click()
Dim strNewTele As String
strNewTele = InputBox("请输入新的订餐电话：", "修改订餐电话", strTele)
strTele = Left(Trim(strNewTele), 20)
Dim I As Integer
I = FreeFile
Open AppDir & "Menu.tel" For Output As #I
Write #I, strTele
Close #I
End Sub

Private Sub MnuFileDelete_Click()
If MsgBox("若想要客人看不到这道菜，可以选中“暂不列入菜单”选项。" & vbCrLf & "您这样删除后这条记录将不可恢复，继续码？", vbYesNo + vbQuestion, "删除提示") = vbNo Then
  Exit Sub
End If
Rec.Delete
Dim I As Integer
I = lstMenu.ListIndex
lstMenu.RemoveItem I
If I = lstMenu.ListCount Then
  I = I - 1
End If
MnuShowWhole_Click
If Rec.RecordCount <> 0 Then
  If I = -1 Then I = 0
  lstMenu.ListIndex = I
End If
End Sub

Private Sub MnuFileExit_Click()
Unload Me
End Sub


Private Sub MnuFileFind_Click()
Dim strFind As String
Dim I As Integer
Dim blnFound As Boolean
strFind = Left(InputBox("请输入要查找的菜名：", "在当前显示的菜单中查找"), 10)
For I = 0 To lstMenu.ListCount - 1
  If lstMenu.List(I) = Trim(strFind) Then
    lstMenu.ListIndex = I
    blnFound = True
    Exit For
  End If
Next
If Not blnFound Then
  MsgBox "在当前显示的菜单列表中没有“" & Trim(strFind) & "”这个名字。", vbInformation, "查询结果"
End If
End Sub

Private Sub MnuFileModi_Click()
DisableCon
MnuFileSave.Enabled = True
imgTool(2).Enabled = True
MnuFileUndo.Enabled = True
DBState = modify
FrameState (DBState)
End Sub

Private Sub MnuFileNew_Click()
txtName = ""
lblImage = ""
txtABC = ""
txtDescribe = ""
Image1.Picture = LoadPicture("")
DisableCon
MnuFileSave.Enabled = True
imgTool(2).Enabled = True
DBState = Add
FrameState (DBState)
End Sub

Private Sub MnuFileSave_Click()
If Trim(txtName) = "" Then
  MsgBox "菜名不能空白！", vbExclamation, "输入、编辑菜单原始资料"
  txtName = ""
  txtName.SetFocus
  Exit Sub
End If
If Trim(txtABC) = "" Then
  MsgBox "请填写菜名的拼音字头！", vbExclamation, "输入、编辑菜单原始资料"
  txtABC = ""
  txtABC.SetFocus
  Exit Sub
End If
If DBState = Add Then
  Rec.Close
  Set Rec = Nothing
  Set Rec = DB.OpenRecordset("Select * from Menu order by ABC,Name")
  Rec.FindFirst "Name='" & txtName & "'"
  If Rec.NoMatch = False Then
    MsgBox "“" & txtName & "”这道菜已经存在！", vbInformation, "保存提示"
    txtName.SetFocus
    SendKeys "{Home}+{End}"
    Exit Sub
  End If
End If
OutputToDB
MnuShowWhole_Click
DBState = saved
FrameState (DBState)
End Sub

Private Sub MnuFileUndo_Click()
InputFromDB
End Sub

Private Sub MnuHelpAbout_Click()
MsgBox "本程序由 LIST Studio 开发。" & vbCrLf _
& "版权所有(2000-2001)：LIST Corp.", vbInformation, "关于《美食向导》"
End Sub

Private Sub MnuList1_Click(Index As Integer)
UncheckMenu
MnuList1(Index).Checked = True
Dim strCondition As String
strCondition = MnuList1(Index).Caption
Rec.Close
Set Rec = Nothing
Set Rec = DB.OpenRecordset("Select * from Menu where Serial='" & strCondition & "'order by ABC,Name")
ShowList
lblList = MnuList1(Index).Caption & "：（共" & lstMenu.ListCount & "个）"
End Sub

Private Sub MnuList2_Click(Index As Integer)
UncheckMenu
MnuList2(Index).Checked = True
Dim strCondition As String
strCondition = MnuList2(Index).Caption
Rec.Close
Set Rec = Nothing
Set Rec = DB.OpenRecordset("Select * from Menu where Material='" & strCondition & "'order by ABC,Name")
ShowList
lblList = MnuList2(Index).Caption & "（类）：（共" & lstMenu.ListCount & "个）"
End Sub

Private Sub MnuList3_Click(Index As Integer)
UncheckMenu
MnuList3(Index).Checked = True
Dim strCondition As String
strCondition = MnuList3(Index).Caption
Rec.Close
Set Rec = Nothing
Set Rec = DB.OpenRecordset("Select * from Menu where Method='" & strCondition & "'order by ABC,Name")
ShowList
lblList = MnuList3(Index).Caption & "（类）：（共" & lstMenu.ListCount & "个）"
End Sub

Private Sub MnuShowWhole_Click()
UncheckMenu
MnuShowWhole.Checked = True
Set Rec = DB.OpenRecordset("Select * from Menu order by ABC,Name")
ShowList
lblList = "全部菜单：（共" & lstMenu.ListCount & "个）"
End Sub

Private Sub txtABC_KeyPress(KeyAscii As Integer)
If (KeyAscii <= Asc("Z") And KeyAscii >= Asc("A")) Or (KeyAscii <= Asc("z") And KeyAscii >= Asc("a")) Or KeyAscii = 8 Then
  Exit Sub
Else
  KeyAscii = 0
End If
End Sub

Private Sub txtNutrition_Change(Index As Integer)
If DBState = saved Then
  Exit Sub
End If
With txtNutrition(Index)
  If Not IsNumeric(.Text) Then
    .Text = ""
  Else
    .Text = Int(.Text)
    .SelStart = Len(.Text)
  End If
End With
End Sub

Private Sub txtPrice_Change()
If DBState = saved Then
  Exit Sub
End If
If Not IsNumeric(txtPrice) Or CCur(Val(txtPrice)) > 9999 Then
  txtPrice = ""
End If
End Sub

Private Sub FrameState(ConState As State)
Select Case ConState
  Case saved
    lblFrame.ForeColor = &H80000012
    lblFrame = "菜单原始资料(浏览状态)："
    Frame1.Enabled = False
    lstMenu.Enabled = True
  Case modify
    lblFrame.ForeColor = vbBlue
    lblFrame = "菜单原始资料(修改状态)："
    Frame1.Enabled = True
    lstMenu.Enabled = False
  Case Add
    lblFrame.ForeColor = vbRed
    lblFrame = "菜单原始资料(添加状态)："
    Frame1.Enabled = True
    lstMenu.Enabled = False
End Select
ControlColor (ConState)
End Sub
Private Sub ControlColor(ConState As State)
Dim conColor As Long
Select Case ConState
  Case saved
    conColor = &H80000012
  Case modify
    conColor = vbBlue
  Case Add
    conColor = vbRed
End Select
Dim ControlinFrame As Control
For Each ControlinFrame In Controls
  If TypeName(ControlinFrame) <> "Image" And _
    TypeName(ControlinFrame) <> "Menu" And _
    TypeName(ControlinFrame) <> "Line" Then
    ControlinFrame.ForeColor = conColor
  End If
Next
End Sub

Private Sub OutputToDB()
If DBState = Add Then
  Rec.AddNew
ElseIf DBState = modify Then
  Rec.Edit
End If
With Rec
  .Fields("Name") = Trim(txtName)
  .Fields("Serial") = Left(Trim(cmbSerial), 10)
  .Fields("Method") = Left(Trim(cmbMethod), 10)
  .Fields("Set") = Left(Trim(cmbSet), 10)
  .Fields("Material") = Left(Trim(cmbMaterial), 10)
  .Fields("Describe") = Trim(txtDescribe)
  .Fields("Nutrition0") = Val(txtNutrition(0))
  .Fields("Nutrition1") = Val(txtNutrition(1))
  .Fields("Nutrition2") = Val(txtNutrition(2))
  .Fields("Nutrition3") = Val(txtNutrition(3))
  .Fields("Nutrition4") = Val(txtNutrition(4))
  .Fields("Image") = lblImage
  .Fields("Price") = Format(Val(txtPrice), "##0.00")
  .Fields("ABC") = UCase(txtABC)
  .Fields("Other1") = chkOther(1).Value
  .Fields("Other2") = chkOther(2).Value
  .Fields("Other3") = chkOther(3).Value
End With
Rec.Update
End Sub


Private Sub InputFromDB()
With Rec
  txtName = .Fields("Name")
  cmbSerial = .Fields("Serial")
  cmbMethod = .Fields("Method")
  cmbMaterial = .Fields("Material")
  cmbSet = .Fields("Set")
  txtDescribe = .Fields("Describe")
  txtNutrition(0) = .Fields("Nutrition0")
  txtNutrition(1) = .Fields("Nutrition1")
  txtNutrition(2) = .Fields("Nutrition2")
  txtNutrition(3) = .Fields("Nutrition3")
  txtNutrition(4) = .Fields("Nutrition4")
  lblImage = .Fields("Image")
  txtPrice = .Fields("Price")
  txtABC = .Fields("ABC")
  chkOther(1).Value = .Fields("Other1")
  chkOther(2).Value = .Fields("Other2")
  chkOther(3).Value = .Fields("Other3")
End With
  If lblImage <> "" Then
    If Dir(AppDir & "Image\" & lblImage) <> "" Then
      Image1.Picture = LoadPicture(AppDir & "Image\" & lblImage)
    Else
      Image1.Picture = LoadPicture("")
      lblImage = ""
    End If
  Else
    Image1.Picture = LoadPicture("")
  End If
End Sub

Private Sub ControlCls()
Dim Con As Control
For Each Con In Controls
  If TypeName(Con) = "TextBox" Or TypeName(Con) = "ComboBox" Then
    Con.Text = ""
  End If
Next
Dim I As Integer
For I = 1 To 3
  chkOther(I).Value = 0
Next I
lblImage = ""
Image1.Picture = LoadPicture("")
End Sub

Private Sub DisableCon()
Dim Con As Control
  For Each Con In Controls
    If TypeName(Con) = "Menu" Then
      If Con.Caption <> "-" And Con.Name <> "MnuFile" _
      And Left(Con.Name, 7) = "MnuFile" Or Left(Con.Name, 7) = "MnuList" Or Con.Name = "MnuShowWhole" Then
        Con.Enabled = False
      End If
    End If
  Next
Dim I As Integer
For I = 0 To 5
  imgTool(I).Enabled = False
Next I
End Sub

Private Sub UncheckMenu()
MnuShowWhole.Checked = False
Dim I As Integer
For I = 0 To 4
  MnuList1(I).Checked = False
Next
For I = 0 To 8
  MnuList2(I).Checked = False
Next
For I = 0 To 7
  MnuList3(I).Checked = False
Next
End Sub

Private Sub EnableCon()
Dim Con As Control
  For Each Con In Controls
    If TypeName(Con) = "Menu" Then
        Con.Enabled = True
    End If
  Next
Dim I As Integer
For I = 0 To 5
  imgTool(I).Enabled = True
Next I
End Sub

Private Sub ShowList()
lstMenu.Clear
If DBState = saved Then
  ControlCls
End If
If Rec.RecordCount <> 0 Then
  Rec.MoveFirst
  Do Until Rec.EOF
    lstMenu.AddItem Rec.Fields("Name")
    Rec.MoveNext
    DoEvents
  Loop
  If DBState = saved Then
    lstMenu.ListIndex = 0
  Else
    lstMenu.Text = txtName
  End If
  EnableCon
  MnuFileSave.Enabled = False
  MnuFileUndo.Enabled = False
  imgTool(2).Enabled = False
Else
  DisableCon
  MnuShowWhole.Enabled = True
  MnuFileNew.Enabled = True
  imgTool(0).Enabled = True
  MnuFileExit.Enabled = True
  imgTool(5).Enabled = True
End If
End Sub