frmlistvoucher.frm

金算盘软件代码

VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmListVoucher 
   Caption         =   "Form1"
   ClientHeight    =   4335
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   6885
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   4335
   ScaleWidth      =   6885
   Begin VB.PictureBox pctDataGrid 
      Height          =   3048
      Left            =   96
      ScaleHeight     =   2985
      ScaleWidth      =   6285
      TabIndex        =   5
      Top             =   552
      Width           =   6348
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   4365
      TabIndex        =   3
      Top             =   0
      Width           =   1815
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial Black"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   6180
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      Top             =   0
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   276
      Left            =   825
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   0
      Width           =   1515
   End
   Begin VB.CheckBox chkShowall 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   4488
      TabIndex        =   8
      Top             =   3888
      Width           =   1035
   End
   Begin VB.Label lblFindKind 
      Caption         =   "查找(&B)"
      DragMode        =   1  'Automatic
      Height          =   204
      Left            =   3
      TabIndex        =   0
      Top             =   48
      Width           =   684
   End
   Begin VB.Label lblFind 
      Caption         =   "内容(&C)"
      Height          =   228
      Left            =   3591
      TabIndex        =   2
      Top             =   36
      Width           =   756
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   0
      Left            =   96
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3828
      Width           =   1212
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;617"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   1
      Left            =   1308
      TabIndex        =   7
      Tag             =   "1018"
      Top             =   3828
      WhatsThisHelpID =   5010
      Width           =   1212
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2138;614"
      TakeFocusOnClick=   0   'False
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmListVoucher"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mclsList As ListGrid
Public WithEvents mclsMainControl As MainControl
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsVoucher As clsVoucherMethod
Private Const mintViewId = 19
Private theEditForm As Form
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Private blnEdit As Boolean '编辑权限
Private blnMenuBuilded As Boolean
Private strVoucher As String '凭证名称
Private mIsFind As Boolean
Private ComPleteLoad As Integer
Private mblnIsFindTextChange As Boolean
Private mIsShowEdit As Boolean
Private intFindCol As Integer
'Private blnAfterLoad As Boolean
'Private blnNumberFinish As Boolean
'Private blnValueFinish As Boolean
'Private WithEvents MyConnect As rdoConnection
'Private mResultsetNo As rdoResultset
'Private mResultsetValue As rdoResultset
'Private mRows As Long

Private Function MakeListSql(ByVal intPageNo As Integer) As Boolean
    Dim BeginDate As Date
    Dim EndDate As Date
    Dim recTemp As rdoResultset
    Dim strSelect As String
    Dim strFrom   As String
    Dim strWhere  As String
    Dim strFromOfMe As String
    Dim strSql As String
    Dim strCWhere As String
    Dim strCSql As String
    Dim strOperator As String
    Dim strOrderBy As String
    Debug.Print " ExeSQLStart: " & Timer
    On Error Resume Next
    strSelect = mclsList.ListSet.SelectOfSql
    strFrom = mclsList.ListSet.FromOfSql
    strWhere = mclsList.ListSet.WhereOfSql
   
    If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
        Exit Function
    End If
    If Not IsCanDo(249, gclsBase.OperatorID) Then
        If Trim(strWhere) <> "" Then
            strWhere = strWhere & " And Voucher.lngOperatorID=" & gclsBase.OperatorID
        Else
            strWhere = " Voucher.lngOperatorID=" & gclsBase.OperatorID
        End If
    End If
    If Not mclsList.ShowAll Then
        If Trim(strWhere) <> "" Then
            strWhere = strWhere & " and  Voucher.blnIsVoid=0"
        Else
            strWhere = " Voucher.blnIsVoid=0"
        End If
    End If
    If mclsList.ListSet.ListID < 1 Then   '新建帐套时，条件为本期
       BeginDate = gclsBase.PeriodBegin
       EndDate = gclsBase.PeriodEnd
        If strWhere <> "" Then
            strWhere = strWhere & " and Voucher.strDate>= '" & _
              Format(BeginDate, "yyyy-mm-dd") & "' And Voucher.strDate<='" & Format(EndDate, "yyyy-mm-dd") & "'"
        Else
            strWhere = " Voucher.strDate>='" & Format(BeginDate, "yyyy-mm-dd") & "' And Voucher.strDate<='" _
             & Format(EndDate, "yyyy-mm-dd") & "'"
        End If
    End If

    If Trim(strWhere) <> "" Then
        strWhere = " where " & strWhere
        strOrderBy = " ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode ||  ' ' || To_char(Voucher.intVoucherNO,'0000'),Voucher.lngVoucherID,VoucherDetail.lngRowID" ' lngVoucherDetailID"                              '" ORDER BY cdate(voucher.strdate), Voucher.lngVoucherID  , VoucherDetail.lngRowID"   ' lngVoucherDetailID"
    Else
        strOrderBy = " ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode ||  ' ' || To_char(Voucher.intVoucherNO,'0000'),Voucher.lngVoucherID,VoucherDetail.lngRowID" ' lngVoucherDetailID"                              '" ORDER BY cdate(voucher.strdate), Voucher.lngVoucherID  , VoucherDetail.lngRowID"   ' lngVoucherDetailID"
    End If
          
    strSelect = "Select Voucher.lngVoucherID As id,decode(Voucher.blnIsVoid,1,'√','') As ""作废""," & strSelect
    If gclsBase.AccountSys = "2" Or gclsBase.AccountSys = "3" Or gclsBase.AccountSys = "4" Then
        strSelect = Replace(strSelect, "损益结转", "收支结转")
    Else
        strSelect = Replace(strSelect, "收支结转", "损益结转")
    End If
