customerinitdetail.frm

金算盘软件代码

'显示
Public Sub ShowInitDetail(ByVal CustomerID As Long, ByVal CurrencyID As Long, _
    ByVal strPrice As String, ByVal intYear As Integer, ByVal blnClose As Boolean, strDec As String)
    Dim intCount As Integer
    
    mlngCustomerID = CustomerID
    mstrPrice = strPrice
    mintYear = intYear
    mblnClose = blnClose
    mstrDec = strDec
    
    SetHelpID 30106
    Set Me.Icon = GetFormResPicture(139, vbResIcon)
    Set cmdCustomerInitDetail(3).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdCustomerInitDetail(4).Picture = GetFormResPicture(1002, vbResBitmap)
    Set cmdCustomerInitDetail(5).Picture = GetFormResPicture(1012, vbResBitmap)
    GetStartDate
    Set mclsListSet = New ListSet
    mclsListSet.ViewId = lngViewId
    SetInitDetail
    #If conVersionType = 4 Then
        lblCustomerInit(1).Visible = False
        lstCustomerInitdetail(1).Visible = False
    #End If
'    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '设置窗体"钩子"对象
    Set mclsSubClassform = New SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    '初始化列表"钩子"对象
    Set mclsSubClass = New SubClass
    mclsSubClass.hwnd = msgCustomerInitDetail.hwnd
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    
    For intCount = 0 To 3
        mblnIsInput(intCount) = False
    Next
    For intCount = 0 To 30
        mblnIsload(intCount) = False
    Next
    mblnisReturn = False
    
    If CurrencyID = 0 Then
        mlngCurrencyID = 1
    Else
        mlngCurrencyID = CurrencyID
    End If
    
    GetCurrency mlngCurrencyID
    
    cmdCustomerInitDetail(0).Enabled = True
    If mblnIsClosed Then
        cmdCustomerInitDetail(0).Enabled = False
        cmdCustomerInitDetail(1).Enabled = False
        cmdCustomerInitDetail(2).Enabled = False
    End If
    Me.Show vbModal
'    Me.ZOrder 0
End Sub

'得到币种属性
Private Function GetCurrency(ByVal lngID As Long)
    Dim recTemp As rdoResultset
    Dim bytTemp As Byte
    
    With gclsBase.BaseDB
        Set recTemp = .OpenResultset("Select * From Currencys WHERE lngCurrencyID=" & lngID, rdOpenStatic)
        If recTemp.RowCount > 0 Then
            bytTemp = recTemp("bytCurrencyDec")
            mstrCurrencyDec = IIf(bytTemp = 0, "#,###,###,###", "#,###,###,##0." + String(bytTemp, "0"))
            bytTemp = recTemp("bytRateDec")
            mstrRateDec = IIf(bytTemp = 0, "#,###,###,###", "#,###,###,##0." + String(bytTemp, "0"))
            mblnIsIndirect = recTemp("blnIsIndirect")
        Else
            mstrCurrencyDec = "Standard"
            mstrRateDec = "Standard"
        End If
        recTemp.Close
    End With
End Function

'初始化列表
Private Sub InitFlex()
    Dim intCount As Integer
    
    With msgCustomerInitDetail
        For intCount = 2 To .Rows - 1
            .RowData(intCount) = 0
        Next
    End With
    For intCount = 0 To 3
        mblnIsInput(intCount) = False
    Next
    For intCount = 0 To 30
        mblnIsload(intCount) = False
    Next
    If tedCustomerInitDetail.Visible Then tedCustomerInitDetail.Visible = False
    If lstCustomerInitdetail(3).Visible Then lstCustomerInitdetail(3).Visible = False
    If gacCustomerInitDetail.Visible Then gacCustomerInitDetail.Visible = False
    If calCustomerInitDetail.Visible Then calCustomerInitDetail.Visible = False
End Sub

