报警单.frm

u8

      .a6 = x6
      .a7 = x7
      .a8 = x8
   End With
End Sub

'********************************************************************
'*函数说明: 填充显示 mGrid()                                          *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub FillGrid()
   Dim f0 As Date, f1 As String, f2 As String, f3 As Date, f4 As Double, f5 As Double, f6 As String
   Dim sqlBill As String, rsBill As New UfRecordset
   Dim sqlBillLx As String, rsBillLx As New UfRecordset
   Dim sqlBj As String, rsBj As New UfRecordset
   Dim sqlLx As String, rsLx As New UfRecordset
   Dim sqlClass As String, rsClass As New UfRecordset
   Dim lngDelay As Long
   Dim lngLines As Long
   
   lngLines = 1
   '贷款单
   bAutoWarnLoad = True
   
   If (Not bAutoWarnLoad) Or AlBill.bEnabled(AlBill.iNameToIndex("贷款单")) Or AlBill.bEnabled(0) Then  'cuidong A.A 2001.09.18
      sqlBill = "SELECT * FROM FD_Cred WHERE [bsettle]=0 AND [cBookCode] IS NOT NULL"
      Set rsBill = dbsZJ.OpenRecordset(sqlBill, dbOpenSnapshot)
      While Not rsBill.EOF
         '是否报警
         If IsNull(rsBill![cCadID]) Then
             lngDelay = 0
         Else
             lngDelay = CadDelayDays(rsBill![cCadID])
         End If
         lngDelay = lngDelay - lngEarly
         f2 = GetClassName(Left(rsBill![cCreID], 2)) & "-" & Right(rsBill![cCreID], 8)
         'Label2 = rsClass![cText] & "：" & Right(rsBill![cCreID], 8) & " "
         With tAlarm
            If .blnAuto Then
               Select Case .iDjlx
                  Case 3 '银行贷款
                      If Not (rsBill![cCreID] Like "05*") Then GoTo CredL
                  Case 4 '内部贷款
                      If Not (rsBill![cCreID] Like "06*") Then GoTo CredL
                  Case 1, 2, 5 '银行存款，内部存款，内部拆借
                      GoTo Cj
                  Case 6 '利息单
                      GoTo Dklx
               End Select
            End If
         End With
         If rsBill![Dret_date] - datDate <= lngEarly Then
            '是否计复利
            If (rsBill![iartyp] = 1 Or rsBill![iartyp] = 2) And datDate - rsBill![Dret_date] >= 0 Then
               f6 = bFlag
            Else
               f6 = ""
            End If
            '计算本金
            sqlBj = "SELECT Sum([mmoney]) AS xM FROM FD_Return WHERE [cCreID]='" & rsBill![cCreID] & "'"
            Set rsBj = dbsZJ.OpenRecordset(sqlBj, dbOpenSnapshot)
            f4 = rsBill![mMoney]
            If Not rsBj.EOF Then
               f4 = f4 - IIf(IsNull(rsBj![xM]), 0, rsBj![xM])
            End If
            FillMar FormatDate(rsBill![Dret_date]), rsBill![cAccID], _
                  f2, FormatDate(rsBill![dbill_date]), _
                  AccToExch(rsBill![cAccID]), FormatCur(f4), "", f6, lngLines
            lngLines = lngLines + 1
         End If
         
         '利息处理
         With tAlarm
            If .blnAuto Then
               Select Case .iDjlx
                  Case 1, 2, 3, 4, 5: GoTo CredL
               End Select
            End If
         End With
