modmain.bas

这是一个用VB编写的“仓库管理系统”源码

Attribute VB_Name = "ModMain"
Option Explicit
Public strCurUser As String
Public dteSysDate As Date
Public intNumWindows As Integer
Public strConnect As String

Sub main()
    frmLogin.Show vbModal
    If Not frmLogin.LoginSucceeded Then
        End
    End If
    Unload frmLogin
    frmlogo.Show
    Load frmMain
    Unload frmlogo
    frmMain.Show
    FrmSysDate.Show vbModal
End Sub

Public Sub SetFormStu(mFrmChi As Form, mFrmFat As Form)
    mFrmChi.Top = (mFrmFat.Height - mFrmChi.Height) / 2 - 300
    mFrmChi.Left = (mFrmFat.Width - mFrmChi.Width) / 2
End Sub

Public Function OpenWindow(intTmp As Integer)
    OpenWindow = intTmp + 1
End Function

Public Function Closewindow(intTmp As Integer)
    Closewindow = intTmp - 1
End Function

Public Function Product_Status(strProNum As String) As String
    Dim rsProSta As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsProSta = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select a.product_name,a.product_model,b.qty,b.price from " & _
    "product a,mat_head b where a.p_id=b.p_id and a.p_id='" & strProNum & "'"
    rsProSta.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as oqty,sum(price) as oprice from " & _
    "order_detail_a where p_id='" & strProNum & "' group by p_id"
    rsOrdDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as sqty,sum(price) as sprice from " & _
    "sale_detail_a where p_id='" & strProNum & "' group by p_id"
    rsSalDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    If rsProSta.RecordCount = 0 Then
        Product_Status = ""
    Else
        With rsProSta
            .MoveFirst
            strSQL = !product_name & "    " & !product_model & "    数量:" & _
            sngOrdQty + !qty - sngSalQty & "    金额:" & CurOrdPrice + !price - CurSalPrice
        End With
        Product_Status = strSQL
    End If
    rsProSta.Close
    Set rsProSta = Nothing
End Function

'Public Function Sale_Status(strSalNum As String, strUnPr As String) As String
'    Dim rsSalSta As ADODB.Recordset
'    Dim strSQL As String
'    Set rsSalSta = New ADODB.Recordset
'    strSQL = "select a.product_name,a.product_model,b.qty from " & _
'    "product a,mat_detail b where a.p_id=b.p_id and a.p_id='" & strSalNum _
'    & "' and b.unit_price=ccur('" & strUnPr & "')"
'    rsSalSta.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
'    If rsSalSta.RecordCount = 0 Then
'        Sale_Status = ""
'    Else
'        With rsSalSta
'            .MoveFirst
'            strSQL = !product_name & "    " & !product_model & "    单价:" & _
'            strUnPr & "    数量:" & !qty
'        End With
'        Sale_Status = strSQL
'    End If
'    rsSalSta.Close
'    Set rsSalSta = Nothing
'End Function

Public Function SaleTooLarge(strSaleID As String, strSalPro As String, strSalQty As String) As Boolean
    Dim rsMatQty As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngMatQty, sngOrdQty, sngSalQty As Single
    Set rsMatQty = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select qty from mat_head where p_id='" & strSalPro & "'"
    rsMatQty.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as oqty from " & _
    "order_detail_a where p_id='" & strSalPro & "' group by p_id"
    rsOrdDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as sqty from " & _
    "sale_detail_a where p_id='" & strSalPro & "' and sale_id<>'" & _
    strSaleID & "' group by p_id"
    rsSalDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
        Else
            sngOrdQty = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
        Else
            sngSalQty = 0
        End If
    End With
    If rsMatQty.RecordCount = 0 Then
        sngMatQty = 0
    Else
        With rsMatQty
            .MoveFirst
            sngMatQty = CSng(!qty)
        End With
    End If
    If (sngOrdQty + sngMatQty - sngSalQty) - CCur(strSalQty) < 0 Then
        SaleTooLarge = False
    Else
        SaleTooLarge = True
    End If
    rsMatQty.Close
    Set rsMatQty = Nothing
End Function

Public Function SaleUnPr(strSaleID As String, strSalPro As String) As Currency
    Dim rsMat As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsMat = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select qty,price from mat_head where p_id='" & strSalPro & "'"
    rsMat.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as oqty,sum(price) as oprice from " & _
    "order_detail_a where p_id='" & strSalPro & "' group by p_id"
    rsOrdDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as sqty,sum(price) as sprice from " & _
    "sale_detail_a where p_id='" & strSalPro & "' and sale_id<>'" & _
    strSaleID & "' group by p_id"
    rsSalDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    With rsMat
        If rsMat.RecordCount = 0 Then
            SaleUnPr = 0
        Else
            If sngOrdQty + CSng(!qty) - sngSalQty <> 0 Then
                SaleUnPr = CCur(Round((CurOrdPrice + CCur(!price) - CurSalPrice) _
                / (sngOrdQty + CSng(!qty) - sngSalQty), 2))
            End If
        End If
    End With
    rsMat.Close
    rsOrdDA.Close
    rsSalDA.Close
    Set rsMat = Nothing
    Set rsOrdDA = Nothing
    Set rsSalDA = Nothing
End Function

Public Function Sale_Price(strSaleID As String, strSaleNum As String, strSaleUnPr As String, strSaleQty As String) As Currency
    Dim rsMatSale As ADODB.Recordset
    Dim rsOrdDA As ADODB.Recordset
    Dim rsSalDA As ADODB.Recordset
    Dim strSQL As String
    Dim sngOrdQty, sngSalQty As Single
    Dim CurOrdPrice, CurSalPrice As Currency
    Set rsMatSale = New ADODB.Recordset
    Set rsOrdDA = New ADODB.Recordset
    Set rsSalDA = New ADODB.Recordset
    strSQL = "select qty,price from mat_head where p_id='" & strSaleNum & "'"
    rsMatSale.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as oqty,sum(price) as oprice from " & _
    "order_detail_a where p_id='" & strSaleNum & "' group by p_id"
    rsOrdDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    strSQL = "select p_id,sum(qty) as sqty,sum(price) as sprice from " & _
    "sale_detail_a where p_id='" & strSaleNum & "' and sale_id<>'" & _
    strSaleID & "'group by p_id"
    rsSalDA.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
    With rsOrdDA
        If .RecordCount <> 0 Then
            sngOrdQty = !oqty
            CurOrdPrice = !oprice
        Else
            sngOrdQty = 0
            CurOrdPrice = 0
        End If
    End With
    With rsSalDA
        If .RecordCount <> 0 Then
            sngSalQty = !sqty
            CurSalPrice = !sprice
        Else
            sngSalQty = 0
            CurSalPrice = 0
        End If
    End With
    With rsMatSale
        If .RecordCount <> 0 Then
            If (sngOrdQty + CSng(!qty) - sngSalQty) - CSng(strSaleQty) < 0.00000001 Then
                Sale_Price = CurOrdPrice + CCur(!price) - CurSalPrice
            Else
                Sale_Price = Round((CCur(strSaleUnPr) * CSng(strSaleQty)), 2)
            End If
        End If
    End With
    rsMatSale.Close
    rsOrdDA.Close
    rsSalDA.Close
    Set rsMatSale = Nothing
    Set rsOrdDA = Nothing
    Set rsSalDA = Nothing
End Function