⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.frm

📁 群里的通讯录管理 供参考 学习专用 无其他商业意义 源码较为简单
💻 FRM
📖 第 1 页 / 共 4 页
字号:
'* 功  能:“关于”菜单响应
'* 参  数:
'* 版  本: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 + -