frmmakeorder.frm

金算盘软件代码

    Select Case Index
    Case 0
        GetLngColNO
        blnCancelOK = False
        If curInput.Visible = True Then
            GrdCol.col = xlngColNo(2)
        End If
        If blnCancelOK Then
            Exit Sub
        End If
        If SaveBills() Then
            Me.MousePointer = vbDefault
            Unload Me
            Exit Sub
        End If
        Me.MousePointer = vbDefault
    Case 1
        blnSucceed = False
        Unload Me
        Exit Sub
    Case 2
        ReCalc
    Case 3
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.RowHeight(i) > 0 Then
                SetSelectRow i, True
            End If
        Next
    Case 4
        SelectSome
    Case 5
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" Then
                SetSelectRow i, False
            End If
        Next
    End Select
End Sub

Private Function ColName(ByVal lngCol As Long) As String
    Dim strTmp As String
    
    strTmp = GrdCol.TextMatrix(0, lngCol)
    
    If InStr(strTmp, "↑") <> 0 Or InStr(strTmp, "↓") <> 0 Then
        strTmp = Left(strTmp, Len(strTmp) - 1)
    End If
    ColName = strTmp
End Function

Private Sub GetLngColNO()
    Dim i As Integer
    Dim j As Integer
    
    For i = 2 To GrdCol.Cols - 1
        For j = 2 To GrdCol.Cols - 1
            If strColName(i) = ColName(j) Then
                xlngColNo(i) = j
                Exit For
            End If
        Next
    Next
End Sub

Private Sub mclsGrid_BeforeEdit(blnCancel As Boolean)
    Dim dblFactor As Double
    
    GetLngColNO
    With GrdCol
        Select Case .col
        Case xlngColNo(11)
            dblFactor = RowDatas(.RowData(.Row)).dblFactor
            If dblFactor <= 1 Then
                curInput.Digits = 0
            Else
                curInput.Digits = Len(CStr(dblFactor - 1))
            End If
        Case xlngColNo(12)
            curInput.Digits = gclsBase.PriceDec
        Case xlngColNo(13)
            curInput.Digits = gclsBase.NaturalCurDec
        Case xlngColNo(14)
        End Select
    End With
End Sub

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim strQuantity As String
    Dim strAmount As String
    Dim strPrice As String
    Dim dblFactor As Double

    GetLngColNO
    With GrdCol
        dblFactor = RowDatas(.RowData(.Row)).dblFactor
        Select Case .col
        Case xlngColNo(11)
            curInput.Text = DisplayData(Me.hWnd, curInput.Text, dblFactor)
            strQuantity = NumberConvert(curInput.Text, dblFactor)
            strPrice = .TextMatrix(.Row, xlngColNo(12))
            strAmount = Format(C2Dbl(strPrice) * C2Dbl(strQuantity) / dblFactor, strCurrDec)
            .TextMatrix(.Row, xlngColNo(13)) = strAmount
        Case xlngColNo(12)
            strQuantity = NumberConvert(.TextMatrix(.Row, xlngColNo(11)), dblFactor)
            strPrice = Format(C2Dbl(curInput.Text), strPriceDec)
            curInput.Text = strPrice
            strAmount = Format(C2Dbl(strPrice) * C2Dbl(strQuantity) / dblFactor, strCurrDec)
            .TextMatrix(.Row, xlngColNo(13)) = strAmount
        Case xlngColNo(13)
            strQuantity = NumberConvert(.TextMatrix(.Row, xlngColNo(11)), dblFactor)
            strAmount = Format(curInput.Text, strCurrDec)
            curInput.Text = strAmount
            If C2Dbl(strQuantity) <= 0 Then
                Exit Sub
            End If
            strPrice = Format(C2Dbl(strAmount) * dblFactor / C2Dbl(strQuantity), strPriceDec)
            .TextMatrix(.Row, xlngColNo(12)) = strPrice
        End Select
    End With
End Sub

