frmtreefind.frm

金算盘软件代码

         Caption         =   "Label1"
         Height          =   285
         Left            =   540
         TabIndex        =   27
         Top             =   240
         Width           =   1725
      End
   End
End
Attribute VB_Name = "frmTreeFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
'Form_Resize常数
Const MinFormHeigh = 6345
Const MinFormWidth = 9555
Const FirstButtTop = 175
Const ButtToRight = 1315
Const Butt2ToButt3 = 110
Const ButtHeight = 350
'*****
Const ConNumPerSel = 14                  '当前行的参数个数
Const ConViewID = 163                    '筛选视图ID
Const conLineOfFind = 22                 '当前行的参数个数

Private mlngViewID As Long                 '总的视图ID号
Private strCondVersionField As String                 '总的版本号
Private strCondVersionEnum As String                 '总的版本号
Private strCondVersion As String                 '总的版本号
Private mblnIsSimpleCustomer As Boolean                '瘦身型条件，对字节点供应商起作用

Private mlngKeyType As Long                '1:list;2:report
Private mlngKeyID As Long                  'input ID
Private mCurentline As Long                '当前行
Private mCurLineOfSelect  As Long          '当前行对应的树接点号
Private WithEvents mclsHook As Hook        '响应msgFilter中vbUp 和vbDown 事件
Attribute mclsHook.VB_VarHelpID = -1
Private mblnRefertext1 As Boolean          'Refertext1_Choose时　Refertext1_click　响应标志
Private mblnRefertext2 As Boolean          'Refertext1_Choose时　Refertext1_click　响应标志
Private mItemNotExit As Boolean

Dim mCurstrTemp(1 To 9) As String          '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5:树接点索引号 6:字段ID号 7:路径 8:表别名 9:子接点表别名

Dim mstrSelected() As String               '当前行的参数(MaxLine,1 To ConNumPerSel)
                                           '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5,6,7:操作符和操作值 8:strWhere子句 9:树接点索引号 10:字段ID号 11:路径 12:表别名 13:子接点表别名 14:编码型类别标志
'Dim mstrViewKey As String
Dim mNode As msComctlLib.Node
Dim mblnSelected As Boolean                '当前行已设置条件标志

Public mChineseCond As String             '返回汉语条件
'把选出的列表的最后一行隐藏
Private WithEvents mclsHookSelect As Hook
Attribute mclsHookSelect.VB_VarHelpID = -1
Private mWhdmsgselect As Long             '消息处理时MsgSelect的句柄号
Private mstrSQLSelFrom As String
Private Function FindReceiptTypeIdWhere() As String
'Dim RsCord As rdoResultset
'Dim strSql As String
Dim strTemp As String
 If mlngViewID = 776 Then
    If IsCanDo(EditNO(41)) Then
        FindReceiptTypeIdWhere = " 2>1 "
    Else
        FindReceiptTypeIdWhere = " 1>2 "
    End If
 Else
'    strSql = "SELECT ReceiptType.lngReceiptTypeID as TypeID FROM ReceiptType"
'    Set RsCord = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    Do While Not RsCord.EOF
'       If IsCanDo(EditNO(RsCord!TypeID)) Then
'           If strTemp = "" Then
'               strTemp = RsCord!TypeID
'           Else
'               strTemp = strTemp & "," & RsCord!TypeID
'           End If
'       End If
'       RsCord.MoveNext
'    Loop
'    RsCord.Close
   '帐务
    If IsCanDo(35, gclsBase.OperatorID) Then
        strTemp = "41,54,55"
    Else
        strTemp = "0"
    End If
    '应收应付
    If IsCanDo(42, gclsBase.OperatorID) Or IsCanDo(211, gclsBase.OperatorID) Then
        strTemp = strTemp & ",2,3,5,7,13,14,16,19,34,35,36,37,38,39,40"
    End If
    '现金银行
    If IsCanDo(49, gclsBase.OperatorID) Then
        strTemp = strTemp & ",39,40"
    End If
    '采购
    If IsCanDo(67, gclsBase.OperatorID) Then
        strTemp = strTemp & ",1,2,3,4,5,8,43,46,52"
    End If
    '销售
    If IsCanDo(87, gclsBase.OperatorID) Then
        strTemp = strTemp & ",12,13,14,15,16,18,19,20,26,44,45"
    End If
    '库存
    If IsCanDo(114, gclsBase.OperatorID) Then
        strTemp = strTemp & ",2,4,6,9,10,11,13,15,17,18,21,22,23,24,28,29,30,31,32,33,42"
    End If
    '委托加工
    If IsCanDo(220, gclsBase.OperatorID) Then
        strTemp = strTemp & ",6,7,17,47"
    End If
    
    If strTemp = "0" Then
       FindReceiptTypeIdWhere = " 1>2 "
    Else
       FindReceiptTypeIdWhere = " TypeKeyID In (" & strTemp & ")"
    End If
 End If
