?? frmintegration.frm

?? 星級酒店管理系統（附帶系統自寫控件源碼）
?? FRM
?? 第 1 頁 / 共 3 頁
字號:
上一頁 1 23
             aRs("MenuType") = Trim(ftMenuTyp.Text)
          End If
          If Trim(ftDescription.Text) <> "" Then
             aRs("MenuDescription") = Trim(ftDescription.Text)
          End If
          aRs.Update
          UpdateNo "酒席配置"
         '添加到列表中
          InsertToIntegration lstPro, stmpID, Trim(ftMenuName.Text), ftPrice.Text, Trim(ftMenuTyp.Text), Trim(ftDescription.Text)
       Else
         aRs.Close
         Set aRs = Nothing
         aDB.Close
         Set aDB = Nothing
         MsgBox "編號【" & stmpID & "】已經存在,   " & vbCrLf _
              & "系統將自動更新編號或手工修改后繼續？  ", vbExclamation
         UpdateNo "酒席配置"
         ftMenuID.Text = GetNo("酒席配置")
         ftMenuID.SetFocus
         Exit Sub
      End If
      
      aRs.Close
      Set aRs = Nothing
      aDB.Close
      Set aDB = Nothing

    '重新添加新的酒席
     ftMenuID.Text = GetNo("酒席配置")
     ftPrice.Text = "0"
     ftMenuName.Text = ""
     ftMenuTyp.Text = ""
     ftDescription.Text = ""
     ftMenuName.SetFocus
  
  Exit Sub
AddERR:
  MsgBox "添加錯誤:" & Err.Description, vbCritical
  
End Sub

Private Sub cmdClos_Click()

  Unload Me
  
End Sub

Private Sub cmdDel_Click()

  If lstPro.ListItems.Count = 0 Then Exit Sub
  If lstPro.SelectedItem.Text = "" Then Exit Sub
  
  If lstDetail.ListItems.Count = 0 Then Exit Sub
  If lstDetail.SelectedItem.Text = "" Then Exit Sub
  
  If MsgBox("真的要刪除〖" & lstPro.SelectedItem.SubItems(1) & "〗酒席   " & vbCrLf _
       & "中【" & lstDetail.SelectedItem.SubItems(1) & "】,嗎？(Y/N)          ", vbYesNo + vbInformation) = vbNo Then Exit Sub
  
  If DeleteMenuCatDetail(lstDetail.SelectedItem.Text, lstPro.SelectedItem.Text, "tbdMenuCat") = True Then
     lstDetail.ListItems.Remove lstDetail.SelectedItem.Index
  End If

End Sub

Private Sub cmdDelCat_Click()

  If lstPro.ListItems.Count = 0 Then Exit Sub
  If lstPro.SelectedItem.Text = "" Then Exit Sub
  
  If MsgBox("真的要刪除〖" & lstPro.SelectedItem.SubItems(1) & "〗酒席嗎？(Y/N)    ", vbYesNo + vbInformation) = vbNo Then Exit Sub
  
  If DeleteMenuCat(lstPro.SelectedItem.Text, "tbdMenuCat") = True Then
     lstPro.ListItems.Remove lstPro.SelectedItem.Index
    '同時清除明細表
     lstDetail.ListItems.Clear
  End If
  
End Sub


Private Sub cmdSelect_Click()

  frmSelectMenus.Show 1
  If sMenuName <> "" Then
     ftID.Text = sMenuName
     If Trim(ftID.Text) <> "" Then
     '給出菜單名稱
      Dim sTmp As String
          sTmp = GetProName(Trim(ftID.Text))
      If sTmp = "" Then
         ftName.Text = ""
         ftID.Text = ""
         'MsgBox "對不起,您輸入的編號不存在。  ", vbExclamation
        Else
         ftName.Text = sTmp
      End If
      Else
       ftName.Text = ""
     End If
     ftID.Enabled = False
     ftNum.SetFocus
     ftID.Enabled = True
    Else
     ftID.SetFocus
  End If
  
End Sub

Private Sub Form_Load()

  GetFormSet Me, frmMain
  IntegrationFocus = True
  
 '刷新預訂信息,顯示所有預訂信息
  frmMain.lbControl.Caption = "酒席配置"
  Screen.MousePointer = 11
 '給出菜類型列表+++++++++++++++++++++++++++++++++++++++++
  GetTypeList "MenuType", cmbType

 '給出酒席內容
  GetIntegration
  ftMenuID.Text = GetNo("酒席配置")
  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
  
  Frame2.Height = Me.Height - 800 - Frame1.Height
  Frame2.Width = Me.Width - 400
  Frame1.Width = Frame2.Width
  
  lstDetail.Height = Frame2.Height - 1300
  lstDetail.Width = Frame2.Width - 150
  lstPro.Width = lstDetail.Width
  ftDescription.Width = lstPro.Width - 4950
  cmdClos.Left = lstPro.Width - cmdClos - 1500
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  IntegrationFocus = False
  
End Sub

Private Sub ftID_DblClick()
  
  Call cmdSelect_Click

End Sub

