frmdkzcx.frm

财务信息管理系统,适合做毕业论文的人使用

      Width           =   90
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   30
      Top             =   465
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
End
Attribute VB_Name = "frmdkzcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金管理8.0
'功能说明: 查询贷款账
'作者: 魏小黎
Option Explicit
Public djbh As String
Public ywbm As String
Public ywrq As String
Private qcye As Double, fdrq As Date, bkll As Double, trs As Long, bkye As Double, bkrq As Date, bkrq1 As Date

Public Sub cmdExcute_Click()
    InitForm False
End Sub

Public Sub cmdRefresh_Click()
    UfGridADO1.Refresh
End Sub

Private Sub Form_Load()
  '  On Error Resume Next
    Screen.MousePointer = vbHourglass
    UfGridADO1.Redraw = False
    UfGridADO1.FixedCols = 0
    
    UfGridADO1.Cols = 10
    UfGridADO1.ColWidth(0) = 440
    UfGridADO1.ColWidth(1) = 250
    UfGridADO1.ColWidth(2) = 250
    UfGridADO1.ColWidth(3) = 1800
    UfGridADO1.ColWidth(4) = 1800
    UfGridADO1.ColWidth(5) = 450
    UfGridADO1.ColWidth(6) = 1800
    UfGridADO1.ColWidth(7) = 600
'    UfGridADO1.ColWidth(8) = 1800        'Cuidong 2000/07/31
'    UfGridADO1.ColWidth(9) = 830         'Cuidong 2000/07/31
    UfGridADO1.ColWidth(8) = 1200         'Cuidong 2000/07/31
    UfGridADO1.ColWidth(9) = 600          'Cuidong 2000/07/31
    
    UfGridADO1.Rows = 2
    UfGridADO1.FixedRows = 2
    
    With Me.UfGridADO1
        .TextMatrix(0, 0) = "日期"
        .TextMatrix(0, 1) = "日期"
        .TextMatrix(0, 2) = "日期"
        .JoinCells 0, 0, 0, 2, True
        .ColAlignment(0) = UG_ALIGNCENTER
        .ColAlignment(1) = UG_ALIGNRIGHT
        .ColAlignment(2) = UG_ALIGNRIGHT
        
        .TextMatrix(1, 0) = "年"
        .TextMatrix(1, 1) = "月"
        .TextMatrix(1, 2) = "日"
                    
        .TextMatrix(0, 3) = "收回金额"
        .ColAlignment(3) = UG_ALIGNRIGHT
        .JoinCells 0, 3, 1, 3, True
         
        .TextMatrix(0, 4) = "结欠金额"
        .ColAlignment(4) = UG_ALIGNRIGHT
        .JoinCells 0, 4, 1, 4, True
        
        .TextMatrix(0, 5) = "日数"
        .ColAlignment(5) = UG_ALIGNRIGHT
        .JoinCells 0, 5, 1, 5, True
                
        .TextMatrix(0, 6) = "积数"
        .ColAlignment(6) = UG_ALIGNRIGHT
        .JoinCells 0, 6, 1, 6, True
        
        .TextMatrix(0, 7) = "利率"
        .TextMatrix(1, 7) = "(%)"
        .ColAlignment(7) = UG_ALIGNRIGHT
        
        .TextMatrix(0, 8) = "利息"
        .ColAlignment(8) = UG_ALIGNRIGHT
        .JoinCells 0, 8, 1, 8, True
        
        .TextMatrix(0, 9) = "复核"
        .ColAlignment(9) = UG_ALIGNCENTER
        .JoinCells 0, 9, 1, 9, True
        
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 9
        .HeadFont.Bold = True
    End With
    InitForm True
    Screen.MousePointer = vbDefault
    
End Sub

