利息计算.frm

不处的管理软件包

      .TextMatrix(1, 3) = bdt
      .TextMatrix(1, 4) = edt
      .TextMatrix(1, 5) = MoneyFormat(lx)
      If Not IsMissing(cdeLx) Then
         .TextMatrix(0, 5) = "定额内利息"
         .ColWidth(6) = 1515
         .TextMatrix(1, 6) = MoneyFormat(cdeLx)
      Else
         .ColWidth(6) = 0
         .TextMatrix(0, 5) = "利息"
      End If
      .TextMatrix(1, 7) = IIf(isf = 0, "应收", "应付")
    Else
      itmX = UnitName & Chr(9) & AccCode & Chr(9) & cBusid & Chr(9) _
            & bdt & Chr(9) & edt & Chr(9) & MoneyFormat(lx) _
            & Chr(9) & strCde & Chr(9) & IIf(isf = 0, "应收", "应付")
      .AddItem itmX
    End If
  End With
  
End Sub

Private Sub Grid_init()

  With grid
    .Cols = 8
    .Rows = 2
    .FixedRows = 1
    .FixedCols = 0
    .RowHeight(0) = 320
    .RowHeight(1) = 0
    .RowHeightMin = 260
    
    .TextMatrix(0, 0) = "单位名称"
    .FixedAlignment(0) = 4
    .ColAlignment(0) = 1
    .ColWidth(0) = 2000
    
    .TextMatrix(0, 1) = "账户号"
    .FixedAlignment(1) = 4
    .ColAlignment(1) = 1
    .ColWidth(1) = 1800
    
    .TextMatrix(0, 2) = "业务编号"
    .FixedAlignment(2) = 4
    .ColAlignment(2) = 1
    .ColWidth(2) = 2100
    
    .TextMatrix(0, 3) = "起始时间"
    .FixedAlignment(3) = 4
    .ColAlignment(3) = 4
    .ColWidth(3) = 1200
    
    .TextMatrix(0, 4) = "结束时间"
    .FixedAlignment(4) = 4
    .ColAlignment(4) = 4
    .ColWidth(4) = 1200
    
    .TextMatrix(0, 5) = "利息"
    .FixedAlignment(5) = 4
    .ColAlignment(5) = 7
    .ColWidth(5) = 1515
  
    .TextMatrix(0, 6) = "超定额利息"
    .FixedAlignment(6) = 4
    .ColAlignment(6) = 7
    .ColWidth(6) = 1515
    
    .TextMatrix(0, 7) = "收/付"
    .FixedAlignment(7) = 4
    .ColAlignment(7) = 4
    .ColWidth(7) = 800
  End With

End Sub

Private Function Valid() As Boolean

  Valid = False
  
    If edEDate = "" Then
        MsgBox "利息计算结束日期不能为空!", vbCritical, zjGl_Name
        edEDate.SetFocus
        Exit Function
    End If
  
    If edSdate.Text <> "" Then
        edSdate = ForDate(edSdate)
        If Not IsDate(edSdate.Text) Then
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            edSdate.SetFocus
            Exit Function
        Else
            edSdate = FormatDate(edSdate)
        End If
    End If
    edEDate = ForDate(edEDate)
    If Not IsDate(edEDate) Then
        MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
        edEDate.SetFocus
        Exit Function
    Else
        edEDate = FormatDate(edEDate)
    End If
    If edSdate > edEDate Then
      Beep
      MsgBox "起始日期不能大于结束日期！", vbInformation, zjGl_Name
      SetTxtFocus edSdate
      Exit Function
    End If
    
    If cobtype.ListIndex <> 0 Then
        If edid(0) = "" Then
            MsgBox "业务编号不能为空!", vbCritical, zjGl_Name
            edid(0).SetFocus
            Exit Function
        End If
        If edid(1) = "" Then
            MsgBox "业务编号不能为空!", vbCritical, zjGl_Name
            edid(1).SetFocus
            Exit Function
        End If
    ElseIf edUnitName = "" And edAccCode = "" Then
        MsgBox "请输入计算条件!", vbCritical, zjGl_Name
        edUnitName.SetFocus
        Exit Function
    End If
  
    If edUnitName <> "" Then
        If Not IsUnitNameExist(edUnitName.Text) Then
            MsgBox "非法的单位名称!", vbCritical, zjGl_Name
            edUnitName.SetFocus
            Exit Function
        End If
    End If
  
    Valid = True
  
End Function

Private Sub RefCmd1_Initialize(Index As Integer)
    
    RefCmd1(Index).InitSys RefWksDB, dbsZJ
    
    If Index = 0 Then
        RefCmd1(0).InitSys RefPara1, edUnitName.Text
    Else
        RefCmd1(1).InitSys RefPara1, edAccCode.Text
        RefCmd1(1).InitSys refpara2, edUnitName.Text
    End If
    
End Sub

Private Sub RefCmd1_RefCancel(Index As Integer)
    If Index = 0 Then
        edUnitName.SetFocus
    Else
        edAccCode.SetFocus
    End If
End Sub

Private Sub RefCmd1_RefOK(Index As Integer, Code As String)

    If Index = 0 Then
        edUnitName.Text = Code
    Else
        edAccCode.Text = Code
    End If
    
End Sub

Private Sub RefCmd2_RefOK(Code As String)

End Sub

Private Sub resize1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
drag = True
starty = Resize1.top
End Sub

Private Sub resize1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If drag Then
  If Y + Resize1.top > maxtop Or Y + Resize1.top < mintop Then Exit Sub
  Resize1.Move Resize1.left, Y + Resize1.top
End If
End Sub

