voucherinfo.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form VoucherInfo 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "凭证汇总表辅助信息"
   ClientHeight    =   5130
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8850
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5130
   ScaleWidth      =   8850
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOk 
      Caption         =   "退出(&X)"
      Height          =   345
      Left            =   7470
      TabIndex        =   1
      Top             =   4710
      Width           =   1155
   End
   Begin MSFlexGridLib.MSFlexGrid grdVoucherInfo 
      Height          =   4185
      Left            =   90
      TabIndex        =   0
      Top             =   450
      Width           =   8655
      _ExtentX        =   15266
      _ExtentY        =   7382
      _Version        =   393216
      WordWrap        =   -1  'True
      AllowUserResizing=   3
   End
   Begin VB.Label lblTotal 
      AutoSize        =   -1  'True
      Caption         =   "本次查询凭证张数"
      Height          =   180
      Left            =   180
      TabIndex        =   3
      Top             =   4740
      Width           =   1440
   End
   Begin VB.Label lblDate 
      AutoSize        =   -1  'True
      Caption         =   "查询期间"
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   180
      Width           =   720
   End
End
Attribute VB_Name = "VoucherInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const GRIDTITLE_VOUCHERYEAR = "会计期间"
Private Const GRIDTITLE_VOUCHERTYPE = "凭证类型"
Private Const GRIDTITLE_VOUCHERNUM = "凭证张数"
Private Const GRIDTITLE_VOUCHERNO = "凭证号"
Private Const GRIDTITLE_VOUCHERMISS = "缺号"

Private Const GRIDCOLS = 5
Private Const GRIDCOL_YEARCOL = 0
Private Const GRIDCOL_TYPECOL = 1
Private Const GRIDCOL_TOTALCOL = 2
Private Const GRIDCOL_NOCOL = 3
Private Const GRIDCOL_MISSCOL = 4

Public Function GetVoucherInfo(ByVal tCond As String, ByVal tBegin As String, ByVal tEnd As String)
  Dim strFrom As String, strSql As String, strOrder As String
  Dim rstData As rdoResultset
  Dim strVoucherType As String
  Dim intVoucherNO As Integer, intRow As Integer
  Dim intBegin As Integer, intEnd As Integer, intPeriod As Integer, intYear As Integer
  Dim intLastAddNo As Integer, intNums As Integer
         
    On Error GoTo ErrHandle
    lblDate.Caption = "查询期间： 从 " & tBegin & " 到 " & tEnd
    InitGrdTitle