Dklx:
         sqlBillLx = "SELECT * FROM FD_CadAcr WHERE [cDanID]='" & rsBill![cCreID] & _
                     "' ORDER BY [dbill_date] DESC"
         Set rsBillLx = dbsZJ.OpenRecordset(sqlBillLx, dbOpenSnapshot)
         Do While Not rsBillLx.EOF
            If rsBillLx![dbill_date] <= datDate Then
               '取出到期日期
               f0 = rsBillLx![dbill_date]
               '是否计复利
               If (rsBill![iartyp] = 1 And (datDate - rsBill![Dret_date]) >= lngDelay) Or (rsBill![iartyp] = 2 And (datDate - f0) >= lngDelay) Then
                  f6 = bFlag
               Else
                  f6 = ""
               End If
               '计算利息
               sqlLx = "SELECT Sum([mmoney]) AS xM FROM FD_CadAcr WHERE [cDanID]='" & _
                  rsBill![cCreID] & "' AND [dbill_date] <= '" & FormatDate(rsBillLx![dbill_date]) & "'"
               Set rsLx = dbsZJ.OpenRecordset(sqlLx, dbOpenSnapshot)
               f5 = IIf(IsNull(rsLx![xM]), 0, rsLx![xM])
               sqlLx = "SELECT Sum([mmoney]) AS xM FROM FD_CreAcrRcp WHERE [cCreID]='" & _
                  rsBill![cCreID] & "' AND [dbill_date] <= '" & FormatDate(datDate) & "'"
               Set rsLx = dbsZJ.OpenRecordset(sqlLx, dbOpenSnapshot)
               f5 = f5 - IIf(IsNull(rsLx![xM]), 0, rsLx![xM])
               f2 = GetClassName(Left(rsBillLx![cCarID], 2)) & "-" & Right(rsBillLx![cCarID], 8)
               If f5 < 0.005 Then Exit Do
               If f5 >= 0.005 Then
                  f5 = IIf(f5 < rsBillLx![mMoney], f5, rsBillLx![mMoney])
                  FillMar FormatDate(f0), rsBill![cAccID], _
                        f2, FormatDate(rsBill![dbill_date]), _
                        AccToExch(rsBill![cAccID]), "", FormatCur(f5), f6, lngLines
                  lngLines = lngLines + 1
               End If
            End If
            rsBillLx.MoveNext
         Loop
CredL:
         rsBill.MoveNext
      Wend
   End If 'cuidong A.A 2001.09.18
   
   '内部拆借单
Cj:
   If (Not bAutoWarnLoad) Or AlBill.bEnabled(AlBill.iNameToIndex("内部拆借单")) Or AlBill.bEnabled(0) Then   'cuidong A.A 2001.09.18
      sqlBill = "SELECT * FROM FD_UnwDeb WHERE [bsettle]=0 AND [cBookCode] IS NOT NULL"
      Set rsBill = dbsZJ.OpenRecordset(sqlBill, dbOpenSnapshot)
      While Not rsBill.EOF
         '是否报警
         f2 = GetClassName(Left(rsBill![cUnwID], 2)) & "-" & Right(rsBill![cUnwID], 8)
         'Label2 = rsClass![cText] & "：" & Right(rsBill![cUnwID], 8) & " "
         With tAlarm
            If .blnAuto Then
               Select Case .iDjlx
                  Case 1, 2, 3, 4: GoTo Ck
                  Case 6: GoTo Cjlx
               End Select
            End If
         End With
         If rsBill![Dret_date] - datDate <= lngEarly Then
            f6 = ""
            '计算本金
            sqlBj = "SELECT Sum([mmoney]) AS xM FROM FD_UnwRet WHERE [cUnwID]='" & rsBill![cUnwID] & "'"
            Set rsBj = dbsZJ.OpenRecordset(sqlBj, dbOpenSnapshot)
            f4 = rsBill![mMoney]
            If Not rsBj.EOF Then
               f4 = f4 - IIf(IsNull(rsBj![xM]), 0, rsBj![xM])
            End If
            FillMar FormatDate(rsBill![Dret_date]), rsBill![cGAccID], f2, _
                  FormatDate(rsBill![dbill_date]), AccToExch(rsBill![cGAccID]), _
                  FormatCur(f4), "", f6, lngLines
            lngLines = lngLines + 1
         End If
         
         '利息处理
         With tAlarm
            If .blnAuto Then
               Select Case .iDjlx
                  Case 1, 2, 3, 4, 5: GoTo CjL
               End Select
            End If
         End With
Cjlx:
         sqlBillLx = "SELECT * FROM FD_CadAcr WHERE [cDanID]='" & rsBill![cUnwID] & _
                     "' ORDER BY [dbill_date] DESC"
         Set rsBillLx = dbsZJ.OpenRecordset(sqlBillLx, dbOpenSnapshot)
         Do While Not rsBillLx.EOF
            If rsBillLx![dbill_date] <= datDate Then
               '取出到期日期
               f0 = rsBillLx![dbill_date]
               f6 = ""
               '计算利息
               sqlLx = "SELECT Sum([mmoney]) AS xM FROM FD_CadAcr WHERE [cDanID]='" & _
                  rsBill![cUnwID] & "' AND [dbill_date] <= '" & FormatDate(rsBillLx![dbill_date]) & "'"
               Set rsLx = dbsZJ.OpenRecordset(sqlLx, dbOpenSnapshot)
               f5 = IIf(IsNull(rsLx![xM]), 0, rsLx![xM])
               sqlLx = "SELECT Sum([mmoney]) AS xM FROM FD_UnwAcrRcp WHERE [cUnwID]='" & _
                  rsBill![cUnwID] & "' AND [dbill_date] <= '" & FormatDate(datDate) & "'"
               Set rsLx = dbsZJ.OpenRecordset(sqlLx, dbOpenSnapshot)
               f5 = f5 - IIf(IsNull(rsLx![xM]), 0, rsLx![xM])
               f2 = GetClassName(Left(rsBillLx![cCarID], 2)) & "-" & Right(rsBillLx![cCarID], 8)
               If f5 < 0.005 Then Exit Do
               If Abs(f5) >= 0.005 Then
                  f5 = IIf(f5 < rsBillLx![mMoney], f5, rsBillLx![mMoney])
                  FillMar FormatDate(f0), rsBill![cGAccID], f2, _
                     FormatDate(rsBill![dbill_date]), AccToExch(rsBill![cGAccID]), _
                     "", FormatCur(f5), f6, lngLines
                  lngLines = lngLines + 1
               End If
            End If
            rsBillLx.MoveNext
         Loop
