frminvoicesettle.frm

金算盘软件代码

    lblTitle(2).Caption = "日期：" & frmName.lblField(2).Caption
    lblTitle(3).Caption = "单据号：" & frmName.lblField(1).Caption
    lblTitle(4).Caption = "发票类型：" & frmName.lblField(14).Caption
    lblTitle(5).Caption = "发票号：" & frmName.lblField(13).Caption
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    mblnFirst = True
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Me.MousePointer = vbHourglass Then
        Cancel = 1
        Exit Sub
    End If
    If Not DATA1.Resultset Is Nothing Then
        DATA1.Resultset.Close
        Set DATA1.Resultset = Nothing
    End If
    Set frmName = Nothing
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
    Erase strColName
    Erase xlngColNo
    Erase RowDatas
    Erase mBorrowDatas
    mclsGrid.ListSet.ViewId = 0
    Set mclsGrid = Nothing
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If GrdCol.MouseRow > 0 Then Exit Sub
    GrdCol.Redraw = False
    For i = 0 To GrdCol.Cols - 1
        If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
            lngRowBak = GrdCol.RowData(GrdCol.MouseRow)
            GrdCol.Row = 0
            GrdCol.col = i
            If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "单价") <> 0 Then
                    For j = 1 To GrdCol.Rows - 1
                        GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                    Next
                End If
                If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                    
                    GrdCol.Sort = flexSortNumericDescending
                Else
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                    
                    GrdCol.Sort = flexSortNumericAscending
                End If
                If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                    For j = 1 To GrdCol.Rows - 1
                        GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                    Next
                ElseIf InStr(GrdCol.TextMatrix(0, i), "单价") <> 0 Then
                    For j = 1 To GrdCol.Rows - 1
                        GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strPriceDec)
                    Next
                End If
            Else
                If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                    
                    GrdCol.Sort = flexSortStringNoCaseDescending
                Else
                    GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                    
                    GrdCol.Sort = 5
                End If
            End If
            For j = 1 To GrdCol.Rows - 1
                If GrdCol.RowData(j) = lngRowBak Then
                    GrdCol.Row = j
                    If Not GrdCol.RowIsVisible(j) Then
                        GrdCol.TopRow = j
                    End If
                    Exit For
                End If
            Next
        Else
            GrdCol.TextMatrix(0, i) = ColName(i)
        End If
    Next
    GrdCol.Redraw = True
End Sub

Private Sub LoadGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    strSql = "SELECT strKey,strSetting FROM Setting WHERE lngModuleID=0 AND strSection='" & Left(Me.Name, 16) & "列宽'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        FirstGrdColWidth
    Else
        Do While Not recTmp.EOF
            GrdCol.ColWidth(C2lng(recTmp!strKey)) = C2lng(recTmp!strSetting)
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub FirstGrdColWidth()
    GrdCol.ColWidth(1) = 1395
    GrdCol.ColWidth(2) = 825
    GrdCol.ColWidth(3) = 825
    GrdCol.ColWidth(4) = 1125
    GrdCol.ColWidth(5) = 1125
    GrdCol.ColWidth(6) = 995
    GrdCol.ColWidth(7) = 995
End Sub
Private Sub SaveGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    On Error GoTo ErrHandle
    GetLngColNO
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    strSql = " FROM Setting WHERE lngModuleID=0 AND strSection='" & Left(Me.Name, 16) & "列宽'"
    gclsBase.BaseDB.Execute "DELETE " & strSql
        
    strSql = "SELECT *" & strSql
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recTmp
        For i = 1 To GrdCol.Cols - 1
            .AddNew
            !lngModuleID = 0
            !strSection = Left(Me.Name, 16) & "列宽"
            !strKey = i
            !strSetting = CStr(IIf(GrdCol.ColWidth(xlngColNo(i)) < 400, 400, GrdCol.ColWidth(xlngColNo(i))))
            !strTypeName = "Long"
            .Update
        Next
    End With
    recTmp.Close
    Set recTmp = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
