formcond.cls

金算盘软件代码

                rsMultiCond!strCodeID = mstrSelected(Index, 6)
                rsMultiCond!strKeyName = mstrSelected(Index, 5)
                rsMultiCond!bLNISCODETYPE = IIf(mstrSelected(Index, 14) = "1", "1", "0")
                rsMultiCond.Update
                rsMultiCond.Close
'               If mlngKeyType = 1 Then
'                    strSql = "insert into listMultiIDCond( LNGLISTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE )  values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 5) & "','" & IIf(mstrSelected(Index, 14) = "1", "1", "0") & "')"
'               Else
'                    strSql = "insert into ReportMultiIDCond( LNGREPORTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE )  values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 5) & "','" & IIf(mstrSelected(Index, 14) = "1", "1", "0") & "')"
'               End If
             End If
'             gclsBase.BaseDB.Execute strSql
   End Select
   rs.Update
    Index = Index + 1
  Loop
  rs.Close
  gclsBase.BaseWorkSpace.CommitTrans
  Exit Sub
ErrHandle:
  gclsBase.BaseWorkSpace.RollBacktrans
End Sub

Public Sub CmdReset_Click(frmFilterSet As Form)
 Dim Index As Long
 With frmFilterSet
    For Index = 1 To .MsgFilter.Rows - 2
      mlngCurLineOfSelect = .MsgFilter.RowData(Index)
      If mlngCurLineOfSelect > 0 Then
        .tvwFilter.Nodes(mlngCurLineOfSelect).Tag = Right(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, Len(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag) - 1)
      End If
    Next
    .MsgFilter.Rows = 2
    .MsgFilter.RowHeight(1) = 0
    mintMaxSelLines = 0
    Erase mstrSelected
    ReDim mstrSelected(1, ConNumPerSel)
    mlngCurentline = 1
    If .tvwFilter.Nodes.Count = 0 Then Exit Sub
    tvwFilter_nodeClick frmFilterSet, .tvwFilter.Nodes(1)
    .tvwFilter.Nodes(1).Selected = True
 End With
End Sub

