modbase.bas

来自「通用书店管理系统」· BAS 代码 · 共 1,335 行 · 第 1/4 页

Public Function GetMaxNo(ByVal chrFields As String, strTable As String, strDate As String) As String
   Dim sqlstring As String
   Dim rsNewTmp As New ADODB.Recordset
   
   On Error GoTo err
   sqlstring = "select top 1 " & chrFields & " from " & strTable & " where  " & chrFields & " like '" & strDate & _
               "%' order by " & chrFields & " desc"
   rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   
   If Not rsNewTmp.EOF Then
     GetMaxNo = strDate & Format(Mid(rsNewTmp.Fields(0).Value, 9, 5) + 1, "0000#")
   Else
      GetMaxNo = strDate & "00001"
   End If
   
   Exit Function
err:
   GetMaxNo = ""
   MsgBox "获取最大单号失败：" & err.Description, , "警告"
   
End Function


'---------------------------------------------------------------------------------------
' 函数名:       Find_Next
' 功能:         查找
' 参数说明:     intSelect--- 查找选择
'               nodCurrent---当前 TreeView 的节点
'               strFind -----查找目标
'               blnRound -----是否回绕查找
'               blnMatch---是否全字匹配
'---------------------------------------------------------------------------------------
Public Sub Find_Next(frm As Form, intSelect As Integer, nodCurrent As Node, strFind As String, _
                     strTable As String, strField As String, strHeader As String, Optional blnRound As Boolean = False, Optional blnMatch As Boolean = False)
    Dim nod_PNext As Node, nod_CNext As Node
    Dim strParent As String
    Dim intNo As Integer
    Dim i As Integer
    
    On Error GoTo FindErr
    
    Select Case intSelect
    Case 1 '按编码查询
        If Left(nodCurrent.Key, 1) = "r" Then
            Set nod_CNext = nodCurrent.Next
            While Not nod_CNext Is Nothing
                If blnMatch Then
                    If Mid(nod_CNext.Key, InStr(3, nod_CNext.Key, ".") + 1) = strFind Then
                        frm.tvwFile.Nodes.Item(nod_CNext.Key).Selected = True
                        frm.strParent = frm.tvwFile.SelectedItem.Text
                        For i = 1 To frm.tvwFile.Nodes.Count
                          frm.tvwFile.Nodes(i).ForeColor = vbBlack
                        Next
                        frm.tvwFile.SelectedItem.ForeColor = vbRed
                        frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                        Call frm.ShowRecorder(strTable, strField, strHeader)
                        Exit Sub
                    End If
                Else
                    If InStr(2, nod_CNext.Key, strFind) <> 0 Then
                        frm.tvwFile.Nodes.Item(nod_CNext.Key).Selected = True
                        frm.strParent = frm.tvwFile.SelectedItem.Text
                        frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                        For i = 1 To frm.tvwFile.Nodes.Count
                          frm.tvwFile.Nodes(i).ForeColor = vbBlack
                        Next
                        
                        frm.tvwFile.SelectedItem.ForeColor = vbRed
                        Call frm.ShowRecorder(strTable, strField, strHeader)
                        Exit Sub
                    End If
                End If
                Set nod_CNext = nod_CNext.Next
            Wend
            Set nod_PNext = nodCurrent.Next
        End If

        If blnRound Then
            If Left(nodCurrent.Key, 1) = "r" Then
               Set nod_PNext = nodCurrent.FirstSibling
            End If
            While Not nod_PNext Is Nothing
                If nod_PNext.Key = nodCurrent.Key Then
                    MsgBox ("已搜索完整个资料表...")
                    Exit Sub
                End If
                If blnMatch Then
                        If Mid(nod_PNext.Key, 2) = strFind Then
                            frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                            frm.strParent = frm.tvwFile.SelectedItem.Text
                            frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                            Call frm.ShowRecorder(strTable, strField, strHeader)
                            For i = 1 To frm.tvwFile.Nodes.Count
                              frm.tvwFile.Nodes(i).ForeColor = vbBlack
                            Next
                            
                            frm.tvwFile.SelectedItem.ForeColor = vbRed
                            Exit Sub
                        End If
                Else
                        If InStr(2, nod_PNext.Key, strFind) <> 0 Then
                            frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                            frm.strParent = frm.tvwFile.SelectedItem.Text
                            frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                            Call frm.ShowRecorder(strTable, strField, strHeader)
                            For i = 1 To frm.tvwFile.Nodes.Count
                              frm.tvwFile.Nodes(i).ForeColor = vbBlack
                            Next
                            
                            frm.tvwFile.SelectedItem.ForeColor = vbRed
                            Exit Sub
                        End If
                End If
                
                Set nod_PNext = nod_PNext.Next
            Wend
        Else
            Set nod_PNext = nodCurrent.Next
            While Not nod_PNext Is Nothing
                If nod_PNext.Key = nodCurrent.Key Then
                    MsgBox ("已搜索完整个资料表...")
                    Exit Sub
                End If
                If blnMatch Then
                            If Mid(nod_PNext.Key, 2) = strFind Then
                                frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                                frm.strParent = frm.tvwFile.SelectedItem.Text
                                frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                                Call frm.ShowRecorder(strTable, strField, strHeader)
                                
                                For i = 1 To frm.tvwFile.Nodes.Count
                                  frm.tvwFile.Nodes(i).ForeColor = vbBlack
                                Next
                                frm.tvwFile.SelectedItem.ForeColor = vbRed
                                Exit Sub
                            End If
                Else
                            If InStr(2, nod_PNext.Key, strFind) <> 0 Then
                                frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                                frm.strParent = frm.tvwFile.SelectedItem.Text
                                frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                                Call frm.ShowRecorder(strTable, strField, strHeader)
                                For i = 1 To frm.tvwFile.Nodes.Count
                                  frm.tvwFile.Nodes(i).ForeColor = vbBlack
                                Next
                                
                                frm.tvwFile.SelectedItem.ForeColor = vbRed
                                Exit Sub
                            End If
                End If
                Set nod_PNext = nod_PNext.Next
           Wend
           
        End If
        MsgBox ("已搜索完整个资料表...")
        frm.tvwFile.Nodes.Item(nodCurrent.Key).Selected = True
       

    Case 2 '若为用户姓名查找
        If Left(nodCurrent.Key, 1) = "r" Then
            Set nod_CNext = nodCurrent.Next
            While Not nod_CNext Is Nothing
                If blnMatch Then '全字匹配
                    intNo = InStr(1, nod_CNext.Text, "(")
                    If intNo <> 0 Then
                      strParent = Mid(nod_CNext.Text, 1, intNo - 2)
                    End If
                    
                    If strParent = strFind Then
                        frm.tvwFile.Nodes.Item(nod_CNext.Key).Selected = True
                        frm.strParent = frm.tvwFile.SelectedItem.Text
                        For i = 1 To frm.tvwFile.Nodes.Count
                          frm.tvwFile.Nodes(i).ForeColor = vbBlack
                        Next
                        frm.tvwFile.SelectedItem.ForeColor = vbRed
                        frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                        Call frm.ShowRecorder(strTable, strField, strHeader)
                        Exit Sub
                    End If
                Else
                    If InStr(1, nod_CNext.Text, strFind) <> 0 Then
                        frm.tvwFile.Nodes.Item(nod_CNext.Key).Selected = True
                        frm.strParent = frm.tvwFile.SelectedItem.Text
                        frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                        For i = 1 To frm.tvwFile.Nodes.Count
                          frm.tvwFile.Nodes(i).ForeColor = vbBlack
                        Next
                        
                        frm.tvwFile.SelectedItem.ForeColor = vbRed
                        Call frm.ShowRecorder(strTable, strField, strHeader)
                        Exit Sub
                    End If
                End If
                Set nod_CNext = nod_CNext.Next
            Wend
            Set nod_PNext = nodCurrent.Next
        End If

        If blnRound Then '回绕
            If Left(nodCurrent.Key, 1) = "r" Then
               Set nod_PNext = nodCurrent.FirstSibling
            End If
            While Not nod_PNext Is Nothing
                If nod_PNext.Key = nodCurrent.Key Then
                    MsgBox ("已搜索完整个资料表...")
                    Exit Sub
                End If
                If blnMatch Then '全字匹配
                        intNo = InStr(1, nod_PNext.Text, "(")
                        If intNo <> 0 Then
                          strParent = Mid(nod_PNext.Text, 1, intNo - 2)
                        End If
                        
                        If strParent = strFind Then
                            frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                            frm.strParent = frm.tvwFile.SelectedItem.Text
                            frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                            Call frm.ShowRecorder(strTable, strField, strHeader)
                            For i = 1 To frm.tvwFile.Nodes.Count
                              frm.tvwFile.Nodes(i).ForeColor = vbBlack
                            Next
                            frm.tvwFile.SelectedItem.ForeColor = vbRed
                            Exit Sub
                        End If
                Else
                        If InStr(1, nod_PNext.Text, strFind) <> 0 Then
                            frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                            frm.strParent = frm.tvwFile.SelectedItem.Text
                            frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                            Call frm.ShowRecorder(strTable, strField, strHeader)
                            For i = 1 To frm.tvwFile.Nodes.Count
                              frm.tvwFile.Nodes(i).ForeColor = vbBlack
                            Next
                            frm.tvwFile.SelectedItem.ForeColor = vbRed
                            Exit Sub
                        End If
                End If
                
                Set nod_PNext = nod_PNext.Next
            Wend
        Else
            Set nod_PNext = nodCurrent.Next
            While Not nod_PNext Is Nothing
                If nod_PNext.Key = nodCurrent.Key Then
                    MsgBox ("已搜索完整个资料表...")
                    Exit Sub
                End If
                If blnMatch Then
                            If Mid(nod_PNext.Key, 2) = strFind Then
                                frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                                frm.strParent = frm.tvwFile.SelectedItem.Text
                                frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                                Call frm.ShowRecorder(strTable, strField, strHeader)
                                For i = 1 To frm.tvwFile.Nodes.Count
                                  frm.tvwFile.Nodes(i).ForeColor = vbBlack
                                Next
                                frm.tvwFile.SelectedItem.ForeColor = vbRed
                                Exit Sub
                            End If
                Else
                            If InStr(2, nod_PNext.Key, strFind) <> 0 Then
                                frm.tvwFile.Nodes.Item(nod_PNext.Key).Selected = True
                                frm.strParent = frm.tvwFile.SelectedItem.Text
                                frm.strParentNo = Mid(frm.tvwFile.SelectedItem.Key, 2)
                                Call frm.ShowRecorder(strTable, strField, strHeader)
                                For i = 1 To frm.tvwFile.Nodes.Count
                                  frm.tvwFile.Nodes(i).ForeColor = vbBlack
                                Next
                                frm.tvwFile.SelectedItem.ForeColor = vbRed
                                Exit Sub
                            End If
                End If
                Set nod_PNext = nod_PNext.Next
           Wend
           
        End If
        MsgBox ("已搜索完整个资料表...")
        frm.tvwFile.Nodes.Item(nodCurrent.Key).Selected = True

   
    End Select
    Exit Sub
    
