frmsettaskpara.frm

金算盘软件代码

'免息天数(属性)
Public Property Get Days() As Integer
    Days = txtDays.Value
End Property
Public Property Let Days(ByVal vNewValue As Integer)
    txtDays.Text = Format(vNewValue, "0")
End Property

'利息收益科目
Public Property Get AccountID() As Long
    AccountID = ltxtAcc.ID
End Property
Public Property Let AccountID(ByVal vNewValue As Long)
    ltxtAcc.SeekId vNewValue
End Property

'根据数据库Setting表设置财务费用参数
Private Sub ReadPara()
    On Error Resume Next
    
    ByARBalance = CBool(GetSet(1, "财务费用", "按照应收余额计息", True))
    ByDueDay = CBool(GetSet(1, "财务费用", "根据到期日(非开票日)计算财务费用", True))
    Duplicate = CBool(GetSet(1, "财务费用", "计算复利", True))
    Days = CInt(GetSet(1, "财务费用", "免息天数", 0))
    RateOfYear = CDbl(GetSet(1, "财务费用", "年利率", 10))
    MinRate = CDbl(GetSet(1, "财务费用", "最小利息", 1))
    AccountID = CLng(GetSet(1, "财务费用", "利息收益科目", 0))
End Sub

'将新的设置写回Setting表
Private Sub SavePara()
    Dim strSql As String
    
    On Error Resume Next
    
    If ByARBalance <> CBool(GetSet(1, "财务费用", "按照应收余额计息", True)) Then
        mblnChanged = True
    ElseIf ByDueDay <> CBool(GetSet(1, "财务费用", "根据到期日(非开票日)计算财务费用", True)) Then
        mblnChanged = True
    ElseIf Duplicate <> CBool(GetSet(1, "财务费用", "计算复利", True)) Then
        mblnChanged = True
    ElseIf Days <> CLng(GetSet(1, "财务费用", "免息天数", 0)) Then
        mblnChanged = True
    ElseIf RateOfYear <> CDbl(GetSet(1, "财务费用", "年利率", 10)) Then
        mblnChanged = True
    End If
    
    SaveSet 1, "财务费用", "按照应收余额计息", CStr(ByARBalance)
    SaveSet 1, "财务费用", "根据到期日(非开票日)计算财务费用", CStr(ByDueDay)
    SaveSet 1, "财务费用", "计算复利", CStr(Duplicate)
    SaveSet 1, "财务费用", "免息天数", CStr(Days)
    SaveSet 1, "财务费用", "年利率", CStr(RateOfYear)
    SaveSet 1, "财务费用", "最小利息", CStr(MinRate)
    SaveSet 1, "财务费用", "利息收益科目", CStr(AccountID)
    If ByDueDay Then
        'strSql = "UPDATE ViewField SET blnIsMust=(UCase(strCombine)='DUEDATE') " _
            & "WHERE lngViewID=653 AND strViewFieldDesc='帐龄'"
        strSql = "UPDATE ViewField SET blnIsMust=DECODE(UPPER(strCombine),'DUEDATE',1,0) " _
            & "WHERE lngViewID=653 AND strViewFieldDesc='帐龄'"
    Else
        'strSql = "UPDATE ViewField SET blnIsMust=(UCase(strCombine)<>'DUEDATE') " _
            & "WHERE lngViewID=653 AND strViewFieldDesc='帐龄'"
        strSql = "UPDATE ViewField SET blnIsMust=DECODE(UPPER(strCombine),'DUEDATE',0,1) " _
            & "WHERE lngViewID=653 AND strViewFieldDesc='帐龄'"
    End If
    gclsBase.ExecSQL strSql
End Sub

'合法性检查
Private Function CheckPara() As Boolean
    Dim strCldText As String
    Dim blnChkBill As Boolean
    Dim lngCusID As Long
    Dim recSet As rdoResultset
    Dim recAccount As rdoResultset
    Dim recTmp As rdoResultset
    Dim recCus As rdoResultset
    Dim strMinRate As String

    On Error Resume Next

    If txtRateOfYear.Value = 0 Then
        ShowMsg hWnd, "请录入年利率", vbExclamation, Me.Caption
        Exit Function
    End If
    If txtRateOfYear.Value < 0 Then
        ShowMsg hWnd, "年利率不能为负值,请重新录入", vbExclamation, Me.Caption
        txtRateOfYear.SetFocus
        Exit Function
    ElseIf txtRateOfYear.Value > 100 Then
        ShowMsg hWnd, "年利率不能大于100%,请重新录入", vbExclamation, Me.Caption
        txtRateOfYear.SetFocus
        Exit Function
    End If
    txtRateOfYear.Text = Format(txtRateOfYear.Value, "0.00")
    If txtMinRate.Value < 0 Then
        ShowMsg hWnd, "最小利息不能为负值,请重新录入", vbExclamation, Me.Caption
        txtMinRate.SetFocus
        Exit Function
    End If
    txtMinRate.Text = Format(txtMinRate.Value, "0.00")
    If txtDays.Value < 0 Then
        ShowMsg hWnd, "免息天数不能为负值,请重新录入", vbExclamation, Me.Caption
        txtDays.SetFocus
        Exit Function
    ElseIf txtDays.Value > 3600 Then
        ShowMsg hWnd, "免息天数不能大于3600天,请重新录入", vbExclamation, Me.Caption
        txtDays.SetFocus
        Exit Function
    End If
    txtDays.Text = Format(txtDays.Value, "0")
    CheckPara = True