CjL:
         rsBill.MoveNext
      Wend
   End If   'cuidong A.A 2001.09.18
   
   
   '定期存款单
Ck:
   If (Not bAutoWarnLoad) Or AlBill.bEnabled(AlBill.iNameToIndex("定期存款单")) Or AlBill.bEnabled(0) Then   'cuidong A.A 2001.09.18
      sqlBill = "SELECT * FROM FD_Sav WHERE [bsettle]=0 AND [isc]=0 AND [cBookCode] IS NOT NULL" & IIf(tAlarm.blnAuto And (tAlarm.iDjlx = 1 Or tAlarm.iDjlx = 2), " AND [imonth]=" & tAlarm.iCq, "")
      Set rsBill = dbsZJ.OpenRecordset(sqlBill, dbOpenSnapshot)
      While Not rsBill.EOF
         '是否报警
         With tAlarm
            If .blnAuto Then
               Select Case .iDjlx
                  Case 1: If Not (rsBill![cSavID] Like "01*") Then GoTo SavL
                  Case 2: If Not (rsBill![cSavID] Like "03*") Then GoTo SavL
                  Case 3, 4, 5, 6: GoTo LastL
               End Select
            End If
         End With
         f2 = GetClassName(Left(rsBill![cSavID], 2)) & "-" & Right(rsBill![cSavID], 8)
         f0 = GetRetDate(rsBill![dbill_date], rsBill![iMonth])
         If f0 - datDate <= lngEarly Then
            f6 = ""
            FillMar FormatDate(f0), rsBill![cAccID], f2, _
                  FormatDate(rsBill![dbill_date]), AccToExch(rsBill![cAccID]), _
                  FormatCur(rsBill![mMoney]), "", f6, lngLines
            lngLines = lngLines + 1
         End If
SavL:
         rsBill.MoveNext
      Wend
   End If  'cuidong A.A 2001.09.18
   
LastL:
   FillUfGrid
   If UfGridADO1.Rows > 2 Then UfGridADO1.Row = 2
   
End Sub

'********************************************************************
'*函数说明: 填充显示Grid                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub FillUfGrid()
   Dim i As Integer
   Dim j As Integer
   Dim iLines As Long
   Dim aGrid() As GridInformation
   Dim dRef As Date
   Dim iRef As Long
   
   iLines = 0
   i = 1
   ReDim aGrid(1)
   On Error GoTo ExitSub
   While iLines < UBound(mGrid) And mGrid(1).a1 <> ""
      If mGrid(i).b1 Then i = i + 1
      If Not mGrid(i).b1 Then
         dRef = CDate(mGrid(i).a1)
         iRef = i
         For j = 1 To UBound(mGrid)
            If Not mGrid(j).b1 Then
               If dRef > CDate(mGrid(j).a1) Then
                  dRef = CDate(mGrid(j).a1)
                  iRef = j
               End If
            End If
         Next j
         mGrid(iRef).b1 = True
         iLines = iLines + 1
         ReDim Preserve aGrid(iLines)
         With aGrid(iLines)
            .a1 = mGrid(iRef).a1
            .a2 = mGrid(iRef).a2
            .a3 = mGrid(iRef).a3
            .a4 = mGrid(iRef).a4
            .a5 = mGrid(iRef).a5
            .a6 = mGrid(iRef).a6
            .a7 = mGrid(iRef).a7
            .a8 = mGrid(iRef).a8
         End With
      End If
   Wend
   ReDim mGrid(1)
   For i = 1 To UBound(aGrid)
      With aGrid(i)
         If aGrid(i).a1 <> "" Then
            UfGridADO1.AddItem .a1 & Chr(9) & .a2 & Chr(9) & .a3 & Chr(9) & .a4 & Chr(9) & .a5 & Chr(9) & .a6 & Chr(9) & .a7 & Chr(9) & .a8
         End If
      End With