frmpdbs.frm

ktv场所的包房开房、迎宾、预定管理系统。

    
    For intNum = 2 To 3
        CmdAct(intNum).Enabled = blnIsEdit
    Next
    'CmdAct(1).Enabled = Not blnIsEdit
    CmdAct(5).Enabled = Not blnIsEdit
    CmdAct(6).Enabled = blnIsEdit
    If txtsa_id = "" Then
        For intNum = 2 To 3
            CmdAct(intNum).Enabled = False
        Next
    End If
End Sub

Private Sub msglist_DblClick()
        If txt_qty.Enabled = False Then Exit Sub
        If msglist.rows = 1 Or msglist.TextMatrix(msglist.row, 1) = "" Then
            Exit Sub
        End If
        With msglist
            txt_id.text = .TextMatrix(.row, 1)
            txt_name.text = .TextMatrix(.row, 2)
            combdw = .TextMatrix(.row, 3)
            txt_qty.text = .TextMatrix(.row, 5)
            combdj.Clear
            combdj = .TextMatrix(.row, 4)
            txt_total.text = .TextMatrix(.row, 6)
'            Text1 = .TextMatrix(.row, 7)
        End With
        txt_qty.SetFocus
        txt_qty.tag = txt_qty.text
        SendKeys "{Home}+{End}"
        CmdAct(1).Enabled = True
        CmdAct(0).Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = False
End Sub

Private Sub msglist_KeyPress(KeyAscii As Integer)
        If txt_qty.Enabled = False Then Exit Sub
    If KeyAscii = 13 Then
        If msglist.TextMatrix(msglist.row, 1) = "" Then
            Exit Sub
        End If
        With msglist
            txt_id.text = .TextMatrix(.row, 1)
            txt_name.text = .TextMatrix(.row, 2)
            combdw = .TextMatrix(.row, 3)
            txt_qty.text = .TextMatrix(.row, 5)
            combdj.Clear
            combdj = .TextMatrix(.row, 4)
            txt_total.text = .TextMatrix(.row, 6)
'            Text1 = .TextMatrix(.row, 7)
        End With
        txt_qty.SetFocus
        txt_qty.tag = txt_qty.text
        SendKeys "{Home}+{End}"
        CmdAct(1).Enabled = True
        CmdAct(0).Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = False
    End If
End Sub
Private Sub txt_id_Change()
Dim s As String
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String
Dim i, j, m As Integer
    If Trim$(txt_id.text) <> "" Then
        s = Mid(txt_id.text, 1, 1)
        If LCase(Asc(s)) > 57 Then
            m = 0
            With flex_pro
                For i = 1 To .rows - 1
                    For j = 1 To Len(Trim$(txt_id.text))
                        If Mid(Trim$(.TextMatrix(i, 5)), j, 1) = UCase(Mid(Trim$(txt_id.text), j, 1)) Then
                            If j > m Then
                                .col = 1
                                .row = i
                                .TopRow = i
                                m = j
                            End If
                        Else
                            Exit For
                        End If
                    Next j
                Next i
            End With
        End If
    End If

End Sub

Private Sub txt_id_GotFocus()
    'txt_id = ""
     SendKeys "{Home}+{End}"
    flex_pro.Visible = True
End Sub


Private Sub txt_id_KeyDown(KeyCode As Integer, Shift As Integer)
With flex_pro
    Select Case KeyCode
        Case 40
             If .row < .rows - 1 Then
                .row = .row + 1
                .TopRow = .row
            End If
        Case 38
            If .row > 1 Then
                .row = .row - 1
                .TopRow = .row
            End If
        Case 34 '上页
            If .rows - .TopRow > 10 Then
                .TopRow = .TopRow + 10
                .row = .TopRow
            End If
        
        Case 33 '下页
            If .TopRow < 10 Then
                .TopRow = 1
                .row = .TopRow
            Else
                If .rows - .TopRow > 10 Then
                    .TopRow = .TopRow - 10
                    .row = .TopRow
                End If
            End If
    End Select
End With
End Sub

Private Sub txt_id_KeyPress(KeyAscii As Integer)
Dim i As Integer
Dim s As String

    If KeyAscii = 13 And flex_pro.rows > 2 Then
        With flex_pro
            If Trim$(txt_id.text) <> "" Then
                s = Mid(txt_id.text, 1, 1)
                If LCase(Asc(s)) <= 57 Then
                    For i = 1 To .rows - 1
                        If Trim$(.TextMatrix(i, 6)) = Trim$(txt_id.text) Then
                            .col = 1
                            .row = i
                            Exit For
                        End If
                    Next i
                    If i - 1 = .rows - 1 And Trim$(.TextMatrix(i - 1, 6)) <> Trim$(txt_id.text) Then
                        MsgBox "仓库库存中没有此商品", vbInformation, "提示"
                        SendKeys "{home}+{end}"
                        txt_id.SetFocus
                        Exit Sub
                    End If
                End If
            End If
            txt_id = "" & .TextMatrix(.row, 0)
            txt_name = "" & .TextMatrix(.row, 1)
            combdj.Clear
            combdj.AddItem "" & .TextMatrix(.row, 3)
            combdj.ListIndex = 0
            combdw = "" & .TextMatrix(.row, 2)
'            Text1 = "" & .TextMatrix(.row, 6)
            txt_qty.Enabled = True
            txt_qty.text = 1
            txt_qty.SetFocus
            SendKeys "{Home}+{End}"
        End With
    End If
End Sub
Private Sub txt_id_LostFocus()
    flex_pro.Visible = False
