clsfilter.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'  功能:采用树结构设置筛选条件(供使用条件的窗体调用)
'  日期:1998年7月10日
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  属性        KeyID                          '报表ID
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Const ConNumPerSel = 14                       '当前行的参数个数
Private strCondVersionField As String         'ViewField的版本号条件
Private strCondVersionEnum As String          'Enum总的版本号条件
Private strCondHospital As String          '行政医疗条件
Private strCondVersion As String              '单据类型的版本号条件
'属性变量
Private mlngKeyID As Long                     '报表ID

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'模块变量
Private mlngViewID As Long                    '总的视图ID号
Private mlngKeyType As Long                   '1:list;2:report

Private mlngCurentline As Long                '当前行
Private mlngCurLineOfSelect  As Long
Private mblnReferText1Filt  As Boolean
Private mItemNotExit As Boolean

Private mintMaxSelLines As Integer             '已选条件个数
Private mCurstrTemp(1 To 9) As String          '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5:树接点索引号 6:视图ID号 7:父视图ID号
Private mstrSelected() As String               '当前行的参数(MaxLine,1 To 13)
Private mstrChineseCond() As Variant           '中文条件
Private mstrTempSelected() As String           '暂存以备条件的数组 ，以备恢复

Private mFilterNode As msComctlLib.Node
Private mMaxNodesNumber As Long
Private mblnSelected As Boolean
Private frmFilterSet As Form
Private mChineseCond As String                '返回汉语条件

'类模块属性
Public Property Set myForm(ByVal myForm As Form)
    Set frmFilterSet = myForm
End Property

Public Property Get myForm() As Object
    Set myForm = frmFilterSet
End Property

'报表ID
Public Property Let KeyID(vData As Long)
    mlngKeyID = vData
End Property

Public Property Get KeyID() As Long
    KeyID = mlngKeyID
End Property
'视图ID
Public Property Let ViewId(vData As Long)
    mlngViewID = vData
End Property

Public Property Get ViewId() As Long
    ViewId = mlngViewID
End Property

Public Property Let blnNotExist(NotExist As Boolean)
    mItemNotExit = NotExist
End Property

Public Property Get blnNotExist() As Boolean
    blnNotExist = mItemNotExit
End Property


'暂存数组以备恢复
Private Function GetSelectd(arrsel() As String) As Boolean
Dim intFirst As Integer, intSecond As Integer
Dim Max1 As Integer, Max2 As Integer
    On Error GoTo ErrHandle
    Max1 = UBound(mstrSelected, 1)
    Max2 = UBound(mstrSelected, 2)
    ReDim arrsel(1 To Max1, 1 To Max2)
    For intFirst = 1 To Max1
       For intSecond = 1 To Max2
         arrsel(intFirst, intSecond) = mstrSelected(intFirst, intSecond)
       Next intSecond
   Next intFirst
   GetSelectd = True
   Exit Function
ErrHandle:
   GetSelectd = False
End Function

'恢复数组mstrSelected()
Public Function ResumeSelectd() As Boolean
Dim intFirst As Integer, intSecond As Integer
Dim Max1 As Integer, Max2 As Integer
    On Error GoTo ErrHandle
    Max1 = UBound(mstrTempSelected, 1)
    mintMaxSelLines = Max1
    Max2 = UBound(mstrTempSelected, 2)
    ReDim mstrSelected(1 To Max1, 1 To Max2)
    For intFirst = 1 To Max1
       For intSecond = 1 To Max2
         mstrSelected(intFirst, intSecond) = mstrTempSelected(intFirst, intSecond)
       Next intSecond
   Next intFirst
   ResumeSelectd = True
   Exit Function
ErrHandle:
   ResumeSelectd = False
End Function

'字符转换为数字
Private Function CondStrToNum(ByVal strOperate As String) As String
    Select Case Trim(strOperate)
        Case "等于"
           CondStrToNum = "1"
        Case "大于"
           CondStrToNum = "2"
        Case "小于"
           CondStrToNum = "3"
        Case "大于等于"
           CondStrToNum = "4"
        Case "小于等于"
           CondStrToNum = "5"
        Case "打头字符为", "介于"
           CondStrToNum = "6"
        Case "包含字符", "零或空值"
           CondStrToNum = "7"
        Case "类似于"
           CondStrToNum = "8"
        Case "不等于"
           CondStrToNum = "9"
        Case "所有"
           CondStrToNum = "18"
     End Select
End Function

'修改数据库
Public Sub UpdateCond()
 Dim rs As rdoResultset
 Dim Index As Long
 Dim strTemp As String
 Dim strTable As String
 Dim strSql As String
 Dim strsql2 As String
 Dim strRootRath As String
 Dim lngTemp As Long

   On Error GoTo ErrHandle
  gclsBase.BaseWorkSpace.BeginTrans
  strSql = " Delete  from ReportFilter where ReportFilter.lngReportID = " & mlngKeyID
  gclsBase.BaseDB.Execute strSql
  Set rs = gclsBase.BaseDB.OpenResultset("Select * FROM ReportFilter", rdOpenDynamic, 4)
  Index = 1
  Do While Index <= mintMaxSelLines
    rs.AddNew
    rs!lngReportID = mlngKeyID
    rs!lngViewFieldID = CLng(Trim(mstrSelected(Index, 10)))
    rs!strPath = mstrSelected(Index, 11)
    rs!strOthTableName = IIf(mstrSelected(Index, 12) = "", " ", mstrSelected(Index, 12))
    If InStr(rs!strPath, "/") <> 0 Then rs!blnHavefathernode = 1
    Select Case UCase(Trim(mstrSelected(Index, 3)))
        Case "STRING"
            rs!strStringOP = CondStrToNum(mstrSelected(Index, 5))
            rs!strString1 = mstrSelected(Index, 6)
        Case "ENUM"
               rs!strString1 = mstrSelected(Index, 5)
               rs!strString2 = mstrSelected(Index, 6)
        Case "LONG", "INTEGER", "DOUBLE"
            rs!strDoubleOP = CondStrToNum(mstrSelected(Index, 5))
            If mstrSelected(Index, 5) = "零或空值" Then
                rs!dbldouble1 = 0
            Else
                rs!dbldouble1 = mstrSelected(Index, 6)
                If mstrSelected(Index, 5) = "介于" Then
                    rs!dbldouble2 = mstrSelected(Index, 7)
                End If
            End If
   End Select
   rs.Update
    Index = Index + 1
  Loop
  rs.Close
  gclsBase.BaseWorkSpace.CommitTrans
  Exit Sub
