frmvouchertypelist.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmVoucherTypeList 
   Caption         =   "凭证类型列表"
   ClientHeight    =   3615
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6720
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   3615
   ScaleWidth      =   6720
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   3120
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   150
      Width           =   2745
   End
   Begin VB.Data datTerm 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   5115
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3150
      Visible         =   0   'False
      Width           =   1260
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   300
      ItemData        =   "frmVoucherTypeList.frx":0000
      Left            =   750
      List            =   "frmVoucherTypeList.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   150
      Width           =   1515
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   5865
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1017"
      ToolTipText     =   "再找"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.CheckBox chkShowAll 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   3780
      TabIndex        =   8
      Top             =   3270
      Width           =   1095
   End
   Begin MSFlexGridLib.MSFlexGrid msgTerm 
      Bindings        =   "frmVoucherTypeList.frx":0004
      Height          =   2565
      Left            =   50
      TabIndex        =   0
      Tag             =   "ctPayMethod////101"
      Top             =   540
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   4524
      _Version        =   393216
      Rows            =   20
      Cols            =   3
      FixedCols       =   0
      BackColor       =   16777215
      BackColorFixed  =   -2147483644
      BackColorSel    =   -2147483646
      BackColorBkg    =   16777215
      Redraw          =   -1  'True
      AllowBigSelection=   0   'False
      FocusRect       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSForms.CommandButton cmdVoucherType 
      Height          =   345
      Index           =   0
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3210
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;617"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdVoucherType 
      Height          =   345
      Index           =   1
      Left            =   1020
      TabIndex        =   7
      Tag             =   "1018"
      Top             =   3780
      Visible         =   0   'False
      WhatsThisHelpID =   5010
      Width           =   1215
      Caption         =   "报表"
      PicturePosition =   196613
      Size            =   "2143;617"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFindKind 
      AutoSize        =   -1  'True
      Caption         =   "查找(&F)"
      Height          =   180
      Left            =   50
      TabIndex        =   1
      Top             =   210
      Width           =   630
   End
   Begin VB.Label lblFind 
      AutoSize        =   -1  'True
      Caption         =   "内容(&C)"
      Height          =   180
      Left            =   2445
      TabIndex        =   3
      Top             =   210
      Width           =   630
   End
End
Attribute VB_Name = "frmVoucherTypeList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'凭证类型模块
'      作者：欧中建
'      日期：1998.6.10
'1.1 所用类模块：List
'1.2 所用钩子函数：mclsSubClass，mclsSubClassForm。
Option Explicit

Private mIsShowCard As Boolean                                  '卡片窗口显示标志
Private mblnCheckNoChange As Boolean                            '不需要响应chkshowAll控件Change事件
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass          '“钩子”对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList As list                                        '列表对象
Private mblnIsSaveListset As Boolean                             'Whether or not save lngViewID in List
Private Const intViewID = 14                                    '视图ID

'
'方法及函数
'

Public Property Let IsShowCard(ByVal vNewValue As Boolean)
   mIsShowCard = vNewValue
End Property
Public Property Get IsShowCard() As Boolean
   IsShowCard = mIsShowCard
End Property
'产生付款条件列表记录集
Public Function GetList() As Recordset
    Dim recRecordset As Recordset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSql As String
    
    strSelectOfSql = mclsList.ListSet.GetSelect
    strFromOfSql = mclsList.ListSet.FromOfSql
    strWhereOfSql = mclsList.ListSet.WhereOfSql
    strSelectOfSql = "Select VoucherType.lngVoucherTypeID As id,IIF(VoucherType.blnIsInActive,'√','') As 停用," & strSelectOfSql
    If strWhereOfSql <> "" Then
        strWhereOfSql = " Where  " & strWhereOfSql
   
    End If
  
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    
    '列表是否为空
    If recRecordset.RecordCount = 0 Then
        msgTerm.HighLight = flexHighlightNever      '光标亮条消失
        cmdAgain.Enabled = False
    Else
        msgTerm.HighLight = flexHighlightAlways     '光标亮条显示
        cmdAgain.Enabled = True
    End If
    mclsList.ShowAll = True
    Set GetList = recRecordset
End Function
Public Function ShowList(ByVal lngID As Long) As Boolean
    Dim intCount As Integer
    Dim strSortField As String
    Dim strSortDec As String
    Dim strSql As String
    Dim recTemp As Recordset
    Dim strofFrom As String
    Dim strofWhere As String
    Me.Show
    Me.ZOrder 0
    With mclsList.ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    If strofWhere <> "" Then
        strofWhere = " where " & strofWhere & "and VoucherType.lngVoucherTypeID=" & lngID
    Else
        strofWhere = " where VoucherType.lngVoucherTypeID=" & lngID
    End If
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
    With recTemp
        If .RecordCount > 0 Then
            txtfind.Text = recTemp(strSortDec)   '查找
            If msgTerm.TextMatrix(msgTerm.Row, 0) = lngID Then     '是否找到
                ShowList = True
            Else
                ShowList = False
            End If
        Else
            ShowList = False
        End If
        .Close
    End With
End Function


'按照付款条件ID提取记录
Public Function GetByTermID(ByVal lngID As Long) As Recordset
    Dim recRecordset As Recordset
    Dim strSql As String
    
    strSql = "Select * From VoucherType Where lngVoucherTypeID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Set GetByTermID = recRecordset
End Function

'按照付款条件ID更新停用标志
Private Function UpdateTermInActive(ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE VoucherType SET blnIsInActive = " & blnIsInActive & " WHERE lngVoucherTypeID = " & lngID
    UpdateTermInActive = gclsBase.ExecSQL(strSql)
End Function

'删除付款条件ID指定记录
Private Function DelByTermID(ByVal lngID As Long) As Boolean
    Dim strSql As String
    
    strSql = "Delete * From VoucherType Where lngVoucherTypeID = " & lngID
    DelByTermID = gclsBase.ExecSQL(strSql)
End Function

'判断付款条件ID是否使用
Private Function IsUseTermID(ByVal lngID As Long) As Boolean
    Dim recRecordset As Recordset
    Dim strSql As String
    
    strSql = "SELECT lngVoucherTypeID FROM VoucherType" _
                & " Where EXISTS (SELECT Fa.lngVoucherTypeID FROM FixedMethod AS Fa WHERE Fa.lngVoucherTypeID=" & lngID & ")" _
                & " OR EXISTS (SELECT TV.lngVoucherTypeID FROM  TransVoucher AS TV WHERE TV.lngVoucherTypeID=" & lngID & ")" _
                & " OR EXISTS (SELECT Vd.lngVoucherTypeID FROM Voucher AS Vd WHERE Vd.lngVoucherTypeID=" & lngID & ")"
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    IsUseTermID = (recRecordset.RecordCount >= 1)
    recRecordset.Close
End Function

'得到付款条件ID
Public Property Get TermID() As Long
    With msgTerm
    If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
        TermID = CLng(.TextArray(.Row * .Cols))
    Else
        TermID = 0
    End If
    End With
End Property

'得到付款条件停用标志
Public Property Get TermIsInActive() As Boolean
    If chkShowAll.Value Then
        With msgTerm
            TermIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        TermIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    Dim IsHaveRight As Boolean