Private Sub mclsGrid_DataValid(blnCancel As Boolean)
    Dim strErr As String
    GetLngColNO
    
    Select Case GrdCol.col
    Case xlngColNo(11)
        If C2Dbl(curInput.Text) < 0 Then
            strErr = GrdCol.TextMatrix(0, GrdCol.col) & "不能小于0！"
            GoTo EndProc
        End If
    Case xlngColNo(12)
        If C2Dbl(curInput.Text) <= 0 Then
            strErr = GrdCol.TextMatrix(0, GrdCol.col) & "必须大于0！"
            GoTo EndProc
        End If
    Case xlngColNo(13)
        If C2Dbl(curInput.Text) < 0 Then
            strErr = GrdCol.TextMatrix(0, GrdCol.col) & "不能小于0！"
            GoTo EndProc
        End If
    Case xlngColNo(14)
        If dtmPromise.Text <> "" Then
            If dtmPromise.Text < dtmInput.Text Then
                strErr = GrdCol.TextMatrix(0, GrdCol.col) & "不能小于制单日期！"
                GoTo EndProc
            End If
        End If
    End Select
    
EndProc:
    If strErr = "" Then
        blnCancel = False
    Else
        blnCancel = True
        ShowMsg Me.hWnd, strErr, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "修改数据"
    End If
End Sub

Private Sub SetSelectRow(ByVal lngRowno As Long, ByVal blnSelect As Boolean)
    If blnSelect Then
        GrdCol.TextMatrix(lngRowno, 1) = "√"
    Else
        GrdCol.TextMatrix(lngRowno, 1) = ""
    End If
End Sub

Private Sub cMsgBox(ByVal strText As String, Optional ByVal strTitle As String = "提示信息")
    ShowMsg Me.hWnd, strText, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