Private Sub InitForm(fsk As Boolean)

    Dim rsTemp As New UfRecordset, rsTemp1 As New UfRecordset, lldm As String, dkrq As Date, dqlx As Double
    If fsk Then
                
        Me.WindowState = 2
        Informtlb2 Tlbckd, ImageList1
        Me.Icon = LoadResPicture(109, vbResIcon)
        Me.Caption = "贷款账"
        Picture1.width = ZjAccInfo.zjPictWidth
        Picture1.Picture = LoadPicture(ZjAccInfo.zjRepPath & "BookBack.bmp")
        
        Label0.Caption = "贷  款  账"
        
        Label1(0).Caption = "业务编号"
        Label1(8).Caption = "账    号"
        Label1(9).Caption = "贷款单位名称"
        Label1(10).Caption = "到期年月日"
        Label1(12).Caption = "金    额"
        Label1(13).Caption = "贷款金额"
        Label1(14).Caption = "(大写)"
        Label1(15).Caption = "备注"
    End If
    Label1(1).Caption = ywbm & "-" & right(djbh, 10)
    Label1(2).Caption = "" & Year(CDate(ywrq)) & "年" & Month(CDate(ywrq)) & "月" & Day(CDate(ywrq)) & "日"
        
    Label1(2).left = ZjAccInfo.zjPictWidth - Label1(2).width - 200
    
    If djbh Like "07*" Then
        Set rsTemp1 = dbsZJ.OpenRecordset("Select * from FD_Unwdeb where not (cBookcode is null) And [cUnwID]='" & djbh & "'", dbOpenSnapshot)
        Label2(0).Caption = rsTemp1![cGAccID]
    Else
        Set rsTemp1 = dbsZJ.OpenRecordset("Select * from FD_Cred where not (cBookcode is null) And [cCreID]='" & djbh & "'", dbOpenSnapshot)
        Label2(0).Caption = rsTemp1![cAccId]
    End If
    Label2(1).Caption = Zhbhtodwmc(Label2(0).Caption)
    With rsTemp1
        Label2(2).Caption = Format(![Dret_date], "yyyy-mm-dd")
        lldm = ![cintrid]
        dkrq = ![dbill_date]
        qcye = ![mMoney]
        Label2(6).Caption = IIf(IsNull(![cDigest]), "", ![cDigest])
    End With
    
    Label2(4).Caption = Rmbdx(qcye)
    Label2(5).Caption = Trim(Format(qcye, "##,##0.00"))
        
    If djbh Like "07*" Then
        Set rsTemp = dbsZJ.OpenRecordset("Select 0 As year1,0 As mon1,0 As day1,sum([mmoney]) As zd6,0 As zd1,0 As zd2,0 As zd3,0 As zd4,0 as zd5,[dbill_date] from FD_Unwret where not (cBookcode is null) And [cUnwID]='" & djbh & "' And [dbill_date]<='" & ywrq & "' Group by [dbill_date]", dbOpenSnapshot)
    Else
        Set rsTemp = dbsZJ.OpenRecordset("Select 0 As year1,0 As mon1,0 As day1,sum([mmoney]) As zd6,0 As zd1,0 As zd2,0 As zd3,0 As zd4,0 as zd5,[dbill_date] from FD_Return where not (cBookcode is null) And [cCreID]='" & djbh & "' And [dbill_date]<='" & ywrq & "' Group by [dbill_date]", dbOpenSnapshot)
    End If
    
    With UfGridADO1
        .Rows = 2
        .FixedRows = 2
        .HeadForeColor = &H404040
        .HeadBackColor = &H8000000E
    End With
    
    Dim rsTfh As New UfRecordset, fhk As String, tmplx As Variant
    bkrq = dkrq
    
    With rsTemp
        If Not .EOF Then
            .MoveFirst
            While Not .EOF
                bkye = qcye
                qcye = qcye - Vround(rsTemp(3), 2)
                bkrq1 = rsTemp(9)
                If djbh Like "07*" Then
                    Set rsTfh = dbsZJ.OpenRecordset("Select [cCheckCode] from FD_Unwret where not (cBookcode is null) And [cUnwID]='" & djbh & "' And [dbill_date]='" & Format(![dbill_date], "yyyy-mm-dd") & "'", dbOpenSnapshot)
                Else
                    Set rsTfh = dbsZJ.OpenRecordset("Select [cCheckCode] from FD_Return where not (cBookcode is null) And [cCreID]='" & djbh & "' And [dbill_date]='" & Format(![dbill_date], "yyyy-mm-dd") & "'", dbOpenSnapshot)
                End If
                rsTfh.MoveFirst
                fhk = rsTfh![cCheckCode]
                rsTfh.oClose
                Set rsTfh = Nothing
                Do While Wfd_rq(lldm, bkrq, bkrq1)
                
                '----zcl comment 2000-1-3
'                    If bkrq1 < ZjAccInfo.zjStartdate Then
'                        trs = 0
'                        dqlx = 0
'                    Else
                        trs = fdrq - bkrq
                        If djbh Like "07*" Then
                            tmplx = Nbcj_Lx(rsTemp1, fdrq - 1, False, bkrq)
                        Else
                            tmplx = Dk_Lx(rsTemp1, fdrq - 1, False, bkrq)
                        End If
                        dqlx = IIf(IsNull(tmplx), 0, tmplx)