'得到明初列表
Private Sub GetDetail()
  Dim strSql As String
  
    msgCustomerInitDetail.Redraw = False
    
    strSql = "Select 日期,单据类型,单据号,摘要,付款条件,开票日期,到期日期,部门," & _
             "职员,工程,统计,项目,商品,计量单位,数量,汇率,不含税单价,扣率," & _
             "金额,本币金额,税率,税额,本币税额,自定义项目1,自定义项目2,自定义项目3,自定义项目4,自定义项目5,自定义项目6," & _
             "lngArApInitID,lngReceiptTypeID,lngTermID,lngDepartmentID,lngEmployeeID,lngJobID,lngClassID1,lngClassID2,lngItemID,lngUnitID," & _
             "lngTaxID,lngCustomID0,lngCustomID1,lngCustomID2,lngCustomID3,lngCustomID4,lngCustomID5,dblFactor,核销标志" & _
             " From CustomerBalanceDetail Where lngAccountId=" & mudtAccount.ID & " And lngCustomerID=" & mlngCustomerID & " And lngCurrencyID=" & mlngCurrencyID
    Set dtaCustomerInitDetail.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If dtaCustomerInitDetail.Resultset.RowCount > 1 Then
        dtaCustomerInitDetail.Resultset.MoveLast
    End If
    dtaCustomerInitDetail.Resultset.Close
    SetFlexGrid
    RestoreQP
    
    msgCustomerInitDetail.Redraw = True
End Sub

'得到到期日
Private Function GetDueDate(ByVal strDate As String, ByVal lngID As Long) As String
    Dim recTemp As rdoResultset
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("Select * From Term Where lngTermID=" & lngID, rdOpenStatic)
    If recTemp.RowCount > 0 Then
        GetDueDate = Format(CDate(strDate) + recTemp("intDueDay"), "YYYY-MM-DD")
    End If
    recTemp.Close
End Function

'参照是否在使用
Private Function IsUsed(ByVal lngID As Long, ByVal intCol As Integer) As Boolean
    Dim intCount As Integer
    
    With msgCustomerInitDetail
        For intCount = 2 To .Rows - 1
            If intCount <> mlngRow Then
                If .TextMatrix(intCount, intCol) = lngID Then Exit For
            End If
        Next
        If intCount <= .Rows - 1 Then
            IsUsed = True
        End If
    End With
End Function

'得到汇率
Private Function GetRate(ByVal lngRow As Long) As Double
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT bytMatchMethod FROM Currencys WHERE lngCurrencyID=" & mlngCurrencyID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    If Not recTemp.EOF Then
        Select Case recTemp!bytMatchmethod
            Case 1
                strSql = "SELECT dblRate FROM Rate WHERE lngCurrencyID=" & mlngCurrencyID _
                    & " AND strDate='" & msgCustomerInitDetail.TextMatrix(lngRow, 0) & "'"
            Case 2
                strSql = "SELECT Max(strDate) AS strD FROM Rate WHERE lngCurrencyID=" & mlngCurrencyID _
                    & " AND strDate<='" & msgCustomerInitDetail.TextMatrix(lngRow, 0) & "' AND dblRate<>0"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
                If Not recTemp.EOF Then
                    strSql = "SELECT dblRate FROM Rate WHERE lngCurrencyID=" & mlngCurrencyID _
                    & " AND strDate='" & recTemp!strD & "'"
                Else
                    strSql = ""
                End If
            Case 3
                strSql = "SELECT Min(strDate) AS strD FROM Rate WHERE lngCurrencyID=" & mlngCurrencyID _
                    & " AND strDate>='" & msgCustomerInitDetail.TextMatrix(lngRow, 0) & "' AND dblRate<>0"
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
                If Not recTemp.EOF Then
                    strSql = "SELECT dblRate FROM Rate WHERE lngCurrencyID=" & mlngCurrencyID _
                    & " AND strDate='" & recTemp!strD & "'"
                Else
                    strSql = ""
                End If
        End Select
        If strSql <> "" Then
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
            If Not recTemp.EOF Then
                GetRate = recTemp!dblRate
            End If
        End If
    End If
End Function

'根据计量单位ID找出其折算因子
Public Function ConvertFactor(ByVal UnitID As Long) As Double
    Dim recTmp As rdoResultset
    Dim SqlClause As String
    
    SqlClause = " SELECT dblfactor FROM itemunit WHERE lngUnitID=" & UnitID
    Set recTmp = gclsBase.BaseDB.OpenResultset(SqlClause, rdOpenStatic)
    If recTmp.RowCount > 0 Then
        ConvertFactor = recTmp!dblFactor
    Else
        ConvertFactor = 0
    End If
    recTmp.Close
    
End Function