Private Sub resize1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button <> vbLeftButton Then Exit Sub
   On Error Resume Next
   If drag Then
      drag = False
      endy = Resize1.top
      Frame1.Height = Frame1.Height + endy - starty
      grid.top = grid.top + endy - starty
      grid.Height = grid.Height + starty - endy
   End If
   On Error GoTo 0
End Sub

Private Function lxjs_busid(rsl As UfRecordset, iType As BillType, Optional curCde As Variant) As Variant

    Dim lx As Variant

    Select Case iType
        Case Save_Bill
            With rsl
                vBday = !dbill_date
                If b_sd_null Then
                    lx = dq_lx(!cAccId, dEday)
                Else
                    lx = dq_lx(!cAccId, dEday, False)
                End If
            End With
            edSdate = FormatDate(CDate(vBday))
            Set vBday = Nothing
        Case Cred_Bill
            With rsl
                If b_sd_null Then
                    lx = Dk_Lx(rsl, dEday, False, , vBday)
                Else
                    lx = Dk_Lx(rsl, dEday, False, dBday, vBday)
                End If
            End With
            If IsDate(vBday) Then edSdate = FormatDate(CDate(vBday))
            Set vBday = Nothing
        Case UnwDeb_Bill
            With rsl
                If b_sd_null Then
                    lx = Nbcj_Lx(rsl, dEday, False, , vBday)
                Else
                    lx = Nbcj_Lx(rsl, dEday, False, dBday, vBday)
                End If
            End With
            If IsDate(vBday) Then edSdate = FormatDate(CDate(vBday))
            Set vBday = Nothing
        Case Lj_Bill
            With rsl
                lx = Zw_Lx(![cAccId], dEday, , curCde)
            End With
    End Select
    lxjs_busid = lx
End Function

Private Sub GenUnionFind(cDanID As String)
    Dim fndCred As clsCred
    Dim fndLend As clsLend
    Dim cType As String
    Dim cID As String
    Dim sql As String
    
  If cDanID = "" Then Exit Sub
  cType = left(cDanID, InStr(1, cDanID, "-") - 1)
  cType = BillNameToCode(cType) & cID
  cID = BillTxtToNumBh(grid.TextMatrix(grid.row, 2))
  oUniFind.ShowBill "FD", cID
''''''  Select Case cType
''''''    Case "01"
''''''        sql = "select * from FD_Sav where cSavID='" & cID & "'"
''''''        Lccqkdj 1, 1, Right(grid.TextMatrix(grid.Row, 2), 8), sql
''''''    Case "03"
''''''        sql = "select * from FD_Sav where cSavID='" & BillTxtToNumBh(grid.TextMatrix(grid.Row, 2)) & "'"
''''''        Lccqkdj 0, 1, Right(grid.TextMatrix(grid.Row, 2), 8), sql
''''''    Case "05", "06"
''''''        Set fndCred = New clsCred
''''''        Set aTemp = fndCred
''''''        aTemp.BillListType = IIf(cType = "05", 1, 2)
''''''        aTemp.FindFlag = True
''''''        aTemp.FindString = " and cCreID='" & cID & "'" 'sqlBillFind
''''''        aTemp.UnionFindflag = True
''''''        aTemp.UnionFindkey = cID
''''''        aTemp.Tag = "Cred" & grid.hWnd
''''''        aTemp.Show
''''''    Case "07"
''''''        Set fndLend = New clsLend
''''''        Set aTemp = fndLend
''''''        aTemp.FindFlag = True
''''''        aTemp.FindString = " and cUnwID='" & cID & "'"
''''''        aTemp.UnionFindflag = True
''''''        aTemp.UnionFindkey = cID
''''''        aTemp.Tag = "Lend" & grid.hWnd
''''''        aTemp.Show
''''''  End Select
''''''
End Sub

Private Sub lxjs_busid_rs(rsBill As UfRecordset, iType As BillType)

Dim sql As String
Dim rsl As New UfRecordset
Dim lx As Currency
Dim id1 As String, id2 As String

  id1 = edid(0): id2 = edid(1)
  Select Case iType
    Case Save_Bill
      sql = "select * from FD_Sav " _
            & "where cSavID>='" & id1 & "' " _
            & "and cSavID<='" & id2 & "' " _
            & "and isc=0 " _
            & "order by cSavID"
      Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
      
      If rsl.EOF Then
        MsgBox "没有符合条件的单据!", vbInformation, zjGl_Name
        Exit Sub
      End If
      
      grid.Rows = 2
      grid.RowHeight(1) = 0
      With rsl
        While Not .EOF
          If b_sd_null Then
            dBday = !dbill_date
            lx = dq_lx(rsl!cAccId, dEday)
          Else
            lx = dq_lx(rsl!cAccId, dEday, dBday)
          End If
          fill_grid !cAccId, !cSavID, edSdate.Text, edEDate.Text, lx, 0
          .MoveNext
        Wend
      End With
    Case Cred_Bill
      sql = "select * from FD_Cred " _
            & "where cCreID>='" & id1 & "' " _
            & "and cCreID<='" & id2 & "' " _
            & "order by cCreID"
      Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)

      If rsl.EOF Then
        MsgBox "没有符合条件的单据!", vbInformation, zjGl_Name
        Exit Sub
      End If

      grid.Rows = 2
      grid.RowHeight(1) = 0
      With rsl
        While Not .EOF
          If b_sd_null Then
            dBday = !dbill_date
            lx = Dk_Lx(rsl, dEday)
          Else
            lx = Dk_Lx(rsl, dEday, False, dBday)
          End If
          fill_grid !cAccId, !cCreID, IIf(IsDate(vBday), CDate(vBday), edSdate), edEDate.Text, lx, 1
          .MoveNext
        Wend
      End With
  End Select
  
End Sub

Public Sub GenSave()
    If grid.Rows = 2 And grid.RowHeight(1) = 0 Then