frmoption.frm

vb+access 饭店餐饮管理系统,酒店管理软件

    With t
        .Caption = "修改"
        .SetPicture ddITNormal, LoadResPicture(200, vbResBitmap)
        .ControlType = ddTTButton
        keys(0) = "Control+E"
        .ShortCuts = keys
        .ToolTipText = "修改消费品信息"
        .CaptionPosition = ddCPBelow
        .Style = ddSIconText
    End With
    
    Set t = Abar.Tools.Add(GetUniqueToolID(), "m_del")
    With t
        .Caption = "删除"
        .SetPicture ddITNormal, LoadResPicture(102, vbResBitmap)
        .ControlType = ddTTButton
        keys(0) = "Control+D"
        .ShortCuts = keys
        .ToolTipText = "删除消费品"
        .CaptionPosition = ddCPBelow
        .Style = ddSIconText
    End With
    
    Set t = Abar.Tools.Add(GetUniqueToolID(), "m_print")
    With t
        .Caption = "打印"
        .SetPicture ddITNormal, LoadResPicture(106, vbResBitmap)
        .ControlType = ddTTButton
        keys(0) = "Control+Q"
        .ShortCuts = keys
        .ToolTipText = "打印"
        .CaptionPosition = ddCPBelow
        .Style = ddSIconText
    End With
    
    Set t = Abar.Tools.Add(GetUniqueToolID(), "m_exit")
    With t
        .Caption = "关闭": Tool.Category = "m_sys"
        .SetPicture ddITNormal, LoadResPicture(103, vbResBitmap)
        .ControlType = ddTTButton
        keys(0) = "Control+C"
        .ShortCuts = keys
        .ToolTipText = "关闭本窗口"
        .CaptionPosition = ddCPBelow
        .Style = ddSIconText
    
    End With
    With b.Tools

        .Insert .Count, Abar.Tools("m_add")
        .Insert .Count, Abar.Tools("m_del")
        .Insert .Count, Abar.Tools("m_modify")
        
        .Insert .Count, Abar.Tools("Separator")
        
        .Insert .Count, Abar.Tools("m_print")
        
        .Insert .Count, Abar.Tools("Separator")
                
        .Insert .Count, Abar.Tools("m_exit")
       
    End With

    Abar.RecalcLayout
    Abar.Refresh
    
    Set dbs = OpenDatabase(ConData, False, False, Constr)
    Set rst = dbs.OpenRecordset("Select menuname From menutype", dbOpenDynaset)
    Do While Not rst.EOF
        Ctype.AddItem rst!menuname
        rst.MoveNext
    Loop
    If rst.RecordCount > 0 Then
        Ctype.ListIndex = 0
    End If
    rst.Close
    
    Set rst = dbs.OpenRecordset("Select unitName From Unit", dbOpenDynaset)
    Do While Not rst.EOF
        Cunit.AddItem rst!unitname
        rst.MoveNext
    Loop
    If rst.RecordCount > 0 Then
        Cunit.ListIndex = 0
    End If
    
    rst.Close
    Set rst = dbs.OpenRecordset("Select 代码,名称,单价,单位,MenuType From eatlist", dbOpenDynaset)
    
    Set siteData.Recordset = rst
    fpsp.OperationMode = OperationModeRow
    
    fpsp.SelBackColor = &HFFC0C0
    InitGrid
End Sub

Private Sub InitGrid()
         
    With rst
        If .RecordCount > 0 Then
            .MoveLast
            .MoveFirst
        
            Tcode.Text = !代码
            Tname.Text = !名称
            Tprice.Text = !单价
            
            For i = 0 To Cunit.ListCount - 1
                If Cunit.List(i) = !单位 Then
                    Cunit.ListIndex = i
                End If
            Next
            
            For i = 0 To Ctype.ListCount - 1
                If Ctype.List(i) = !MenuType Then
                    Ctype.ListIndex = i
                End If
            Next

        Else
        
            VSrs.Value = 2
            VSrs.Value = 2
        End If
    End With
        
    With fpsp
        .UnitType = UnitTypeTwips

        .RowHeight(0) = 500
        
        .MaxRows = rst.RecordCount
        .MaxCols = rst.Fields.Count
        
        .Row = 0
        .Row2 = .MaxRows
        .Col = 1
        .Col2 = .MaxCols
        
        .BlockMode = True
        .Protect = True
        .FontName = "宋体"
        .FontSize = "9.25"
        .Lock = True
        .BlockMode = False
        
         .Row = 0
         .Row2 = 0
         .Col = 1
         .Col2 = .MaxCols
         .Clip = "代码" & Chr(9) & "名称" & Chr(9) & "单价" & Chr(9) & "计量单位" & Chr(9) & "类别"

         
        .ColWidth(1) = 800
        .ColWidth(2) = 1200
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 1000
        
    End With
        

        
End Sub

Private Sub Form_Unload(Cancel As Integer)
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing
    SaveFormSet Me
End Sub

Private Sub ccancle_Click()
    Fredit.Enabled = False
    fpsp.Enabled = True
    
    
    With fpsp
        .Row = .ActiveRow
        .Col = 1
        Tname.Text = fpsp.Text
        .Col = 2
        Trs.Text = fpsp.Text
        .Col = 3
        Tsp.Text = .Value

    End With
    Abar.Tools("m_add").Enabled = True
    Abar.Tools("m_modify").Enabled = True
    Abar.Tools("m_del").Enabled = True
    Abar.Tools("m_print").Enabled = True
End Sub


Private Sub cok_Click()
'On Error GoTo er
    If CheckOK() Then
        If CurrOp = "add" Then
            sqlstr = "Insert into EatList (代码,名称,单价,单位,MenuType) values('" & Trim(Tcode.Text) & "','" & Trim(Tname.Text) & _
                     "'," & CStr(Tprice.Text) & ",'" & Cunit.Text & "','" & Ctype.Text & "')"
                     
            dbs.Execute sqlstr
        
        Else
            fpsp.Row = fpsp.ActiveRow
            fpsp.Col = 1
            t = fpsp.Text
            dbs.Execute "update site set 代码 ='" & Tcode.Text & _
                                          "',名称='" & Tname.Text & _
                                          "',单价=" & Tprice.Text & _
                                          ",单位='" & Cunit.Text & _
                                          "',MenuType=" & Ctype.Text & _
                                          "' where sitename = '" & t & "';"
        End If
        rst.Requery
        InitGrid
        Fredit.Enabled = False
        fpsp.Enabled = True
        Abar.Tools("m_add").Enabled = True
        Abar.Tools("m_modify").Enabled = True
        Abar.Tools("m_del").Enabled = True
        Abar.Tools("m_print").Enabled = True
        
    End If
    

    Exit Sub
er:
    ErrorHandle ""
    Fredit.Enabled = False
    fpsp.Enabled = True
    
    Abar.Tools("m_add").Enabled = True
    Abar.Tools("m_modify").Enabled = True
    Abar.Tools("m_del").Enabled = True
    Abar.Tools("m_print").Enabled = True

End Sub


Private Sub fpsp_LeaveRow(ByVal Row As Long, ByVal RowWasLast As Boolean, ByVal RowChanged As Boolean, ByVal AllCellsHaveData As Boolean, ByVal NewRow As Long, ByVal NewRowIsLast As Long, Cancel As Boolean)
    With fpsp
        .Row = NewRow
        .Col = 1
            Tcode.Text = .Value
        .Col = 2
            Tname.Text = .Value
        .Col = 3
        Tprice.Text = .Value
        .Col = 4
        For i = 0 To Cunit.ListCount - 1
            If Cunit.List(i) = .Value Then
                Cunit.ListIndex = i
            End If
        Next
        .Col = 5
        For i = 0 To Ctype.ListCount - 1
            If Ctype.List(i) = .Value Then
                Ctype.ListIndex = i
            End If
        Next
    End With
    
End Sub



Private Sub Pic_Resize()
'On Error Resume Next
    fpsp.Left = 0
    fpsp.Top = 0
    fpsp.Height = Pic.Height - 50
    Fredit.Height = fpsp.Height - Fredit.Top
    Fredit.Left = Pic.Width - Fredit.Width - 100
    fpsp.Width = Fredit.Left - 50
    cok.Top = Fredit.Top + Fredit.Height - 350 - cok.Height
    ccancle.Top = cok.Top
End Sub

Private Sub Tprice_Validate(Cancel As Boolean)
    If Not IsNumeric(Tprice.Text) Then
        MsgBox Tprice.Text & "不是有效的台位费,‘台位费’必须为数字！", vbCritical, "提示"
        Cancel = True
    
        Tprice.SetFocus
    End If

End Sub


Private Function CheckOK() As Boolean

    CheckOK = False
    
    If Len(Tname.Text) > 0 Then
        If Not IsNumeric(Tprice.Text) Then
            MsgBox Tprice.Text & "不是有效的单价,‘单价’必须为数字！", vbCritical, "提示"
            Tprice.SetFocus
            Exit Function
        End If
        If Len(Trim(Tcode.Text)) = 0 Then
            MsgBox Tcode.Text & "消费品代码不能为空！", vbCritical, "提示"
            Tcode.SetFocus
            Exit Function
        End If
    Else
        MsgBox Te.Text & "消费品名称不能为空！", vbCritical, "提示"
        Tname.SetFocus
    End If
    CheckOK = True
End Function

Private Sub Tname_GotFocus()
    SendKeys "{Home}+{End}"
End Sub

Private Sub Tsp_GotFocus()
    SendKeys "{Home}+{End}"
End Sub