www.pudn.com > jxc001.rar > ModMain.bas

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