VB财务软件系统下载源代码提供自由下载使用学习

   End With
   With JszxInfo
      .mTodayMb = mQc + m1
      .mTenday = ((dToday - dTendayBegin + 1) * (mQc + m3) + M5) / (dToday - dTendayBegin + 1)
      .mMonth = ((dToday - dMonthBegin + 1) * (mQc + m2) + M4) / (dToday - dMonthBegin + 1)
   End With
   
End Sub

Private Sub MakeZero(iGrade As Long)
   toDayYe(iGrade) = 0
   TendayBeginYe(iGrade) = 0
   MonthBeginYe(iGrade) = 0

End Sub

'********************************************************************
'*函数说明: 加百分号                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub AddPercent()
   Dim iEndRow As Long, i As Long
   Static iStartRow As Long
   
   If blnFirstRun Then
      iStartRow = 2
      blnFirstRun = False
   End If
   With UfGridado1
      iEndRow = .Rows - 1
      For i = iStartRow To iEndRow
         If IIf(.TextMatrix(i, 12) = "", 0, 1) = 1 Then
            If toDayYe(1) <> 0 Then .TextMatrix(i, 5) = Format(.TextMatrix(i, 4) / Format(toDayYe(1), "#0.00"), "#0.00%")
            If TendayBeginYe(1) <> 0 Then .TextMatrix(i, 8) = Format(.TextMatrix(i, 7) / Format(TendayBeginYe(1), "#0.00"), "#0.00%")
            If MonthBeginYe(1) <> 0 Then .TextMatrix(i, 11) = Format(.TextMatrix(i, 10) / Format(MonthBeginYe(1), "#0.00"), "#0.00%")
'            If toDayYe(1) <> 0 Then .TextMatrix(i, 5) = Format(.TextMatrix(i, 4) / toDayYe(1), "#0.00%")
'            If TendayBeginYe(1) <> 0 Then .TextMatrix(i, 8) = Format(.TextMatrix(i, 7) / TendayBeginYe(1), "#0.00%")
'            If MonthBeginYe(1) <> 0 Then .TextMatrix(i, 11) = Format(.TextMatrix(i, 10) / MonthBeginYe(1), "#0.00%")
            .TextMatrix(i, 12) = ""
         End If
      Next i
      iStartRow = .Rows
   End With
   
End Sub

'********************************************************************
'*函数说明: 初始化  Grid                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Public Sub initGrid()
   Dim i As Integer
   Dim rsHead As New UfRecordset, sqlHead As String
   sqlHead = "SELECT * FROM FD_Item WHERE iitems_id=1"
   Set rsHead = dbsZJ.OpenRecordset(sqlHead, dbOpenSnapshot)
   If Not rsHead.EOF Then Label4 = rsHead!citems_name
   lblTime = Year(dToday) & " 年 " & Month(dToday) & " 月 " & Day(dToday) & " 日"
   
   With UfGridado1
      ' 设置表头
      .Rows = 0
      DoEvents
      .LargeVirtualGrid = True
      .Rows = 2
      .Cols = 13
      .FixedCols = 1
      .FixedRows = 2
      
      ' 设置宽度
      For i = 0 To 12
          Select Case i
              Case 0
                  .ColWidth(i) = 2000
              Case 1, 2
                  .ColWidth(i) = 700
              Case 3, 4, 6, 7, 9, 10
                  .ColWidth(i) = 2000
              Case 5, 8, 11
                  .ColWidth(i) = 900
              Case 12
                  .ColWidth(i) = 0
          End Select
      Next i
   
      .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) = Day(dToday) & "  日"
      .TextMatrix(1, 3) = Day(dToday) & "  日"
      .JoinCells 0, 3, 1, 3, True
      
      .TextMatrix(0, 4) = Day(dToday) & " 日(本位币)"
      .TextMatrix(1, 4) = Day(dToday) & " 日(本位币)"
      .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
      
      .TextMatrix(0, 8) = "占 (%)"
      .TextMatrix(1, 8) = "占 (%)"
      .JoinCells 0, 8, 1, 8, True
      
      .TextMatrix(0, 9) = "月"
      .TextMatrix(1, 9) = "月"
      .JoinCells 0, 9, 1, 9, True
      
      .TextMatrix(0, 10) = "月(本位币)"
      .TextMatrix(1, 10) = "月(本位币)"
      .JoinCells 0, 10, 1, 10, True
      
      .TextMatrix(0, 11) = "占( %)"
      .TextMatrix(1, 11) = "占( %)"
      .JoinCells 0, 11, 1, 11, True
      
      '设置表体的Alignment
      For i = 0 To 11
          Select Case i
              Case 0
                  .ColAlignment(i) = UG_ALIGNLEFT
              Case 1, 5, 8, 11
                  .ColAlignment(i) = UG_ALIGNCENTER
              Case 2, 3, 4, 6, 7, 9, 10
                  .ColAlignment(i) = UG_ALIGNRIGHT
          End Select
      Next i
      
      .HeadFont.Name = "宋体"
      .HeadBackColor = &H8000000E
      .HeadFont.Size = 9
      .HeadFont.Bold = True
   End With
   Set frmRptItem.mCollectColWidth = New Collection
   For i = 0 To 11
      frmRptItem.mCollectColWidth.Add UfGridado1.ColWidth(i), CStr(i)
   Next i
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Cancel = DoUnloadInfo.blnRjszx
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
      Picture1.Left = Me.Width - Picture1.Width
      Label4.Left = Me.Width / 2 - Label4.Width / 2 + (Picture1.Width - Me.Width)
      lblTime.Left = Me.Width - lblTime.Width - 200 + (Picture1.Width - Me.Width)
      UfGridado1.Width = Me.Width - 100
      UfGridado1.Height = Me.Height - Toolbar1.Height - Picture1.Height - 400 - IIf(StatusBar1.Visible, StatusBar1.Height, 0)
      UfGridado1.Top = Toolbar1.Height + Picture1.Height
      UfGridado1.Left = 0
      ProBar1.Left = 4860
      ProBar1.Top = Me.Height - 640
   End If
   On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Dim i As Long
   For i = 1 To 4
      MakeZero i
   Next i
   Set frmRptItem = Nothing
    zjLogInfo.TaskExec "FD0403", 0, zjLogInfo.cIYear
    zjLogInfo.ClearError
    zjGen_arr.FD0403 = False
