frmlxmx.frm

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

    
    On Error Resume Next
    '获取账户数据来源
    dataly = Dwzhdtsr(zhbh)
    '是否定额控制
    bCde = IsCde(zhbh)
    
    With Me.UfGridADO1
      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(1).Caption = "单位名称"
          .Redraw = False
          .FixedCols = 0
      
          .Cols = 12
          .ColWidth(0) = 440
          .ColWidth(1) = 250
          .ColWidth(2) = 250
          .ColWidth(3) = 1800
          .ColWidth(4) = 1800
          
          .ColWidth(6) = 1800
          .ColWidth(7) = 440
          .ColWidth(8) = 1800
          .ColWidth(11) = 1800
       End If
    
       .Rows = 2
       .FixedRows = 2
       
       .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) = IIf(dataly, "收入金额", "借方发生")
       .ColAlignment(3) = UG_ALIGNRIGHT
       .JoinCells 0, 3, 1, 3, True
'      dataly=False,数据来源为总帐
       .TextMatrix(0, 4) = IIf(dataly, "支出金额", "贷方发生")
       .ColAlignment(4) = UG_ALIGNRIGHT
       .JoinCells 0, 4, 1, 4, True
   
       .TextMatrix(0, 5) = "方向"
       .ColAlignment(5) = UG_ALIGNCENTER
       .JoinCells 0, 5, 1, 5, True
           
       .TextMatrix(0, 6) = "计息余额"
       .ColAlignment(6) = UG_ALIGNRIGHT
       .JoinCells 0, 6, 1, 6, True
   
       .TextMatrix(0, 7) = "天数"
       .ColAlignment(7) = UG_ALIGNCENTER
       .JoinCells 0, 7, 1, 7, True
   
       .TextMatrix(0, 8) = "积数"
       .ColAlignment(8) = UG_ALIGNRIGHT
       .JoinCells 0, 8, 1, 8, True
   
       .TextMatrix(0, 9) = "定额内利息"
       .ColAlignment(9) = UG_ALIGNRIGHT
       .JoinCells 0, 9, 1, 9, True
   
       .TextMatrix(0, 10) = "超定额利息"
       .ColAlignment(10) = UG_ALIGNRIGHT
       .JoinCells 0, 10, 1, 10, True
       
       .ColWidth(5) = IIf(dataly, 0, 440)
       .ColWidth(9) = IIf(bCde, 1800, 0)
       .ColWidth(10) = IIf(bCde, 1800, 0)
       
       .TextMatrix(0, 11) = IIf(bCde, "利息合计", "利息")
       .ColAlignment(11) = UG_ALIGNRIGHT
       .JoinCells 0, 11, 1, 11, True
       
       .HeadFont.Name = "宋体"
       .HeadFont.Size = 9
       .HeadFont.Bold = True
   End With
    
    Label1(2).Caption = zhbh
    Label1(3).Caption = zhmc
    Label1(4).Caption = "币别: "
    Label1(5).Caption = Wgetwbb(zhbh)
    
    Label1(4).Left = Picture1.Width - Label1(4).Width - Label1(5).Width - 260
    Label1(5).Left = Label1(4).Left + Label1(4).Width + 60
    If dataly Then
        zhfx = ""
        zhfx1 = ""
        '数据来源为资金
        Set tmpqr = dbsZJ.QueryDefs("fd_cxlxmx3")
    Else
    '获取总账取数账户方向
        If Getzhfx(zhbh) Then
            zhfx = "借"
            zhfx1 = "贷"
        Else
            zhfx = "贷"
            zhfx1 = "借"
        End If
            
        Set tmpqr = dbsZJ.QueryDefs("fd_cxlxmx4")
    End If

    tmpqr.Parameters("dfrom") = CDate(sDate)
    tmpqr.Parameters("dto") = CDate(eDate)
    tmpqr.Parameters("zhbh") = zhbh

    Set rsTemp = tmpqr.OpenRecordset()
    tshj = 0
    jfhj = 0
    dfhj = 0
    lxhj = 0
    '使用累积类户总账表对应的日期
    If Not rsTemp.EOF Then
        rsTemp.MoveFirst
        Set rstJs = dbsZJ.OpenRecordset("select * from FD_AccSum where cAccID='" & zhbh & "' order by dbill_date", dbOpenSnapshot)
        If Not rstJs.EOF Then
            If rsTemp(0) = rstJs!dbill_date Then
                rsTemp.MoveNext
            End If
        End If
    End If
    Do While Not rsTemp.EOF
        dqjs = rsTemp(4)
        dqjs2 = 0
        dqlx = 0
        dqlx2 = 0
        rstJs.FindFirst "dbill_date=#" & Format(rsTemp(0), "yyyy-mm-dd") & "#"
        If Not rstJs.NoMatch Then
        'Mh_Cad=最近结息日（或计息日）积数
            If rstJs!Mh_Cad <> 0 Then
                dqjs = dqjs + rstJs!Mh_Cad
                '结息日（或计息日）超定额积数=Mcdeh_Cad
                dqjs2 = dqjs2 + rstJs!Mcdeh_Cad
                
                IRx.IRMethod = AccCode_Method
                IRx.AccCode = zhbh
                nLl = rll(IRx, Format(rsTemp(0), "yyyy-mm-dd"))
                
                dqlx = (dqjs - dqjs2) * nLl.zyll + dqjs2 * nLl.cdell     'Cuidong 2000/08/23 按计息余额
                'rsTemp(1)
                  '超定额利率=cdell
                dqlx2 = dqjs2 * nLl.cdell
            End If
        End If
        
        UfGridADO1.AddItem Year(rsTemp(0)) & Chr(9) & _
                 Month(rsTemp(0)) & Chr(9) & _
                Day(rsTemp(0)) & Chr(9) & _
                IIf(rsTemp(1) = 0, "", Format(rsTemp(1), "##,##0.00")) & Chr(9) & _
                IIf(rsTemp(2) = 0, "", Format(rsTemp(2), "##,##0.00")) & Chr(9) & _
                IIf(rsTemp(3) = 0, "平", IIf(rsTemp(3) > 0, zhfx, zhfx1)) & Chr(9) & _
                IIf(rsTemp(3) = 0, "", Format(IIf(dataly, rsTemp(3), Abs(rsTemp(3))), "##,##0.00")) & Chr(9) & _
                "1" & Chr(9) & _
                IIf(dqjs = 0, "", Format(dqjs, "##,##0.00")) & Chr(9) & _
                IIf(dqlx - dqlx2 = 0, "", Format(dqlx - dqlx2, "##,##0.00")) & Chr(9) & _
                IIf(dqlx2 = 0, "", Format(dqlx2, "##,##0.00")) & Chr(9) & _
                IIf(dqlx = 0, "", Format(dqlx, "##,##0.00"))
            jfhj = jfhj + rsTemp(1)
            dfhj = dfhj + rsTemp(2)
            tshj = tshj + 1
            lxhj = lxhj + FormatCur(dqlx)
            lxhj2 = lxhj2 + FormatCur(dqlx2)
        rsTemp.MoveNext
    Loop
    
    With UfGridADO1
        .HeadForeColor = &H404040
        .HeadBackColor = &H8000000E
        .AddItem "合计" & Chr(9) & _
                 "" & Chr(9) & _
                 "" & Chr(9) & _
                IIf(jfhj = 0, "", Format(jfhj, "##,##0.00")) & Chr(9) & _
                IIf(dfhj = 0, "", Format(dfhj, "##,##0.00")) & Chr(9) & _
                .TextMatrix(.Rows - 1, 5) & Chr(9) & _
                .TextMatrix(.Rows - 1, 6) & Chr(9) & _
                Trim(str(tshj)) & Chr(9) & _
                .TextMatrix(.Rows - 1, 8) & Chr(9) & _
                IIf(lxhj - lxhj2 = 0, "", Format(lxhj - lxhj2, "##,##0.00")) & Chr(9) & _
                IIf(lxhj2 = 0, "", Format(lxhj2, "##,##0.00")) & Chr(9) & _
                IIf(lxhj = 0, "", Format(lxhj, "##,##0.00"))
          .Row = 2
          .Col = 0
          .Redraw = True
    End With
    
    rsTemp.oClose
    Set rsTemp = Nothing
    rstJs.oClose
    Set rstJs = Nothing
    tmpqr.oClose
    Set tmpqr = Nothing
