?? generalfunc.bas
字號:
Attribute VB_Name = "GeneralFunc"
Public Sub Add_DepToTree(TreeView1 As TreeView, _
ByVal TmpKey As String)
Dim Bh As Long
Dim TmpNode As Node
'當前選擇結點的關鍵字
Dim CurKey As String
'臨時數組
Dim TmpArr_DepName() As String
Dim TmpArr_DepId() As Long
ReDim TmpArr_DepName(0)
ReDim TmpArr_DepId(0)
'從關鍵字中讀取當前的部門編號
Bh = Val(Right(TmpKey, Len(TmpKey) - 1))
'獲取當前部門信息
MyDep.GetInfo (Bh)
'讀取當前部門的下一級部門數據
i = 0
Do While Arr_DepName(i) <> ""
ReDim Preserve TmpArr_DepName(i + 1)
TmpArr_DepName(i) = Arr_DepName(i)
ReDim Preserve TmpArr_DepId(i + 1)
TmpArr_DepId(i) = Arr_DepId(i)
i = i + 1
Loop
i = 0
Do While TmpArr_DepName(i) <> ""
'生成部門對應的關鍵字,格式為“字母a”+部門編號
CurKey = "a" + Trim(Str(TmpArr_DepId(i)))
'如果當前部門有下一級部門,則顯示文件夾圖標
If MyDep.HaveSon(TmpArr_DepId(i)) = True Then
Set TmpNode = TreeView1.Nodes.Add(TmpKey, _
tvwChild, CurKey, TmpArr_DepName(i), 1, 3)
TmpNode.ExpandedImage = 2
'否則顯示葉結點圖標
Else
Set TmpNode = TreeView1.Nodes.Add(TmpKey, _
tvwChild, CurKey, TmpArr_DepName(i), 4, 5)
End If
'FocusDepName、FocusDepBh和FocusDepKey分別表示希望選中的部門的名稱、編號和關鍵字
If FocusDepName <> "" And TmpArr_DepName(i) = FocusDepName Then
TmpNode.Selected = True
FocusDepKey = CurKey
End If
If FocusDepBh > 0 And TmpArr_DepId(i) = FocusDepBh Then
TmpNode.Selected = True
FocusDepKey = CurKey
End If
If FocusDepKey <> "" And CurKey = FocusDepKey Then
TmpNode.Selected = True
End If
'以當前部門為參數遞歸調用
Call Add_DepToTree(TreeView1, CurKey)
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 Combo1 As ComboBox) As Boolean
i = 0
Do While i < Combo1.ListCount
If Combo1.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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -