frmjhd.frm

注释：用VB开发的进销存系统源码

                        strValue = Format(RsTemp(j), "#")
                    Else
                        strValue = Format(RsTemp(j), DecNum)
                    End If
                ElseIf j = 0 Or j = 1 Or j = 2 Then
                    strControl = "lblc" & (j + 1) & "r" & N + 1
                    strValue = RsTemp(j)
                End If
                rptBill.Sections("Indent").Controls(strControl).Caption = strValue
                
            Next j
        
            If GetSetting("LSDSTAR", "库存设置", "进货打印含税价", "1") = "1" Then
                sSQL = "select 商品编码,品名,单位,颜色,尺寸,进货数量 as 数量 from LSJHD where 表单号='" & Trim(txtPurcode.Text) & "' and 商品编码='" & Trim(RsTemp("商品编码")) & "' and 含税进价=" & RsTemp("单价") & " order by 商品编码,颜色,尺寸"
            Else
                sSQL = "select 商品编码,品名,单位,颜色,尺寸,进货数量 as 数量 from LSJHD where 表单号='" & Trim(txtPurcode.Text) & "' and 商品编码='" & Trim(RsTemp("商品编码")) & "' and 进价=" & RsTemp("单价") & " order by 商品编码,颜色,尺寸"
            End If
            Set RP = Nothing
            RP.CursorLocation = adUseClient
            RP.Open sSQL, Conn, adOpenStatic, adLockPessimistic
            strControl = "lblR" & Trim(Str(N + 1))
       
        
        
            ColorAndSize = ColorAndSize & Trim(RP("商品编码"))
            PRECOLOR = ""
            While Not RP.EOF
                If PRECOLOR <> Trim(RP("颜色")) Then
                    PRECOLOR = Trim(RP("颜色"))
                    ColorAndSize = ColorAndSize & Trim(RP("颜色")) & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                Else
                    ColorAndSize = ColorAndSize & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                End If
                RP.MoveNext
            Wend

            ColorAndSize = ColorAndSize & vbCrLf
            Qty = Qty + RsTemp("数量")
            sum = sum + RsTemp("金额")
            RsTemp.MoveNext
        Next N
        rptBill.Sections("Indent").Controls("lblColorAndSize").Caption = ColorAndSize

'        sum = Format(sum, DecNum)
        rptBill.Sections("Indent").Controls("lbl大写").Caption = D2X(sum)
        rptBill.Sections("Indent").Controls("lblSum").Caption = Format(Qty, "#")
        rptBill.Sections("Indent").Controls("lblIamt").Caption = Format(sum, DecNum)
        
        RsTemp.MovePrevious
        rptBill.Sections("Indent").Controls("lblPage").Caption = "第 " & Str(Int((RsTemp.AbsolutePosition - 1) / 6) + 1) & " 页 共 " & Str(Int((RsTemp.RecordCount - 1) / 6) + 1) & " 页"
        RsTemp.MoveNext
        
        rptBill.Sections("Indent").Controls("lbltitle").Caption = GetSetting("LSDSTAR", "单据标题", "进货单", "进货单")
        rptBill.Sections("Indent").Controls("lblno").Caption = "NO:" & txtPurcode.Text
        rptBill.Sections("Indent").Controls("lblgrp").Caption = "供应商:" & cmbProvider.Columns("厂商名称").Text
        rptBill.Sections("Indent").Controls("lblDate").Caption = "日期:" & txtPurdate.Text
        rptBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & txtRemark.Text
        rptBill.Sections("Indent").Controls("lblYH").Visible = True
        rptBill.Sections("Indent").Controls("lblIptno").Caption = "开票:" & txtIptno.TheName
    
        If GetSetting("LSDSTAR", "单据标题", "显示预览窗口", "1") = "1" Then
            rptBill.Show 1
        Else
            rptBill.PrintReport
        End If
        Unload rptBill
    Wend
        
    MsgBox "打印完成!", vbInformation, "提示窗口"

End Sub

'增加新表
Private Sub cmdToolAdd_Click()
    On Error Resume Next
    TableState = "新建"
    grdDET.AllowUpdate = True
    grdDET.SelectByCell = False
    Set Rs = Nothing
    QueryFlag = False
    Call ShowStatus(2)
    '清除整个表显示
    Call ClearTable
    txtIptno.Text = UserCode
    If GetSetting("LSDSTAR", "进销管理", "进货单单号是否自动生成", "1") = "1" Then
        txtPurcode.Text = GeneratePurcode(TableName)
    End If
    txtPurcode.SetFocus
    cmdToolSave.Enabled = True
    cmdToolCommit.Caption = "审核[&O]"
