frmlxhz.frm

用友U8财务软件VB源程序, 本版本为2002年版本

        UfGridADO1.ColWidth(4) = 1800
        UfGridADO1.ColWidth(5) = 1800
        UfGridADO1.ColWidth(8) = 1800
    End If
    If bCde Then
        UfGridADO1.ColWidth(6) = 1800
        UfGridADO1.ColWidth(7) = 1800
    Else
        UfGridADO1.ColWidth(6) = 0
        UfGridADO1.ColWidth(7) = 0
    End If
    UfGridADO1.Rows = 2
    UfGridADO1.FixedRows = 2
    
'    If fsk Then
        With Me.UfGridADO1
            .TextMatrix(0, 0) = "账户号"
            .ColAlignment(0) = UG_ALIGNLEFT
            .JoinCells 0, 0, 1, 0, True
        
            .TextMatrix(0, 1) = "单位名称"
            .ColAlignment(1) = UG_ALIGNLEFT
            .JoinCells 0, 1, 1, 1, True
         
            .TextMatrix(0, 2) = "币别"
            .ColAlignment(2) = UG_ALIGNLEFT
            .JoinCells 0, 2, 1, 2, True
        
            .TextMatrix(0, 3) = "方向"
            .ColAlignment(3) = UG_ALIGNCENTER
            .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) = "超定额利息"
            .ColAlignment(7) = UG_ALIGNRIGHT
            .JoinCells 0, 7, 1, 7, True
            
            .TextMatrix(0, 8) = IIf(bCde, "利息合计", "利息")
            .ColAlignment(8) = UG_ALIGNRIGHT
            .JoinCells 0, 8, 1, 8, True
        
            .HeadFont.Name = "宋体"
            .HeadFont.Size = 9
            .HeadFont.Bold = True
        End With
'    End If
    
    Label1(1).Caption = Format(sRq1, "yyyy-mm-dd")
    Label1(2).Caption = Format(eRq2, "yyyy-mm-dd")
   Dim sT As String
   sT = getWcaccidStr
    sqlst = "SELECT fd_accunit.cunitname, fd_accdef.caccid, fd_accsum.mb, fd_accsum.mh+fd_accsum.mh_Cad as mhb" & _
            " From fd_accunit, fd_accdef, fd_accsum WHERE fd_accunit.cunitcode=fd_accdef.cunitcode" & _
            " and fd_accdef.caccid=fd_accsum.caccid and fd_accsum.dbill_date='" & _
            eDate & "' and fd_accsum.caccid in (" + sT + " ) order by FD_AccDef.cAccid"
   
    Set rsTemp = dbsZJ.OpenRecordset(sqlst, dbOpenSnapshot)
       
'    sqlst = "SELECT [cGAccID], sum(mmoney) as lx, Sum(cdeLx) As cLx From FD_CadAcr where " & _
            "dbill_date >='" & sDate & "' and dbill_date <='" & eDate & "' and cGAccid in (" + sT + ") Group by cGAccID"                  'cuidong 2001.07.10
    sqlst = "SELECT [cGAccID], sum(convert(money,mmoney)) as lx, Sum(convert(money,cdeLx)) As cLx From FD_CadAcr where " & _
            "dbill_date >='" & sDate & "' and dbill_date <='" & eDate & "' and cGAccid in (" + sT + ") And iDanType = 0 Group by cGAccID" 'cuidong 2001.07.10
   'sT--->'select * from " & ZjAccInfo.zjTempPath & ZjAccInfo.zjTempDB & ".wcaccid
    Set rstlx = dbsZJ.OpenRecordset(sqlst, dbOpenSnapshot)
    
    fx1 = "借"
    fx2 = "贷"
    yehj = 0
    
    CX_Sum_Init 'cuidong S.A 2001.09.27
    
    With rsTemp
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                dataly = Dwzhdtsr(![cAccID])
                nMb = ![Mb]
                If dataly Then
                    zhfx = ""
                Else
                    'zhfx = IIf(Getzhfx(![cAccID]), fx1, fx2)                'cuidong 2002.01.15
                    zhfx = IIf(Getzhfx(![cAccID]) Xor (![Mb] < 0), fx1, fx2) 'cuidong 2002.01.15
                    nMb = Abs(nMb)
                End If
                
                dqlx = 0
                dqlx2 = 0
                
                rstlx.FindFirst "cGAccid='" & rsTemp(1) & "'"
                   
                If Not rstlx.NoMatch Then
                    dqlx = IIf(IsNull(rstlx![lx]), 0, rstlx![lx])
                    dqlx2 = IIf(IsNull(rstlx!cLx), 0, rstlx!cLx)
                End If
                
                yehj = yehj + dqlx
                
