On Error GoTo GetERR
   
   Dim utDB As Connection
   Set utDB = CreateObject("ADODB.Connection")
       utDB.Open Constr
       utDB.BeginTrans
       utDB.Execute "Delete From EatList Where MID='" & sName & "'"
       utDB.Execute "Delete From Cust Where CID='" & sName & "'"
       utDB.Execute "Delete From tmpCust1 Where CID='" & sName & "'"
       utDB.Execute "Delete From tmpCust Where CID='" & sName & "'"
       utDB.CommitTrans
       utDB.Close
       Set utDB = Nothing
       DeleteEatList = True
       
   Exit Function
GetERR:
   DeleteEatList = False
   MsgBox "刪除錯誤:" & Err.Description, vbCritical
   
End Function

Private Sub cmdModify_Click()
 
 On Error Resume Next
 
 If cmdModify.Caption = "取消" Then
    lstPro.Enabled = True
    Strip1.Enabled = True
    If lstPro.SelectedItem.Text <> "" Then cmdDel.Enabled = True
    cmdAdd.Caption = "添加輸入的新菜(&A)"
    cmdModify.Caption = "修改選定的菜單(&M)"
    txtCode = "": txtPM = "": txtPingYin = "": txtDJ = "0"
    txtPM.SetFocus
    Old_Code = ""
    txtPM.SetFocus
    '取消代碼---------------------------------------------
  Else
    '修改
    lstPro.Enabled = False
    Strip1.Enabled = False
    Old_Code = lstPro.SelectedItem.Text
    cmdModify.Caption = "取消"
    cmdAdd.Caption = "保存"
    cmdDel.Enabled = False
   '給出值
    txtCode.Text = lstPro.SelectedItem.Text
    txtPM.Text = lstPro.SelectedItem.SubItems(1)
    txtPingYin.Text = lstPro.SelectedItem.SubItems(2)
    txtDJ.Text = lstPro.SelectedItem.SubItems(3)
    cmbType.Text = lstPro.SelectedItem.SubItems(5)
    txtDW.Text = lstPro.SelectedItem.SubItems(4)
    txtPM.SetFocus
  End If
  
End Sub

Private Sub cmdPrint_Click()

 If lstPro.ListItems.Count = 0 Then Exit Sub
 
'打印列表
    If MsgBox("真的要打印【菜名列表】嗎？(Y/N)   " & vbCrLf _
         & "請設置打印機的紙張：A4 縱向   " & vbCrLf & vbCrLf _
         & "如果需要打印所有物品,請在菜分類上選擇(所有物品)后,再打印。   ", vbInformation + vbYesNo) = vbNo Then
       Exit Sub
    End If
 
    Dim ptGrid As listViewPrint
 
   '建立打印對象
    On Error GoTo Err1
    
    Dim strPageLeft As String
    Dim strPageTop As String
    Dim PageTop As Long
    Dim PageLeft As Long

Set ptGrid = New listViewPrint
    ptGrid.N_Border = 1
    ptGrid.N_Cols = "1,2,3,4,5,6"
    Set ptGrid.N_Grid = lstPro
    ptGrid.N_TiTle = "【菜名列表】"
    ptGrid.N_Head10 = "制表人：" & UserText
    ptGrid.N_Head2 = "制表時間：" & Now
    ptGrid.N_PageLeft = XLeft
    ptGrid.N_PageTop = XTop
    ptGrid.N_PageHeight = 290
    ptGrid.N_PageWidth = 200
    ptGrid.N_RowHeight = 6
    ptGrid.PrintPage
    
    Set ptGrid = Nothing
  
 Exit Sub
Err1:
  MsgBox "對不起,打印列表錯誤。  " & vbCrLf & vbCrLf & Err.Description, vbInformation
  Exit Sub

End Sub

Private Sub lstPro_DblClick()

  'If lstPro.ListItems.Count = 0 Then Exit Sub
  'If lstPro.SelectedItem.Text = "" Then Exit Sub
  
 '修改該菜單
  'Call cmdModify_Click
  
End Sub