End Sub
Private Sub txt_memo_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub
Private Sub txt_qty_Change()
 Dim ru As Integer
 If txt_qty.Enabled = True Then
    If CmdAct(1).Enabled = True Then
        With flex_pro
            For ru = 1 To .rows - 1
                If Trim$(.TextMatrix(ru, 0)) = Trim$(msglist.TextMatrix(msglist.row, 1)) Then
                    .TextMatrix(ru, 4) = Val(.TextMatrix(ru, 4)) + Val(txt_qty.tag)
                    Exit For
                End If
            Next ru
        End With
    End If
    If Val(txt_qty.text) > Val(flex_pro.TextMatrix(flex_pro.row, 4)) Then
        MsgBox "库存数量不足！", vbCritical, "警告"
        txt_qty.text = "" & Val(flex_pro.TextMatrix(flex_pro.row, 4))
         SendKeys "{Home}+{End}"
    End If
End If
End Sub
Private Sub txt_qty_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If IsNumeric(txt_qty.text) = False Then
            MsgBox "必须输入数字！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        If txt_qty.text = "" Or txt_qty.text <= 0 Then
            MsgBox "请输入正确的报损数量！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        'txt_price = Val(txt_qty) * Val(txt_unit)
        txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
        combdj.SetFocus
    End If
End Sub
Private Sub txt_qty_LostFocus()
    If txt_qty.Enabled = True Then
        txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
    End If
End Sub
Private Sub txtsa_id_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And txtsa_id.text <> "" Then
        If Len(txtsa_id.text) = 7 Then
            txtsa_id.text = "CK" & txtsa_id.text
        End If
        CmdAct(2).Enabled = True
        CmdAct(3).Enabled = True
    Else
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
    End If
End Sub
Private Sub txtsa_id_Validate(Cancel As Boolean)
    If txtsa_id.text <> "" Then
        If Len(txtsa_id.text) = 7 Then
            txtsa_id.text = "CR" & txtsa_id.text
        End If
        CmdAct(2).Enabled = True
        CmdAct(3).Enabled = True
    Else
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
    End If
End Sub
Private Sub txtsa_date_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub
Private Sub txtsa_demo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then CmdAct(2).SetFocus
End Sub
Private Sub txtsa_maker_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub
Private Sub txtsa_rid_KeyDown(KeyCode As Integer, Shift As Integer)
   EnterToTab KeyCode
End Sub
Public Sub showtitle()
    Dim i As Integer
    With msglist
        .Cols = 7
        .rows = 2
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "编号"
        .TextMatrix(0, 2) = "产品名称"
        .TextMatrix(0, 3) = "单位"
        .TextMatrix(0, 4) = "单价"
        .TextMatrix(0, 5) = "数量"
        .TextMatrix(0, 6) = "金额"
'        .TextMatrix(0, 7) = "类别"
        '设置各列的对齐方
        For i = 1 To 6
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 600
        .colWidth(1) = 1000
        .colWidth(2) = 2800
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 800
        .colWidth(6) = 1100
'        .colWidth(7) = 900
        
        .row = 1
    End With
End Sub
Private Sub updatesales(mrc1 As Integer)
Dim mrc3, mrc5 As ADODB.Recordset
Dim TxtSQL As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim strsql As String
    
    If mrc1 = 1 Then

        With mrc
            .AddNew
            !PS_id = "" & txtsa_id.text
            !PS_date = dtptime
            !ps_rid = ""
            !ps_maker = "" & txtsa_maker
            !ps_demo = "" & txt_memo
            !ps_type = "" & Combtype.text
            !ps_total = Val(txt_total)
            mrc.Update
            mrc.Close
        End With
    End If
    TxtSQL = "select * from order_detail_b where order_id=' " & txtsa_id.text & "'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    With mrc
        .AddNew
        !order_id = "" & txtsa_id.text
        !p_id = msglist.TextMatrix(mrc1, 1)
        !p_name = "" & msglist.TextMatrix(mrc1, 2)
        !unit_price = Val("" & msglist.TextMatrix(mrc1, 4))
        !qty = msglist.TextMatrix(mrc1, 5)
        !price = msglist.TextMatrix(mrc1, 6)
        !UNIT = msglist.TextMatrix(mrc1, 3)
        mrc.Update
        mrc.Close
    End With
    TxtSQL = "update mat_detail set qty=qty- " & Val(msglist.TextMatrix(mrc1, 5)) & " where p_id='" & Trim$(msglist.TextMatrix(mrc1, 1)) & "'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)

End Sub
Public Sub totalprice()
Dim i As Integer
Dim totalnum As Double

    totalnum = 0
    With msglist
        For i = 1 To .rows - 1
            totalnum = totalnum + Val(.TextMatrix(i, 6))
        Next
    End With
    Label2.Caption = Format(totalnum, "0.000")
    lab_total.Caption = ChMoney(Val(Label2.Caption))
End Sub

Private Sub showtitle_pro()
    Dim i As Integer
    
    With flex_pro
        .Cols = 7
        If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "商品名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "库存"
        .TextMatrix(0, 5) = "拼音码"
        .TextMatrix(0, 6) = "条形码"
        '设置各列的对齐方
        For i = 0 To 6
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        
        '设置单元大小
        .colWidth(0) = 800
        .colWidth(1) = 2500
        .colWidth(2) = 800
        .colWidth(3) = 800
        .colWidth(4) = 1000
        .colWidth(5) = 1200
        .colWidth(6) = 1600
        .row = 1
    End With
End Sub