报警单.frm

u8

   Next i
   Exit Sub
ExitSub:
   
End Sub

Private Function GetRetDate(dDate As Date, iMonth As Integer) As Date
   Dim xYear As Integer, xMonth As Integer, xDay As Integer
   
   xYear = Year(dDate)
   xMonth = Month(dDate)
   xDay = Day(dDate)
   
   If (xMonth + iMonth) Mod 12 = 0 Then
      xYear = xYear + (xMonth + iMonth) \ 12 - 1
      xMonth = 12
   Else
      xYear = xYear + (xMonth + iMonth) \ 12
      xMonth = (xMonth + iMonth) Mod 12
   End If
   On Error GoTo ErrL
   GetRetDate = CDate(xYear & "-" & xMonth & "-" & xDay)
   Exit Function
   
ErrL:
   xDay = xDay - 1
   Resume
   
End Function

Private Sub InitDataOut()
   ReDim prnReport1(8)
   
   prnReport1(0).iColNumber = 0
   prnReport1(0).iColType = dbText
   prnReport1(0).cColName = UfGridADO1.TextMatrix(0, 0)
   prnReport1(0).iColLength = lngText
   
   prnReport1(1).iColNumber = 1
   prnReport1(1).iColType = dbText
   prnReport1(1).cColName = UfGridADO1.TextMatrix(0, 1)
   prnReport1(1).iColLength = lngText
   
   prnReport1(2).iColNumber = 2
   prnReport1(2).iColType = dbText
   prnReport1(2).cColName = UfGridADO1.TextMatrix(0, 2)
   prnReport1(2).iColLength = lngText
   
   prnReport1(3).iColNumber = 3
   prnReport1(3).iColType = dbText
   prnReport1(3).cColName = UfGridADO1.TextMatrix(0, 3)
   prnReport1(3).iColLength = lngText
   
   prnReport1(4).iColNumber = 4
   prnReport1(4).iColType = dbText
   prnReport1(4).cColName = UfGridADO1.TextMatrix(0, 4)
   prnReport1(4).iColLength = lngText
   
   prnReport1(5).iColNumber = 5
   prnReport1(5).iColType = dbCurrency
   prnReport1(5).cColName = UfGridADO1.TextMatrix(0, 5)
   prnReport1(5).iColLength = lngCurrency
   
   prnReport1(6).iColNumber = 6
   prnReport1(6).iColType = dbCurrency
   prnReport1(6).cColName = UfGridADO1.TextMatrix(0, 6)
   prnReport1(6).iColLength = lngCurrency
   
   prnReport1(7).iColNumber = 7
   prnReport1(7).iColType = dbText
   prnReport1(7).cColName = UfGridADO1.TextMatrix(0, 7)
   prnReport1(7).iColLength = lngDay
End Sub

'********************************************************************
'*函数说明: 初始化  Grid                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub initGrid()
   Dim i As Integer
   
   With UfGridADO1
      ' 设置表头
      .Redraw = True
      .LargeVirtualGrid = True
      .Cols = 8
      .Rows = 2
      .FixedCols = 0
      .FixedRows = 2
      .TextMatrix(0, 0) = "到期日期"
      .TextMatrix(1, 0) = "到期日期"
      .JoinCells 0, 0, 1, 0, True
      
      .TextMatrix(0, 1) = "账户号"
      .TextMatrix(1, 1) = "账户号"
      .JoinCells 0, 1, 1, 1, True
      
      .TextMatrix(0, 2) = "业务编号"
      .TextMatrix(1, 2) = "业务编号"
      .JoinCells 0, 2, 1, 2, True
      
      .TextMatrix(0, 3) = "业务时间"
      .TextMatrix(1, 3) = "业务时间"
      .JoinCells 0, 3, 1, 3, True
      
      .TextMatrix(0, 4) = "币别"
      .TextMatrix(1, 4) = "币别"
      .JoinCells 0, 4, 1, 4, True
      
      .TextMatrix(0, 5) = "本金"
      .TextMatrix(1, 5) = "本金"
      .JoinCells 0, 5, 1, 5, True
      
      .TextMatrix(0, 6) = "利息"
      .TextMatrix(1, 6) = "利息"
      .JoinCells 0, 6, 1, 6, True
      
      .TextMatrix(0, 7) = "计复利"
      .TextMatrix(1, 7) = "计复利"
      .JoinCells 0, 7, 1, 7, True
      
      ' 设置宽度
      For i = 0 To 7
          Select Case i
              Case 1
                  .ColWidth(i) = 1400
              Case 0, 3
                  .ColWidth(i) = 1100
              Case 2
                  .ColWidth(i) = 1800
              Case 4
                  .ColWidth(i) = 900
              Case 5, 6
                  .ColWidth(i) = 1500
              Case 7
                  .ColWidth(i) = 800
          End Select
      Next i
   
      '设置表体的Alignment
      For i = 0 To 7
          Select Case i
              Case 0, 1, 2, 3, 4, 7
                  .ColAlignment(i) = UG_ALIGNCENTER
              Case 5, 6
                  .ColAlignment(i) = UG_ALIGNRIGHT
          End Select
      Next i
      
      .HeadFont.Name = "宋体"
      .HeadFont.Size = 9
      .HeadBackColor = &H8000000E
      .HeadFont.Bold = True
   End With
   
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   If Me.WindowState <> 1 Then
      If Me.Width < frmMinWidth Then Me.Width = frmMinWidth
      If Me.Height < frmMinWidth Then Me.Height = frmMinWidth
      UfGridADO1.Width = Me.Width - 100
      UfGridADO1.Height = Me.Height - Toolbar1.Height - Picture1.Height - 400
      UfGridADO1.Top = Toolbar1.Height + Picture1.Height
      UfGridADO1.Left = 0
      Picture1.Left = Me.Width - Picture1.Width
      Label1(0).Left = Me.Width / 2 - Label1(0).Width / 2 + (Picture1.Width - Me.Width)
      Label1(1).Left = Me.Width - 200 - Label1(1).Width + (Picture1.Width - Me.Width)
      Label2.Left = 200 + (Picture1.Width - Me.Width)
   End If
   On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    zjLogInfo.TaskExec "FD0721", 0, zjLogInfo.cIYear
    zjLogInfo.ClearError
    zjGen_arr.FD0721 = False
    tAlarm.blnAuto = False
    bAutoWarnLoad = False 'cuidong A.A 2001.09.18
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
   Gen_Key Button.key