End Function
Private Sub cmdFind_Click()
Dim Index As Long
Dim strSQLTotal As String
Dim RsCord As rdoResultset
Dim blnRowTag As Boolean
Dim strSQLWhere As String
Dim ReceiptTypeIDWhere As String     '有权限的单据类型ID串条件
On Error GoTo EndHandle
 CmdFind.Enabled = False
 MsgForm.PleaseWait
  If mlngViewID = 776 Then
    If mstrSQLSelFrom = "" Then
        mstrSQLSelFrom = "SELECT * FROM USER_VIEWS WHERE VIEW_NAME='SEARCHFROMSQL2'"
        Set RsCord = gclsBase.BaseDB.OpenResultset(mstrSQLSelFrom, rdOpenStatic)
        mstrSQLSelFrom = RsCord!Text '.rdoColumns.Count '(1).GetChunk(5000)
        RsCord.Close
    End If
 Else
    If mstrSQLSelFrom = "" Then
        mstrSQLSelFrom = "SELECT * FROM USER_VIEWS WHERE VIEW_NAME='SEARCHSELFROM'"
        Set RsCord = gclsBase.BaseDB.OpenResultset(mstrSQLSelFrom, rdOpenStatic)
        mstrSQLSelFrom = RsCord!Text '.rdoColumns.Count '(1).GetChunk(5000)
        RsCord.Close
    End If
 End If
 ReceiptTypeIDWhere = FindReceiptTypeIdWhere

 '选出的数据不为空标志
 If MsgFilter.Rows <= 2 Then
    strSQLWhere = " 2>1 "
 Else
    '生成 strSQLWhere 字句
    Index = 1
    Do While Index < MsgFilter.Rows - 1
       If strSQLWhere <> "" Then
           strSQLWhere = strSQLWhere & " and " & mstrSelected(Index, 8)
       Else
           strSQLWhere = mstrSelected(Index, 8)
       End If
       Index = Index + 1
    Loop
 End If
 strSQLTotal = mstrSQLSelFrom & " And " & ReceiptTypeIDWhere & " And " & strSQLWhere
 
 MsgSelected.Rows = 2
 MsgSelected.RowHeight(1) = 0
 Set RsCord = gclsBase.BaseDB.OpenResultset(strSQLTotal, rdOpenStatic)
 If RsCord.RowCount <> 0 Then
    CmdGoto.Enabled = True
    CmdReport.Enabled = True
    MsgSelected.Enabled = True
    Index = 1
    RsCord.MoveFirst
    Do While Not RsCord.EOF
          MsgSelected.Rows = MsgSelected.Rows + 1
          MsgSelected.RowHeight(Index) = 255
          MsgSelected.TextMatrix(Index, 0) = IIf(IsNull(RsCord!BstrDate), "", Format(CDate(RsCord!BstrDate), "yyyy-mm-dd"))
          MsgSelected.TextMatrix(Index, 1) = IIf(IsNull(RsCord!BstrReceiptTypeName), "", RsCord!BstrReceiptTypeName)
          MsgSelected.TextMatrix(Index, 2) = IIf(IsNull(RsCord!BstrReceiptNO), "", Trim(RsCord!BstrReceiptNO))
          MsgSelected.TextMatrix(Index, 3) = IIf(IsNull(RsCord!BstrCurrencyName), "", RsCord!BstrCurrencyName)
          MsgSelected.TextMatrix(Index, 4) = IIf(IsNull(RsCord!BstrAccountName), "", RsCord!BstrAccountName)
          MsgSelected.TextMatrix(Index, 5) = IIf(IsNull(RsCord!BstrCustomerName), "", RsCord!BstrCustomerName)
          MsgSelected.TextMatrix(Index, 6) = IIf(IsNull(RsCord!BstrDepartmentName), "", RsCord!BstrDepartmentName)
          MsgSelected.TextMatrix(Index, 7) = IIf(IsNull(RsCord!BstrEmployeeName), "", RsCord!BstrEmployeeName)
          If mlngViewID = 776 Then
            MsgSelected.TextMatrix(Index, 8) = ""
            MsgSelected.TextMatrix(Index, 9) = IIf(IsNull(RsCord!BdblQuantity), "", IIf(RsCord!BdblQuantity = 0, "", RsCord!BdblQuantity))
            MsgSelected.TextMatrix(Index, 10) = IIf(IsNull(RsCord!BdblCurrPrice), "", IIf(RsCord!BdblCurrPrice = 0, "", Format(RsCord!BdblCurrPrice, "#0.00")))
            MsgSelected.TextMatrix(Index, 11) = ""
            MsgSelected.TextMatrix(Index, 12) = IIf(IsNull(RsCord!BdblAmount), "", IIf(RsCord!BdblAmount = 0, "", Format(RsCord!BdblAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 13) = IIf(IsNull(RsCord!BdblCurrAmount), "", IIf(RsCord!BdblCurrAmount = 0, "", Format(RsCord!BdblCurrAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 14) = ""
            MsgSelected.TextMatrix(Index, 15) = ""
            MsgSelected.TextMatrix(Index, 16) = ""
            MsgSelected.TextMatrix(Index, 17) = IIf(IsNull(RsCord!strClassName1), "", RsCord!strClassName1)
            MsgSelected.TextMatrix(Index, 18) = IIf(IsNull(RsCord!strClassName2), "", RsCord!strClassName2)
            MsgSelected.TextMatrix(Index, 19) = IIf(IsNull(RsCord!BstrOperatorName), "", RsCord!BstrOperatorName)
            MsgSelected.TextMatrix(Index, 20) = IIf(IsNull(RsCord!BstrOperatorName1), "", RsCord!BstrOperatorName1)
            MsgSelected.TextMatrix(Index, 21) = IIf(IsNull(RsCord!BstrOperatorName2), "", RsCord!BstrOperatorName2)
            MsgSelected.TextMatrix(Index, conLineOfFind) = RsCord!BlngReceiptID
            MsgSelected.RowData(Index) = 50
          Else
            MsgSelected.TextMatrix(Index, 8) = IIf(IsNull(RsCord!BstrItemName), "", RsCord!BstrItemName)
            MsgSelected.TextMatrix(Index, 9) = IIf(IsNull(RsCord!BdblQuantity), "", IIf(RsCord!BdblQuantity = 0, "", BillPublic.NumberConvert(IIf(IsNull(RsCord!BdblQuantity), 0, RsCord!BdblQuantity), IIf(IsNull(RsCord!BdblFactor), 0, RsCord!BdblFactor), False)))
            MsgSelected.TextMatrix(Index, 10) = IIf(IsNull(RsCord!BdblCurrPrice), "", IIf(RsCord!BdblCurrPrice = 0, "", Format(RsCord!BdblCurrPrice * RsCord!BdblFactor, "#0.00")))
            MsgSelected.TextMatrix(Index, 11) = IIf(IsNull(RsCord!BdblDiscountRate), "", IIf(RsCord!BdblDiscountRate = 0, "", Format(RsCord!BdblDiscountRate, "#0.00")))
            MsgSelected.TextMatrix(Index, 12) = IIf(IsNull(RsCord!BdblAmount), "", IIf(RsCord!BdblAmount = 0, "", Format(RsCord!BdblAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 13) = IIf(IsNull(RsCord!BdblCurrAmount), "", IIf(RsCord!BdblCurrAmount = 0, "", Format(RsCord!BdblCurrAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 14) = IIf(IsNull(RsCord!BstrTaxName), "", IIf(InStr(Trim(RsCord!BstrTaxName), "%") = 1, "", RsCord!BstrTaxName))
            MsgSelected.TextMatrix(Index, 15) = IIf(IsNull(RsCord!BdblTaxAmount), "", IIf(RsCord!BdblTaxAmount = 0, "", Format(RsCord!BdblTaxAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 16) = IIf(IsNull(RsCord!BdblCurrTaxAmount), "", IIf(RsCord!BdblCurrTaxAmount = 0, "", Format(RsCord!BdblCurrTaxAmount, "#0.00")))
            MsgSelected.TextMatrix(Index, 17) = IIf(IsNull(RsCord!strClassName1), "", RsCord!strClassName1)
            MsgSelected.TextMatrix(Index, 18) = IIf(IsNull(RsCord!strClassName2), "", RsCord!strClassName2)
            MsgSelected.TextMatrix(Index, 19) = IIf(IsNull(RsCord!BstrJobName), "", RsCord!BstrJobName)
            MsgSelected.TextMatrix(Index, 20) = IIf(IsNull(RsCord!BstrOperatorName), "", RsCord!BstrOperatorName)
            MsgSelected.TextMatrix(Index, 21) = IIf(IsNull(RsCord!BstrNote), "", RsCord!BstrNote)
            MsgSelected.TextMatrix(Index, conLineOfFind) = RsCord!BlngReceiptID
            MsgSelected.RowData(Index) = RsCord!BlngReceiptTypeID
          End If
          Index = Index + 1
'       End If
       RsCord.MoveNext
    Loop
    MsgSelected.RowHeight(Index) = 0
  Else
    CmdGoto.Enabled = False
    CmdReport.Enabled = False
  End If
  RsCord.Close
  MsgSelected.Row = 1
'  '生成中文条件
'  MakeChineseCond
EndHandle:
Unload MsgForm
End Sub

Private Sub MakeChineseCond()
  Dim Index As Long
    mChineseCond = ""
    For Index = 1 To MsgFilter.Rows - 2
         If mstrSelected(Index, 5) = "自定义" Or mstrSelected(Index, 5) = "介于" Then
                If mChineseCond = "" Then
                    mChineseCond = Trim(mstrSelected(Index, 1)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                Else
                    mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 1)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                End If
         Else
                Select Case UCase(Trim(mstrSelected(Index, 3)))
                   Case "ENUM", "CODE", "BOOLEAN", "DATE", "PERIOD"
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 1)) & ": " & MsgFilter.TextMatrix(Index, 1)
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 1)) & ": " & MsgFilter.TextMatrix(Index, 1)
                       End If
                   Case Else
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 11)) & " " & MsgFilter.TextMatrix(Index, 1)
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 1)) & " " & MsgFilter.TextMatrix(Index, 1)
                       End If
                End Select
         End If
    Next
    mChineseCond = strReplace(mChineseCond, "/", "--")
End Sub

Private Sub CmdNo_Click()
 Unload Me
End Sub


Private Sub mclsMainControl_ToolRefresh()
    cmdFind_Click
End Sub
Private Sub CmdGoto_Click()
  Dim lngTypeID As Long
    If MsgSelected.SelectionMode = flexSelectionByColumn Then Exit Sub
    If MsgSelected.Row = 0 Or MsgSelected.Row = MsgSelected.Rows - 1 Then Exit Sub
    lngTypeID = MsgSelected.RowData(MsgSelected.Row)
    If lngTypeID = 0 Then Exit Sub
    If frmMain.tlbMain.Enabled = False Then Exit Sub
    CmdGoto.Enabled = False
    MsgSelected.Enabled = False
    If Trim(MsgSelected.TextMatrix(MsgSelected.Row, 1)) = "采购订单" Or Trim(MsgSelected.TextMatrix(MsgSelected.Row, 1)) = "销售订单" Then
        BillPublic.ShowBill1 lngTypeID, MsgSelected.TextMatrix(MsgSelected.Row, conLineOfFind)
    Else
        BillPublic.ShowBill lngTypeID, MsgSelected.TextMatrix(MsgSelected.Row, conLineOfFind)
    End If
    CmdGoto.Enabled = True
    MsgSelected.Enabled = True
End Sub

Private Sub CmdHelp_Click()
   HtmlHelp.HtmlHelp Me.hWnd, App.HelpFile, 15, 10001
End Sub

Private Sub CmdReset_Click()
 On Error Resume Next
 MsgSelected.Rows = 2
 MsgSelected.RowHeight(1) = 0
 CmdGoto.Enabled = False
 CmdReport.Enabled = False
' tvwFilter.Nodes.Clear
' InitTree
' tvwFilter_nodeClick tvwFilter.Nodes(1)
 Dim Index As Long
  For Index = 1 To MsgFilter.Rows - 2
    mCurLineOfSelect = MsgFilter.RowData(Index)
    If mCurLineOfSelect > 0 Then
        tvwFilter.Nodes(mCurLineOfSelect).Tag = Right(tvwFilter.Nodes(mCurLineOfSelect).Tag, Len(tvwFilter.Nodes(mCurLineOfSelect).Tag) - 1)
    End If
  Next
  MsgFilter.Rows = 2
  MsgFilter.RowHeight(1) = 0
  Erase mstrSelected
  mCurentline = 1
  If tvwFilter.Nodes.Count = 0 Then Exit Sub
  tvwFilter_nodeClick tvwFilter.Nodes(1)
  tvwFilter.Nodes(1).Selected = True

 CmdFind.Enabled = True
End Sub

Private Sub Form_Activate()
    SetHelpID 10001
    gclsSys.CurrFormName = Me.hWnd
    tvwFilter.SetFocus
    frmMain.mnuToolRefresh.Enabled = True
    frmMain.SetToolBar
End Sub

Private Sub Form_Load()
On Error GoTo ErrHandle