frmclient.frm

客户关系管理系统

Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private OK As Boolean               '确定用户按了OK还是CANCEL按钮
Private mvarViewType As gxcViewType '显示类型，即表示当前是添加、查看、修改
Private objClient As CClient        '存储客户信息对象
Private TypeId As Long              '所在客户类型的ID，在新增时记录所添加的客户类别
Private mvarBirthdayWarn As Boolean '标识是否启用生日提醒

'显示类型，即表示当前是添加、查看、修改
Public Property Get ViewType() As gxcViewType
  ViewType = mvarViewType
End Property

'标识是否启用生日提醒
Public Property Get ShowBirthdayWarn() As Boolean
  ShowBirthdayWarn = mvarBirthdayWarn
End Property

Private Sub CancelButton_Click()
  '按了取消按钮
  OK = False
  Me.Hide
End Sub

'新增合作
Private Sub cmdAdd_Click()
  Dim objCoop As CCooperate
  '显示对话框
  If frmAddCoop.RetriveCoop(objCoop, vtadd, objClient.ID) = False Then Exit Sub
  '更新数据库
  If objCoop.AddNew = AddNewOK Then
    AddCooperateToLvw objCoop, lvListView, False
  Else
    MsgBox "错误"
  End If
End Sub

'查看合作
Private Sub cmdCoopInfo_Click()
  Dim objCoop As CCooperate
  '获取选中的合作记录
  If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub
  '显示对话框
  If frmAddCoop.RetriveCoop(objCoop, vtInfo, objClient.ID) = False Then Exit Sub
  '如果转入了修改状态，则更新数据库
  If frmAddCoop.ViewType = vtModify Then
    If objCoop.Update = UpdateOK Then
      AddCooperateToLvw objCoop, lvListView, True
    Else
      MsgBox "错误"
    End If
  End If
End Sub