Private Sub ReCalc()
    Dim strSql As String
    Dim strAvgQuantity As String
    Dim strQuantity As String
    Dim strStartDate As String
    Dim strNextDate As String
    Dim datTmp As Date
    Dim lngCount As Long
    Dim i As Long
    Dim j As Long
    Dim dblTmp As Double
    
    
    datTmp = C2Date(dtmInput.Text)
    lngCount = C2Dbl(SpinInput.Text)
    Select Case CboInput.Text
    Case "年"
        strNextDate = Format(DateAdd("yyyy", 1, datTmp), "YYYY-MM-DD")
        datTmp = DateAdd("yyyy", -1 * lngCount, datTmp)
    Case "季"
        strNextDate = Format(DateAdd("q", 1, datTmp), "YYYY-MM-DD")
        datTmp = DateAdd("q", -1 * lngCount, datTmp)
    Case "月"
        strNextDate = Format(DateAdd("m", 1, datTmp), "YYYY-MM-DD")
        datTmp = DateAdd("m", -1 * lngCount, datTmp)
    Case "周"
        strNextDate = Format(DateAdd("ww", 1, datTmp), "YYYY-MM-DD")
        datTmp = DateAdd("ww", -1 * C2Dbl(SpinInput.Text), datTmp)
    Case "天"
        strNextDate = Format(DateAdd("d", 1, datTmp), "YYYY-MM-DD")
        datTmp = DateAdd("d", -1 * C2Dbl(SpinInput.Text), datTmp)
    End Select
    
    strStartDate = Format(datTmp, "YYYY-MM-DD")
    If strStartDate < gclsBase.BeginDate Then
        strStartDate = gclsBase.BeginDate
        datTmp = C2Date(strStartDate)
        Select Case CboInput.Text
        Case "年"
            lngCount = DateDiff("yyyy", datTmp, C2Date(dtmInput.Text))
            If datTmp <> DateAdd("yyyy", -1 * lngCount, C2Date(dtmInput.Text)) Then
                lngCount = lngCount + 1
            End If
        Case "季"
            lngCount = DateDiff("q", datTmp, C2Date(dtmInput.Text))
            If datTmp <> DateAdd("q", -1 * lngCount, C2Date(dtmInput.Text)) Then
                lngCount = lngCount + 1
            End If
        Case "月"
            lngCount = DateDiff("m", datTmp, C2Date(dtmInput.Text))
            If datTmp <> DateAdd("m", -1 * lngCount, C2Date(dtmInput.Text)) Then
                lngCount = lngCount + 1
            End If
        Case "周"
            lngCount = DateDiff("ww", datTmp, C2Date(dtmInput.Text))
            If datTmp <> DateAdd("ww", -1 * lngCount, C2Date(dtmInput.Text)) Then
                lngCount = lngCount + 1
            End If
        Case "天"
            lngCount = DateDiff("d", datTmp, C2Date(dtmInput.Text))
        End Select
    End If
    
    If lngCount <= 0 Then
        cMsgBox "计算周期数小于等于0，不能计算！"
        Exit Sub
    End If
    strAvgQuantity = " (Sum(dblSaleQuantity+dblLendQuantity+dblStageQuantity" & _
        ") " & "/" & lngCount & ")"
        
    strQuantity = " Sum(dblPurchaseQuantity" & _
        "+dblEntrustInQuantity" & _
        "+dblInQuantity" & _
        "+dblCheckUpQuantity" & _
        "-dblSaleQuantity" & _
        "-dblLendQuantity" & _
        "-dblStageQuantity" & _
        "-dblEntrustOutQuantity" & _
        "-dblOutQuantity" & _
        "-dblCheckDownQuantity) "
    
        
    strSql = "SELECT Item.lngItemID AS 选择,Item.strItemCode||' '||Item.strItemName AS 商品," & _
        " Item.strItemStyle AS 规格型号,ItemUnit.strUnitName AS 计量单位," & _
        " Customer.strCustomerCode||' '|| Customer.strCustomerName AS 供应商,Item.dblMinUnitsInStock AS 最小库存量," & _
        " QAVG.dblAVGQuantity AS " & CboInput.Text & "平均销售量," & _
        " QNOW.dblNowQuantity AS 当前现有库存量," & _
        " QNEXT.dblNextQuantity AS 预计本" & CboInput.Text & "到货量, " & _
        " 0 AS 建议每" & CboInput.Text & "采购量,0 AS 建议本次采购量," & _
        " Item.dblPurchasePrice1 AS 本币含税单价, 0 AS 本币含税金额,'" & dtmInput.Text & "' AS 约定到货日期, " & _
        " Customer.lngCustomerID,ItemUnit.lngUnitID,ItemUnit.dblFactor,Tax.lngTaxID,Tax.dblPurchaseTaxRate," & _
        " Item.lngCustomID0,Item.lngCustomID1,Item.lngCustomID2," & _
        " Item.lngCustomID3,Item.lngCustomID4,Item.lngCustomID5 "
    strSql = strSql & " FROM Item,ItemNature,ItemUnit,Customer,Tax," & _
        " (SELECT " & strAvgQuantity & " AS dblAVGQuantity,ItemDaily2.lngItemID FROM ItemDaily2 WHERE " & _
        " ItemDaily2.strDate >='" & strStartDate & "' AND ItemDaily2.strDate<='" & dtmInput.Text & "' GROUP BY ItemDaily2.lngItemID) QAVG, " & _
        " (SELECT " & strQuantity & " AS dblNowQuantity,ItemDaily2.lngItemID FROM ItemDaily2 WHERE " & _
        " ItemDaily2.strDate<='" & dtmInput.Text & "' GROUP BY ItemDaily2.lngItemID) QNOW, " & _
        " (SELECT Sum(PurchaseOrderDetail.dblQuantity-PurchaseOrderDetail.dblReceiveQuantity) AS dblNextQuantity,PurchaseOrderDetail.lngItemID " & _
        " FROM PurchaseOrderDetail WHERE PurchaseOrderDetail.strPromiseDate>='" & dtmInput.Text & "' " & _
        " AND PurchaseOrderDetail.strPromiseDate<'" & strNextDate & "' GROUP BY PurchaseOrderDetail.lngItemID) QNEXT "
    strSql = strSql & " WHERE Item.lngItemNatureID=ItemNature.lngItemNatureID " & _
        " AND Item.lngStockUnitID=ItemUnit.lngUnitID " & _
        " AND Item.lngCustomerID=Customer.lngCustomerID " & _
        " AND ItemNature.lngTaxID=Tax.lngTaxID " & _
        " AND Item.lngItemID=QAVG.lngItemID(+) " & _
        " AND Item.lngItemID=QNOW.lngItemID(+) " & _
        " AND Item.lngItemID=QNEXT.lngItemID(+) " & _
        " AND Item.lngCustomerID<>0 AND Item.blnIsInActive=0 " & _
        " AND (Customer.strCategory='1' OR Customer.strCategory='3') AND ItemNature.strItemCategory='1' " & _
        " ORDER BY Item.strItemCode"
        
    Me.MousePointer = vbHourglass
    GrdCol.Redraw = False
    mclsGrid.ColOfs = 1
    Set Data1.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    If Not Data1.Resultset.EOF Then