'    cmdToolCommit.Enabled = False
    cmdToolPrevious.Enabled = False
    cmdToolNext.Enabled = False
    cmdToolDelete.Enabled = False
    txtPurdate.Text = Format(Now, "yyyy-mm-dd")
End Sub

'改变确认状态
'只有审核员才能进行该操作
Private Sub cmdToolCommit_Click()
    If GetSetting("LSDSTAR", "库存设置", "使用存储过程", "1") = "0" Then
        If cmdToolCommit.Caption = "审核[&O]" Then
            AcceptVil (True)
        Else
            AcceptVil (False)
        End If
    Else
        Cmd.ActiveConnection = Conn
        If cmdToolCommit.Caption = "审核[&O]" Then
            Cmd.CommandText = "P_INStoreBill '审核','LSJHD','" & Trim(txtPurcode.Text) & "'"
            Call SetButtonState(True)
        Else
            Cmd.CommandText = "P_INStoreBill '弃审','LSJHD','" & Trim(txtPurcode.Text) & "'"
            Call SetButtonState(False)
        End If
        Cmd.ActiveConnection = Conn
        Cmd.Execute
    End If
    
End Sub

'删除当前表
Private Sub cmdToolDelete_Click()
    On Error Resume Next
    Call ShowStatus(88)
    If txtPurcode.Text = "" Then
        MsgBox "当前表单为空!", vbExclamation, "提示窗口"
        Exit Sub
    End If

    Temp = "确认之要删除该表吗?" & vbCrLf & "表单号为：" & txtPurcode.Text
    Temp = MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口")
    If Temp = vbYes Then
        
        sSQL = "DELETE  FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
        RunSQL sSQL
        
        Call ClearTable
        cmdToolPrevious.Enabled = False
        cmdToolNext.Enabled = False
        Call ShowStatus(5)
    End If
End Sub

'退出
Private Sub cmdToolExit_Click()
    Unload Me
End Sub

''设置是否进行合法性验证
Private Sub SetValidate(Flag As Boolean)
    txtPurcode.CausesValidation = Flag
    txtPurdate.CausesValidation = Flag
    cmbProvider.CausesValidation = Flag
    txtIptno.Validation = Flag
    grdDET.CausesValidation = Flag
End Sub

'生成查询条件
Private Function GenerateQuerySQL() As String
    Dim strTemp As String
    sSQL = "SELECT 表单号 FROM LSJHD "
    If txtPurcode.Text <> "" Then
        strTemp = strTemp & "  表单号" & AnalyseCondition(txtPurcode.Text, True) & " AND "
    End If
    If txtPurdate.Text <> "" Then
        strTemp = strTemp & "  制表日期 BETWEEN '" & _
                Format(txtPurdate.Text, "YYYY-MM-DD 00:00") & "' AND '" & _
                Format(txtPurdate.Text, "YYYY-MM-DD") & " 23:59' AND "
    End If
    If cmbProvider.Text <> "" Then
        strTemp = strTemp & "  厂商编码" & _
            AnalyseCondition(cmbProvider.Text, True) & " AND "
    End If
    If txtIptno.Text <> "" Then
        strTemp = strTemp & "  录入员" & _
            AnalyseCondition(txtIptno.Text, True) & " AND "
    End If
    If grdDET.Columns(0).CellText(0) <> "" Then
        strTemp = strTemp & "  商品编码 " & _
            AnalyseCondition(grdDET.Columns(0).CellText(0), True) & " AND "
    End If
    If grdDET.Columns(3).CellText(0) <> "" Then
        strTemp = strTemp & "  进货数量 " & _
            AnalyseCondition(grdDET.Columns(3).CellText(0), True) & " AND "
    End If
    If grdDET.Columns(4).CellText(0) <> "" Then
        strTemp = strTemp & "  进价 " & _
            AnalyseCondition(grdDET.Columns(4).CellText(0), False) & " AND "
    End If
    If strTemp <> "" Then
        '去掉尾部的" AND "
        sSQL = sSQL & " WHERE " & Mid(strTemp, 1, Len(strTemp) - 4)
    End If
    sSQL = sSQL & " GROUP BY 表单号,制表日期 ORDER BY 制表日期 desc,表单号 desc"
    GenerateQuerySQL = sSQL
End Function

