frmpsedit.frm

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

            CmdAct(2).Enabled = True
            CmdAct(3).Enabled = True
        Case 2
            If txt_id.text = "" Then
                Exit Sub
            End If
            txt_total.text = Val(txt_qty.text) * Val(Combdj.text)
            With msglist
                .TextMatrix(.rows - 1, 0) = .rows - 1
                .TextMatrix(.rows - 1, 1) = txt_id.text
                .TextMatrix(.rows - 1, 2) = txt_name.text
                .TextMatrix(.rows - 1, 3) = combdw.text
                .TextMatrix(.rows - 1, 4) = Combdj.text
                .TextMatrix(.rows - 1, 5) = txt_qty.text
                .TextMatrix(.rows - 1, 6) = txt_total.text
                .rows = .rows + 1
                If .rows >= 10 Then
                    .TopRow = .TopRow + 1
                End If
            End With
            
            totalprice
            
            txt_id = ""
            txt_qty = 0
            txt_total = ""
            txt_name = ""
            Combdj = ""
            combdw = ""
            CmdAct(7).SetFocus
        Case 3
            If msglist.rows > 2 And msglist.TextMatrix(msglist.row, 1) <> "" Then
                ru = MsgBox("确认删除?", 33, "询问")
                If ru = 2 Then
                    Exit Sub
                End If
                msglist.RemoveItem (msglist.row)
                For ru = 1 To msglist.rows - 1
                    msglist.TextMatrix(msglist.rows - ru, 0) = msglist.rows - ru
                Next
            Else
                MsgBox "本行不能删除！", vbInformation, "信息"
            End If
            CmdAct(7).SetFocus
        Case 4
            If yesno1 = False Then
               If yesno2 = False Then
                frm_cgreport.Show
               End If
            Else
                If msglist.rows > 2 And cmdSave.Enabled = True Then
                    ru = MsgBox("放弃当前销售的数据?", 33, "询问")
                    If ru = 2 Then
                        Exit Sub
                    End If
                End If
            End If
            Unload Me
        Case 5
            txt_id.text = ""
            txt_qty.text = 0
            txtsa_maker.text = strCurUser
            dtptime.Value = Now
            Combsupp.text = ""
            txt_memo = ""
            msglist.Clear
            showtitle
            strsql = "select CountNum from counterid where TableName='ps_head_a'"
            rscount.Open strsql, cnn, adOpenDynamic, adLockOptimistic
            txtsa_id.text = Format(rscount!CountNum + 1, "00000")
            Call IsEdit(True)
            combdw.Enabled = False
            rscount.Close
            Combtype.SetFocus
        Case 6
            Call IsEdit(True)
        Case 7
            txt_qty = 0
            txt_name = ""
            txt_id = ""
            txt_total = ""
            txt_lb = ""
            Combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
        Case 8
            
            rpt.SetPrinter 10500.488, 13000.064, Portrait
            Set txt = New clsText
            With txt
                .stringX = " "
                .fontsize = 10
                .Align = tymiddle
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
                        Set txt = New clsText
            With txt
                .stringX = Combtype & "单(未审核)"
                .fontsize = 12
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "供应商:" & Combsupp
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head2", txt
            Set txt = Nothing
            Set txt = New clsText
            With txt
                .stringX = "单号:" & txtsa_id & Space(10) & "日期:" & dtptime.Value & Space(5) & "|备注:" & txt_memo
                .fontsize = 10

                .Align = tyLeft
                .orient = Portrait
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
            Set txt = New clsText
            With txt
                .stringX = "总金额：" & Label2.Caption & "|制单人:" & txtsa_maker
                .fontsize = 10

                .Align = tyLeft
            End With
            rpt.Footer.AddText "footer1", txt
            Set txt = Nothing
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            BTarray(1) = 800
            BTarray(2) = 2900
            BTarray(3) = 800
            BTarray(4) = 1000
            BTarray(5) = 1000
            BTarray(6) = 1500
            recBT(1) = "编号"
            recBT(2) = "产品名称"
            recBT(3) = "单位"
            recBT(4) = "单价"
            recBT(5) = "数量"
            recBT(6) = "金额"
            
            TxtSQL = "select a.p_id,a.p_name,b.unit,format(a.unit_price,'0.000'),a.qty,format(a.unit_price*a.qty,'0.000')"
            TxtSQL = TxtSQL & " from order_detail_a as a,Product as b where a.order_id='" & txtsa_id & "'"
            TxtSQL = TxtSQL & " and a.p_id=b.p_id"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            If mrc.EOF Then
                Exit Sub
            End If
            report = False
            rpt.Attachmrc mrc, recBT, BTarray
            rpt.Preview
            mrc.Close
            Set mrc = Nothing
            
        Case 9
            txt_qty.text = 0
            txt_name.text = ""
            txt_id.text = ""
            txt_total.text = ""
            txt_lb.text = ""
            combdw.text = ""
            Combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
    End Select
    Exit Sub