'        Data1.Resultset.MoveLast
'    End If
    ReDim RowDatas(GrdCol.Rows - 1)
    For i = 1 To GrdCol.Rows - 1
        RowDatas(i).dblFactor = GrdCol.TextMatrix(i, 17)
        GrdCol.RowData(i) = i
        RowDatas(i).lngItemID = GrdCol.TextMatrix(i, 1)
        GrdCol.TextMatrix(i, 1) = ""
        GrdCol.TextMatrix(i, 7) = Format(C2Dbl(GrdCol.TextMatrix(i, 7)), "#0")
        dblTmp = C2Dbl(GrdCol.TextMatrix(i, 6)) + C2Dbl(GrdCol.TextMatrix(i, 7))
        GrdCol.TextMatrix(i, 10) = IIf(dblTmp <= 0, "", Format(dblTmp, "#0"))
        dblTmp = dblTmp - C2Dbl(GrdCol.TextMatrix(i, 8)) - C2Dbl(GrdCol.TextMatrix(i, 9))
        If dblTmp < 0 Then dblTmp = 0
        GrdCol.TextMatrix(i, 11) = IIf(dblTmp <= 0, "", Format(dblTmp, "#0"))
        dblTmp = dblTmp * C2Dbl(GrdCol.TextMatrix(i, 12))
        GrdCol.TextMatrix(i, 12) = IIf(C2Dbl(GrdCol.TextMatrix(i, 12)) <= 0, "", Format(C2Dbl(GrdCol.TextMatrix(i, 12)) * RowDatas(i).dblFactor, strPriceDec))
        GrdCol.TextMatrix(i, 13) = IIf(dblTmp <= 0, "", Format(dblTmp, strCurrDec))
        RowDatas(i).lngCustomerID = GrdCol.TextMatrix(i, 15)
        RowDatas(i).lngUnitID = GrdCol.TextMatrix(i, 16)
        RowDatas(i).lngTaxID = GrdCol.TextMatrix(i, 18)
        RowDatas(i).dblTaxRate = GrdCol.TextMatrix(i, 19) / 100
        RowDatas(i).lngCustomID0 = GrdCol.TextMatrix(i, 20)
        RowDatas(i).lngCustomID1 = GrdCol.TextMatrix(i, 21)
        RowDatas(i).lngCustomID2 = GrdCol.TextMatrix(i, 22)
        RowDatas(i).lngCustomID3 = GrdCol.TextMatrix(i, 23)
        RowDatas(i).lngCustomID4 = GrdCol.TextMatrix(i, 24)
        RowDatas(i).lngCustomID5 = GrdCol.TextMatrix(i, 25)
        RowDatas(i).dblPurchasePrice1 = C2Dbl(GrdCol.TextMatrix(i, 12))
        For j = 6 To 11
            GrdCol.TextMatrix(i, j) = IIf(C2Dbl(GrdCol.TextMatrix(i, j)) = 0, "", DisplayData(Me.hWnd, NumberConvert(GrdCol.TextMatrix(i, j), RowDatas(i).dblFactor, False), RowDatas(i).dblFactor))
        Next
    Next
        
    GrdCol.Cols = 15