📄 mainform.frm
字号:
'* 功 能:“关于”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_About_Click()
frmAbout.Show vbModal
End Sub
'***********************************************************************
'* 过程名:Menu_AppendNewGroup_Click
'* 功 能:“追加组”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_AppendNewGroup_Click()
AppendNewGroupForm.Show vbModal
End Sub
'***********************************************************************
'* 过程名:Menu_AppendPeople_Click
'* 功 能:“追加人员”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_AppendPeople_Click()
If GetGroupNum() = 0 Then
MsgBox "请先设定分组信息!", vbExclamation Or vbOKOnly, "警告"
Else
EditPeopleForm.Show vbModal
Unload EditPeopleForm
End If
End Sub
'***********************************************************************
'* 过程名:Menu_AppendPeople_Click
'* 功 能:“更改资料”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_editPeople_Click()
'变量定义
Dim nodeKind As Integer '节点类型
Dim peopleId As Long '人员ID
Dim nodeKey As String '节点KEY
Dim groupNodeKey As String '组节点KEY
Dim newPeopleInfo As PeopleInfo '人员信息
Dim iLoop As Integer '循环变量
If GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then
EditPeopleForm.g_peopleId = peopleId
EditPeopleForm.Show vbModal
'更新成功
If EditPeopleForm.g_updateFlag Then
nodeKey = PEOPLEKEYPRE & CStr(peopleId)
'取得人员信息
If GetSinglePeopleInfo(peopleId, newPeopleInfo) Then
groupNodeKey = GROUPKEYPRE & CStr(newPeopleInfo.groupid)
For iLoop = 1 To trvAll.Nodes.Count
If trvAll.Nodes.Item(iLoop).key = nodeKey Then
'判断所属组是否改变
If trvAll.Nodes.Item(iLoop).Parent.key = _
groupNodeKey Then '未改变
trvAll.Nodes.Item(iLoop).Text = _
newPeopleInfo.peopleName
trvAll_Click
Else '改变
trvAll.Nodes.Remove iLoop
RefreshTreeView
End If
End If
Next
End If
End If
'UNLOAD窗口
Unload EditPeopleForm
End If
End Sub
'***********************************************************************
'* 过程名:Menu_GroupManage_Click
'* 功 能:“退出”菜单响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub Menu_Exit_Click()
Unload Me
End Sub
'***********************************************************************
'* 过程名:Menu_GroupManage_Click
'* 功 能:“组管理”菜单响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub Menu_GroupManage_Click()
'“删除组”/“更改组名”菜单可用状态控制
If GetGroupNum() = 0 Then
Menu_RemoveGroup.Enabled = False
Menu_RenameGroup.Enabled = False
Else
Menu_RemoveGroup.Enabled = True
Menu_RenameGroup.Enabled = True
End If
End Sub
'***********************************************************************
'* 过程名:Menu_GroupManage_Click
'* 功 能:“导入像片”菜单响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub Menu_importPhoto_Click()
ImportPhotoForm.Show vbModal
Unload ImportPhotoForm
'刷新像片信息
RefreshCurPeoplePhoto
End Sub
'***********************************************************************
'* 过程名:Menu_People_Click
'* 功 能:“联系人管理”菜单响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub Menu_People_Click()
'变量定义
Dim nodeKind As Integer '节点类型
Dim peopleId As Long '人员ID
'所有子菜单可用控制
If GetGroupNum() = 0 Then
Menu_AppendPeople.Enabled = False
Menu_RemovePeople.Enabled = False
Menu_editPeople.Enabled = False
Menu_importPhoto.Enabled = False
Else
Menu_AppendPeople.Enabled = True
Menu_RemovePeople.Enabled = True
Menu_editPeople.Enabled = True
Menu_importPhoto.Enabled = True
End If
'“删除联系人”\“更改资料”菜单可用状态控制
If GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then
Menu_RemovePeople.Enabled = True
Menu_editPeople.Enabled = True
Menu_importPhoto.Enabled = True
Else
Menu_RemovePeople.Enabled = False
Menu_editPeople.Enabled = False
Menu_importPhoto.Enabled = False
End If
End Sub
'***********************************************************************
'* 过程名:Menu_RemoveGroup_Click
'* 功 能:“删除组”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_RemoveGroup_Click()
'变量定义
Dim selGroupId As Long '当前组ID
Dim curGroupInfo As GroupInfo '当前组信息
'取得当前组的ID
selGroupId = GetCurrentGroupId()
If selGroupId <= 0 Then
MsgBox "没有可删除的组!", vbExclamation Or vbOKOnly, "警告"
Exit Sub
End If
'取得当前组的组名
If Not GetGroupInfo(selGroupId, curGroupInfo) Then
MsgBox "取得当前组名失败!", vbExclamation Or vbOKOnly, "警告"
Exit Sub
End If
If MsgBox("你确信要删除组[" & curGroupInfo.groupName & _
"] 及该组下的所有成员吗?", vbQuestion Or vbYesNo, _
"询问") = vbYes Then
'执行删除
If Not RemoveGroup(curGroupInfo) Then
MsgBox "删除失败!", vbExclamation Or vbOKOnly, "警告"
Else
'删除TREEVIEW中对应组
trvAll.Nodes.Remove _
GetNodeIndex(GROUPKEYPRE, curGroupInfo.groupid)
End If
End If
End Sub
'***********************************************************************
'* 过程名:Menu_RemovePeople_Click
'* 功 能:“删除联系人”菜单响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Menu_RemovePeople_Click()
'变量定义
Dim nodeKind As Integer '节点类型
Dim peopleId As Long '人员ID
If GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then
If MsgBox("您确信要删除联系人[" & _
trvAll.SelectedItem.Text & "]吗?", vbQuestion Or vbYesNo, _
"询问") = vbYes Then
'执行删除
If RemovePeople(peopleId) Then
trvAll.Nodes.Remove trvAll.SelectedItem.index
Else
MsgBox "删除失败!", vbExclamation Or vbOKOnly, "警告"
End If
End If
End If
End Sub
'***********************************************************************
'* 过程名:Menu_RenameGroup_Click
'* 功 能:“更改组名”菜单响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub Menu_RenameGroup_Click()
'定义变量
Dim groupid As Long '当前组ID
Dim curGroupInfo As GroupInfo '组信息
Dim groupNodeKey As String '组节点KEY
Dim iLoop As Integer '循环变量
Dim newGroupInfo As GroupInfo '新组信息
'取得组ID
groupid = GetCurrentGroupId()
'检查是组否存在
If GetGroupInfo(groupid, curGroupInfo) Then
'显示更改窗口
RenameGroupForm.g_groupId = groupid
RenameGroupForm.Show vbModal
'更新成功更新TREEVIEW显示
If RenameGroupForm.g_updateFlag Then
groupNodeKey = GROUPKEYPRE & CStr(groupid)
'取得新组名
If GetGroupInfo(groupid, newGroupInfo) Then
For iLoop = 1 To trvAll.Nodes.Count
If trvAll.Nodes.Item(iLoop).key = groupNodeKey Then
trvAll.Nodes.Item(iLoop).Text = newGroupInfo.groupName
End If
Next
End If
End If
Unload RenameGroupForm
Else
MsgBox "当前状态不能修改组名!", vbExclamation Or vbOKOnly, "警告"
End If
End Sub
'***********************************************************************
'* 过程名:PopMenu_Photo_Click
'* 功 能:图像显示菜单选择事件响应
'* 参 数:
'* 版 本:2005.12.16 颜志军 初版
'***********************************************************************
Private Sub PopMenu_Photo_Click()
'全屏菜单可用状态
If photoIndex >= 0 Then
PopMenu_Photo_FullDsp.Enabled = True
Else
PopMenu_Photo_FullDsp.Enabled = False
End If
End Sub
'***********************************************************************
'* 过程名:PopMenu_Photo_FullDsp_Click
'* 功 能:全屏显示菜单选择事件响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub PopMenu_Photo_FullDsp_Click()
FullScrDspPhotoForm.g_FileName = App.Path & _
"\photo\" & photoArray(photoIndex).photoFile
FullScrDspPhotoForm.Show vbModal
End Sub
'***********************************************************************
'* 过程名:trvAll_Click
'* 功 能:TREEVIEW控件CLICK事件响应
'* 参 数:
'* 版 本:2005.12.14 颜志军 初版
'***********************************************************************
Private Sub trvAll_Click()
'取得选择条目的KEY
Dim key As String
'有选择条目
If Not trvAll.SelectedItem Is Nothing Then
key = trvAll.SelectedItem.key
'判断是组还是人员
If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then
'显示信息
DspPeopleInfo CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))
'显示像片
GetPhotoArray CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))
End If
End If
End Sub
'***********************************************************************
'* 过程名:trvAll_MouseDown
'* 功 能:TREEVIEW控件鼠标DOWN事件响应
'* 参 数:
'* 版 本:2005.12.15 颜志军 初版
'***********************************************************************
Private Sub trvAll_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)
'变量定义
Dim key As String '选择节点的的KEY
'鼠标右键按下弹出菜单
If Button = vbRightButton Then
If trvAll.SelectedItem Is Nothing Then
'无选择的节点弹出添加组操作菜单
PopupMenu Menu_GroupManage
Else
'取得节点KEY
key = trvAll.SelectedItem.key
'判断选择的节点类型
If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员
PopupMenu Menu_People
Else '组
PopupMenu Menu_GroupManage
End If
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -