frmstore.frm

一套好的餐饮行业管理软件

        b.Type = ddBTNormal
        b.Caption = "工具条"
        b.DisplayMoreToolsButton = False
        b.DockingArea = ddDATop
        b.MouseTracking = ddTSBevel
        b.GrabHandleStyle = ddGSNormal

    Set t = Abar.Tools.Add(GetUniqueToolID(), "m_add")
    With t
        .Caption = "增加"
        .SetPicture ddITNormal, LoadResPicture(101, vbResBitmap)
        .ControlType = ddTTButton
        keys(0) = "Control+A"
        .ShortCuts = keys
        .ToolTipText = "增加进货项"
        .CaptionPosition = ddCPBelow
        .Style = ddSIconText
    End With
    
    Set t = Abar.Tools.Add(GetUniqueToolID(), "m_modify")
    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_instore")
    With t
        .Caption = "审核"
        .SetPicture ddITNormal, LoadResPicture(236, vbResIcon)
        .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_instore")
        .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
        SetNU
    End If
    rst.Close
    
    Set rst = dbs.OpenRecordset("Select * From StoreListtmp", dbOpenDynaset)
    
    Set kcData.Recordset = rst
    kcData.Refresh
    
    fpsp.OperationMode = OperationModeRow
    fpsp.SelBackColor = &HFFC0C0
    
    
End Sub

Private Sub InitGrid()
         
    
    With fpsp
    
        .Visible = False
        rst.Requery
        
        .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) & "单价" & Chr(9) & "数量" & Chr(9) & "金额" & Chr(9) & "日期"
        
    
        .ColWidth(1) = 0
        .ColWidth(2) = 1200
        .ColWidth(3) = 1200
        .ColWidth(4) = 800
        .ColWidth(5) = 1000
        .ColWidth(6) = 800
        .ColWidth(7) = 1200
        .ColWidth(8) = 1200
        
        .Visible = True
    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
    
    If rst.RecordCount > 0 Then
        With fpsp
            .Row = .ActiveRow
            .Col = 2
            For i = 0 To Ctype.ListCount - 1
                If Ctype.List(i) = .Text Then
                    Ctype.ListIndex = i
                End If
            Next
            .Col = 3
            For i = 0 To Cname.ListCount - 1
                If Cname.List(i) = .Text Then
                    Cname.ListIndex = i
                End If
            Next
            
            .Col = 4
            Tdw.Text = .Text
            
            .Col = 5
            tDJ.Text = .Value
            .Col = 6
            Tsl.Text = .Value
            .Col = 7
            Tje.Text = .Value
            .Col = 8
            tpDate.Value = .Value
    
        End With
    End If
    Abar.Tools("m_add").Enabled = True
    Abar.Tools("m_modify").Enabled = True
    Abar.Tools("m_del").Enabled = True
    Abar.Tools("m_print").Enabled = True
    
    SetEnable False
End Sub


Private Sub cok_Click()
'On Error GoTo er
    If CheckOK() Then
        If CurrOp = "add" Then
            sqlstr = "Insert into site (Type,名称,单位,单价,数量,金额,日期) values('" & Ctype.Text & "','" & Cname.Text & "','" & Cdw.Text & "'," & tDJ.Text & "," & Tsl.Text & "," & Tje.Text & ",'" & tpDate.Value & "');"
            dbs.Execute sqlstr
        
        Else
            fpsp.Row = fpsp.ActiveRow
            fpsp.Col = 1
            t = fpsp.Text
            dbs.Execute "update site set Type ='" & Ctype.Text & "'" & _
                                          ",名称=" & Cname.Text & "'" & _
                                          ",单位=" & Cdw.Text & "'" & _
                                          ",单价=" & tDJ.Text & _
                                          ",数量=" & Tsl.Text & _
                                          ",金额=" & Tje.Text & _
                                          ",日期=" & tpDate.Value & _
                                          " where id = '" & t & "';"
        End If

        InitGrid
        Fredit.Enabled = False
        fpsp.Enabled = True
        
        SetEnable False
        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
    
    SetEnable False
    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 = 2
        For i = 0 To Ctype.ListCount - 1
            If Ctype.List(i) = .Text Then
                Ctype.ListIndex = i
            End If
        Next
        .Col = 3
        For i = 0 To Cname.ListCount - 1
            If Cname.List(i) = .Text Then
                Cname.ListIndex = i
            End If
        Next
        
        .Col = 4
        Tdw.Text = .Text
        
        .Col = 5
        tDJ.Text = .Value
        .Col = 6
        Tsl.Text = .Value
        .Col = 7
        Tje.Text = .Value
        .Col = 8
        tpDate.Value = .Value
    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 tDJ_Change()
    If IsNumeric(tDJ.Text) Then
        Tje.Text = CStr(Val(tDJ.Text) * Val(Tsl.Text))
    End If
End Sub

Private Sub Tdj_Validate(Cancel As Boolean)
    If Not IsNumeric(tDJ.Text) Then
        MsgBox tDJ.Text & "不是有效的数量,‘单价’必须为数字！", vbCritical, "提示"
        Cancel = True
    
        tDJ.SetFocus
    End If
End Sub


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


Private Sub SetEnable(flg As Boolean)
    For i = 1 To 7
        Label1(i).Enabled = flg
    Next
    Ctype.Enabled = flg
    Cname.Enabled = flg
    Cdw.Enabled = flg
    tDJ.Enabled = flg
    Tje.Enabled = flg
    Tsl.Enabled = flg
    tpDate.Enabled = flg
End Sub


Private Sub SetNU()
Dim r As Recordset
        Cname.Clear
        Set r = dbs.OpenRecordset("Select 名称,单位 From EatList where menutype='" & tmp & "'", dbOpenDynaset)
        Do While Not r.EOF
            Cname.AddItem r!名称
            r.MoveNext
        Loop
        If r.RecordCount > 0 Then
            r.MoveFirst
            Tdw.Text = r!单位
            Cname.ListIndex = 0
        End If
r.Close
Set r = Nothing
End Sub