End Sub

Private Sub Recx()
   With frmReportXz
      .Quitfs = False
      .strReportType = "Jszx"
      .Show vbModal
   End With
End Sub

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

Private Sub InitDataOut()
   ReDim prnReport1(12)
   
   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 = dbCurrency
   prnReport1(2).cColName = UfGridado1.TextMatrix(0, 2)
   prnReport1(2).iColLength = lngCurrency
   
   prnReport1(3).iColNumber = 3
   prnReport1(3).iColType = dbCurrency
   prnReport1(3).cColName = UfGridado1.TextMatrix(0, 3)
   prnReport1(3).iColLength = lngCurrency
   
   prnReport1(4).iColNumber = 4
   prnReport1(4).iColType = dbCurrency
   prnReport1(4).cColName = UfGridado1.TextMatrix(0, 4)
   prnReport1(4).iColLength = lngCurrency
   
   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 = dbCurrency
   prnReport1(7).cColName = UfGridado1.TextMatrix(0, 7)
   prnReport1(7).iColLength = lngCurrency
   
   prnReport1(8).iColNumber = 8
   prnReport1(8).iColType = dbCurrency
   prnReport1(8).cColName = UfGridado1.TextMatrix(0, 8)
   prnReport1(8).iColLength = lngCurrency
   
   prnReport1(9).iColNumber = 9
   prnReport1(9).iColType = dbCurrency
   prnReport1(9).cColName = UfGridado1.TextMatrix(0, 9)
   prnReport1(9).iColLength = lngCurrency
   
   prnReport1(10).iColNumber = 10
   prnReport1(10).iColType = dbCurrency
   prnReport1(10).cColName = UfGridado1.TextMatrix(0, 10)
   prnReport1(10).iColLength = lngCurrency
   
   prnReport1(11).iColNumber = 11
   prnReport1(11).iColType = dbCurrency
   prnReport1(11).cColName = UfGridado1.TextMatrix(0, 11)
   prnReport1(11).iColLength = lngCurrency
End Sub

Private Sub Gen_Key(TLB_Key As String)
    '----设置互斥
    If m_bExclude = True Then Exit Sub
   
   Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            If TLB_Key = "Dataout" Then InitDataOut
            zjbPrnViewOut Me, "jszxb", TLB_Key, True, Label4.Caption, "", "", lblTime.Caption
      Case "Recx"
         Recx
      Case "Item"
         With frmRptItem
            Set .mGrid = Me.UfGridado1
            .mStartCol = 1
            .mEndCol = 11
            .Show vbModal
         End With
      Case "Help"
         SendKeys "{F1}"
      Case "Exit"
         Unload Me
   End Select

End Sub