📄 mainform.frm
字号:
TabIndex = 11
Top = 270
Width = 360
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "地址"
ForeColor = &H00000080&
Height = 180
Left = 120
TabIndex = 10
Top = 630
Width = 360
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "邮编"
ForeColor = &H00000080&
Height = 180
Left = 120
TabIndex = 9
Top = 990
Width = 360
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "电话"
ForeColor = &H00000080&
Height = 180
Left = 1800
TabIndex = 8
Top = 990
Width = 360
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "传真"
ForeColor = &H00000080&
Height = 180
Left = 3840
TabIndex = 7
Top = 990
Width = 360
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "网址"
ForeColor = &H00000080&
Height = 180
Left = 120
TabIndex = 6
Top = 1350
Width = 360
End
End
Begin MSComctlLib.TreeView trvAll
Height = 7695
Left = 120
TabIndex = 0
Top = 120
Width = 1815
_ExtentX = 3201
_ExtentY = 13573
_Version = 393217
HideSelection = 0 'False
Indentation = 529
LabelEdit = 1
Sorted = -1 'True
FullRowSelect = -1 'True
HotTracking = -1 'True
SingleSel = -1 'True
Appearance = 1
End
Begin VB.Label lblSex
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 255
Left = 4080
TabIndex = 5
Top = 240
Width = 495
End
Begin VB.Label lblName
BeginProperty Font
Name = "隶书"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 2160
TabIndex = 1
Top = 120
Width = 1575
End
Begin VB.Menu Menu_People
Caption = "联系人管理(&P)"
Begin VB.Menu Menu_AppendPeople
Caption = "追加联系人(&A)"
End
Begin VB.Menu Menu_RemovePeople
Caption = "删除联系人(&D)"
End
Begin VB.Menu Menu_editPeople
Caption = "更改资料(&E)"
End
Begin VB.Menu Menu_importPhoto
Caption = "导入像片(&I)"
End
End
Begin VB.Menu Menu_GroupManage
Caption = "组管理(&G)"
Begin VB.Menu Menu_AppendNewGroup
Caption = "追加组(&A)"
End
Begin VB.Menu Menu_RemoveGroup
Caption = "删除组(&D)"
End
Begin VB.Menu Menu_RenameGroup
Caption = "更改组名(&E)"
End
End
Begin VB.Menu Menu_System
Caption = "系统"
Begin VB.Menu Menu_About
Caption = "关于(&A)"
End
Begin VB.Menu Menu_Exit
Caption = "退出(&Q)"
End
End
Begin VB.Menu PopMenu_Photo
Caption = "像片显示弹出菜单"
Visible = 0 'False
Begin VB.Menu PopMenu_Photo_FullDsp
Caption = "全屏显示"
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************
'* 文件名： MainForm.frm
'* 说 明： 主窗口
'* 版 本： 2005.12.14 颜志军 初版
'***********************************************************************
Option Explicit
'***********************************************************************
'模块级常量定义
Const GROUPKEYPRE = "GRROUP" '组KEY前缀
Const PEOPLEKEYPRE = "PEOPLE" '人员KEY前缀
'***********************************************************************
'模块级变量定义
Private photoArray() As PhotoInfo '像片信息动态数组
Private photoIndex As Integer '当前显示像片的对应数组下标
'***********************************************************************
'API声明
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" _
(ByRef saArray() As Any) As Long
'***********************************************************************
'* 函数名：GetCurrentSelectedNode
'* 功 能：取得TreeView中的当前选择节点信息
'* 参 数：Integer(OUT) 1：组节点 2：人员节点
'* ：Long(OUT) 组ID或人员ID
'* 返回值：Boolean true 有选择节点
'* ： false 无选择节点
'* 版 本：2005.12.15 颜志军 初版
'***********************************************************************
Public Function GetCurrentSelectedNode(ByRef nodeKind As Integer, _
ByRef id As Long) As Boolean
'变量定义
Dim key As String '节点KEY
If trvAll.SelectedItem Is Nothing Then
'无选择的节点
GetCurrentSelectedNode = False
Else
'取得节点KEY
key = trvAll.SelectedItem.key
'判断选择的节点类型
If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员
nodeKind = 2
id = CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))
GetCurrentSelectedNode = True
ElseIf Left(key, Len(GROUPKEYPRE)) = GROUPKEYPRE Then '组
nodeKind = 1
id = CLng(Mid(key, Len(GROUPKEYPRE) + 1))
GetCurrentSelectedNode = True
Else
GetCurrentSelectedNode = False
End If
End If
End Function
'***********************************************************************
'* 函数名：GetCurrentGroupId
'* 功 能：取得TreeView中的当前选择节点所在组的ID
'* 参 数：
'* 返回值：Long 组ID，失败时为-1
'* 版 本：2005.12.15 颜志军 初版
'***********************************************************************
Public Function GetCurrentGroupId() As Long
'变量定义
Dim key As String '节点KEY
If trvAll.SelectedItem Is Nothing Then
'无选择的节点
GetCurrentGroupId = -1
Else
'取得节点KEY
key = trvAll.SelectedItem.key
'判断选择的节点类型
If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员
'取父节点KEY
key = trvAll.SelectedItem.Parent.key
End If
'取得组节点ID
If Left(key, Len(GROUPKEYPRE)) = GROUPKEYPRE Then
GetCurrentGroupId = Mid(key, Len(GROUPKEYPRE) + 1)
Else
GetCurrentGroupId = -1
End If
End If
End Function
'***********************************************************************
'* 函数名：GetNodeIndex
'* 功 能：取得TreeView中指定节点的index
'* 参 数：String NODE节点KEY前缀
'* ：Long NODE节点后缀
'* 返回值：Long NODE的index，失败时为-1
'* 版 本：2005.12.15 颜志军 初版
'***********************************************************************
Private Function GetNodeIndex(ByVal keypre As String, ByVal id As Long)
'初始化返回值
GetNodeIndex = -1
'参数检查
If IsNull(keypre) Or IsEmpty(keypre) Or keypre = "" _
Or id <= 0 Then
Exit Function
End If
'定义变量
Dim nodeKey As String 'NODE KEY
Dim iLoop As Integer '循环变量
'生成NODE KEY
nodeKey = keypre & CStr(id)
'查找节点
For iLoop = 1 To trvAll.Nodes.Count
If trvAll.Nodes(iLoop).key = nodeKey Then
GetNodeIndex = iLoop
Exit For
End If
Next
End Function
'***********************************************************************
'* 过程名：IniGroupInTreeView
'* 功 能：初始化TreeView中的组信息
'* 参 数：
'* 版 本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub IniGroupInTreeView()
'变量定义
Dim rs As ADODB.Recordset '记录集
Dim currentNode As Node '当前组节点
'取得组信息记录集
Set rs = GetGroupRecordset()
'添加组
If IsObject(rs) Then
While Not rs.EOF
Set currentNode = trvAll.Nodes.Add(, tvwLast, _
GROUPKEYPRE & rs("groupid"), rs("groupname"))
'添加组成员
IniPeopleInGroup rs("groupid"), currentNode.index
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
End If
End Sub
'***********************************************************************
'* 过程名：IniPeopleInGroup
'* 功 能：初始化组成员信息
'* 参 数：Long 组ID
'* ：Integer 组节点index
'* 版 本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub IniPeopleInGroup(ByVal groupkey As Long, _
ByVal index As Integer)
'变量定义
Dim rs As ADODB.Recordset '记录集
'取得指定组成员信息
Set rs = GetGroupMember(groupkey)
'添加组成员
If IsObject(rs) Then
While Not rs.EOF
trvAll.Nodes.Add index, tvwChild, PEOPLEKEYPRE & _
CStr(rs("peopleId")), rs("peopleName")
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
End If
End Sub
'***********************************************************************
'* 过程名：IniTreeView
'* 功 能：初始化TreeView
'* 参 数：
'* 版 本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub IniTreeView()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -