editpeopleform.frm

群里的通讯录管理 供参考 学习专用 无其他商业意义 源码较为简单

      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "邮编"
         Height          =   180
         Left            =   120
         TabIndex        =   11
         Top             =   960
         Width           =   360
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "地址"
         Height          =   180
         Left            =   120
         TabIndex        =   9
         Top             =   600
         Width           =   360
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "职位"
         Height          =   180
         Left            =   6000
         TabIndex        =   7
         Top             =   240
         Width           =   360
      End
      Begin VB.Label Label4 
         Caption         =   "部门"
         Height          =   255
         Left            =   4080
         TabIndex        =   5
         Top             =   203
         Width           =   375
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "名称"
         Height          =   180
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   360
      End
   End
   Begin VB.Label Label21 
      AutoSize        =   -1  'True
      Caption         =   "所属分组"
      Height          =   180
      Left            =   4560
      TabIndex        =   48
      Top             =   240
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "性别"
      Height          =   180
      Left            =   2280
      TabIndex        =   45
      Top             =   240
      Width           =   360
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "姓名"
      Height          =   180
      Left            =   240
      TabIndex        =   43
      Top             =   240
      Width           =   360
   End
End
Attribute VB_Name = "EditPeopleForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************
'* 文件名： EditPeopleForm.frm
'* 说  明： 编辑人员信息窗口
'* 版  本： 2005.12.14 颜志军 初版
'***********************************************************************

Option Explicit

'***********************************************************************
'模块级变量定义
Public g_peopleId As Long       '人员ID，为0表示新增
Public g_updateFlag As Boolean  '更新状态

'***********************************************************************
'* 函数名：AppendNewPeople
'* 功  能：新增人员
'* 参  数：
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Function AppendNewPeople() As Boolean
    AppendNewPeople = NewPeopleInfoOp(True)
End Function

'***********************************************************************
'* 函数名：UpdatePeople
'* 功  能：更新人员信息
'* 参  数：
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Function UpdatePeople() As Boolean
    UpdatePeople = NewPeopleInfoOp(False)
End Function

'***********************************************************************
'* 函数名：NewPeopleInfoOp
'* 功  能：人员信息操作
'* 参  数：Boolean              true    追加
'*       ：                     false   更新
'* 返回值：Boolean              true    成功
'*       ：                     false   失败
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Function NewPeopleInfoOp(ByVal opkind As Boolean) As Boolean
    '变量定义
    Dim newPeopleInfo As PeopleInfo '人员信息
    
    '构造人员信息
    '基本信息
    newPeopleInfo.peopleName = Trim(txtName)
    If optSex.Item(0).Value Then
        newPeopleInfo.sex = "男"
    Else
        newPeopleInfo.sex = "女"
    End If
    newPeopleInfo.groupid = GetGroupId(Trim(cboGroupList.Text))

    '公司信息
    newPeopleInfo.companyName = Trim(txtCompanyName.Text)
    newPeopleInfo.companyDepartment = Trim(txtDepartMent.Text)
    newPeopleInfo.appointment = Trim(txtAppointment.Text)
    newPeopleInfo.companyAddress = Trim(txtCompanyAddress.Text)
    newPeopleInfo.companyPostcode = Trim(txtCompanyPostcode.Text)
    newPeopleInfo.companyPhone = Trim(txtCompanyPhone.Text)
    newPeopleInfo.companyFax = Trim(txtCompanyFax.Text)
    newPeopleInfo.compnaywebsite = Trim(txtCompnaywebsite.Text)
    '家庭信息
    newPeopleInfo.familyAddress = Trim(txtFamilyAddress.Text)
    newPeopleInfo.familyPostcode = Trim(txtFamilyPostcode.Text)
    newPeopleInfo.familyPhone = Trim(txtFamilyPhone.Text)
    '个人信息
    newPeopleInfo.mobilePhone = Trim(txtMobilePhone.Text)
    newPeopleInfo.homepage = Trim(txtHomePage.Text)
    newPeopleInfo.email = Trim(txtEmail.Text)
    newPeopleInfo.emailbak = Trim(txtEmailbak.Text)
    newPeopleInfo.MSN = Trim(txtMsn.Text)
    newPeopleInfo.QQ = Trim(txtQq.Text)
    newPeopleInfo.QQbak = Trim(txtQqbak.Text)
    '备注
    newPeopleInfo.otherInfo = Trim(txtOtherInfo.Text)
    
    '执行追加
    If opkind Then
        NewPeopleInfoOp = AppendPeople(newPeopleInfo)
    Else
        newPeopleInfo.peopleId = g_peopleId
        NewPeopleInfoOp = UpdatePeopleInfo(newPeopleInfo)
    End If
End Function

'***********************************************************************
'* 函数名：CheckInputData
'* 功  能：检查输入值
'* 参  数：
'* 返回值：Boolean                  true    数据合法
'*       ：                         false   数据不合法
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Function CheckInputData() As Boolean
    '初始化返回值
    CheckInputData = False
    
    '检查姓名
    Dim name As String
    name = Trim(txtName)
    If IsEmpty(name) Or name = "" Then
        MsgBox "请输入姓名！", vbInformation Or vbOKOnly, "提示"
        Exit Function
    End If
    
    CheckInputData = True
End Function

