文档来源为:从网络收集整理.word版本可编辑.欢迎下载支持.班级：041212学号：04121134姓名：李春红个人通讯录管理系统一、设计要求对于同学、朋友、同事等会与自己有联系的人员，设计一个数据库管理系统辅助管理各位联系人的信息。
能够按联系人分类、姓名、所在地区等方式查询联系人的情况，实现对联系人的添加、修改、删除、查询、统计、报表打印等功能。
具体功能如下：1、联系人的通讯信息管理：录入、修改、删除、查询有关联系人的电话、邮箱、传真、通讯地址等信息。
2、单位信息管理：对所有联系人所在的单位进行录入、修改、删除，并能按单位查询联系人信息。
3、联系人类别管理：以与自己的关系作为分类方式，对类别进行录入、修改、删除；并能按类别查询联系人信息。
4、建立报表，按类别统计每一类联系人的情况。
二、知识点应用1、建立数据库、数据表2、用向导建立数据窗体，实现对数据表的记录进行定位、添加和删除操作3、建立选择查询、参数查询、统计查询实现查询操作4、用报表向导建立报表三、设计步骤1、建立数据库和数据表1）建立数据库在Access的窗口右侧的“新建文件”对话框中选择“新建/空数据库”，在弹出的“文件新建数据库”对话框中输入数据库的名称――“个人通讯录管理”，确定保存位置，并按下“创建”按钮。
2）建立数据表在“个人通讯录管理”数据库中选择“表”，并单击“新建”。
在数据表视图中输入字段名、选择字段类型、确定字段宽度。
在本案例中需要建立如下三个数据表：ABC3选择“工具/关系”菜单，为三张数据表建立关系。
三张表间的关系为：联系人信息表和单位信息表通过“单位名称”字段关联；联系人信息表和联系人类别表通过类别字段关联。
2、建立数据窗体对数据表记录进行定位、编辑、添加和删除等操作1）用向导建立输入联系人信息的窗体①.在数据库窗口中选择“窗体”项，双击“使用向导创建窗体”，启动“窗体向导”②.单击“表/查询”下拉列表框右侧的箭头，列出所有有效的表或者查询数据源，从中选择“表/联系人基本信息表”。
在“可用字段”列表中会显示出数据表中的所有字段，从中选择需要在新建的窗体中显示的字段，使用中间的按钮将它们移动到“选定的字段”列表中。
单击“下一步”按钮。
③.进行“窗体布局”的设置，这里选择“纵栏表”，单击“下一步”按钮。
④.设置窗体的样式，在对话框右侧的列表框中列出了窗体的样式，选中的样式效果在对话框的左侧显示，这里选择“宣纸”。
⑤.在这一步中可为所创建的窗体设置一个标题，此处输入“录入联系人基本信息”，单击“完成”按钮。
“录入联系人信息”窗体可以对联系人信息进行定位、编辑、添加和删除等操作。
2）建立输入单位信息的窗体用向导快速建立输入单位信息的窗体。
在数据库窗口中选择“窗体”项，单击“新建”按钮，在“新建窗体”对话框中选择“自动创建窗体：纵栏式”，在下方的“请选择该对象的数据来源表或查询”中选择“单位信息表”，此时会打开一个输入单位信息窗体，关闭窗体时系统会提示保存窗体，用此方法可以快速创建一个输入单位信息的窗体。
3）建立输入联系人类别的窗体用向导建立一个表格式的录入联系人类别的窗体，建立的方法同上，不同之处是在“新建窗体”对话框中选择“自动创建窗体：表格式”。
3、查询设计1）建立简单的选择查询建立查询，显示所有类别为“同学”的联系人的主要联系信息（姓名、性别、电话、通讯地址、工作单位等）①.在数据库窗口中选择“查询”，双击“在设计视图中新建查询”，从“显示表”对话框添加以下数据表：联系人通讯录表、联系人类别表。
关闭“显示表”对话框。
②.从查询设计器窗口中的数据源表中双击需要的字段：联系人通讯录中的姓名、性别、所在单位、电话，联系人类别表中的、类别名称。
③.在类别名称列的“条件”下输入“同学”。
④.保存查询为：“同学通讯录”以上就是简单的选择查询的设计步骤，用此方法可建立简单的选择查询，如查询所在地为云南的所有联系人信息等。
2）建立参数查询参数查询是由用户输入查询条件，根据条件显示相应的记录信息。
如：建立查询，由用户输入出联系人所在地，查询出该地所有联系人的信息。
①.在数据库窗口中选择“查询”，双击“在设计视图中新建查询”，从“显示表”对话框添加以下数据表：联系人通讯录表、单位信息表、联系人类别表。
关闭“显示表”对话框。
②.从查询设计器窗口中的数据源表中双击需要的字段。
③.在“所在地”列下的“条件”中输入：[请输入要查询的地区：]当运行此查询时，会弹出一个对话框，在此对话框中输入要查询的地区名称（例如“上海“）则可查询出所有上海的联系人的通讯信息。
3）建立统计查询建立查询按类别统计出联系人的人数。
①.在数据库窗口中选择“查询”，双击“在设计视图中新建查询”，从“显示表”对话框添加以下数据表：联系人通讯录表、联系人类别表。
关闭“显示表”对话框。
②.在数据源表中双击需要的字段，这里选择：联系人类别表.类别名称，联系人通讯录表.编号。
③.选择“视图”菜单中的“总计”命令，将“类别名称”列下的总计设置为“Group By”，将“编号”列下的总计设置为“Count”。
运行此查询时，会按照类别名称分类统计出各类联系人的人数。
以上是各种查询的建立方法，可根据这些方法按照需要建立相关查询。
4、报表设计用向导建立报表的步骤为：①.在数据库窗口中选择“报表”，双击“使用向导创建报表”，弹出“报表向导”对话框。
②.在“表/查询”组合框中选择“表：联系人通讯录表”，在“可用字段”列表中选择需要在报表中打印的字段，双击字段使之移动到“选定的字段”列表中；在“表/查询”组合框中选择“表：联系人类别表”，选择“类别名称”字段。
单击“下一步”按钮。
③.“请确定数据的查看方式”，选择“通过联系人通讯录表”，单击“下一步”按钮。
④.“确定分组级别”，选择“联系人类别表.类别名称”，单击“下一步”按钮。
⑤.“记录的排序次序”，选择按“编号”排序。
⑥.“报表样式”，选择需要的报表样式，这里选择“正式”。
⑦.为报表确定报表标题：通讯录报表。
单击“完成”按钮，完成报表的创建。
以上即是用向导建立报表的方法，可参照此方法完成所需的报表创建。
四、具体设计1、界面设计界面代码'***********************************************************************'* 文件名： MainForm.frm'* 说明：主窗口'***********************************************************************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 无选择节点'*********************************************************************** Public Function GetCurrentSelectedNode(ByRef nodeKind As Integer, _ByRef id As Long) As Boolean'变量定义Dim key As String '节点KEYIf trvAll.SelectedItem Is Nothing Then'无选择的节点GetCurrentSelectedNode = FalseElse'取得节点KEYkey ='判断选择的节点类型If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员nodeKind = 2id = CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))GetCurrentSelectedNode = TrueElseIf Left(key, Len(GROUPKEYPRE)) = GROUPKEYPRE Then '组nodeKind = 1id = CLng(Mid(key, Len(GROUPKEYPRE) + 1))GetCurrentSelectedNode = TrueElseGetCurrentSelectedNode = FalseEnd IfEnd IfEnd Function'*********************************************************************** '* 函数名：GetCurrentGroupId'* 功能：取得TreeView中的当前选择节点所在组的ID'* 参数：'* 返回值：Long 组ID，失败时为-1'*********************************************************************** Public Function GetCurrentGroupId() As Long'变量定义Dim key As String '节点KEYIf trvAll.SelectedItem Is Nothing Then'无选择的节点GetCurrentGroupId = -1Else'取得节点KEYkey ='判断选择的节点类型If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员'取父节点KEYkey =End If'取得组节点IDIf Left(key, Len(GROUPKEYPRE)) = GROUPKEYPRE ThenGetCurrentGroupId = Mid(key, Len(GROUPKEYPRE) + 1)ElseGetCurrentGroupId = -1End IfEnd IfEnd Function'*********************************************************************** '* 函数名：GetNodeIndex'* 功能：取得TreeView中指定节点的index'* 参数：String NODE节点KEY前缀'* ：Long NODE节点后缀'* 返回值：Long NODE的index，失败时为-1'*********************************************************************** Private Function GetNodeIndex(ByVal keypre As String, ByVal id As Long) '初始化返回值GetNodeIndex = -1'参数检查If IsNull(keypre) Or IsEmpty(keypre) Or keypre = "" _Or id <= 0 ThenExit FunctionEnd If'定义变量Dim nodeKey As String 'NODE KEYDim iLoop As Integer '循环变量'生成NODE KEYnodeKey = keypre & CStr(id)'查找节点For iLoop = 1 ToIf trvAll.Nodes(iLoop).key = nodeKey ThenGetNodeIndex = iLoopExit ForEnd IfNextEnd Function'*********************************************************************** '* 过程名：IniGroupInTreeView'* 功能：初始化TreeView中的组信息'* 参数：'*********************************************************************** Private Sub IniGroupInTreeView()'变量定义Dim rs As ADODB.Recordset '记录集Dim currentNode As Node '当前组节点'取得组信息记录集Set rs = GetGroupRecordset()'添加组If IsObject(rs) ThenWhile Not rs.EOFSet currentNode = , tvwLast, _GROUPKEYPRE & rs("groupid"), rs("groupname"))'添加组成员IniPeopleInGroup rs("groupid"), currentNode.indexrs.MoveNextWendrs.CloseSet rs = NothingEnd IfEnd Sub'*********************************************************************** '* 过程名：IniPeopleInGroup'* 功能：初始化组成员信息'* 参数：Long 组ID'* ：Integer 组节点index'*********************************************************************** Private Sub IniPeopleInGroup(ByVal groupkey As Long, _ByVal index As Integer)'变量定义Dim rs As ADODB.Recordset '记录集'取得指定组成员信息Set rs = GetGroupMember(groupkey)'添加组成员If IsObject(rs) ThenWhile Not rs.EOFindex, tvwChild, PEOPLEKEYPRE & _CStr(rs("peopleId")), rs("peopleName")rs.MoveNextWendrs.CloseSet rs = NothingEnd IfEnd Sub'*********************************************************************** '* 过程名：IniTreeView'* 功能：初始化TreeView'*********************************************************************** Private Sub IniTreeView()IniGroupInTreeViewEnd Sub'*********************************************************************** '* 过程名：RefreshGroupInTreeView'* 功能：刷新TreeView中的组信息'* 参数：'*********************************************************************** Private Sub RefreshGroupInTreeView()'变量定义Dim rs As ADODB.Recordset '记录集Dim currentNode As Node '当前组节点Dim nodeKey As String '节点KEYDim iLoop As Integer '循环变量Dim existFlag As Boolean '已存在标志Dim nodeindex As Integer '节点index'取得组信息记录集Set rs = GetGroupRecordset()'添加组If IsObject(rs) ThenWhile Not rs.EOF'查找节点是否已存在nodeKey = GROUPKEYPRE & rs("groupid")existFlag = FalseFor iLoop = 1 ToIf = nodeKey Thennodeindex = iLoopexistFlag = TrueExit ForEnd IfNextIf existFlag Then '组已存在,刷新组成员RefreshPeopleInGroup rs("groupid"), nodeindexElse '组不存在，追加新组Set currentNode = , tvwLast, _GROUPKEYPRE & rs("groupid"), rs("groupname"))currentNode.Selected = True'添加组成员IniPeopleInGroup rs("groupid"), currentNode.indexEnd Ifrs.MoveNextWendrs.CloseSet rs = NothingEnd IfEnd Sub'*********************************************************************** '* 过程名：RefreshPeopleInGroup'* 功能：初始化组成员信息'* 参数：Long 组ID'* ：Integer 组节点index'*********************************************************************** Private Sub RefreshPeopleInGroup(ByVal groupkey As Long, _ByVal index As Integer)'变量定义Dim rs As ADODB.Recordset '记录集Dim iLoop As Integer '循环变量Dim existFlag As Boolean '存在标志Dim curNode As Node '节点Dim nodeKey As String '节点KEY'取得指定组成员信息Set rs = GetGroupMember(groupkey)'添加组成员If IsObject(rs) ThenWhile Not rs.EOF'查找是否已存在nodeKey = PEOPLEKEYPRE & CStr(rs("peopleId"))existFlag = FalseIf ThenSet curNode =Do While Not curNode Is NothingIf curNode.key = nodeKey ThenexistFlag = TrueExit DoEnd IfSet curNode = curNode.NextLoopEnd IfIf Not existFlag ThenSet curNode = , tvwChild, PEOPLEKEYPRE & _CStr(rs("peopleId")), rs("peopleName"))curNode.Selected = TrueEnd Ifrs.MoveNextWendrs.CloseSet rs = NothingEnd IfEnd Sub'*********************************************************************** '* 过程名：RefreshTreeView'* 功能：刷新TreeView'* 参数：'*********************************************************************** Public Sub RefreshTreeView()RefreshGroupInTreeViewtrvAll_ClickEnd Sub'*********************************************************************** '* 过程名：RefreshCurPeoplePhoto'* 功能：刷新当前联系人像片信息'* 参数：'*********************************************************************** Public Sub RefreshCurPeoplePhoto()'取得选择条目的KEYDim key As String'有选择条目If Not trvAll.SelectedItem Is Nothing Thenkey ='判断是组还是人员If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then'取得像片信息GetPhotoArray CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))End IfEnd IfEnd Sub'*********************************************************************** '* 过程名：DspPeopleInfo'* 功能：显示人员信息'* 参数：Long 联系人ID'***********************************************************************Private Sub DspPeopleInfo(ByVal peopleId As Long)'变量定义Dim currentPeopleInfo As PeopleInfo '人员信息'取得信息If GetSinglePeopleInfo(peopleId, currentPeopleInfo) Then'显示信息'基本信息lblName.Caption = currentPeopleInfo.peopleNamelblSex.Caption = currentPeopleInfo.sex'公司信息lblCompanyName.Caption = panyNamelblCompanyDepartment.Caption = panyDepartment lblApointMent.Caption = currentPeopleInfo.appointmentlblCompanyAddress.Caption = panyAddresslblCompanyPostCode.Caption = panyPostcodelblCompanyPhone.Caption = panyPhonelblCompanyFax.Caption = panyFaxlblCompanyWebsite.Caption = pnaywebsite'家庭信息lblFamilyAddress.Caption = currentPeopleInfo.familyAddresslblFamilyPostcode.Caption = currentPeopleInfo.familyPostcodelblFamilyPhone.Caption = currentPeopleInfo.familyPhone'人个信息lblMobilePhone.Caption = currentPeopleInfo.mobilePhonelblHomepage.Caption = currentPeopleInfo.homepagelblEmail.Caption = currentPeopleInfo.emaillblEmailbak.Caption = currentPeopleInfo.emailbaklblMSN.Caption = currentPeopleInfo.MSNlblQQ.Caption = currentPeopleInfo.QQlblQQbak.Caption = currentPeopleInfo.QQbak'备注txtOtherInfo.Text = currentPeopleInfo.otherInfoEnd IfEnd Sub'*********************************************************************** '* 过程名：GetPhotoArray'* 功能：取得当前联系人像片信息'* 参数：Long 联系人ID'*********************************************************************** Private Sub GetPhotoArray(ByVal peopleId As Long)'清除此前数组中内容Erase photoArray'清除显示的像片ImagePhoto.Picture = LoadPicturephotoIndex = -1'取得当前联系人像片信息If GetPeoplePhoto(peopleId, photoArray) ThenIf SafeArrayGetDim(photoArray) > 0 ThenIf UBound(photoArray) > 0 ThenDspPhoto ImagePhoto, App.Path & _"\photo\" & photoArray(0).photoFilephotoIndex = 0End IfEnd IfEnd If'改变按钮可用状态SetPhotoButtonEnableEnd Sub'*********************************************************************** '* 过程名：SetPhotoButtonEnable'* 功能：像片按钮可用状态设定'* 参数：'*********************************************************************** Private Sub SetPhotoButtonEnable()'变量定义Dim photoNum As Integer '像片数量'取得像片数量If SafeArrayGetDim(photoArray) > 0 ThenphotoNum = UBound(photoArray)ElsephotoNum = 0End If'可用状态设定If photoNum <= 1 Then'上下按钮均不可用cmdPre.Enabled = FalsecmdNext.Enabled = FalseElsecmdPre.Enabled = TruecmdNext.Enabled = TrueIf photoIndex = 0 ThencmdPre.Enabled = FalseEnd IfIf photoIndex = photoNum - 1 ThencmdNext.Enabled = FalseEnd IfEnd IfEnd Sub'*********************************************************************** '* 过程名：cmdPre_Click'* 功能：下一张像片按钮事件响应'*********************************************************************** Private Sub cmdNext_Click()'变量定义Dim photoNum As Integer '像片数量'取得像片数量If SafeArrayGetDim(photoArray) > 0 ThenphotoNum = UBound(photoArray)ElsephotoNum = 0End If'显示像片If photoNum > 0 And photoIndex < photoNum - 1 ThenphotoIndex = photoIndex + 1DspPhoto ImagePhoto, App.Path & _"\photo\" & photoArray(photoIndex).photoFileEnd If'改变按钮可用状态SetPhotoButtonEnableEnd Sub'*********************************************************************** '* 过程名：cmdPre_Click'* 功能：上一张像片按钮事件响应'* 参数：'*********************************************************************** Private Sub cmdPre_Click()'变量定义Dim photoNum As Integer '像片数量'取得像片数量If SafeArrayGetDim(photoArray) > 0 ThenphotoNum = UBound(photoArray)ElsephotoNum = 0End If'显示像片If photoNum > 0 And photoIndex > 0 ThenphotoIndex = photoIndex - 1DspPhoto ImagePhoto, App.Path & _"\photo\" & photoArray(photoIndex).photoFileEnd If'改变按钮可用状态SetPhotoButtonEnableEnd Sub'*********************************************************************** '* 过程名：Form_Load'* 功能：窗体LOAD事件响应'* 参数：'*********************************************************************** Private Sub Form_Load()'初始化TREEVIEWIniTreeView'设定像片更换按钮可用状态SetPhotoButtonEnable'当前像片INDEXphotoIndex = -1End Sub'*********************************************************************** '* 过程名：Form_Unload'* 功能：窗体UnLOAD事件响应'* 参数：'*********************************************************************** Private Sub Form_Unload(Cancel As Integer)'关闭数据库连接CloseDbConnEnd Sub'*********************************************************************** '* 过程名：ImagePhoto_MouseDown'* 功能：图片显示控件鼠标DOWN事件响应'* 参数：'*********************************************************************** Private Sub ImagePhoto_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single)'鼠标右键按下弹出菜单If Button = vbRightButton ThenPopupMenu PopMenu_PhotoEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_AppendNewGroup_Click'* 功能：“关于”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_About_Click()frmAbout.Show vbModalEnd Sub'***********************************************************************'* 过程名：Menu_AppendNewGroup_Click'* 功能：“追加组”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_AppendNewGroup_Click()AppendNewGroupForm.Show vbModalEnd Sub'*********************************************************************** '* 过程名：Menu_AppendPeople_Click'* 功能：“追加人员”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_AppendPeople_Click()If GetGroupNum() = 0 ThenMsgBox "请先设定分组信息！", vbExclamation Or vbOKOnly, "警告" ElseEditPeopleForm.Show vbModalUnload EditPeopleFormEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_AppendPeople_Click'* 功能：“更改资料”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_editPeople_Click()'变量定义Dim nodeKind As Integer '节点类型Dim peopleId As Long '人员IDDim nodeKey As String '节点KEYDim groupNodeKey As String '组节点KEYDim newPeopleInfo As PeopleInfo '人员信息Dim iLoop As Integer '循环变量If GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then EditPeopleForm.g_peopleId = peopleIdEditPeopleForm.Show vbModal'更新成功If EditPeopleForm.g_updateFlag ThennodeKey = PEOPLEKEYPRE & CStr(peopleId)'取得人员信息If GetSinglePeopleInfo(peopleId, newPeopleInfo) ThengroupNodeKey = GROUPKEYPRE & CStr(newPeopleInfo.groupid) For iLoop = 1 ToIf = nodeKey Then'判断所属组是否改变If = _groupNodeKey Then '未改变= _newPeopleInfo.peopleNametrvAll_ClickElse '改变iLoopRefreshTreeViewEnd IfEnd IfNextEnd IfEnd If'UNLOAD窗口Unload EditPeopleFormEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_GroupManage_Click'* 功能：“退出”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_Exit_Click()Unload MeEnd Sub'*********************************************************************** '* 过程名：Menu_GroupManage_Click'* 功能：“组管理”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_GroupManage_Click()'“删除组”/“更改组名”菜单可用状态控制If GetGroupNum() = 0 ThenMenu_RemoveGroup.Enabled = FalseMenu_RenameGroup.Enabled = FalseElseMenu_RemoveGroup.Enabled = TrueMenu_RenameGroup.Enabled = TrueEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_GroupManage_Click'* 功能：“导入像片”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_importPhoto_Click()ImportPhotoForm.Show vbModalUnload ImportPhotoForm'刷新像片信息RefreshCurPeoplePhotoEnd Sub'*********************************************************************** '* 过程名：Menu_People_Click'* 功能：“联系人管理”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_People_Click()'变量定义Dim nodeKind As Integer '节点类型Dim peopleId As Long '人员ID'所有子菜单可用控制If GetGroupNum() = 0 ThenMenu_AppendPeople.Enabled = FalseMenu_RemovePeople.Enabled = FalseMenu_editPeople.Enabled = FalseMenu_importPhoto.Enabled = FalseElseMenu_AppendPeople.Enabled = TrueMenu_RemovePeople.Enabled = TrueMenu_editPeople.Enabled = TrueMenu_importPhoto.Enabled = TrueEnd If'“删除联系人”\“更改资料”菜单可用状态控制If GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then Menu_RemovePeople.Enabled = TrueMenu_editPeople.Enabled = TrueMenu_importPhoto.Enabled = TrueElseMenu_RemovePeople.Enabled = FalseMenu_editPeople.Enabled = FalseMenu_importPhoto.Enabled = FalseEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_RemoveGroup_Click'* 功能：“删除组”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_RemoveGroup_Click()'变量定义Dim selGroupId As Long '当前组IDDim curGroupInfo As GroupInfo '当前组信息'取得当前组的IDselGroupId = GetCurrentGroupId()If selGroupId <= 0 ThenMsgBox "没有可删除的组！", vbExclamation Or vbOKOnly, "警告"Exit SubEnd If'取得当前组的组名If Not GetGroupInfo(selGroupId, curGroupInfo) ThenMsgBox "取得当前组名失败！", vbExclamation Or vbOKOnly, "警告" Exit SubEnd IfIf MsgBox("你确信要删除组[" & curGroupInfo.groupName & _"] 及该组下的所有成员吗？", vbQuestion Or vbYesNo, _"询问") = vbYes Then'执行删除If Not RemoveGroup(curGroupInfo) ThenMsgBox "删除失败！", vbExclamation Or vbOKOnly, "警告"Else'删除TREEVIEW中对应组_GetNodeIndex(GROUPKEYPRE, curGroupInfo.groupid)End IfEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_RemovePeople_Click'* 功能：“删除联系人”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_RemovePeople_Click()'变量定义Dim nodeKind As Integer '节点类型Dim peopleId As Long '人员IDIf GetCurrentSelectedNode(nodeKind, peopleId) And nodeKind = 2 Then If MsgBox("您确信要删除联系人[" & _& "]吗？", vbQuestion Or vbYesNo, _"询问") = vbYes Then'执行删除If RemovePeople(peopleId) ThenElseMsgBox "删除失败！", vbExclamation Or vbOKOnly, "警告"End IfEnd IfEnd IfEnd Sub'*********************************************************************** '* 过程名：Menu_RenameGroup_Click'* 功能：“更改组名”菜单响应'* 参数：'*********************************************************************** Private Sub Menu_RenameGroup_Click()'定义变量Dim groupid As Long '当前组IDDim curGroupInfo As GroupInfo '组信息Dim groupNodeKey As String '组节点KEYDim iLoop As Integer '循环变量Dim newGroupInfo As GroupInfo '新组信息'取得组IDgroupid = GetCurrentGroupId()'检查是组否存在If GetGroupInfo(groupid, curGroupInfo) Then'显示更改窗口RenameGroupForm.g_groupId = groupidRenameGroupForm.Show vbModal'更新成功更新TREEVIEW显示If RenameGroupForm.g_updateFlag ThengroupNodeKey = GROUPKEYPRE & CStr(groupid)'取得新组名If GetGroupInfo(groupid, newGroupInfo) ThenFor iLoop = 1 ToIf = groupNodeKey Then= newGroupInfo.groupNameEnd IfNextEnd IfEnd IfUnload RenameGroupFormElseMsgBox "当前状态不能修改组名！", vbExclamation Or vbOKOnly, "警告" End IfEnd Sub'*********************************************************************** '* 过程名：PopMenu_Photo_Click'* 功能：图像显示菜单选择事件响应'* 参数：'*********************************************************************** Private Sub PopMenu_Photo_Click()'全屏菜单可用状态If photoIndex >= 0 ThenPopMenu_Photo_FullDsp.Enabled = TrueElsePopMenu_Photo_FullDsp.Enabled = FalseEnd IfEnd Sub'*********************************************************************** '* 过程名：PopMenu_Photo_FullDsp_Click'* 功能：全屏显示菜单选择事件响应'* 参数：'*********************************************************************** Private Sub PopMenu_Photo_FullDsp_Click()FullScrDspPhotoForm.g_FileName = App.Path & _"\photo\" & photoArray(photoIndex).photoFileFullScrDspPhotoForm.Show vbModalEnd Sub'*********************************************************************** '* 过程名：trvAll_Click'* 功能：TREEVIEW控件CLICK事件响应'* 参数：'*********************************************************************** Private Sub trvAll_Click()'取得选择条目的KEYDim key As String'有选择条目If Not trvAll.SelectedItem Is Nothing Thenkey ='判断是组还是人员If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then'显示信息DspPeopleInfo CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))'显示像片GetPhotoArray CLng(Mid(key, Len(PEOPLEKEYPRE) + 1))End IfEnd IfEnd Sub'*********************************************************************** '* 过程名：trvAll_MouseDown'* 功能：TREEVIEW控件鼠标DOWN事件响应'* 参数：'*********************************************************************** Private Sub trvAll_MouseDown(Button As Integer, Shift As Integer, _X As Single, Y As Single)'变量定义Dim key As String '选择节点的的KEY'鼠标右键按下弹出菜单If Button = vbRightButton ThenIf trvAll.SelectedItem Is Nothing Then'无选择的节点弹出添加组操作菜单PopupMenu Menu_GroupManageElse'取得节点KEYkey ='判断选择的节点类型If Left(key, Len(PEOPLEKEYPRE)) = PEOPLEKEYPRE Then '人员PopupMenu Menu_PeopleElse '组PopupMenu Menu_GroupManageEnd IfEnd IfEnd IfEnd Sub'*********************************************************************** '* 文件名： databaseop.frm'* 说明：追加新组窗口'*********************************************************************** Option Explicit'*********************************************************************** '* 函数名：AppendNewGroup'* 功能：追加组信息'* 参数：newgroup 组名'* 返回值：Boolean true 追加成功'* ： false 追加失败'*********************************************************************** Private Function AppendNewGroup(newgroup As String) As Boolean'变量定义Dim newGroupInfo As GroupInfo '组信息'构造组信息newGroupInfo.groupName = newgroup'执行追加操作AppendNewGroup = AppendGroup(newGroupInfo)End Function'***********************************************************************'* 过程名：cmdCancle_Click'* 功能：“放弃”按钮响应'* 参数：'*********************************************************************** Private Sub cmdCancle_Click()Unload MeEnd Sub'*********************************************************************** '* 过程名：cmdOk_Click'* 功能：“确定”按钮响应'* 参数：'*********************************************************************** Private Sub cmdOk_Click()'变量定义Dim newGroupName As String '新组名Dim existFlag As Boolean '组名存在标志'取得用户输入组名newGroupName = txtGroupName.Text'删除首尾空格newGroupName = Trim(newGroupName)'新组名合法性检查If IsEmpty(newGroupName) Or newGroupName = "" ThenlbErrorInfo.Caption = "组名不能为空！"Exit SubEnd If'检查组名是否已经存在existFlag = FalseIf IsExistGroup(newGroupName, existFlag) ThenIf existFlag ThenlbErrorInfo.Caption = "组名已经存在！"Exit SubEnd IfEnd If'追加新组名到数据库If AppendNewGroup(newGroupName) ThenUnload MeMainForm.RefreshTreeViewElselbErrorInfo.Caption = "追加新组失败！"End IfEnd SubPrivate Sub lbErrorInfo_Click()End Sub数据库操作模块：。