'    strFrom = " From ((((((((((((((((((Voucher INNER JOIN VoucherDetail ON Voucher.lngVoucherID=VoucherDetail.lngVoucherID)" & _
'              " INNER JOIN Account ON Account.lngAccountID=VoucherDetail.lngAccountID)" & _
'              " INNER JOIN AccountType ON Account.lngAccountTypeID=AccountType.lngAccountTypeID)" & _
'              " INNER JOIN Currencys ON Currencys.lngCurrencyID=VoucherDetail.lngCurrencyID)" & _
'              " INNER JOIN VoucherType ON Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID)" & _
'              " INNER JOIN Operator As MakeMan ON Voucher.lngOperatorID=MakeMan.lngOperatorID)" & _
'    strFrom = strFrom & " LEFT JOIN Customer ON Customer.lngCustomerID=VoucherDetail.lngCustomerID)" & _
'              " LEFT JOIN CustomerType ON CustomerType.lngCustomerTypeID = Customer.lngCustomerTypeID)" & _
'              " LEFT JOIN Department ON Department.lngDepartmentID=VoucherDetail.lngDepartmentID)" & _
'              " LEFT JOIN Employee ON Employee.lngEmployeeID=VoucherDetail.lngEmployeeID)" & _
'              " LEFT JOIN EmployeeType ON EmployeeType.lngEmployeeTypeID=Employee.lngEmployeeTypeID)" & _
'              " LEFT JOIN Department As Department1 ON Employee.lngDepartmentID = Department1.lngDepartmentID)" & _
'              " LEFT JOIN Employee As Employee1 ON Customer.lngEmployeeID = Employee1.lngEmployeeID)" & _
'    strFrom = strFrom & " LEFT JOIN Area As Area2 ON Customer.lngAreaID = Area2.lngAreaID)" & _
'              " LEFT JOIN Class1 ON Class1.lngClassID=VoucherDetail.lngClassID1)" & _
'              " LEFT JOIN Operator As VerifyMan ON Voucher.lngCheckerID=VerifyMan.lngOperatorID)" & _
'              " LEFT JOIN Operator As RecordMan ON Voucher.lngPostID=RecordMan.lngOperatorID)" & _
'              " LEFT JOIN Class2 ON Class2.lngClassID=VoucherDetail.lngClassID2)"
    strFrom = " From Voucher,VoucherDetail,Account,AccountType,Currencys,VoucherType,Operator MakeMan,Customer," & _
              "CustomerType,Department,Employee,EmployeeType,Department Department1,Employee Employee1," & _
              "Area Area2,Class1,Operator VerifyMan,Operator RecordMan,Class2 " & _
              " WHERE Voucher.lngVoucherID = VoucherDetail.lngVoucherID " & _
              " AND Account.lngAccountID=VoucherDetail.lngAccountID " & _
              " AND Account.lngAccountTypeID=AccountType.lngAccountTypeID " & _
              " AND Currencys.lngCurrencyID=VoucherDetail.lngCurrencyID" & _
              " AND Voucher.lngVoucherTypeID=VoucherType.lngVoucherTypeID" & _
              " AND Voucher.lngOperatorID=MakeMan.lngOperatorID" & _
    strFrom = strFrom & " AND Customer.lngCustomerID =VoucherDetail.lngCustomerID(+)" & _
              " AND CustomerType.lngCustomerTypeID = Customer.lngCustomerTypeID(+)" & _
              " AND Department.lngDepartmentID=VoucherDetail.lngDepartmentID(+)" & _
              " AND Employee.lngEmployeeID=VoucherDetail.lngEmployeeID(+)" & _
              " AND EmployeeType.lngEmployeeTypeID=Employee.lngEmployeeTypeID(+)" & _
              " AND Employee.lngDepartmentID(+) = Department1.lngDepartmentID" & _
              " AND Customer.lngEmployeeID(+) = Employee1.lngEmployeeID" & _
    strFrom = strFrom & " AND Customer.lngAreaID(+) = Area2.lngAreaID" & _
              " AND Class1.lngClassID=VoucherDetail.lngClassID1(+)" & _
              " AND Voucher.lngCheckerID(+)=VerifyMan.lngOperatorID" & _
              " AND Voucher.lngPostID(+)=RecordMan.lngOperatorID" & _
              " AND Class2.lngClassID=VoucherDetail.lngClassID2(+)"
    strOrder = " ORDER BY Voucher.intYear,Voucher.bytPeriod,Voucher.lngVoucherTypeID,Voucher.intVoucherNO"
    strSql = "Select DistinctRow Voucher.*,VoucherType.strVoucherTypeCode || '-' || VoucherType.strVoucherTypeName as strVoucherTypeName  " & strFrom & " Where " & tCond & strOrder
    Set rstData = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstData
       intRow = grdVoucherInfo.Rows - 1
       If Not .EOF Then
          intYear = !intYear
          intPeriod = !bytPeriod
          strVoucherType = !strVoucherTypeName
          intVoucherNO = !intVoucherNO
          intBegin = intVoucherNO
          intEnd = intBegin
          intNums = 0
          If intBegin > 1 Then
             AddInfo intYear, intPeriod, strVoucherType, intBegin, 0, intEnd, False, intNums, True
          End If
       Else
          Exit Function
       End If
       Do While Not .EOF
          If intYear <> !intYear Or intPeriod <> !bytPeriod Then
                AddInfo intYear, intPeriod, strVoucherType, intBegin, intEnd, intVoucherNO, True, intNums
                intLastAddNo = intEnd
                If Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> "" Then
                   grdVoucherInfo.AddItem ""
                End If
                intNums = 0
                intYear = !intYear
                intPeriod = !bytPeriod
                strVoucherType = !strVoucherTypeName
                intVoucherNO = !intVoucherNO
                intBegin = intVoucherNO
                intEnd = intBegin
                If intBegin > 1 Then
                   AddInfo intYear, intPeriod, strVoucherType, intBegin, 0, intEnd, False, intNums, True
                End If
          Else
                If strVoucherType = !strVoucherTypeName Then
                   If !intVoucherNO - intVoucherNO <= 1 Then
                      intEnd = !intVoucherNO
                   Else
                      If Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> "" And Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> strVoucherType Then
                         grdVoucherInfo.AddItem ""
                      End If
                      AddInfo intYear, intPeriod, strVoucherType, intBegin, intEnd, !intVoucherNO, , intNums
                      intLastAddNo = intEnd
                      intBegin = !intVoucherNO
                      intEnd = intBegin
                   End If
                   intVoucherNO = !intVoucherNO
                Else
                   If Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> "" And Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> strVoucherType Then
                      grdVoucherInfo.AddItem ""
                   End If
                   AddInfo intYear, intPeriod, strVoucherType, intBegin, intEnd, intVoucherNO, True, intNums
                   intLastAddNo = intEnd
                   intYear = !intYear
                   intPeriod = !bytPeriod
                   strVoucherType = !strVoucherTypeName
                   intVoucherNO = !intVoucherNO
                   intBegin = intVoucherNO
                   intEnd = intBegin
                   intNums = 0
                   If intBegin > 1 Then
                      grdVoucherInfo.AddItem ""
                      AddInfo intYear, intPeriod, strVoucherType, intBegin, 0, intEnd, False, intNums, True
                   End If
                End If
          End If
          .MoveNext
          intNums = intNums + 1
       Loop
       If strVoucherType <> "" And (Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_YEARCOL)) <> (intYear & "年第" & intPeriod & "期") _
          Or Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> strVoucherType) Then
          If Trim(grdVoucherInfo.TextMatrix(grdVoucherInfo.Rows - 1, GRIDCOL_TYPECOL)) <> "" Then
             grdVoucherInfo.AddItem ""
          End If
          AddInfo intYear, intPeriod, strVoucherType, intBegin, intEnd, intVoucherNO, True, intNums
       Else
          If intEnd <> intLastAddNo Then
             AddInfo intYear, intPeriod, strVoucherType, intBegin, intEnd, intVoucherNO, True, intNums
          End If
       End If
       lblTotal.Caption = "本次查询凭证张数：" & .RowCount & "张"
    End With
    Exit Function