Err:
    MsgBox "错误号为：" & Err.Number & Chr(13) & "错误说明：" & Err.Description

End Sub


Private Sub DCbouser_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        CmdAct(2).SetFocus
    End If
End Sub

Private Sub cmdSave_Click()
    
    Dim ru As Long
    Dim i  As Long
    Dim strsql As String

    If Combtype = "" Then
        MsgBox "单据类型不能为空!", vbCritical, "错误"
        Combtype.SetFocus
        Exit Sub
    End If
    If msglist.rows <= 2 Then
        MsgBox "单据明细项不能为空!", vbCritical, "错误"
        Exit Sub
    End If
    ru = MsgBox("确认保存?", 33, "保存")
    If ru = 2 Then
        Exit Sub
    End If
    
    On Error GoTo errdeal
    cnn.Errors.Clear
cnn.BeginTrans
    With msglist
        For i = 1 To .rows - 1
            If Trim$(.TextMatrix(i, 1)) <> "" Then
                updatesales i
            End If
        Next
    End With
    cnn.Execute "update counterid set CountNum=CountNum+1 where TableName='ps_head_a' and val(countnum)< " & Val(txtsa_id.text)
cnn.CommitTrans
    MsgBox "数据保存完毕。", vbInformation
    On Error Resume Next
    Call IsEdit(False)
    CmdAct(8).SetFocus
    Exit Sub
errdeal:
    MsgBox "保存失败，请检查每个项目的正确性。" & cnn.Errors(0).Description, vbCritical
    cnn.Errors.Clear

End Sub

Private Sub Combdj_GotFocus()
Dim strsql As String
Dim rscount As ADODB.Recordset
Dim Addstring As String
Dim custID As Double

    Set rscount = New ADODB.Recordset
    strsql = "select unit_price from order_detail_b where p_id='" & Trim$(txt_id) & "'"
    strsql = strsql & " group by unit_price"
    strsql = strsql & " order by unit_price"
    rscount.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    'Combdj.Clear
    Do Until rscount.EOF
           Addstring = "" & rscount!unit_price
           Combdj.AddItem Addstring
           custID = "" & Val(rscount!unit_price)
           Combdj.ItemData(Combdj.NewIndex) = custID
           rscount.MoveNext
    Loop
    rscount.Close
    
End Sub



Private Sub Combdj_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 And CmdAct(2).Enabled = True Then
        CmdAct(2).SetFocus
    Else
        If KeyAscii = 13 Then
            CmdAct(1).SetFocus
        End If
    End If
End Sub

Private Sub Combdj_LostFocus()
    If Combdj.text = "" Then Combdj.text = 0
    txt_total = Val(txt_qty) * Val(Combdj) * (100 / 100)
End Sub

Private Sub combdw_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub Combsupp_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub Combtype_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub Command1_Click()
    frm_seleps.yesno = True
    frm_seleps.Show 1
End Sub

Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txt_qty.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txt_qty.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub flex_pro_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    If flex_pro.row > 0 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
 End If
End Sub