'***********************************************************************
'* 过程名：IniComboxList
'* 功  能：初始化下拉框
'* 参  数：
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub IniComboxList()
    '变量定义
    Dim rs As ADODB.Recordset   '记录集
    
    '取得当前组名
    Set rs = GetGroupRecordset()
    
    '添加下拉项
    If IsObject(rs) Then
        While Not rs.EOF
            cboGroupList.AddItem rs.Fields(1)
            rs.MoveNext
        Wend
        rs.Close
        Set rs = Nothing
    End If
    
    '初始化下拉框当前选择项
    IniComboxCurrentSelect
End Sub

'***********************************************************************
'* 过程名：IniComboxCurrentSelect
'* 功  能：初始化下拉框当前选择项
'* 参  数：
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Sub IniComboxCurrentSelect()
    If cboGroupList.ListCount = 0 Then
        Exit Sub
    End If
    
    '变量定义
    Dim id As Long                  'ID
    Dim curGroupInfo As GroupInfo   '组信息
    
    '当前组ID
    id = MainForm.GetCurrentGroupId()
    
    If id > 0 And GetGroupInfo(id, curGroupInfo) Then
        cboGroupList.Text = curGroupInfo.groupName
    Else
        cboGroupList.ListIndex = 0
    End If
End Sub

'***********************************************************************
'* 函数名：DspPeopleInfo
'* 功  能：新增人员
'* 参  数：Long                         人员ID
'* 版  本：2005.12.15 颜志军 初版
'***********************************************************************
Private Sub DspPeopleInfo(ByVal peopleId As Long)
    '变量定义
    Dim curPeopleInfo As PeopleInfo '人员信息
    Dim curGroupInfo As GroupInfo   '组信息
    
    '取得人员信息
    If GetSinglePeopleInfo(peopleId, curPeopleInfo) Then
        '基本信息
        txtName.Text = curPeopleInfo.peopleName
        If curPeopleInfo.sex = "男" Then
            optSex.Item(0).Value = True
            optSex.Item(1).Value = False
        Else
            optSex.Item(0).Value = False
            optSex.Item(1).Value = True
        End If
        If GetGroupInfo(curPeopleInfo.groupid, curGroupInfo) Then
            cboGroupList.Text = curGroupInfo.groupName
        End If
    
        '公司信息
        txtCompanyName.Text = curPeopleInfo.companyName
        txtDepartMent.Text = curPeopleInfo.companyDepartment
        txtAppointment.Text = curPeopleInfo.appointment
        txtCompanyAddress.Text = curPeopleInfo.companyAddress
        txtCompanyPostcode.Text = curPeopleInfo.companyPostcode
        txtCompanyPhone.Text = curPeopleInfo.companyPhone
        txtCompanyFax.Text = curPeopleInfo.companyFax
        txtCompnaywebsite.Text = curPeopleInfo.compnaywebsite
        '家庭信息
        txtFamilyAddress.Text = curPeopleInfo.familyAddress
        txtFamilyPostcode.Text = curPeopleInfo.familyPostcode
        txtFamilyPhone.Text = curPeopleInfo.familyPhone
        '个人信息
        txtMobilePhone.Text = curPeopleInfo.mobilePhone
        txtHomePage.Text = curPeopleInfo.homepage
        txtEmail.Text = curPeopleInfo.email
        txtEmailbak.Text = curPeopleInfo.emailbak
        txtMsn.Text = curPeopleInfo.MSN
        txtQq.Text = curPeopleInfo.QQ
        txtQqbak.Text = curPeopleInfo.QQbak
        '备注
        txtOtherInfo.Text = curPeopleInfo.otherInfo
    End If
End Sub

'***********************************************************************
'* 过程名：cmdCancle_Click
'* 功  能："放弃"按钮单击事件响应
'* 参  数：
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub cmdCancle_Click()
    Me.Hide
End Sub

'***********************************************************************
'* 过程名：cmdCancle_Click
'* 功  能："确认"按钮单击事件响应
'* 参  数：
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub cmdOK_Click()
    '检查输入数据
    If Not CheckInputData() Then
        Exit Sub
    End If
    
    If g_peopleId > 0 Then    '修改
        If UpdatePeople() Then
            g_updateFlag = True
        Else
            MsgBox "更新人员信息失败！", vbExclamation Or vbOKOnly, "警告"
            Exit Sub
        End If
    Else                    '新增
        If Not AppendNewPeople() Then
            MsgBox "新增人员信息失败！", vbExclamation Or vbOKOnly, "警告"
            Exit Sub
        End If
        MainForm.RefreshTreeView
    End If
    
    '隐藏窗口
    Me.Hide
End Sub

'***********************************************************************
'* 过程名：Form_Load
'* 功  能：窗体LOAD事件响应
'* 参  数：
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Form_Load()
    '初始化下拉框
    IniComboxList
    
    '初始化更新状态
    g_updateFlag = False
    
    If g_peopleId > 0 Then
        DspPeopleInfo g_peopleId
    End If
End Sub

'***********************************************************************
'* 过程名：Form_UnLoad
'* 功  能：窗体UNLOAD事件响应
'* 参  数：
'* 版  本：2005.12.14 颜志军 初版
'***********************************************************************
Private Sub Form_Unload(Cancel As Integer)
    g_peopleId = 0
End Sub