frmpsedit.frm

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

    msglist.Enabled = blnIsEdit
    flex_pro.Enabled = blnIsEdit
    
    CmdAct(2).Enabled = blnIsEdit
    CmdAct(3).Enabled = blnIsEdit
    
    CmdAct(5).Enabled = Not blnIsEdit
    CmdAct(6).Enabled = blnIsEdit
    CmdAct(7).Enabled = blnIsEdit
    CmdAct(9).Enabled = blnIsEdit
    If txtsa_id.text = "" Then
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
    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
        cmdSave.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
        cmdSave.Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = False
    End If
End Sub


Private Sub txt_id_Change()

    Dim i As Long, j As Long, m As Long
    Dim strText As String
    If Trim$(txt_id.text) <> "" Then
        strText = txt_id.text
        If Asc(Left$(strText, 1)) > 57 Or Asc(Right$(strText, 1)) > 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
        Else
            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, 0)), 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_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_GotFocus()
    flex_pro.Visible = True
End Sub


Private Sub txt_id_KeyPress(KeyAscii As Integer)
    Dim i As Long
    Dim bFinded As Boolean
    On Error GoTo errpro
    bFinded = False
    If KeyAscii = 13 And flex_pro.rows > 2 Then
        With flex_pro
                

            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_total.text = Val(txt_qty.text) * Val(Combdj.text)
    End If
    
End Sub

Private Sub txt_qty_LostFocus()
    txt_qty = Val(txt_qty.text)
    If txt_qty.Enabled = True Then
        txt_total.text = Val(txt_qty.text) * Val(Combdj.text)
    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

Private Sub loadroompopup()
    Dim strsql As String
    Dim custID As String
    Dim Addstring As String
    
    Combtype.Clear
    Combtype.AddItem "采购入库"
    Combtype.AddItem "盘盈入库"
    Combtype.AddItem "其它入库"
    Combtype.ListIndex = 0
    strsql = "select supplier_id,supplier_name from Supplier_unit where supplier_id<>'' order by supplier_name"
    rscount.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    Combsupp.Clear
    Do Until rscount.EOF
           Addstring = ""
           Addstring = Addstring & rscount!supplier_id & "," & rscount!supplier_name
           Combsupp.AddItem Addstring
           custID = "" & rscount!supplier_id
           Combsupp.ItemData(Combsupp.NewIndex) = custID
           rscount.MoveNext
    Loop
    rscount.Close
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(ByVal pos As Long)

    Dim mrc As New ADODB.Recordset

    If pos = 1 Then
        cnn.Execute "delete from order_detail_a where order_id='" & txtsa_id & "'"
        cnn.Execute "delete from ps_head_a where ps_id='" & txtsa_id & "'"
    
        Dim roomnum As Integer
        Dim roomstr As String
        roomnum = InStr(1, Combsupp.text, ",") - 1
        If roomnum > -1 Then
            roomstr = Mid(Combsupp.text, 1, roomnum)
        Else
            roomstr = Combsupp.text
        End If
        
        mrc.Open "select * from ps_head_a where ps_id=' " & txtsa_id.text & "'", cnn, adOpenDynamic, adLockOptimistic
        With mrc
            .AddNew
            !PS_id = "" & txtsa_id.text
            !PS_date = dtptime.Value
            !ps_rid = "" & roomstr
            !ps_maker = "" & txtsa_maker.text
            !ps_demo = "" & txt_memo.text
            !ps_type = "" & Combtype.text
            !ps_total = Val(Label2.Caption)
            mrc.Update
        End With
    End If
    
    If mrc.State = adStateOpen Then mrc.Close
    mrc.Open "select * from order_detail_a where order_id=' " & txtsa_id.text & "'", cnn, adOpenDynamic, adLockOptimistic
    With mrc
        .AddNew
        !order_id = "" & txtsa_id.text
        !p_id = msglist.TextMatrix(pos, 1)
        !p_name = "" & msglist.TextMatrix(pos, 2)
        !unit_price = Val("" & msglist.TextMatrix(pos, 4))
        !qty = msglist.TextMatrix(pos, 5)
        !price = msglist.TextMatrix(pos, 6)
        !UNIT = msglist.TextMatrix(pos, 3)
        mrc.Update
    End With
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing

End Sub

Public Sub totalprice()

    Dim i As Long
    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) = 900
        .colWidth(5) = 800
        .colWidth(6) = 1600
        .row = 1
    End With
End Sub