Private Sub Form_Load()
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String

    
    Set rsProduct = DEjxc.rsComproductbycode

    Set cmProduct = New ADODB.Command
    cmProduct.ActiveConnection = cnn
    cmProduct.CommandType = adCmdText
    
    Set rsSaHA = DEjxc.rsComPsHA
    Set rsSalDA = DEjxc.rsComOrdDA
    Set rscount = New ADODB.Recordset
    Set rssql = New ADODB.Recordset
    Set cmSaHA = New ADODB.Command
    cmSaHA.ActiveConnection = cnn
    cmSaHA.CommandType = adCmdText
    showtitle
    If yesno1 = False Then
        cmdSave.Visible = False
        CmdAct(1).Visible = False
        CmdAct(2).Visible = False
        CmdAct(3).Visible = False
        CmdAct(5).Visible = False
        CmdAct(6).Visible = False
        CmdAct(7).Visible = False
        CmdAct(8).Visible = False
        CmdAct(9).Visible = False
        If yesno2 = True Then
'           txtsa_id = frmlocat_in.MSHFlexGrid1.TextMatrix(frmlocat_in.MSHFlexGrid1.row, 0)
        Else
          txtsa_id = frm_cgreport.msglist1.TextMatrix(frm_cgreport.msglist1.row, 0)
        End If
        TxtSQL = "select ps_id,ps_date,ps_rid,ps_maker,ps_type,ps_demo"
        TxtSQL = TxtSQL & " from ps_head_b"
        TxtSQL = TxtSQL & " where ps_id='" & txtsa_id & "'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        If mrc.EOF Then Exit Sub
        txtsa_maker = "" & mrc.Fields("ps_maker")
        Combtype = "" & mrc.Fields("ps_type")
        dtptime.Value = mrc.Fields("ps_date")
        txt_memo = "" & mrc.Fields("ps_demo")
        
        TxtSQL = "select a.ps_rid,b.supplier_name "
        TxtSQL = TxtSQL & " from ps_head_b a ,Supplier_unit as b "
        TxtSQL = TxtSQL & " where a.ps_id='" & txtsa_id & "'"
        TxtSQL = TxtSQL & " and a.ps_rid=b.supplier_id"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        If Not mrc.EOF Then
           Combsupp = "" & mrc.Fields("ps_rid") & "," & "" & mrc.Fields("supplier_name")
        End If

        TxtSQL = "select *"
        TxtSQL = TxtSQL & " from order_detail_b"
        TxtSQL = TxtSQL & " where order_id='" & txtsa_id & "'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        If mrc.EOF Then Exit Sub
        Do While Not mrc.EOF
            With FrmPsEdit.msglist
                .TextMatrix(.rows - 1, 0) = .rows - 1
                .TextMatrix(.rows - 1, 1) = mrc.Fields("p_id")
                .TextMatrix(.rows - 1, 2) = mrc.Fields("p_name")
                .TextMatrix(.rows - 1, 3) = mrc.Fields("unit")
                .TextMatrix(.rows - 1, 4) = mrc.Fields("unit_price")
                .TextMatrix(.rows - 1, 5) = mrc.Fields("qty")
                .TextMatrix(.rows - 1, 6) = mrc.Fields("price")
                .rows = .rows + 1
                mrc.MoveNext
            End With
        Loop
        msglist.Enabled = True
        totalprice
        mrc.Close
        Set mrc = Nothing
    Else
        Call IsEdit(False)
        intNumWindows = OpenWindow(intNumWindows)
        Call SetFormStu(Me, frmMain)
    End If
    loadroompopup
    
    TxtSQL = "select p_id,product_name,unit,product_cos,product_code,type_id,product_eno"
    TxtSQL = TxtSQL & " from Product "
    TxtSQL = TxtSQL & " where p_id<>'' and p_id<>'1'"
    TxtSQL = TxtSQL & " order by type_id,product_name, p_id"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    Set flex_pro.DataSource = mrc
    showtitle_pro
    flex_pro.Visible = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    
    Set rsSaHA = Nothing
    Set rsSalDA = Nothing
    Set cmSaHA = Nothing
    Set cmProduct = Nothing
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    
    txt_id.Enabled = blnIsEdit
    Combsupp.Enabled = blnIsEdit
    Combtype.Enabled = blnIsEdit
    cmdSave.Enabled = blnIsEdit
    combdw.Enabled = blnIsEdit
    txt_memo.Enabled = blnIsEdit
    
    dtptime.Enabled = blnIsEdit
    txt_qty.Enabled = blnIsEdit
    Combdj.Enabled = blnIsEdit