customerinitdetail1.frm

金算盘软件代码

Private mstrStartDate As String                                 '账套启用日期
Private mstrBeginDate As String                                 '会计年度开始日期
Private mintCol As Integer, mlngRow As Long                     '录入框所在行,列
Private mblnHscroll As Boolean, mblnVscroll As Boolean          '横向及垂直滚动条出现标志
Private mlngCurrencyID As Long                                  '币种ID
Private mlngCustomerID As Long                                  '单位ID
Private Const lngViewId As Long = 777                           '视图ID
Private mudtAccount As Account                                  '科目自定义类型
Private mdblDiscountRate As Double
Private mblnisReturn As Boolean
Private mblnClose As Boolean
Private mstrCurrencyDec As String
Private mstrRateDec As String
Private mblnIsIndirect As Boolean
Private mblnIsAddNew As Boolean
Private mblnIsEdit As Boolean

'显示
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 CurrencyID
    #If conVersionType = 4 Then
        lblCustomerInit(1).Visible = False
        lstCustomerInitdetail(1).Visible = False
    #End If
'    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '设置窗体"钩子"对象
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    '初始化列表"钩子"对象
    Set mclsSubClass = New SubClass32.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 日期,凭证类型,凭证号,摘要,付款条件,开票日期,到期日期,部门," & _
             "职员,统计,项目,汇率," & _
             "金额,借方,贷方," & _
             "lngArApInitID,lngVoucherTypeID,lngTermID,lngDepartmentID,lngEmployeeID,lngClassID1,lngClassID2," & _
             "核销标志" & _
             " From CustomerBalanceDetail1 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
    
    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

'计算本币金额
Private Sub CalCurrAmount()
    Dim dblRate As Double
    Dim dblAmount As Double
    Dim dblCurrAmount As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 11) = "" Then
            dblRate = 0
        Else
            dblRate = CDbl(.TextMatrix(mlngRow, 11))
        End If
        If .TextMatrix(mlngRow, 12) = "" Then
            dblAmount = 0
        Else
            dblAmount = CDbl(.TextMatrix(mlngRow, 12))
        End If
        If dblRate = 0 Then
            dblCurrAmount = 0
        Else
            If mblnIsIndirect Then
                dblCurrAmount = dblAmount / dblRate
            Else
                dblCurrAmount = dblAmount * dblRate
            End If
        End If
        If dblCurrAmount = 0 Then
            .TextMatrix(mlngRow, 13) = ""
            .TextMatrix(mlngRow, 14) = ""
        Else
            If .TextMatrix(mlngRow, 14) = "" Then
                .TextMatrix(mlngRow, 13) = Format(dblCurrAmount, mstrDec)
            Else
                .TextMatrix(mlngRow, 14) = Format(dblCurrAmount, mstrDec)
            End If
        End If
    End With
End Sub

'计算汇率
Private Sub CalRate(ByVal intCol As Integer)
    Dim dblCurrAmount As Double
    Dim dblAmount As Double
    Dim dblRate As Double
    
    With msgCustomerInitDetail
        If .TextMatrix(mlngRow, 12) = "" Then
            dblCurrAmount = 0
        Else
            dblCurrAmount = CDbl(.TextMatrix(mlngRow, 12))
        End If
        If .TextMatrix(mlngRow, intCol) = "" Then
            dblAmount = 0
        Else
            dblAmount = CDbl(.TextMatrix(mlngRow, intCol))
        End If
        If dblCurrAmount = 0 Then
            dblRate = 0
        Else
            If mblnIsIndirect Then
                dblRate = dblCurrAmount / dblAmount
            Else
                dblRate = dblAmount / dblCurrAmount
            End If
        End If
        If dblRate = 0 Then
'            .TextMatrix(mlngRow, 11) = ""
        Else
            .TextMatrix(mlngRow, 11) = Format(dblRate, mstrRateDec)
        End If
    End With
End Sub

'计算到期日
Private Sub CalDueDate(ByVal lngRow As Long, ByVal lngID As Long)
    Dim dteReciept As Date
    Dim recTemp As rdoResultset
    
    If lngID > 0 Then
        Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT intDueDay FROM Term WHERE lngTermID=" & lngID)
        If recTemp.RowCount > 0 Then
            With msgCustomerInitDetail
                If .TextMatrix(lngRow, 5) <> "" Then
                    .TextMatrix(lngRow, 6) = Format(CDate(.TextMatrix(lngRow, 5)) + recTemp!intDueDay, "YYYY-MM-DD")
                End If
            End With
        End If
    End If
End Sub

'设置弹出菜单
Private Sub SetMenu()
    Dim intCount As Integer
    
    With frmMain
        For intCount = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCount)
        Next
        .mnuListEditMenu(0).Caption = "插入"
        Load .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "删除"
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditBar1, .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        .mnuListEditMenu(3).Caption = "删除全部"
        If mblnIsClosed Then
            .mnuListEditMenu(0).Enabled = False
            .mnuListEditMenu(1).Enabled = False
            .mnuListEditMenu(3).Enabled = False
        Else
            .mnuListEditMenu(0).Enabled = True
            If msgCustomerInitDetail.Row > 1 Then
                .mnuListEditMenu(1).Enabled = True
            Else
                .mnuListEditMenu(1).Enabled = False
            End If
            If msgCustomerInitDetail.Rows > 2 Then
                .mnuListEditMenu(3).Enabled = True
            Else
                .mnuListEditMenu(3).Enabled = False
            End If
        End If
    End With