frmpdby.frm

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

    Combtype.Enabled = blnIsEdit
    CmdAct(0).Enabled = blnIsEdit
    combdw.Enabled = blnIsEdit
    txt_memo.Enabled = blnIsEdit
'    txt_name.Enabled = blnIsEdit
    dtptime.Enabled = blnIsEdit
    txt_qty.Enabled = blnIsEdit
    combdj.Enabled = blnIsEdit
    msglist.Enabled = blnIsEdit
    flex_pro.Enabled = blnIsEdit
    
    For intNum = 2 To 3
        CmdAct(intNum).Enabled = blnIsEdit
    Next
    'CmdAct(1).Enabled = Not blnIsEdit
    CmdAct(5).Enabled = Not blnIsEdit
    CmdAct(6).Enabled = blnIsEdit
    CmdAct(7).Enabled = blnIsEdit
    CmdAct(9).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 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)
        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 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)
        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, 4)), 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()
    flex_pro.Visible = True
End Sub
Private Sub txt_id_KeyDown(KeyCode As Integer, Shift As Integer)
    
    On Error GoTo errpro
    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
    Exit Sub
errpro:
    MsgBox "错误号为：" & Err.Number & "说明" & Err.Description
    Exit Sub
End Sub

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

    On Error GoTo errpro
    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)
            txt_qty.Enabled = True
            txt_qty.text = 1
            txt_qty.SetFocus
            SendKeys "{Home}+{End}"
        End With
    End If
    Exit Sub
errpro:
    MsgBox "错误号为：" & Err.Number & "说明" & Err.Description
    Exit Sub
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_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
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 = "" Then
            MsgBox "请输入入库数量！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        If 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)
    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_maker_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) = "金额"
        '设置各列的对齐方
        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) = 800
        .colWidth(1) = 1000
        .colWidth(2) = 2500
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 800
        .colWidth(6) = 1200
        
        .row = 1
    End With
End Sub

Private Sub updatesales(mrc1 As Integer)

Dim TxtSQL As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim strsql As String
    
    If mrc1 = 1 Then
        
        TxtSQL = "select * from ps_head_b where ps_id=' " & txtsa_id.text & "'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        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(Label2)
            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
    
    cnn.Execute "update mat_detail set qty=qty+ " & Val(msglist.TextMatrix(mrc1, 5)) & " where p_id='" & Trim$(msglist.TextMatrix(mrc1, 1)) & "'"


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 = ChMoney(Val(Label2))
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) = 900
        .colWidth(5) = 800
        .colWidth(6) = 1600
        .row = 1
    End With
End Sub