Private Sub lstPro_ItemClick(ByVal Item As MSComctlLib.ListItem)

  If lstPro.ListItems.Count = 0 Then
     cmdDel.Enabled = False: cmdModify.Enabled = False
     Exit Sub
  End If
  If lstPro.SelectedItem.Text = "" Then
     cmdDel.Enabled = False: cmdModify.Enabled = False
     Exit Sub
  End If
  
  cmdDel.Enabled = True: cmdModify.Enabled = True
  
End Sub

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

  DirectFocus txtDW, cmbType, txtCode, txtCode, KeyCode
  
End Sub

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

  DirectFocus txtCode, txtPingYin, cmbType, cmbType, KeyCode

End Sub

Private Sub txtDW_Click()

  AddValid

End Sub

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

 DirectFocus txtDJ, txtCode, txtDW, txtDW, KeyCode

End Sub

Private Sub txtPingYin_KeyDown(KeyCode As Integer, Shift As Integer)
  
  DirectFocus cmbType, cmdAdd, txtPingYin, txtPingYin, KeyCode

End Sub

Private Sub txtPingyin_GotFocus()

  txtPingYin.SelStart = 0
  txtPingYin.SelLength = Len(txtPingYin.Text)
 
End Sub

Private Sub txtPM_Change()

  AddValid
  
 '取消時,給出拼音無效
  If cmdModify.Caption <> "取消" Then
     txtPingYin.Text = GetPy(txtPM.Text)
  End If
  
End Sub

Private Sub txtPM_GotFocus()

  txtPM.SelStart = 0
  txtPM.SelLength = Len(txtPM)
  
End Sub

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

 DirectFocus txtPM, txtDJ, txtPM, txtPM, KeyCode

End Sub


Private Sub Form_Load()

   GetFormSet Me, frmMain
   MenuFocus = True
  
  '刷新預訂信息,顯示所有預訂信息
   frmMain.lbControl.Caption = "菜單配置"
   Screen.MousePointer = 11
   
   sGlobalType = ""
   ConfigType
  '配置菜單列表
   ConfigGrid
    
  '給出菜類型列表+++++++++++++++++++++++++++++++++++++++++
   GetTypeList "MenuType", cmbType
   GetTypeList "UnitType", txtDW
 
   Screen.MousePointer = 0
  
End Sub

Private Sub Form_Resize()

  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
        
  '常規時
  If Me.WindowState = 0 Then
     Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
  End If
  
  Frame1.Width = Me.Width - 400
  Frame2.Width = Frame1.Width
  Frame2.Height = Me.Height - 1100 - Frame1.Height
  Strip1.Width = Frame1.Width - 50
  'cmdClose.Left = Frame1.Width - cmdClose.Width - 200
  lstPro.Width = Frame2.Width - 80
  lstPro.Height = Frame2.Height - 180
  Line1.X2 = lstPro.Width
  
  cmdClose.Left = Me.ScaleWidth - cmdClose.Width - 400
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  MenuFocus = False
  
End Sub

Private Sub lstPro_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

 On Error Resume Next
 
'排序操作
 If lstPro.ListItems.Count > 0 Then
 
    lstPro.SortKey = ColumnHeader.Index - 1
    lstPro.Sorted = True
    
    If lstPro.SortOrder = lvwAscending Then
       lstPro.SortOrder = lvwDescending
       Else
       lstPro.SortOrder = lvwAscending
    End If
    
 End If

End Sub

Private Sub txtDJ_Change()

 AddValid
 If Trim(txtDJ.Text) = "" Then
    txtDJ.Text = "0"
    txtDJ.SelStart = 0
    txtDJ.SelLength = 1
    txtDJ.SetFocus
    Exit Sub
 End If
 If Trim(txtDJ.Text) = "." Then
    txtDJ.Text = "0."
    txtDJ.SelStart = 2
    txtDJ.SelLength = 0
    txtDJ.SetFocus
    Exit Sub
 End If
 
End Sub

Private Sub txtDJ_GotFocus()

  txtDJ.SelStart = 0
  txtDJ.SelLength = Len(txtDJ)
  
End Sub

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