'    strFromOfMe = " FROM (((((Voucher INNER JOIN VoucherType ON Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) INNER JOIN Template ON Voucher.lngTemplateID = Template.lngTemplateID)" & _
'                " INNER JOIN Operator ON Voucher.lngOperatorID = Operator.lngOperatorID)" & _
'                " LEFT JOIN Operator AS Operator_1 ON Voucher.lngCheckerID = Operator_1.lngOperatorID)" & _
'                " LEFT JOIN Operator AS Operator_2 ON Voucher.lngPostID = Operator_2.lngOperatorID) " & _
'                " INNER JOIN (((((((VoucherDetail INNER JOIN Account ON VoucherDetail.lngAccountID = Account.lngAccountID)" & _
'                " INNER JOIN Currencys ON VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID) " & _
'                " LEFT JOIN Class1 ON VoucherDetail.lngClassID1 = Class1.lngClassID) " & _
'                " LEFT JOIN Class2 ON VoucherDetail.lngClassID2 = Class2.lngClassID)" & _
'                " LEFT JOIN Customer ON VoucherDetail.lngCustomerID = Customer.lngCustomerID) " & _
'                " LEFT JOIN Department ON VoucherDetail.lngDepartmentID = Department.lngDepartmentID) " & _
'                " LEFT JOIN Employee ON VoucherDetail.lngEmployeeID = Employee.lngEmployeeID)" & _
'                " ON Voucher.lngVoucherID = VoucherDetail.lngVoucherID"
'    strFromOfMe = " FROM Voucher,VoucherType,Template,Operator,Operator  Operator_1," & _
'                " Operator  Operator_2,VoucherDetail,Account,AccountType,Currencys,Class1,Class2,Customer,Department,Employee " & _
'                " Where (((((  Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) and Voucher.lngTemplateID = Template.lngTemplateID)" & _
'                " and Voucher.lngOperatorID = Operator.lngOperatorID)" & _
'                " and Voucher.lngCheckerID = Operator_1.lngOperatorID(+))" & _
'                " and Voucher.lngPostID = Operator_2.lngOperatorID(+)) " & _
'                " and ((((((((  VoucherDetail.lngAccountID = Account.lngAccountID)" & _
'                " And Account.lngAccountTypeID=AccountType.lngAccountTypeID)" & _
'                " and VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID) " & _
'                " and VoucherDetail.lngClassID1 = Class1.lngClassID(+)) " & _
'                " and VoucherDetail.lngClassID2 = Class2.lngClassID(+))" & _
'                " and VoucherDetail.lngCustomerID = Customer.lngCustomerID(+)) " & _
'                " and VoucherDetail.lngDepartmentID = Department.lngDepartmentID(+)) " & _
'                " and VoucherDetail.lngEmployeeID = Employee.lngEmployeeID(+))" & _
'                " and Voucher.lngVoucherID = VoucherDetail.lngVoucherID"
    strCSql = " Select count(*)  As Num " & strFrom & strWhere '& " and Rownum<500"
    strSql = strSelect & strFrom & strWhere & strOrderBy