Private Sub ftID_LostFocus()

  If Trim(ftID.Text) <> "" Then
     '給出菜單名稱
      Dim sTmp As String
          sTmp = GetProName(Trim(ftID.Text))
      If sTmp = "" Then
         ftName.Text = ""
         ftID.Text = ""
         'MsgBox "對不起,您輸入的編號不存在。  ", vbExclamation
        Else
         ftName.Text = sTmp
      End If
    Else
     ftName.Text = ""
  End If
  
End Sub

Private Sub ftName_DblClick()

  Call cmdSelect_Click
  
End Sub

Private Sub ftNum_Change()

  If ftNum.Text = "" Then
     ftNum.Text = "1"
     ftNum.SelStart = 0
     ftNum.SelLength = 1
     Exit Sub
  End If
  If ftNum.Text = "." Then
     ftNum.Text = "0."
     ftNum.SelStart = 2
     ftNum.SelLength = 0
     Exit Sub
  End If
  
End Sub

Private Sub ftPrice_Change()

  If ftPrice.Text = "" Then
     ftPrice.Text = "1"
     ftPrice.SelStart = 0
     ftPrice.SelLength = 1
     Exit Sub
  End If
  If ftPrice.Text = "." Then
     ftPrice.Text = "0."
     ftPrice.SelStart = 2
     ftPrice.SelLength = 0
     Exit Sub
  End If

End Sub

Private Sub lstDetail_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

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

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 GetIntegration()
  
  On Error GoTo Ett
  
  lstPro.ListItems.Clear
  Me.MousePointer = 11
  Dim iDB As Connection
  Dim iRS As Recordset
  Set iDB = CreateObject("ADODB.Connection")
  Set iRS = CreateObject("ADODB.Recordset")
      iDB.Open Constr
      iRS.Open "Select * from tbdMenuCat", iDB, adOpenStatic, adLockReadOnly, adCmdText
      If Not (iRS.EOF And iRS.BOF) Then
         Do While Not iRS.EOF
            InsertToIntegration lstPro, iRS("MenuID"), iRS("MenuName"), iRS("MenuPrice"), NullValue(iRS("MenuType")), NullValue(iRS("MenuDescription"))
            iRS.MoveNext
         Loop
      End If
      iRS.Close
      Set iRS = Nothing
      iDB.Close
      Set iDB = Nothing
      Me.MousePointer = 0
  
      Exit Sub
Ett:
      Me.MousePointer = 0
      MsgBox "給出酒席錯誤:" & Err.Description, vbCritical
      Exit Sub
  
End Sub

Private Sub InsertToIntegration(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 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)
       
End Sub

Private Sub lstPro_ItemClick(ByVal Item As MSComctlLib.ListItem)

  If lstPro.ListItems.Count > 0 Then
     If lstPro.SelectedItem.Text <> "" Then
        Frame2.Caption = "【" & lstPro.SelectedItem.SubItems(1) & "】酒席菜單列表"
       '給出配菜明細
        GetIntegrationDetail lstPro.SelectedItem.Text
     End If
    Else
     Frame2.Caption = "配菜明細表"
  End If
  
End Sub

Private Sub GetIntegrationDetail(IDs As String)
  
  On Error GoTo Ett
  
  lstDetail.ListItems.Clear
  
  Me.MousePointer = 11
  Dim iDB As Connection
  Dim iRS As Recordset
  Set iDB = CreateObject("ADODB.Connection")
  Set iRS = CreateObject("ADODB.Recordset")
      iDB.Open Constr
      iRS.Open "Select tbdMenuCatDetail.MenuID,tbdMenuCatDetail.MenuName,tbdMenuCatDetail.MenuNum,tbdMenuCatDetail.MenuTYpe," _
                 & "EatList.MName from tbdMenuCatDetail Inner Join EatList On tbdMenuCatDetail.MenuName=EatList.MID " _
                 & " Where tbdMenucatDetail.MenuID='" & IDs & "'", iDB, adOpenStatic, adLockReadOnly, adCmdText
      If Not (iRS.EOF And iRS.BOF) Then
         Do While Not iRS.EOF
            'MenuName為菜單編號，MName為菜單名稱
            InsertToIntegrationDetail lstDetail, iRS("MenuName"), iRS("MName"), iRS("MenuNum"), NullValue(iRS("MenuType"))
            iRS.MoveNext
         Loop
       Else
        iRS.Close
        Set iRS = Nothing
        iDB.Close
        Set iDB = Nothing
        Me.MousePointer = 0
        'MsgBox "沒有找到編號為〖" & IDs & "〗的酒席明細表,請重新建立。  ", vbExclamation
        Exit Sub
      End If
      iRS.Close
      Set iRS = Nothing
      iDB.Close
      Set iDB = Nothing
      Me.MousePointer = 0
  
      Exit Sub
Ett:
      Me.MousePointer = 0
      MsgBox "給出酒席明細錯誤:" & Err.Description, vbCritical
      Exit Sub
End Sub

Private Sub InsertToIntegrationDetail(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 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)
       
End Sub
上一頁 1 23
?? 文件大小 12233 K
?? 上傳用戶 norwaybaby
?? 所屬分類其他數據庫
??? 相關標簽

#管理系統 #控件 #源碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmintegration.frm

?? 快捷鍵說明