DirectFocus txtPM, txtDW, txtDJ, txtDJ, KeyCode

End Sub

Private Sub txtDJ_KeyPress(KeyAscii As Integer)

If (KeyAscii > 45 And KeyAscii < 58 And KeyAscii <> 47) Or KeyAscii = 8 Then
   If KeyAscii = 46 And InStr(1, txtDJ, ".", vbBinaryCompare) > 0 Then '為小數點時
      KeyAscii = 0
   End If
      Exit Sub
   Else
   KeyAscii = 0
End If

End Sub

Private Sub txtCode_Change()

 AddValid
  
End Sub

Private Sub txtCode_GotFocus()
  
  txtCode.SelStart = 0
  txtCode.SelLength = Len(txtCode)
  
End Sub

Private Sub Strip1_Click()
  
  '選擇類別
   sGlobalType = Strip1.SelectedItem.Key
   If sGlobalType = "ALL" Then sGlobalType = ""
       ConfigGrid
  
End Sub

Private Sub ConfigGrid()

On Error GoTo Err_init

    Dim DB As Connection, EF As Recordset
    Set DB = CreateObject("ADODB.Connection")
        DB.Open Constr
    Set EF = CreateObject("ADODB.Recordset")
        
      If sGlobalType = "" Then
         EF.Open "Select * from EatList Order by MID", DB, adOpenStatic, adLockReadOnly, adCmdText
      Else
         EF.Open "Select * from EatList Where MType='" & sGlobalType & "' Order by MID", DB, adOpenStatic, adLockReadOnly, adCmdText
      End If
        
      lstPro.Visible = False
      lstPro.ListItems.Clear
      
        If Not (EF.EOF And EF.BOF) Then
            Do While Not EF.EOF()
               InsertToMenu lstPro, EF("MID"), EF("MName"), NullValue(EF("PingYin")), EF("MPrice"), NullValue(EF("Munit")), EF("MType")
               EF.MoveNext
            Loop
            cmdDel.Enabled = True
            cmdModify.Enabled = True
         Else
          cmdDel.Enabled = False
          cmdModify.Enabled = False
        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
        lstPro.Visible = True
        
   Exit Sub
Err_init:
   MsgBox "給出菜單錯誤:" & Err.Description, vbCritical
 
End Sub

Private Sub InsertToMenu(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String, sText6 As String)
 
   On Error Resume Next
   
   If Trim(sText1) = "" Then Exit Sub
   
   Dim lstTmp As ListItem
   Set lstTmp = tmpView.ListItems.Add
       lstTmp.Text = Trim(sText1)
       lstTmp.SubItems(1) = Trim(sText2)
       lstTmp.SubItems(2) = Trim(sText3)
       lstTmp.SubItems(3) = Trim(sText4)
       lstTmp.SubItems(4) = Trim(sText5)
       lstTmp.SubItems(5) = Trim(sText6)
       
End Sub

Private Sub ConfigType()

   On Error GoTo Err_init
   
   Dim tDB As Connection
   Dim tEf As Recordset, sEXE As String
   Set tDB = CreateObject("ADODB.Connection")
       tDB.Open Constr
       sEXE = "Select Class From MenuType"
   Set tEf = CreateObject("ADODB.Recordset")
       tEf.Open sEXE, tDB, adOpenStatic, adLockReadOnly, adCmdText
     If tEf.EOF And tEf.BOF Then
        Strip1.SelectedItem.Key = "Null"
        sGlobalType = ""
      Else
        Dim x As Integer
            x = 1
        Do While Not tEf.EOF
          '給出菜分類
           Strip1.Tabs.Add x, tEf.Fields(0), tEf.Fields(0) & "&" & Chr(64 + x)
           x = x + 1
           tEf.MoveNext
        Loop
        sGlobalType = Strip1.SelectedItem.Key
     End If
     tEf.Close
     Set tEf = Nothing
     tDB.Close
     Set tDB = Nothing
     Exit Sub
     
Err_init:
    MsgBox "菜分類錯誤，名稱不能全為數字 ？ " & Err.Description, vbExclamation, "錯誤：0577-86261392 013955647557"

End Sub