'    strCSql = "select count(*) as Num from aa "
'    strSql = "select aa.id,aa.日期,aa.凭证字号,aa.摘要,aa.借方金额," _
'            & " aa.贷方金额 , aa.制单, aa.复核, aa.记帐 from aa order by aa.日期,,aa.凭证字号 "
     Debug.Print " ExeSQLRowsOpenResultSetStart: " & Timer
    Set recTemp = gclsBase.BaseDB.OpenResultset(strCSql, rdOpenForwardOnly)
    Debug.Print " ExeSQLOpenRowsResultSetEnd: " & Timer
    Debug.Print " ExeSQLOpenResultSetStart: " & Timer
    Set mclsList.Resultset(intPageNo) = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Debug.Print " ExeSQLOpenResultSetEnd: " & Timer
    If Not recTemp.EOF Then mclsList.TotalRow(intPageNo) = recTemp!Num
    mclsList.intTab = intPageNo
    If recTemp!Num = 0 Then
        cmdAgain.Enabled = False
    Else
        cmdAgain.Enabled = True
    End If
    recTemp.Close
    Set recTemp = Nothing
'    If mclsList.TotalRow(intPageNo) < 500 Then Exit Function
'    strCSql = " Select count(*)  As Num " & strFrom & strWhere
'    strSql = strSelect & strFrom & strWhere & strOrderBy
'    If Not mResultsetNo Is Nothing Then mResultsetNo.Close
'    If Not mResultsetValue Is Nothing Then mResultsetValue.Close
'    Set mResultsetNo = MyConnect.OpenResultset(strCSql, rdOpenForwardOnly, , rdAsyncEnable)
'    blnNumberFinish = False
'    Set mResultsetValue = MyConnect.OpenResultset(strSql, rdOpenStatic, , rdAsyncEnable)
'    blnValueFinish = False
End Function

Public Function ListID() As Long
    With mclsList.DbTabCtrl
        If .CellValue(.Row, 0) <> "" Then
            ListID = CLng(.CellValue(.Row, 0))
        Else
            ListID = 0
        End If
    End With
End Function

'初始查找列
Public Sub intcboFindKind()
    Dim intSortCol As Integer
    Dim intCount As Integer
    Dim intItem As Integer
    
    cboFindKind.Clear
    For intCount = 1 To mclsList.ListSet.Columns
        If mclsList.ListSet.ColumnIsFind(intCount) Then
            cboFindKind.AddItem mclsList.ListSet.ColumnDesc(intCount)
            Select Case UCase(mclsList.ListSet.ColumnFieldType(intCount))
                Case "INTEGER", "LONG", "DOUBLE"
                    cboFindKind.ItemData(intItem) = 1
                Case Else
                    cboFindKind.ItemData(intItem) = 10 + mclsList.ListSet.ColumnFieldSize(intCount)
            End Select
            
            If mclsList.ListSet.ColumnOrderType(intCount) <> 0 Then
                intSortCol = intItem
                mclsList.SortCol = intCount
                mclsList.FindColName = mclsList.ListSet.ColumnFieldName(intCount)
                'ozj注释
                If mclsList.ListSet.ColumnOrderType(intCount) = 1 Then
                    mclsList.ListSet.ColumnOrderType(intCount) = 1
                    mclsList.SortType = 1
                Else
                    mclsList.ListSet.ColumnOrderType(intCount) = 2
                    mclsList.SortType = 2
                End If
            End If
            intItem = intItem + 1
        End If
    Next
    cboFindKind.ListIndex = intSortCol
End Sub

'重新刷新当前页
Public Function ToolRefresh() As Boolean