'                    End If     '----zcl comment 2000-1-3
                    
                    UfGridADO1.AddItem Year(fdrq) & Chr(9) & _
                        Month(fdrq) & Chr(9) & _
                        Day(fdrq) & Chr(9) & _
                        IIf(fdrq = bkrq1, Format$(rsTemp(3), "##,##0.00"), "") & Chr(9) & _
                        Format$(IIf(fdrq = bkrq1, qcye, bkye), "##,##0.00") & Chr(9) & _
                        Format$(trs, "##,###") & Chr(9) & _
                        IIf(trs = 0, "", Format$(bkye * trs, "##,##0.00")) & Chr(9) & _
                        IIf(trs = 0, "", Vround(bkll, 5)) & Chr(9) & _
                        IIf(dqlx = 0, "", Format$(dqlx, "##,##0.00")) & Chr(9) & _
                        IIf(fdrq = bkrq1, fhk, "")
                        
                    bkrq = fdrq
                Loop
                bkrq = rsTemp(9)
                .MoveNext
            Wend
        End If
        .oClose
    End With
    With UfGridADO1
        If .Rows > 2 Then
            .row = 2
            .col = 0
        End If
        .Redraw = True
    End With
    Set rsTemp = Nothing
    rsTemp1.oClose
    Set rsTemp1 = Nothing
End Sub

Private Sub Form_Resize()
    If Me.WindowState = 1 Then
        Exit Sub
    End If
    If Me.WindowState = 0 Then
        If Me.width < 4200 Then Me.width = 4200
        If Me.Height < 4400 Then Me.Height = 4400
        If Me.width = 9540 Then Me.width = 9300
    End If
    UfGridADO1.width = Me.width - 100
    UfGridADO1.Height = Me.Height - (5820 - 2720)
    
    Picture1.left = Me.width - ZjAccInfo.zjPictWidth
    If Picture1.left > 0 Then Picture1.left = 0
    Label0.left = (Me.width - Label0.width) / 2 - Picture1.left
    Label1(0).left = ZjAccInfo.zjPictWidth - Me.width + 75
    Label1(1).left = ZjAccInfo.zjPictWidth - Me.width + 855
    Label1(2).left = ZjAccInfo.zjPictWidth - Label1(2).width - 200
    If Label1(2).left > ZjAccInfo.zjPictWidth - 200 - Label1(2).width Then Label1(2).left = ZjAccInfo.zjPictWidth - 200 - Label1(2).width
End Sub

Private Sub Form_Unload(Cancel As Integer)
    zjLogInfo.TaskExec "FD0712", 0, zjLogInfo.cIYear
    zjLogInfo.ClearError
    zjGen_arr.FD0712 = False
End Sub

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

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF4
            If Shift = 2 Then
                Gen_Key "Exit"
            End If
        Case vbKeyP
            If Shift = 2 Then
                Gen_Key "Print"
                KeyCode = 0
            End If
        Case vbKeyS
            'cuidong 2001.01.15
            'If Shift = 2 Then
            '    Gen_Key "Preview"
            '    KeyCode = 0
            'End If
        Case vbKeyW
            If Shift = 2 Then
                Gen_Key "Dataout"
                KeyCode = 0
            End If
        Case vbKeyF
            If Shift = 2 Then
                Gen_Key "Recx"
                KeyCode = 0
            End If
    End Select
End Sub

Private Sub Gen_Key(TLB_Key As String)
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjbPrnViewOut Me, "dkzcx", TLB_Key, False
        Case Is = "Recx"
            frmdkztj.Quitfs = False
            frmdkztj.Show 1
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Exit"
            Unload Me
    End Select
End Sub

Private Function Wfd_rq(ldm As String, sDate As Date, eDate As Date) As Boolean
    Wfd_rq = False
    If sDate = eDate Then
        If UfGridADO1.Rows = 2 Then
            bkll = 0
            fdrq = eDate
            Wfd_rq = True
        End If
        Exit Function
    End If
    bkll = 0
    fdrq = eDate
    Wfd_rq = True
    
    '----zcl comment 2001-1-3
'    If eDate < ZjAccInfo.zjStartdate Then
'        Exit Function
'    End If
    Dim rsTemp As New UfRecordset
    Set rsTemp = dbsZJ.OpenRecordset("Select [dbdate],[nzy] from FD_Intras where [cIntrID]='" & ldm & "' order by [dbdate]", dbOpenSnapshot)
    With rsTemp
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                If ![dbDate] > sDate And ![dbDate] < eDate Then
                    fdrq = ![dbDate]
                    Exit Function
                End If
                If ![dbDate] >= eDate Then
                    Exit Function
                End If
                bkll = Vround(![nzy], 5)
                .MoveNext
            Loop
        End If
        .oClose
    End With
End Function