ErrHandle:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    If Me.MousePointer = vbHourglass Then
        Exit Sub
    End If
    Dim i As Long
    
    Select Case Index
    Case 0
        GetLngColNO
        If SaveBill() Then
            Me.MousePointer = vbDefault
            Unload Me
            Exit Sub
        End If
        Me.MousePointer = vbDefault
    Case 1
        blnSucceed = False
        Unload Me
    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 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 RefreshGrid()
    Dim strSql As String
    Dim i As Long, j As Long, k As Long, l As Long
    Dim lngFirstReceiptRow As Long
    Dim dblTotalQuantity As Double
    Dim dblTotalAmount As Double
    
    Me.MousePointer = vbHourglass
    mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
    mclsGrid.ColOfs = 1
    
    GrdCol.Redraw = False
    strCurrDec = FormatString(CurrencyDec(frmName.GetFID(7)))
    strSql = "SELECT Item.strItemCode||' '||Item.strItemName||' '||Item.strItemStyle AS 商品或劳务名称," & _
        "ItemUnit.strUnitName AS 计量单位,0 AS 入库数量,0 AS 暂估金额," & _
        "ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount AS 发票金额,0 AS 差额,0 AS 已核销金额,"
    strSql = strSql & _
        "Item.lngItemID,ItemUnit.lngUnitID,ItemUnit.dblFactor,Item.dblPlanPrice,Item.dblRetainPrice," & _
        "ItemNature.strItemCategory,ItemNature.strCostMethod,Item.lngPositionID,Item.blnIsBatch," & _
        "Tax.lngTaxID,Tax.dblPurchaseTaxRate,ItemActivityDetail.lngActivityDetailID,0 AS InvoiceDetailID,"
    strSql = strSql & "ItemActivityDetail.strProduceNum,ItemActivityDetail.strProduceDate," & _
        "ItemActivityDetail.strValidDate,ItemActivityDetail.intValidDay,ItemActivityDetail.lngJobID," & _
        "ItemActivityDetail.lngCustomID0,ItemActivityDetail.lngCustomID1,ItemActivityDetail.lngCustomID2," & _
        "ItemActivityDetail.lngCustomID3, ItemActivityDetail.lngCustomID4, ItemActivityDetail.lngCustomID5 "
    strSql = strSql & " FROM ItemActivityDetail,Item,ItemUnit,ItemNature,Tax "
    strSql = strSql & " WHERE ItemActivityDetail.lngItemID = Item.lngItemID " & _
        " AND ItemActivityDetail.lngUnitID=ItemUnit.lngUnitID " & _
        " AND Item.lngItemNatureID=ItemNature.lngItemNatureID " & _
        " AND ItemActivityDetail.lngTaxID=Tax.lngTaxID " & _
        " AND ItemActivityDetail.lngActivityID=" & mlngActivityID
    strSql = strSql & " UNION All " & _
        " SELECT Item.strItemCode||' '||Item.strItemName||' '||Item.strItemStyle AS 商品或劳务名称," & _
        " ItemUnit.strUnitName AS 计量单位,ItemActivityDetail.dblQuantity-" & _
        " NVL(Q1.dblOtherQuantity,0) AS 入库数量," & _
        " ItemActivityDetail.dblCurrAmount+ItemActivityDetail.dblCurrTaxAmount- " & _
        " NVL(Q1.dblOtherAmount,0) AS 暂估金额, 0 AS 发票金额,0 AS 差额,PurchaseToInvoice.dblCurrAmount AS 已核销金额,"
    strSql = strSql & _
        "Item.lngItemID,ItemUnit.lngUnitID,ItemUnit.dblFactor,Item.dblPlanPrice,Item.dblRetainPrice," & _
        "ItemNature.strItemCategory,ItemNature.strCostMethod,Item.lngPositionID,Item.blnIsBatch," & _
        "Tax.lngTaxID,Tax.dblPurchaseTaxRate,ItemActivityDetail.lngActivityDetailID,IADI.lngActivityDetailID AS InvoiceDetailID,"
    strSql = strSql & "ItemActivityDetail.strProduceNum,ItemActivityDetail.strProduceDate," & _
        "ItemActivityDetail.strValidDate,ItemActivityDetail.intValidDay,ItemActivityDetail.lngJobID," & _
        "ItemActivityDetail.lngCustomID0,ItemActivityDetail.lngCustomID1,ItemActivityDetail.lngCustomID2," & _
        "ItemActivityDetail.lngCustomID3, ItemActivityDetail.lngCustomID4, ItemActivityDetail.lngCustomID5 "
    strSql = strSql & " FROM ItemActivityDetail IADI,PurchaseToInvoice,ItemActivityDetail,Item,ItemUnit,ItemNature,Tax "
    strSql = strSql & ",(SELECT PTI2.lngReceiptDetailID,SUM(PTI2.dblQuantity) AS dblOtherQuantity,SUM(PTI2.dblCurrAmount) AS dblOtherAmount " & _
        " FROM PurchaseToInvoice PTI2,ItemActivityDetail IADO " & _
        " WHERE PTI2.lngInvoiceDetailID=IADO.lngActivityDetailID " & _
        " AND IADO.lngActivityID<>" & mlngActivityID & " GROUP BY PTI2.lngReceiptDetailID) Q1"
    strSql = strSql & " WHERE IADI.lngActivityDetailID = PurchaseToInvoice.lngInvoiceDetailID " & _
        " AND PurchaseToInvoice.lngReceiptDetailID=ItemActivityDetail.lngActivityDetailID " & _
        " AND ItemActivityDetail.lngItemID=Item.lngItemID " & _
        " AND ItemActivityDetail.lngUnitID=ItemUnit.lngUnitID " & _
        " AND Item.lngItemNatureID=ItemNature.lngItemNatureID " & _
        " AND ItemActivityDetail.lngTaxID=Tax.lngTaxID " & _
        " AND ItemActivityDetail.lngActivityDetailID=Q1.lngReceiptDetailID(+) " & _
        " AND IADI.lngActivityID=" & mlngActivityID
    
    Set DATA1.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    ReDim RowDatas(GrdCol.Rows - 1)
    
    With GrdCol
        For i = 1 To .Rows - 1
            .RowData(i) = i
            RowDatas(i).dblQuantity = .TextMatrix(i, 3)
            RowDatas(i).dblReceiptAmount = .TextMatrix(i, 4)
            RowDatas(i).dblInvoiceAmount = .TextMatrix(i, 5)
            RowDatas(i).dblSettleAmount = .TextMatrix(i, 7)
            RowDatas(i).lngItemID = .TextMatrix(i, 8)
            RowDatas(i).lngUnitID = .TextMatrix(i, 9)
            RowDatas(i).dblFactor = .TextMatrix(i, 10)
            RowDatas(i).dblPlanPrice = .TextMatrix(i, 11)
            RowDatas(i).dblRetainPrice = .TextMatrix(i, 12)
            RowDatas(i).strItemCategory = .TextMatrix(i, 13)
            RowDatas(i).strCostMethod = .TextMatrix(i, 14)
            RowDatas(i).lngStockPositionID = .TextMatrix(i, 15)
            RowDatas(i).blnIsBatch = (.TextMatrix(i, 16) <> 0)
            RowDatas(i).lngTaxID = .TextMatrix(i, 17)
            RowDatas(i).dblTaxRate = .TextMatrix(i, 18)
            RowDatas(i).lngActivityDetailID = .TextMatrix(i, 19)
            RowDatas(i).lngInvoiceDetailID = .TextMatrix(i, 20)
            If lngFirstReceiptRow = 0 Then
                If RowDatas(i).lngInvoiceDetailID <> 0 Then
                    lngFirstReceiptRow = i
                End If
            End If
            RowDatas(i).strProduceNum = .TextMatrix(i, 21)
            RowDatas(i).strProduceDate = .TextMatrix(i, 22)
            RowDatas(i).strValidDate = .TextMatrix(i, 23)
            RowDatas(i).intValidDay = .TextMatrix(i, 24)
            RowDatas(i).lngJobID = .TextMatrix(i, 25)
            RowDatas(i).lngCustomID0 = .TextMatrix(i, 26)
            RowDatas(i).lngCustomID1 = .TextMatrix(i, 27)
            RowDatas(i).lngCustomID2 = .TextMatrix(i, 28)
            RowDatas(i).lngCustomID3 = .TextMatrix(i, 29)
            RowDatas(i).lngCustomID4 = .TextMatrix(i, 30)
            RowDatas(i).lngCustomID5 = .TextMatrix(i, 31)
            '数据归整
            .RowData(i) = i
            RowDatas(i).dblTaxRate = RowDatas(i).dblTaxRate / 100
            If RowDatas(i).strItemCategory = "3" Or RowDatas(i).strItemCategory = "4" Then
                RowDatas(i).dblTaxRate = RowDatas(i).dblTaxRate / (1 - RowDatas(i).dblTaxRate)
            End If
        Next