Private Sub cmdToolJian_Click()
    Dim s, ss, Qty
    Load frmDist
    'Set frmDist.frm = Me
    frmDist.Show 1
    sSQL = "SELECT 品名,单位,进价,零售价,税率,含税进价 FROM 商品主档 WHERE 商品编码='" & frmDist.GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
    
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If
    If frmDist.R <> "" Then
        ss = frmDist.R
        
        I = 1
        While I <= Len(ss)
            s = ""
            Qty = ""
            While Mid(ss, I, 1) <> "#" And I <= Len(ss)
                If Mid(ss, I, 1) = "@" Then
                    s = s & vbTab
                ElseIf Mid(ss, I, 1) = "$" Then
                    Qty = ""
                    s = s & vbTab & RsTemp("含税进价") & vbTab & RsTemp("进价") & vbTab & "17" & vbTab
                Else
                    Qty = Qty & Mid(ss, I, 1)
                    s = s & Mid(ss, I, 1)
                End If
                I = I + 1
            Wend
            I = I + 1
            Temp = frmDist.GCode & vbTab & RsTemp("品名") & vbTab & _
                    RsTemp("单位") & vbTab & s & vbTab & Str(Qty * RsTemp("含税进价")) & vbTab & Str(Qty * RsTemp("进价"))
            grdDET.AddItem Temp
        Wend
    End If


    Unload frmDist
End Sub

'查询
Private Sub cmdToolQuery_Click()
    Dim strTemp As String
    TableState = "查询"
    grdDET.AllowUpdate = True
    grdDET.SelectByCell = False
    If cmdToolQuery.Caption = "查询[&Q]" Then
        cmdToolQuery.Caption = "开始[&Q]"
        QueryFlag = True
        Call ShowStatus(1)
        
        cmdToolAdd.Enabled = False
        cmdToolSave.Enabled = False
        cmdToolPrevious.Enabled = False
        cmdToolNext.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolCommit.Caption = "弃审[&O]"
        
        Call SetValidate(False)
        Call ClearTable
        txtPurcode.SetFocus
    ElseIf cmdToolQuery.Caption = "开始[&Q]" Then
        cmdToolQuery.Caption = "查询[&Q]"
        QueryFlag = False
        
        cmdToolAdd.Enabled = True
        cmdToolSave.Enabled = True
        cmdToolPrevious.Enabled = True
        cmdToolNext.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolCommit.Caption = "审核[&O]"
        
        Call SetValidate(True)

        grdDET.Update
        Call GenerateQuerySQL

        Set Rs = Nothing
        Rs.CursorLocation = adUseClient
        Rs.Open sSQL, Conn, adOpenStatic, adLockOptimistic
        If Rs.EOF Then
            MsgBox "无匹配记录!", vbInformation, "提示窗口"
            cmdToolPrevious.Enabled = False
            cmdToolNext.Enabled = False
            Exit Sub
        End If
        sSQL = "SELECT * FROM LSJHD WHERE 表单号='" & Trim(Rs(0)) & "' order by 商品编码"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockPessimistic
        Call RefreshTable(RsTemp)
        Call ShowStatus(0)
    End If
End Sub


'下一条记录
Private Sub cmdToolNext_Click()
    On Error Resume Next
    If Rs.State = adStateClosed Then Exit Sub
    If Not Rs.EOF Then
        Rs.MoveNext
        Call ShowStatus(0)
        If Not Rs.EOF Then
            sSQL = "SELECT * FROM LSJHD WHERE 表单号='" & Trim(Rs(0)) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            
            Call RefreshTable(RsTemp)
        Else
            Call ClearTable
        End If
    End If
End Sub

'上一条记录
Private Sub cmdToolPrevious_Click()
    On Error Resume Next
    If Rs.State = adStateClosed Then Exit Sub
    If Not Rs.BOF Then
        Rs.MovePrevious
        Call ShowStatus(0)
        If Not Rs.BOF Then
            sSQL = "SELECT * FROM LSJHD WHERE 表单号='" & Trim(Rs(0)) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            
            Call RefreshTable(RsTemp)
        Else
            Call ClearTable
        End If
    End If
End Sub



'刷新表
Private Sub cmdToolSave_Click()
    On Error GoTo RefErr
    If Not DataOK() Then
        MsgBox "数据存在错误!请检查!", vbExclamation, "提示窗口"
        Exit Sub
    End If
   
    Conn.BeginTrans
    Call ShowStatus(3)
    Call CalTotalDelete
    '开始事务
    sSQL = "SELECT * FROM LSJHD WHERE 表单号='" & txtPurcode.Text & "'"
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    If Not RsTemp.EOF Then
        Temp = "该表单已经存在，覆盖原表单吗？"
        Temp = MsgBox(Temp, vbOKCancel + vbQuestion, "提示窗口")
        If Temp = vbCancel Then
            Conn.RollbackTrans