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

      .ColWidth(5) = 0
      .ColWidth(6) = 1800
      .ColWidth(7) = 2600
      .ColWidth(8) = 1200
      .ColWidth(9) = 1200
      
   '初始化表头及对齐方式
      .TextMatrix(0, 0) = "日期"
      .TextMatrix(0, 1) = "日期"
      .TextMatrix(0, 2) = "日期"
      .JoinCells 0, 0, 0, 2, True
      
      .ColAlignment(0) = UG_ALIGNCENTER
      .ColAlignment(1) = UG_ALIGNCENTER
      .ColAlignment(2) = UG_ALIGNCENTER
      
      .TextMatrix(1, 0) = "年"
      .TextMatrix(1, 1) = "月"
      .TextMatrix(1, 2) = "日"
      
      .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) = "业务id"
      .TextMatrix(1, 5) = "业务id"
      .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
      
      .ColAlignment(8) = UG_ALIGNRIGHT
      .ColAlignment(9) = UG_ALIGNRIGHT
      
      .HeadFont.Name = "宋体"
      .HeadBackColor = &HFFFFFF
      .HeadFont.Size = 9
      .HeadFont.Bold = True
   End With
   
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Cancel = DoUnloadInfo.blnXsh
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
      Label1(1).left = Me.width / 2 - Label1(1).width / 2 + (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 PrepareDate()
   Dim i As Long, j As Long
   Dim str As String
   Dim rsClass As New UfRecordset
   Dim HStr As String
   Dim HVal As Long
   
   Set rsClass = dbsZJ.OpenRecordset("FD_Class")
   While Not rsClass.EOF
      strClass(val(rsClass![cSign])) = rsClass![ctext]
      rsClass.MoveNext
   Wend
   
   If nMaxRows = 0 Then GoTo ExitS
   Me.UfGridADO1.Redraw = True
   ProBar1.Max = nMaxRows
   ProBar1.Value = 0
   ProBar1.Min = 0
   DoUnload True
   
   CX_Sum_Init 'cuidong S.A 2001.09.11
   
   i = 1
   If Not rsFind.EOF Then rsFind.MoveFirst
   While Not rsFind.EOF
       If IsNull(rsFind![AccID]) Then
           ChangeStatus "", 1
       Else
           str = AccIDToUnitName(rsFind![AccID])
           HVal = val(left(rsFind![YWID], 2))
           If HVal < 1 Or HVal > 50 Then
              HStr = ""
           Else
              HStr = strClass(HVal) & "-"
           End If
           ChangeStatus HStr & right(rsFind![YWID], 10), 1
           UfGridADO1.AddItem Year(rsFind![BillDate]) & Chr(9) & _
              Month(rsFind![BillDate]) & Chr(9) & _
              Day(rsFind![BillDate]) & Chr(9) & _
              str & Chr(9) & _
              rsFind![AccID] & Chr(9) & _
              rsFind![transactions_id] & Chr(9) & _
              HStr & right(rsFind![YWID], 10) & Chr(9) & _
              rsFind![Digest] & Chr(9) & _
              IIf(rsFind![mc] = 0, "", Format(rsFind![mc], "#0.00")) & Chr(9) & _
              IIf(rsFind![md] = 0, "", Format(rsFind![md], "#0.00"))
              
           CX_Sum_Add Format(rsFind![mc], "#0.00"), AccToExch(rsFind![AccID]), Vround(rsFind![nFrat], 6), Format(rsFind![md], "#0.00") 'cuidong S.A 2001.09.11
        End If
        rsFind.MoveNext
   Wend
   
   'cuidong S.A 2001.09.11
   '--------------------------------------
   For i = 1 To UBound(CX_Sum)
      UfGridADO1.AddItem CX_SumTEXT & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_SumCHAR & Chr(9) & _
         CX_Sum(i).sExchName & Chr(9) & _
         IIf(CX_Sum(i).mMoney = 0, "", Format(CX_Sum(i).mMoney, "#0.00")) & Chr(9) & _
         IIf(CX_Sum(i).mMoney_1 = 0, "", Format(CX_Sum(i).mMoney_1, "#0.00"))
    
'         CX_Sum(i).sExchName & " ( 汇率:" & CX_Sum(i).nFrat & " )" & Chr(9) & _

    Next i
   '--------------------------------------
   
   DoUnload False
ExitS:
   StatusBar1.Visible = False
   ProBar1.Visible = False
   UfGridADO1.Height = UfGridADO1.Height + StatusBar1.Height
   If Me.UfGridADO1.Rows > 2 Then Me.UfGridADO1.row = 2
   
End Sub

Private Sub ChangeStatus(cItemName As String, iChangeUnit As Long)
   StatusBar1.Panels(2).Text = cItemName
   ProBar1.Value = ProBar1.Value + iChangeUnit
   DoEvents
   
End Sub

Private Sub DoUnload(blnLoad As Boolean)
   DoUnloadInfo.blnXsh = blnLoad
End Sub

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

Private Sub Recx()
   With frmXShFind
      .Quitfs = False
      .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(9)
   
   prnReport1(0).iColNumber = 0
   prnReport1(0).iColType = dbText
   prnReport1(0).cColName = UfGridADO1.TextMatrix(1, 0)
   prnReport1(0).iColLength = lngText
   
   prnReport1(1).iColNumber = 1
   prnReport1(1).iColType = dbText
   prnReport1(1).cColName = UfGridADO1.TextMatrix(1, 1)
   prnReport1(1).iColLength = lngText
   
   prnReport1(2).iColNumber = 2
   prnReport1(2).iColType = dbText
   prnReport1(2).cColName = UfGridADO1.TextMatrix(1, 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 = dbText
   prnReport1(5).cColName = UfGridADO1.TextMatrix(0, 5)
   prnReport1(5).iColLength = lngText
   
   prnReport1(6).iColNumber = 6
   prnReport1(6).iColType = dbText
   prnReport1(6).cColName = UfGridADO1.TextMatrix(0, 6)
   prnReport1(6).iColLength = lngText
   
   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
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, "cxxsz", TLB_Key, True, Label1(1).Caption
      Case "Recx"
         Recx
      Case "UnionFind"
         UfGridado1_DBClick UfGridADO1.row, UfGridADO1.col
      Case "Help"
         SendKeys "{F1}"
      Case "Exit"
         Unload Me
   End Select

End Sub

Private Sub UfGridado1_DBClick(ByVal nRow As Long, ByVal nCol As Long)
   Dim xTemp As String, yTemp As String
   Dim cClass As String, sqlID 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.TextMatrix(UfGridADO1.row, 0) = CX_SumTEXT Then Exit Sub 'cuidong S.A 2001.09.11
   
   yTemp = UfGridADO1.TextMatrix(UfGridADO1.row, UfGridADO1.col)
   UfGridADO1.TextMatrix(UfGridADO1.row, UfGridADO1.col) = yTemp
   
   xTemp = UfGridADO1.TextMatrix(UfGridADO1.row, 5)
   UfGridADO1.TextMatrix(UfGridADO1.row, 5) = xTemp
   
   For i = 1 To 20
      cClass = cClass & mID(xTemp, i, 1)
      If mID(xTemp, i + 1, 1) = "-" Then
         Exit For
      End If
   Next i
   sqlID = mID(xTemp, Len(cClass) + 2)
   'If Not IsNumeric(sqlID) Then Exit Sub
   For i = 1 To 50
      If strClass(i) = cClass Then Exit For
   Next i
   
   On Error GoTo lblExit
'   If i > 9 Then
'            oUniFind.ShowBill "FD", CStr(i) + sqlID
'   Else
'            oUniFind.ShowBill "FD", "0" + CStr(i) + sqlID
'   End If
   
 If Me.UfGridADO1.Rows > 1 Then
     Dim OID           As New U8FDEso.OIDObject
     Dim objVchInputUI As New clsVchInputUI
     
     OID = Me.UfGridADO1.TextMatrix(Me.UfGridADO1.row, 5)
     objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)
     
     Set OID = Nothing
     Set objVchInputUI = Nothing
 End If

   Exit Sub
   
lblExit:
   MsgBox Err.Description, vbInformation, zjGl_Name
   
End Sub