'删除合作
Private Sub cmdDel_Click()
  If MsgBox("要删除合作？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

  Dim objCoop As CCooperate
  '获取选中的合作记录
  If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub

  '更新数据库
  If objCoop.Delete = DeleteOK Then
    lvListView.ListItems.Remove (lvListView.SelectedItem.Index)
  Else
    MsgBox "错误"
  End If
End Sub

'修改合作
Private Sub cmdModify_Click()
  Dim objCoop As CCooperate
  
  '获取选中的合作记录
  If GetCoopFromControl(lvListView, objCoop) = False Then Exit Sub
  '显示对话框
  If frmAddCoop.RetriveCoop(objCoop, vtModify, objClient.ID) = False Then Exit Sub
  '更新数据库
  If objCoop.Update = UpdateOK Then
    AddCooperateToLvw objCoop, lvListView, True
  Else
    MsgBox "错误"
  End If
End Sub

Private Sub cmdModifyInfo_Click()
  mvarViewType = vtModify
  SetStatus
End Sub

Private Sub dtpBirthday_Change()
  txtAge.Text = Year(Date) - dtpBirthday.Year
End Sub

Private Sub lvListView_DblClick()
    cmdCoopInfo_Click
End Sub

Private Sub OKButton_Click()
  If mvarViewType = vtInfo Then
    Me.Hide
    Exit Sub
  End If
  
  If CheckValid() = False Then
    Exit Sub
  End If
  OK = True
  
  '如果是新增状态，则新建立一个“人员”对象
  If mvarViewType = vtadd Then Set objClient = New CClient
  
  '给“人员”对象赋值
  SaveValue
  
  
  Me.Hide
  
End Sub

'根据对话框的显示方式来确定显示的数据
Private Sub SetStatus()
  Dim ctl As Control
  Dim intBorderStyle As Integer
  Dim lngbkColor As Long
  Dim boolLocked As Boolean
  
  '默认的文本框风格设置
  intBorderStyle = 1  '3D
  lngbkColor = &H80000009
  boolLocked = False
  OKButton.Visible = True
  CancelButton.Caption = "取消"
  
  cmdModifyInfo.Visible = False

  SetDefaultValue
  
  Select Case mvarViewType
  Case vtadd    '添加客户
    '操作按钮可用性设置
    cmdModify.Enabled = False
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    cmdCoopInfo.Enabled = False
    
    OKButton.Caption = "确定"
    Me.Caption = "添加客户"
  Case vtModify '修改客户信息
    OKButton.Caption = "保存"
    Me.Caption = "修改客户信息"
  Case vtInfo   '查看客户信息
    '只读的文本框风格设置
    intBorderStyle = 0  '3D
    lngbkColor = &H8000000F
    boolLocked = True

    cmdModifyInfo.Visible = True
    OKButton.Visible = False
    CancelButton.Caption = "关闭"
    Me.Caption = "查看客户信息"
  Case Else
  End Select
  
  '根据显示状态不同设置文本框风格
  For Each ctl In Controls
    If (TypeOf ctl Is TextBox) Then
      ctl.BorderStyle = intBorderStyle
      ctl.BackColor = lngbkColor
      ctl.Locked = boolLocked
    ElseIf (TypeOf ctl Is ComboBox) Or _
            (TypeOf ctl Is DTPicker) Or _
            (TypeOf ctl Is CheckBox) Or _
            (TypeOf ctl Is Slider) Then
      ctl.Enabled = Not boolLocked
    End If
  Next
  
End Sub

'弹出客户信息管理对话框，初始化对话框数据显示
Public Function RetriveClient(ByRef oClient As CClient, _
                              ByVal eViewType As gxcViewType, _
                              Optional nTypeID As Long = -1) As Boolean
  Set objClient = oClient
  
  If nTypeID = -1 And (Not oClient Is Nothing) Then
    TypeId = oClient.TypeId
  Else
    TypeId = nTypeID
  End If
  mvarViewType = eViewType  '对话框状态
  
  SetStatus '根据新增或编辑状态设置显示内容
  
  OK = False
  Me.Show vbModal
  If OK = False Then Exit Function
  
  '传出对象
  Set oClient = objClient
  RetriveClient = True
  Unload Me
End Function

Private Sub SetDefaultValue()
  Dim ctl As Control
  Dim i As Integer
 
  '添加所有的客户类型到组合框
  AllClientsTypeToCombo cboClientType
  
  For i = 0 To cboClientType.ListCount - 1
    If cboClientType.ItemData(i) = TypeId Then
      cboClientType.ListIndex = i         '客户类型Id
      Exit For
    End If
  Next i
  
  If objClient Is Nothing Then
    For Each ctl In Controls
      If TypeOf ctl Is TextBox Then
        ctl.Text = ""
      End If
    Next
  Else
    With objClient
      txtName.Text = .Name
      cboSex.ListIndex = IIf(.Sex = Male, 0, 1)
      txtMobile.Text = .Mobile
      txtEmail.Text = .Email
      txtName.Text = .Name           '客户名称
      txtAge.Text = .Age                             '客户年龄
      cboSex.ListIndex = IIf(.Sex = Male, 0, 1)          '性别
      txtMobile.Text = .Mobile       '手机
      txtEmail.Text = .Email         'E-mail
      txtOfficePhone.Text = .OfficePhone   '办公室电话
      txtHomePhone.Text = .HomePhone    '宅电
      txtFax.Text = .Fax           '传真
      txtHomeAdr.Text = .HomeAdr      '家庭住址
      txtMailAdr.Text = .MailAdr      '通讯地址
      txtZipCode.Text = .ZipCode      '邮编
      dtpBirthday.Value = .Birthday                          '生日
      chkBirthdayWarn.Value = IIf(.BirthdayWarn, 1, 0)         '是不启用生日提醒
      txtWork.Text = .Work         '职业
      txtPosition.Text = .Position     '职位
      txtCompany.Text = .Company      '公司
      txtCompanySite.Text = .CompanySite  '公司网址
      txtSelfSite.Text = .SelfSite     '个人网址
      txtLikes.Text = .Likes        '喜好
      txtHate.Text = .Hate         '厌恶
      txtRemark.Text = .Remark       '备注
      sldImportance.Value = .Importance  '重要度
      sldFriendly.Value = .Friendly                         '友好度
      sldSatisfaction.Value = .Satisfaction                     '满意度
  
      '显示所有的合作信息
      ListAllCooperates lvListView, .ID
    End With
  End If
  
  
End Sub

Private Function CheckValid() As Boolean
  If txtName.Text = "" Or _
    cboSex.Text = "" Or _
    cboClientType.Text = "" Or _
    txtMobile.Text = "" Or _
    txtEmail.Text = "" Then
      MsgBox "请填写表格中的必填信息", vbOKOnly + vbExclamation
      CheckValid = False
  Else
    CheckValid = True
  End If
End Function

Private Sub SaveValue()
  
  With objClient
    .Name = Trim(txtName.Text)                '客户名称
    .Age = Val(txtAge.Text)                   '客户年龄
    .Sex = IIf(cboSex.ListIndex = 0, Male, Female)            '性别
    .TypeId = cboClientType.ItemData(cboClientType.ListIndex) '客户类型Id
    .Mobile = Trim(txtMobile.Text)            '手机
    .Email = Trim(txtEmail.Text)              'E-mail
    .OfficePhone = Trim(txtOfficePhone.Text)  '办公室电话
    .HomePhone = Trim(txtHomePhone.Text)      '宅电
    .Fax = Trim(txtFax.Text)                  '传真
    .HomeAdr = Trim(txtHomeAdr.Text)          '家庭住址
    .MailAdr = Trim(txtMailAdr.Text)          '通讯地址
    .ZipCode = Trim(txtZipCode.Text)          '邮编
    .Birthday = dtpBirthday.Value             '生日
    .BirthdayWarn = chkBirthdayWarn.Value     '是不启用生日提醒
    .Work = Trim(txtWork.Text)                '职业
    .Position = Trim(txtPosition.Text)        '职位
    .Company = Trim(txtCompany.Text)          '公司
    .CompanySite = Trim(txtCompanySite.Text)  '公司网址
    .SelfSite = Trim(txtSelfSite.Text)        '个人网址
    .Likes = Trim(txtLikes.Text)              '喜好
    .Hate = Trim(txtHate.Text)                '厌恶
    .Remark = Trim(txtRemark.Text)            '备注
    .Importance = sldImportance.Value         '重要度
    .Friendly = sldFriendly.Value             '友好度
    .Satisfaction = sldSatisfaction.Value     '满意度
  End With
  
  mvarBirthdayWarn = IIf(chkBirthdayWarn.Value = 0, False, True)

End Sub

Private Sub txtAge_Change()
  dtpBirthday.Year = Year(Date) - Val(txtAge.Text)
End Sub