End Sub

Private Function IsCde(AccID As String) As Boolean
   Dim sqlC As String
   Dim rsC  As New UfRecordset
   
   sqlC = "SELECT FD_AccDef.cIntrID FROM FD_AccDef INNER JOIN FD_Intras " & _
      "ON FD_AccDef.cIntrID = FD_Intras.cIntrID " & _
      "WHERE FD_Intras.bde<>0 AND FD_AccDef.cAccID = '" & AccID & "'"
   Set rsC = dbsZJ.OpenRecordset(sqlC, dbOpenSnapshot)
   If Not rsC.EOF Then IsCde = True
   CloseRS rsC
End Function

Private Sub Form_Resize()
    If Me.WindowState = 1 Then
        Exit Sub
    End If
    If Me.WindowState = 0 Then
        If Me.Width < 4700 Then Me.Width = 4700
        If Me.Height < 3300 Then Me.Height = 3300
    End If
    UfGridADO1.Width = Me.Width - 100
    UfGridADO1.Height = Me.Height - (5820 - 3890)
    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 + 75
    Label1(2).Left = ZjAccInfo.zjPictWidth - Me.Width + 840
    Label1(3).Left = ZjAccInfo.zjPictWidth - Me.Width + 840
    Label1(4).Left = Picture1.Width - Label1(4).Width - Label1(5).Width - 260
    Label1(5).Left = Label1(4).Left + Label1(4).Width + 60
End Sub

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

Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index = 3 Then
        Label1(Index).ToolTipText = Label1(Index).Caption
    End If
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"
            If TLB_Key = "Dataout" Then InitDataOut
            zjbPrnViewOut Me, "lxmxb", TLB_Key, True, Label0.Caption, Label1(0).Caption & ": " & Label1(2).Caption, Label1(1).Caption & ": " & Label1(3).Caption, Label1(4).Caption & Label1(5).Caption
        Case Is = "Recx"
            frmlxmxtj.Quitfs = False
            frmlxmxtj.Show 1
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Exit"
            Unload Me
    End Select
End Sub

Private Function Cd_tjzh() As String
    '作废
    Cd_tjzh = Cd_tjzh & " And [dbill_date] >= #" & sDate & "# And [dbill_date] <= #" & eDate & "# Group by [dbill_date]"
End Function

Private Sub UfGridado1_CanSizeCol(ByVal nCol As Long, bSize As Boolean)
    If dataly And nCol = 5 Then bSize = False
    If (Not bCde) And (nCol = 9 Or nCol = 10) Then bSize = False
End Sub