'                UfGridado1.AddItem ![cAccID] & Chr(9) & _
                 ![cUnitName] & Chr(9) & _
                 Wgetwbb(![cAccID]) & Chr(9) & _
                 zhfx & Chr(9) & _
                 IIf(![Mb] = 0, "", Format(![Mb], "##,##0.00")) & Chr(9) & _
                 IIf(![mhb] = 0, "", Format(![mhb], "##,##0.00")) & Chr(9) & _
                 IIf(dqlx - dqlx2 = 0, "", FormatCur(dqlx - dqlx2)) & Chr(9) & _
                 IIf(dqlx2 = 0, "", FormatCur(dqlx2)) & Chr(9) & _
                 IIf(dqlx = 0, "", FormatCur(dqlx)) 'cuidong 2002.01.15
                 
                UfGridADO1.AddItem ![cAccID] & Chr(9) & _
                 ![cUnitName] & Chr(9) & _
                 Wgetwbb(![cAccID]) & Chr(9) & _
                 zhfx & Chr(9) & _
                 IIf(nMb = 0, "", Format(nMb, "##,##0.00")) & Chr(9) & _
                 IIf(![mhb] = 0, "", Format(![mhb], "##,##0.00")) & Chr(9) & _
                 IIf(dqlx - dqlx2 = 0, "", FormatCur(dqlx - dqlx2)) & Chr(9) & _
                 IIf(dqlx2 = 0, "", FormatCur(dqlx2)) & Chr(9) & _
                 IIf(dqlx = 0, "", FormatCur(dqlx)) 'cuidong 2002.01.15
                 
                 'cuidong S.A 2001.09.27
                 '--------------------------------
                 CX_Sum_Add 0, Wgetwbb(![cAccID]), 0, Format(nMb, "##,##0.00"), Format(![mhb], "##,##0.00"), FormatCur(dqlx - dqlx2), FormatCur(dqlx2), FormatCur(dqlx)
                 '--------------------------------
                 
                .MoveNext
            Loop
        End If
        .oClose
    End With
    
    'cuidong S.A 2001.09.27
    '------------------------------------
    For i = 1 To UBound(CX_Sum)
        UfGridADO1.AddItem CX_SumTEXT & Chr(9) & _
                           CX_SumCHAR & Chr(9) & _
                           CX_Sum(i).sExchName & Chr(9) & _
                           CX_SumCHAR & Chr(9) & _
                           IIf(CX_Sum(i).mMoney_1 = 0, "", Format(CX_Sum(i).mMoney_1, "##,##0.00")) & Chr(9) & _
                           IIf(CX_Sum(i).mMoney_2 = 0, "", Format(CX_Sum(i).mMoney_2, "##,##0.00")) & Chr(9) & _
                           IIf(CX_Sum(i).mMoney_3 = 0, "", FormatCur(CX_Sum(i).mMoney_3)) & Chr(9) & _
                           IIf(CX_Sum(i).mMoney_4 = 0, "", FormatCur(CX_Sum(i).mMoney_4)) & Chr(9) & _
                           IIf(CX_Sum(i).mMoney_5 = 0, "", FormatCur(CX_Sum(i).mMoney_5))
    Next i
    '------------------------------------
    
    With UfGridADO1
        .HeadForeColor = &H404040
        .HeadBackColor = &H8000000E
        If .Rows > 2 Then
            .Row = 2
            .Col = 0
        End If
        .Redraw = True
    End With
    
    rstlx.oClose
    Set rstlx = Nothing
    Set rsTemp = Nothing
'    Timer1.Enabled = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState = 1 Then
        Exit Sub
    End If
    If Me.WindowState = 0 Then
        If Me.Width < 3700 Then Me.Width = 3700
        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
    Label1(0).Left = ZjAccInfo.zjPictWidth - Me.Width + 75
    Label1(1).Left = ZjAccInfo.zjPictWidth - Me.Width + 855
    Line1.x1 = ZjAccInfo.zjPictWidth - Me.Width + 1920
    Line1.x2 = ZjAccInfo.zjPictWidth - Me.Width + 2045
    Label1(2).Left = ZjAccInfo.zjPictWidth - Me.Width + 2070
    Label0.Left = (Me.Width - Label0.Width) / 2 - Picture1.Left
End Sub

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

Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Index = 1 Then
        Label1(Index).ToolTipText = Label1(Index).Caption
    End If
End Sub

Private Sub Timer1_Timer()
'   Dim iRow       As Long
'   Dim curTotal   As Currency
'
'   For iRow = 2 To UfGridado1.Rows - 1
'      If UfGridado1.TextMatrix(iRow, 8) <> "" Then curTotal = curTotal + UfGridado1.TextMatrix(iRow, 8)
'   Next iRow
'   UfGridado1.AddItem "   合计:" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & FormatCur(curTotal)
'   UfGridado1.Refresh
'   Timer1.Enabled = 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"
            If TLB_Key = "Dataout" Then InitDataOut
            zjbPrnViewOut Me, "lxhzb", TLB_Key, True, Label0.Caption, "", Label1(0).Caption & ": " & Label1(1).Caption & " — " & Label1(2).Caption, ""
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Recx"
            frmlxhztj.Quitfs = False
            frmlxhztj.Show 1
        Case Is = "Exit"
            Unload Me
    End Select
End Sub

Private Sub UfGridado1_CanSizeCol(ByVal nCol As Long, bSize As Boolean)
   If (nCol = 6 Or nCol = 7) And Not bCde Then bSize = False
End Sub

Private Function IsCde() 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 IN (" + getWcaccidStr + " ) "
   Set rsC = dbsZJ.OpenRecordset(sqlC, dbOpenSnapshot)
   If Not rsC.EOF Then IsCde = True
   CloseRS rsC
End Function

Private Function getWcaccidStr() As String
      Dim sT As String
      Dim rstT As dao.Recordset
      Set rstT = dbsZjTemp.OpenRecordset("wcaccid", dbOpenSnapshot)
      With rstT
            If .EOF Then Exit Function
            .MoveFirst
            Do While Not .EOF
                  sT = sT + "'" + .Fields(0) + "',"
                  .MoveNext
            Loop
            sT = Left(sT, Len(sT) - 1)
      End With
      getWcaccidStr = sT
End Function