FindErr:
    MsgBox "请将光标焦点置于树型视图内！", vbInformation
    
End Sub


'回车后自动换行
Public Sub EnterToTab(KeyAscii As Integer, Optional blnSelectText As Boolean)
    KeyAscii = 0
    SendKeys "{TAB}"
    If blnSelectText Then SendKeys "{Home}+{End}"
End Sub

' 在注册表保存最近信息
Public Function SaveLastInfo(ByVal strPrePath As String, ByVal strKey As String, ByVal strVal As String)
    Dim strPath As String, strTemp As String
    
'    strPath = "Software\" & App.CompanyName & "\" & App.ProductName & "\" & strKey
    Call Registry.UpdateKey(HKEY_LOCAL_MACHINE, strPrePath, strKey, strVal)

End Function


' 在注册表读取最近信息
Public Function GetLastInfo(ByVal strPrePath As String, ByVal strKey As String)
    Dim strTemp As String * 500, strPath As String
    Dim intI As Integer
    
    GetLastInfo = ""
    strPath = strPrePath & "\" & strKey

    If Registry.GetKeyValue(HKEY_LOCAL_MACHINE, strPrePath, strKey, strTemp) Then
        intI = InStr(1, strTemp, Chr(0))
    
        If intI > 0 Then
            GetLastInfo = Left(strTemp, intI - 1)
        Else
            GetLastInfo = Trim(strTemp)
        End If
    End If

End Function

'判断一个字符真正的长度
Public Function DBLen(strS As String) As Integer
    DBLen = LenB(StrConv(strS, vbFromUnicode))
End Function