Public Sub dateone_lostfocus(frmFilterSet As Form)
 Dim Index As Long
 Dim index2 As Long
 If Trim(frmFilterSet.DateOne.Text) = "" Then
    '删出当前行
    If Left(frmFilterSet.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
       DelCurentline frmFilterSet
    End If
      
 Else
 'Add One line of dateclass.
      Modifyrefertext1 frmFilterSet
      mstrSelected(mlngCurentline, 5) = frmFilterSet.DateOne.Text
      mstrSelected(mlngCurentline, 6) = ""
      mstrSelected(mlngCurentline, 7) = ""
      If mstrSelected(mlngCurentline, 1) = "截止日期" Then
            mstrSelected(mlngCurentline, 8) = Trim(mstrSelected(mlngCurentline, 2)) & " >= '" & Trim(mstrSelected(mlngCurentline, 5)) & "'"
      Else
            mstrSelected(mlngCurentline, 8) = Trim(mstrSelected(mlngCurentline, 2)) & " = '" & Trim(mstrSelected(mlngCurentline, 5)) & "'"
      End If
      AddSelectedTag frmFilterSet
      frmFilterSet.MsgFilter.TextMatrix(mlngCurentline, 1) = Trim(mstrSelected(mlngCurentline, 5))
      AddMsgFilter frmFilterSet
   End If
End Sub

'初始化已选条件表表头
Private Sub InitChooseGrd(frmFilterSet As Form)
  Dim Count As Integer
    With frmFilterSet.MsgFilter
         .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 ReferText1_MouseDown(frmFilterSet As Form, Button As Integer, Shift As Integer, x As Single, y As Single)
  mblnRefertext1 = True
End Sub

Public Sub ReferText2_KeyPress(frmFilterSet As Form, KeyAscii As Integer)
    mblnRefertext2 = True
End Sub

Public Sub ReferText2_MouseDown(frmFilterSet As Form, Button As Integer, Shift As Integer, x As Single, y As Single)
    mblnRefertext2 = True
End Sub

Public Sub tvwFilter_Collapse(frmFilterSet As Form, ByVal Node As msComctlLib.Node)
    Node.iMage = "closed"
    If frmFilterSet.tvwFilter.SelectedItem = Node Then
        tvwFilter_nodeClick frmFilterSet, frmFilterSet.tvwFilter.SelectedItem
    End If
End Sub


'增加
Public Sub tvwFilter_Expand(frmFilterSet As Form, ByVal Node As msComctlLib.Node)
 Dim RsCord As rdoResultset
 Dim strSql As String
 Dim lngNodeIndex As Long
 Dim Index As Long
 Dim OthTableName As String
    Node.iMage = "open"
    If Node.Child.Text = "Null" Then
        OthTableName = Right(Node.Tag, Len(Node.Tag) - InStr(Node.Tag, "`"))
        lngNodeIndex = Node.Index
        strSql = "select * from viewfield where blnisfilter=1 and lngviewId =" & Node.Child.Tag & strCondVersionField & "  order by  ViewField.lngViewFieldNo "
        Set RsCord = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        RsCord.MoveFirst
        Set mFilterNode = Node.Child
        mFilterNode.Key = Node.Key & "/" & RsCord!strViewFieldDesc
        mFilterNode.Text = RsCord!strViewFieldDesc
        mFilterNode.iMage = "book"
        mFilterNode.Tag = Trim(RsCord.rdoColumns("strViewFielddesc") & "@" & IIf(UCase(RsCord!strFieldType) = "CODE", RsCord!strKeyField, RsCord!strFieldName) & "@" & RsCord.rdoColumns("strTableName") & "@" & RsCord.rdoColumns("strFieldType") & "@" & RsCord.rdoColumns("lngViewFieldID") & "@" & OthTableName & "`" & RsCord!strBiaTableName)
        Index = 1
        For Index = 1 To mintMaxSelLines
            If frmFilterSet.MsgFilter.RowData(Index) = 0 Then
                If mstrSelected(Index, 11) = mFilterNode.Key Then
                    mFilterNode.Tag = "*" & mFilterNode.Tag
                    frmFilterSet.MsgFilter.RowData(Index) = mFilterNode.Index
                    mstrSelected(Index, 9) = mFilterNode.Index
                    Exit For
                End If
            End If
        Next
        If RsCord!lngCodeViewID > 0 And RsCord!blnIschildCond Then
               Set mFilterNode = frmFilterSet.tvwFilter.Nodes.Add(mFilterNode.Index, tvwChild, "/rschild" & mFilterNode.Index & RsCord.AbsolutePosition, "Null", "book")
               mFilterNode.Tag = RsCord!lngCodeViewID
        End If
        On Error GoTo EndHandle
        RsCord.MoveNext
        Do While Not RsCord.EOF
            If RsCord!strViewFieldDesc = "科目性质" And (mlngViewID = 126 Or (mlngViewID >= 609 And mlngViewID <= 611) Or (mlngViewID >= 1004 And mlngViewID <= 1007)) Then GoTo NextHandle
            Set mFilterNode = frmFilterSet.tvwFilter.Nodes.Add(lngNodeIndex, tvwChild, Node.Key & "/" & RsCord!strViewFieldDesc, RsCord!strViewFieldDesc, "book")
            mFilterNode.Tag = Trim(RsCord.rdoColumns("strViewFieldDesc") & "@" & IIf(UCase(RsCord!strFieldType) = "CODE", RsCord!strKeyField, RsCord.rdoColumns("strFieldName")) & "@" & RsCord.rdoColumns("strTableName") & "@" & RsCord.rdoColumns("strFieldType") & "@" & RsCord.rdoColumns("lngViewFieldID") & "@" & OthTableName & "`" & RsCord!strBiaTableName)
            Index = 1
            For Index = 1 To mintMaxSelLines
                If frmFilterSet.MsgFilter.RowData(Index) = 0 Then
                    If mstrSelected(Index, 11) = mFilterNode.Key Then
                        mFilterNode.Tag = "*" & mFilterNode.Tag
                        frmFilterSet.MsgFilter.RowData(Index) = mFilterNode.Index
                        mstrSelected(Index, 9) = mFilterNode.Index
                        Exit For
                    End If
                End If
            Next
            If RsCord!lngCodeViewID > 0 And RsCord!blnIschildCond Then
                   mFilterNode.iMage = "closed"
                   Set mFilterNode = frmFilterSet.tvwFilter.Nodes.Add(mFilterNode.Index, tvwChild, "/rschild" & mFilterNode.Index & RsCord.AbsolutePosition, "Null", "book")
                   mFilterNode.Tag = RsCord!lngCodeViewID
            End If
NextHandle:
            RsCord.MoveNext
        Loop
EndHandle:
        RsCord.Close
    End If
End Sub

'单击树或者,MsgFilter.Row 改变或者单击
Public Sub tvwFilter_nodeClick(frmFilterSet As Form, 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
    frmFilterSet.picAccount.Enabled = False
    frmFilterSet.picDate.Enabled = False
    '树接点索引值
    mlngCurLineOfSelect = Node.Index
    mblnSelected = False
    mblnRefertext1 = False
    mblnRefertext2 = 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.MsgFilter.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
    .ReferText1.ClearRefer
    .ReferText1.Referrows = 0
    .txtFrom.Text = ""
    .txtTo.Text = ""
    .txtFrom.Visible = False
    .txtTo.Visible = False
    .lblFrom2.Visible = False
    .lblTo2.Visible = False
    .ReferText1.CodeSort = False
    Select Case UCase(strFieldType)
      Case "CODE"
         .ReferText1.width = .MsgFilter.width - 250
         .picAccount.ZOrder 0
         .picAccount.Enabled = True
         .Lblsel.Caption = strViewFieldDesc & "(&D)"
         .ReferText1.CodeSort = True
         CodeHandle frmFilterSet, Node.Index
      Case "ENUM"
         .ReferText1.width = .MsgFilter.width / 2
         .picAccount.ZOrder 0
         .picAccount.Enabled = True
         .Lblsel.Caption = strViewFieldDesc & "(&D)"
         EnumHandle frmFilterSet, Node.Index
      Case "STRING"
         .ReferText1.width = .MsgFilter.width / 3 + 200
         .picAccount.ZOrder 0
         .picAccount.Enabled = True
         .Lblsel.Caption = strViewFieldDesc & "(&D)"
         .txtFrom.MaxLength = 254
         .txtTo.MaxLength = 254
         StringHandle frmFilterSet, Node.Index
      Case "LONG", "DOUBLE", "INTEGER"
         .ReferText1.width = .MsgFilter.width / 3 + 200
         .picAccount.ZOrder 0
         .picAccount.Enabled = True
         .Lblsel.Caption = strViewFieldDesc & "(&D)"
         If UCase(strFieldType) = "INTEGER" Then
            .txtFrom.MaxLength = 4
            .txtTo.MaxLength = 4
         ElseIf UCase(strFieldType) = "DOUBLE" Then
            .txtFrom.MaxLength = 18
            .txtTo.MaxLength = 18
         Else
            .txtFrom.MaxLength = 8
            .txtTo.MaxLength = 8
         End If
         NumberHandle frmFilterSet, Node.Index