ErrHandle:
End Function

Private Sub AddInfo(ByVal tYear As Integer, ByVal tPeriod As Integer, ByVal tType As String, _
                    ByVal tBegin As Integer, ByVal tEnd As Integer, ByVal tNext As Integer, _
                    Optional IsLast As Boolean = False, Optional Nums As Integer = 0, Optional IsFirstMiss As Boolean = False)
  Dim intRow As Integer, intCol As Integer
  Dim strNo As String, strMiss As String
  
    With grdVoucherInfo
       intRow = .Rows - 1
       .TextMatrix(intRow, GRIDCOL_YEARCOL) = tYear & "年第" & tPeriod & "期"
       .TextMatrix(intRow, GRIDCOL_TYPECOL) = tType
       If Nums > 0 Then
          .TextMatrix(intRow, GRIDCOL_TOTALCOL) = Nums
       End If
       If tBegin = tEnd Then
          strNo = tBegin
       Else
          strNo = "(" & tBegin & "-" & tEnd & ")"
       End If
       
       If tNext - tEnd > 2 Then
          strMiss = "(" & tEnd + 1 & "-" & tNext - 1 & ")"
       Else
          strMiss = tEnd + 1
       End If
       
       If IsLast Then
          strMiss = ""
       End If
       
       If IsFirstMiss Then
          strNo = ""
       End If
       
       If strNo <> "" Then
            If Trim(.TextMatrix(intRow, GRIDCOL_NOCOL)) = "" Then
               .TextMatrix(intRow, GRIDCOL_NOCOL) = strNo
            Else
               .TextMatrix(intRow, GRIDCOL_NOCOL) = .TextMatrix(intRow, GRIDCOL_NOCOL) & "," & strNo
            End If
       End If
       
       If strMiss <> "" Then
            If Trim(.TextMatrix(intRow, GRIDCOL_MISSCOL)) = "" Then
               .TextMatrix(intRow, GRIDCOL_MISSCOL) = strMiss
            Else
               .TextMatrix(intRow, GRIDCOL_MISSCOL) = .TextMatrix(intRow, GRIDCOL_MISSCOL) & "," & strMiss
            End If
       End If
       .Row = intRow
       For intCol = 0 To .Cols - 1
          .col = intCol
          If .col = GRIDCOL_TOTALCOL Then
             .CellAlignment = 7
          Else
             .CellAlignment = 1
          End If
       Next intCol
    End With
End Sub

Private Sub InitGrdTitle()
    With grdVoucherInfo
       .Rows = 2
       .Cols = GRIDCOLS
       .FixedRows = 1
       .FixedCols = 1
       .TextMatrix(0, GRIDCOL_YEARCOL) = GRIDTITLE_VOUCHERYEAR
       .TextMatrix(0, GRIDCOL_TYPECOL) = GRIDTITLE_VOUCHERTYPE
       .TextMatrix(0, GRIDCOL_TOTALCOL) = GRIDTITLE_VOUCHERNUM
       .TextMatrix(0, GRIDCOL_NOCOL) = GRIDTITLE_VOUCHERNO
       .TextMatrix(0, GRIDCOL_MISSCOL) = GRIDTITLE_VOUCHERMISS
       .ColWidth(GRIDCOL_YEARCOL) = Me.TextWidth("A") * (StrLen(.TextMatrix(0, GRIDCOL_YEARCOL)) + 6)
       .ColWidth(GRIDCOL_TYPECOL) = Me.TextWidth("A") * (StrLen(.TextMatrix(0, GRIDCOL_TYPECOL)) + 5)
       .ColWidth(GRIDCOL_TOTALCOL) = Me.TextWidth("A") * (StrLen(.TextMatrix(0, GRIDCOL_TOTALCOL)) + 3)
       .ColWidth(GRIDCOL_NOCOL) = Me.TextWidth("A") * (StrLen(.TextMatrix(0, GRIDCOL_NOCOL)) + 40)
       .ColWidth(GRIDCOL_MISSCOL) = Me.TextWidth("A") * (StrLen(.TextMatrix(0, GRIDCOL_MISSCOL)) + 20)
       
       .ColAlignment(GRIDCOL_YEARCOL) = 4
       .ColAlignment(GRIDCOL_TYPECOL) = 4
       .ColAlignment(GRIDCOL_TOTALCOL) = 4
       .ColAlignment(GRIDCOL_NOCOL) = 4
       .ColAlignment(GRIDCOL_MISSCOL) = 4
    End With
End Sub

Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
       Unload Me
    End If
End Sub

Private Sub Form_Load()
    Set Me.Icon = GetFormResPicture(139, vbResIcon)
End Sub