'恢复数量及价格
Private Sub RestoreQP()
    Dim intCount As Integer
    Dim dblFactor As Double
    
    With msgCustomerInitDetail
        For intCount = 2 To .Rows - 1
            If .TextMatrix(intCount, 46) = "" Then
                dblFactor = 0
            Else
                dblFactor = CDbl(.TextMatrix(intCount, 46))
            End If
            If dblFactor > 0 Then
                If .TextMatrix(intCount, 14) <> "" Then
                    .TextMatrix(intCount, 14) = NumberConvert(.TextMatrix(intCount, 14), dblFactor, False)
                End If
                If .TextMatrix(intCount, 16) <> "" Then
                    .TextMatrix(intCount, 16) = Format(CDbl(.TextMatrix(intCount, 16)) * dblFactor, mstrCurrencyDec)
                End If
            End If
        Next
    End With
End Sub

'得到商品单价
Private Sub GetPrice(ByVal lngItemID As Long, ByVal lngRow As Long)
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    With msgCustomerInitDetail
        Select Case .TextMatrix(lngRow, 30)
            Case "2", "3", "5"
                strSql = "SELECT dblPurchasePrice FROM Item WHERE lngItemID=" & lngItemID
            Case "13", "14", "16", "19"
                strSql = "SELECT dblSalePrice FROM Item WHERE lngItemID=" & lngItemID
        End Select
        If strSql <> "" Then
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
            If Not recTemp.EOF Then
                If recTemp.rdoColumns(0) = 0 Then
                    .TextMatrix(lngRow, 16) = ""
                Else
                    .TextMatrix(lngRow, 16) = Format(recTemp.rdoColumns(0), mstrPrice)
                End If
            End If
        End If
    End With
End Sub

'得到商品基本单位
Private Sub GetUnit(ByVal lngItemID As Long, ByVal lngRow As Long)
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "Select lngMinUnitID,strUnitName From Item,ItemUnit Where Item.lngMinUnitID=ItemUnit.lngUnitID And Item.lngItemID=" & lngItemID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.RowCount > 0 Then
        With msgCustomerInitDetail
            .TextMatrix(lngRow, 13) = recTemp("strUnitName")
            .TextMatrix(lngRow, 38) = recTemp("lngMinUnitID")
        End With
    End If
End Sub

'得到单位折扣率
Private Sub GetDiscountRate(ByVal lngCustomerID As Long)
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "Select dblDiscountRate From Customer Where lngCustomerID=" & lngCustomerID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    If recTemp.RowCount > 0 Then
        mdblDiscountRate = recTemp("dblDiscountRate")
    Else
        mdblDiscountRate = 0
    End If
End Sub

'得到税率
Private Function GetTaxRate(ByVal lngTaxID As Long, ByVal lngRecieptTypeID As Long) As Double
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    Select Case lngRecieptTypeID
        Case "2", "3", "5", "7", "8"
            strSql = "Select dblPurchaseTaxRate AS TaxRate From Tax Where lngTaxID=" & lngTaxID
        Case "13", "14", "16", "19", "20"
            strSql = "Select dblSaleTaxRate AS TaxRate From Tax Where lngTaxID=" & lngTaxID
        Case Else
            GetTaxRate = 0
            Exit Function
    End Select
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql)
    If recTemp.RowCount > 0 Then
        GetTaxRate = recTemp("TaxRate")
    Else
        GetTaxRate = 0
    End If
End Function

'计算金额
Private Sub CalSum()
    Dim dblQuantity As Double
    Dim dblPrice As Double
    Dim dblSum As Double
    Dim dblFactor As Double
    Dim dblRebate As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 46) = "" Then
            dblFactor = 0
        Else
            dblFactor = CDbl(.TextMatrix(mlngRow, 46))
        End If
        If dblFactor > 0 Then
            If .TextMatrix(mlngRow, 14) = "" Then
                dblQuantity = 0
            Else
                dblQuantity = CDbl(NumberConvert(.TextMatrix(mlngRow, 14), dblFactor))
            End If
            If .TextMatrix(mlngRow, 16) = "" Then
                dblPrice = 0
            Else
                dblPrice = CDbl(.TextMatrix(mlngRow, 16))
            End If
            If .TextMatrix(mlngRow, 17) = "" Then
                dblRebate = 0
            Else
                dblRebate = CDbl(.TextMatrix(mlngRow, 17))
            End If
            dblSum = dblQuantity * dblPrice / dblFactor * dblRebate / 100
            If dblSum = 0 Then
                .TextMatrix(mlngRow, 18) = ""
            Else
                .TextMatrix(mlngRow, 18) = Format(dblSum, mstrCurrencyDec)
            End If