ErrHandle:
  gclsBase.BaseWorkSpace.RollBacktrans
End Sub

Public Sub CmdResetFilt_Click()
 Dim Index As Long
 With frmFilterSet
    For Index = 1 To .MsgFilt.Rows - 2
      mlngCurLineOfSelect = .MsgFilt.RowData(Index)
      If mlngCurLineOfSelect > 0 Then
        .tvwFilt.Nodes(mlngCurLineOfSelect).Tag = Right(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, Len(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag) - 1)
      End If
    Next
    .MsgFilt.Rows = 2
    .MsgFilt.RowHeight(1) = 0
    mintMaxSelLines = 0
    Erase mstrSelected
    Erase mstrChineseCond
    ReDim mstrChineseCond(1)
    ReDim mstrSelected(1, 14)
    mlngCurentline = 1
    If .tvwFilt.Nodes.Count = 0 Then Exit Sub
    tvwFilt_nodeClick .tvwFilt.Nodes(1)
    .tvwFilt.Nodes(1).Selected = True
 End With
End Sub


'初始化已选条件表表头
Private Sub InitChooseGrd()
  Dim Count As Integer
    With frmFilterSet.MsgFilt
         .Rows = 2
         .Cols = 2
         For Count = 0 To .Cols - 1
             .FixedAlignment(Count) = 4
         Next Count
         .TextMatrix(0, 0) = "过滤项目"
         .TextMatrix(0, 1) = "过滤条件"
         .ColWidth(0) = 1500
         .ColWidth(1) = 2400
         .RowHeight(1) = 0
         .ColAlignment(1) = 1
    End With
End Sub

Public Sub refertext1Filt_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  mblnReferText1Filt = True
End Sub
Public Sub ReferText1Filt_KeyPress(KeyAscii As Integer)
    mblnReferText1Filt = True
End Sub

'单击树或者,MsgFilt.Row 改变或者单击
Public Sub tvwFilt_nodeClick(ByVal Node As msComctlLib.Node)
 '当前行参数变量
 Dim strViewFieldDesc As String
 Dim strFieldName As String
 Dim strFieldType As String
 Dim strTableName As String
 Dim strViewFieldID As String
 Dim strPath As String
 Dim strBiaTableName As String
 Dim strOthTableName As String

 Dim strTemp As String
 Dim lngTemp As Long

 Dim Index As Long
    '树接点索引值
    mlngCurLineOfSelect = Node.Index
    mblnSelected = False
    mblnReferText1Filt = False
    mItemNotExit = False


    '初始化当前行参数
    strPath = Node.Key
    strTemp = Trim(Node.Tag)
    lngTemp = InStr(strTemp, "`")
    strOthTableName = Right(strTemp, Len(strTemp) - lngTemp)
    strTemp = Left(strTemp, lngTemp - 1)
    lngTemp = InStr(strTemp, "@")
    strViewFieldDesc = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Right(strTemp, Len(strTemp) - lngTemp)
    lngTemp = InStr(strTemp, "@")
    strFieldName = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "@")
    strTableName = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "@")
    strFieldType = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "@")
    strViewFieldID = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    strBiaTableName = strTemp


    If Left(strViewFieldDesc, 1) = "*" Then
       mblnSelected = True
       strViewFieldDesc = Right(strViewFieldDesc, Len(strViewFieldDesc) - 1)
    Else
       If frmFilterSet.MsgFilt.Rows > 26 Then
            MsgBox "你设置的条件已经有25个之多了,你将不能再多设条件,只能修改或者减少已设条件."
            Exit Sub
       End If
    End If
    '暂存单前行参数
    mCurstrTemp(1) = strViewFieldDesc
    mCurstrTemp(2) = strFieldName
    mCurstrTemp(3) = UCase(strFieldType)
    mCurstrTemp(4) = strTableName
    mCurstrTemp(5) = Node.Index
    mCurstrTemp(6) = strViewFieldID
    mCurstrTemp(7) = strPath
    mCurstrTemp(8) = strBiaTableName
    mCurstrTemp(9) = strOthTableName

    With frmFilterSet
    .ReferText1Filt.ClearRefer
    .TxtFromFilt.Text = ""
    .TxtToFilt.Text = ""
    .TxtFromFilt.Visible = False
    .TxtToFilt.Visible = False
    .lblFromFilt.Visible = False
    .lblToFilt.Visible = False
    .TxtFromFilt.MaxLength = 18
    .TxtToFilt.MaxLength = 18
    Select Case UCase(strFieldType)