End Sub

Private Sub Gen_Key(TLB_Key As String)
   Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            If TLB_Key = "Dataout" Then InitDataOut
            zjbPrnViewOut Me, "cxwarn", TLB_Key, True, Label1(0).Caption, "", "", Label1(1).Caption
      Case "UnionFind"
         UfGridado1_DBClick UfGridADO1.Row, UfGridADO1.Col
      Case "Recx"
         Recx
      Case "Help"
         SendKeys "{F1}"
      Case "Exit"
         Unload Me
   End Select
End Sub

Private Sub Recx()
   frmRwarnCx.Quitfs = False
   frmRwarnCx.Show vbModal
End Sub

Private Sub UfGridado1_DBClick(ByVal nRow As Long, ByVal nCol As Long)
   Dim xTemp As String
   Dim cClass As String, rsClass As New UfRecordset
   Dim sqlID As String, strAccID As String, strYwID As String
   Dim i As Integer
   Dim fndCred As clsCred, fndLend As clsLend, fndCad As clsCadBill
   Dim fndCredRet As clsCredRet, fndLendRet As clsLendRet

   If UfGridADO1.Rows <= 2 Then Exit Sub
   xTemp = UfGridADO1.TextMatrix(UfGridADO1.Row, 2)
   sqlID = Right(xTemp, 8)
  If Not IsNumeric(sqlID) Then Exit Sub
   oUniFind.ShowBill "FD", oV.Name2Code(Left(xTemp, InStr(xTemp, "-") - 1)) + sqlID

'''''''   strAccID = UfGridADO1.TextMatrix(UfGridADO1.Row, 1)
'''''''   Set rsClass = dbsZJ.OpenRecordset("SELECT * FROM FD_Class WHERE [ctext]='" & Left(xTemp, InStr(1, xTemp, "-") - 1) & "'", dbOpenSnapshot)
'''''''   If rsClass.EOF Then Exit Sub
'''''''   strYwID = rsClass![cSign] & Right(UfGridADO1.TextMatrix(UfGridADO1.Row, 2), 8)
   
'''''''   If UfGridADO1.TextMatrix(UfGridADO1.Row, 5) = "" Then
'''''''      '利息单
'''''''      Set fndCad = New clsCadBill
'''''''      Set aTemp = fndCad
'''''''      aTemp.FindFlag = True
'''''''      aTemp.FindString = " AND [cCarID]='" & strYwID & "'"
'''''''      aTemp.UnionFindflag = True
'''''''      aTemp.UnionFindkey = "16" & sqlID
'''''''      aTemp.Tag = "Cad" & UfGridADO1.hWnd
'''''''      aTemp.Show
'''''''      Exit Sub
'''''''   End If
'''''''
'''''''   Select Case rsClass![cSign]
'''''''      Case "01"      '银行存款
'''''''        Lccqkdj 1, 1, sqlID, "select * from FD_Sav where cSavid like '01*' AND [cAccID]='" & strAccID & "'"
'''''''      Case "03"      '内部存款
'''''''        Lccqkdj 0, 1, sqlID, "select * from FD_Sav where cSavid like '03*' AND [cAccID]='" & strAccID & "'"
'''''''      Case "05"      '银行贷款
'''''''         Set fndCred = New clsCred
'''''''         Set aTemp = fndCred
'''''''         aTemp.BillListType = 1
'''''''         aTemp.FindFlag = True
'''''''         aTemp.FindString = " AND [cAccID]='" & strAccID & "' AND [cCreID]='" & strYwID & "'"
'''''''         aTemp.UnionFindflag = True
'''''''         aTemp.UnionFindkey = "05" & sqlID
'''''''         aTemp.Tag = "Cred" & UfGridADO1.hWnd
'''''''         aTemp.Show
'''''''
'''''''      Case "06"      '内部贷款
'''''''         Set fndCred = New clsCred
'''''''         Set aTemp = fndCred
'''''''         aTemp.BillListType = 2
'''''''         aTemp.FindFlag = True
'''''''         aTemp.FindString = " AND [cAccID]='" & strAccID & "' AND [cCreID]='" & _
'''''''            strYwID & "' "
'''''''         aTemp.UnionFindflag = True
'''''''         aTemp.UnionFindkey = "06" & sqlID
'''''''         aTemp.Tag = "Cred" & UfGridADO1.hWnd
'''''''         aTemp.Show
'''''''
'''''''      Case "07"      '内部拆借
'''''''         Set fndLend = New clsLend
'''''''         Set aTemp = fndLend
'''''''         aTemp.FindFlag = True
'''''''         aTemp.FindString = " AND [cGAccID]='" & strAccID & "' AND [cUnwID]='" & strYwID & "' "
'''''''         aTemp.UnionFindflag = True
'''''''         aTemp.UnionFindkey = "07" & sqlID
'''''''         aTemp.Tag = "Lend" & UfGridADO1.hWnd
'''''''         aTemp.Show
'''''''
'''''''   End Select
   
End Sub