generalfunc.bas

企业客户资源管理系统,相当的不错

Attribute VB_Name = "GeneralFunc"
Public Sub Add_AreaToTree(TreeView1 As TreeView)
  Dim Id As Long
  Dim TmpNode As Node
  Dim CurKey, UpperKey As String
  
  MyArea.Load_Area
  i = 0
  Do While Arr_AreaName(i) <> ""
    '生成地域对应的键，格式为“字母”＋“数字”
    '字母为：全球地域为a，洲为b，国家为c，等等
    '数字为：地域的编号
    CurKey = Chr(Asc("a") + Arr_AreaType(i))
    CurKey = CurKey + Trim(Str(Arr_AreaId(i)))
    '找到上一级节点
    UpperKey = ""
    If Arr_AreaUpper(i) = 0 Then
      UpperKey = "a0"
    Else
      j = 0
      Do While Arr_AreaName(j) <> ""
        If Arr_AreaId(j) = Arr_AreaUpper(i) Then
          UpperKey = Chr(Asc("a") + Arr_AreaType(j))
          UpperKey = UpperKey + Trim(Str(Arr_AreaId(j)))
        End If
        
        j = j + 1
      Loop
    End If
    
    '如果找到上一级地域
    If UpperKey <> "" Then
      If MyArea.HaveSon(Arr_AreaId(i)) = True Then
        Set TmpNode = TreeView1.Nodes.Add(UpperKey, _
              tvwChild, CurKey, Arr_AreaName(i), 1, 3)
          
        TmpNode.ExpandedImage = 2
      Else
        Set TmpNode = TreeView1.Nodes.Add(UpperKey, _
              tvwChild, CurKey, Arr_AreaName(i), 4, 5)
      End If
      
      If FocusAreaName <> "" And Arr_AreaName(i) = FocusAreaName Then
        TmpNode.Selected = True
        FocusKey = CurKey
      End If
      If FocusAreaId > 0 And Arr_AreaId(i) = FocusAreaId Then
        TmpNode.Selected = True
        FocusKey = CurKey
      End If
      If FocusKey <> "" And CurKey = FocusKey Then
        TmpNode.Selected = True
      End If
    End If
    
    i = i + 1
  Loop
End Sub

Public Function In_Single(KeyAscii As Integer) As Boolean
  Dim Ch_Accept_Single(20) As String
  '可以接受的字符数组
  Ch_Accept_Single(0) = "0"
  Ch_Accept_Single(1) = "1"
  Ch_Accept_Single(2) = "2"
  Ch_Accept_Single(3) = "3"
  Ch_Accept_Single(4) = "4"
  Ch_Accept_Single(5) = "5"
  Ch_Accept_Single(6) = "6"
  Ch_Accept_Single(7) = "7"
  Ch_Accept_Single(8) = "8"
  Ch_Accept_Single(9) = "9"
  Ch_Accept_Single(10) = "."
  Ch_Accept_Single(11) = "-"
  Ch_Accept_Single(12) = Chr(8)
  '检查输入字符是否在数组中
  In_Single = False
  For i = 0 To 12
    If Chr(KeyAscii) = Ch_Accept_Single(i) Then
      In_Single = True
    End If
  Next
End Function

Public Function In_Int(KeyAscii As Integer) As Boolean
  Dim Ch_Accept_Int(20) As String
  '可以接受的字符数组
  Ch_Accept_Int(0) = "0"
  Ch_Accept_Int(1) = "1"
  Ch_Accept_Int(2) = "2"
  Ch_Accept_Int(3) = "3"
  Ch_Accept_Int(4) = "4"
  Ch_Accept_Int(5) = "5"
  Ch_Accept_Int(6) = "6"
  Ch_Accept_Int(7) = "7"
  Ch_Accept_Int(8) = "8"
  Ch_Accept_Int(9) = "9"
  Ch_Accept_Int(10) = Chr(8)
  '检查输入字符是否在数组中
  In_Int = False
  For i = 0 To 10
    If Chr(KeyAscii) = Ch_Accept_Int(i) Then
      In_Int = True
    End If
  Next
End Function

Public Function InCombo(ByVal Str As String, _
                         ByVal ComboArea As ComboBox) As Boolean
  i = 0
  Do While i < ComboArea.ListCount
    If ComboArea.List(i) = Trim(Str) Then
      InCombo = True
      Exit Function
    End If
    i = i + 1
  Loop
  MsgBox Str + " 不在列表中，请重新设置"
  InCombo = False
End Function

Public Function Lench(ByVal TmpStr As String) As String
  Lench = LenB(StrConv(TmpStr, vbFromUnicode))
End Function

Public Function TrimStr(ByVal Str As String) As String
  If InStr(Str, Chr(0)) <= 0 Then
    TrimStr = Trim(Str)
  Else
    TrimStr = Trim(Left(Str, InStr(Str, Chr(0)) - 1))
  End If
End Function

Public Function MakeStr(ByVal Str As String) As String
  MakeStr = Trim(Replace(Str, "'", "''"))
End Function

Public Sub EnterTAB(KeyAscii As Integer)
  If KeyAscii = 13 Then '13表示回车键
    SendKeys "{TAB}"    '转换为TAB键
  End If
End Sub