End Function

'处理按钮数组的click事件
Private Sub cmdOK_Click(Index As Integer)
    Me.MousePointer = vbHourglass
    Select Case Index
        Case 0
            If CheckPara() Then
                SavePara
                Hide
            End If
        Case 1
            mblnChanged = False
            ReadPara
            Hide
    End Select
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
    RefreshLtxtAcc
    ReadPara

    Me.HelpContextID = 60116
    Utility.LoadFormResPicture Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If (TypeOf Screen.ActiveControl Is ListText) Then
        If Not Screen.ActiveControl.ReferVisible Then
            If KeyCode = vbKeyReturn Then
               KeyCode = 0
               SendKeys "{Tab}", True
            End If
        End If
    Else
        If KeyCode = vbKeyReturn Then
           KeyCode = 0
           SendKeys "{Tab}", True
        End If
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    Utility.LoadFormResPicture Me
    Set frmSetTaskPara = Nothing
End Sub

Private Sub ltxtAcc_AddNew()
    Dim lngID As Long

    lngID = Card.AddCard(1) '调用卡片
    RefreshLtxtAcc
    ltxtAcc.SeekId lngID
End Sub

Private Sub ltxtAcc_Edit()
    If ltxtAcc.ID = 0 Then
        ShowMsg hWnd, "没有可供修改的项目", vbExclamation, Me.Caption
    Else
        Card.EditCard 1, ltxtAcc.ID
        RefreshLtxtAcc
    End If
End Sub

Private Sub ltxtAcc_Delete()
    If ltxtAcc.ID = 0 Then
        ShowMsg hWnd, "没有可供删除的项目", vbExclamation, Me.Caption
    Else
        Card.DelCard 1, ltxtAcc.ID
        RefreshLtxtAcc
    End If
End Sub

'科目参照
Private Sub ltxtAcc_Choose()
    Dim lngAttribute As Long
    Dim lngNatureID As Long
    
    With ltxtAcc
        If .ID > 0 Then
            lngAttribute = AccountAttribute(.ID, , lngNatureID)
            If (lngAttribute And aaDetail) <> aaDetail Then
                ShowMsg hWnd, "您选择了一个非末级科目,请重新选择", vbExclamation, Me.Caption
                .Text = ""
            ElseIf lngAttribute >= 8 Then
                ShowMsg hWnd, "利息收益科目不能有辅助核算,请重新选择", vbExclamation, Me.Caption
                .Text = ""
            ElseIf lngNatureID >= 1 And lngNatureID <= 5 Then
                ShowMsg hWnd, "利息收益科目不能是现金银行、应收应付及存货类科目", vbExclamation, Me.Caption
                .Text = ""
            End If
        End If
    End With
End Sub
Private Sub ltxtAcc_ItemNotExist()
    Dim lngID As Long

    If frmMsgAdd.MsgAddShow(Me.Caption, _
            "科目列表中没有" & ltxtAcc.Text) = vbOK Then
        lngID = Card.AddCard(1, Trim(ltxtAcc.Text)) '调用卡片
        RefreshLtxtAcc
        ltxtAcc.SeekId lngID
    Else
        ltxtAcc.Text = ""
    End If
End Sub

'刷新科目参照
Private Sub RefreshLtxtAcc()
    Dim strSql As String

    'strSql = "SELECT lngAccountID,strAccountCode,strAccountName " _
        & " FROM Account WHERE not blnIsInActive ORDER BY strAccountCode"
    strSql = "SELECT lngAccountID,strAccountCode,strAccountName " _
        & " FROM Account WHERE  blnIsInActive=0  ORDER BY strAccountCode"
    With ltxtAcc
        .ClearRefer
        'Set .Recordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set .Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        .Comparts = 2
        .AddRefer "<新增>"
        .AddRefer "<修改>"
        .AddRefer "<删除>"
    End With
End Sub