frmmain.frm

客户管理是CRM的基础核心部分

Dim mTDbClient As New clsDataBase                          '定义一个clsDataBase类实例

'=============================属性===================================
'数据库的数据是否更改
Public Property Get DataChanged() As Boolean
    DataChanged = mIsChangedBool
End Property
Public Property Let DataChanged(bValue As Boolean)
    mIsChangedBool = bValue
End Property


'=============================窗口===================================
Private Sub Form_GotFocus()
    'tbToolBar.Visible = True
    Call SizeControls
End Sub

Private Sub Form_Load()
    DataChanged = True
    Call mTDbClient.OpenDB(DB_TABLE_CLIENT)                '打开数据库
    Call init_lstvwClientInfo                              '初始化lvwClientInfo控件
    Call intFind
    ShowRecodeset                                          '显示记录
End Sub


Private Sub Form_Paint()
    Select Case lstvwClientInfo.View
        Case lvwIcon
            tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed
        Case lvwSmallIcon
            tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed
        Case lvwList
            tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed
        Case lvwReport
            tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed
    End Select
End Sub


Private Sub Form_Unload(Cancel As Integer)
    SaveSetting App.Title, "Settings", "ViewMode", lstvwClientInfo.View
    mTDbClient.CloseDB                                     '关闭数据库
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls
End Sub

'=====================================================================
'调整控件的大小位置
Sub SizeControls()
    On Error Resume Next
    lstvwClientInfo.Left = 0
    lstvwClientInfo.Width = Me.Width - 140
    picFind.Top = tbToolBar.Height
    picFind.Left = 0
    picFind.Width = Me.Width
    If tbToolBar.Visible Then
        lstvwClientInfo.Top = picFind.Top + picFind.Height
        lstvwClientInfo.Height = Me.ScaleHeight - 700
    Else
        lstvwClientInfo.Top = 0
        lstvwClientInfo.Height = Me.ScaleHeight - 700 + tbToolBar.Height
    End If
End Sub
'=======================lstvwClientInfo控件===========================
'双击lstvwClientInfo 控件后 显示选种的客户的详细信息
Private Sub lstvwClientInfo_DblClick()
    Dim nSelectIndex As Integer
    If Not (lstvwClientInfo.SelectedItem Is Nothing) Then
        nSelectIndex = lstvwClientInfo.SelectedItem.Index
        Call ShowClientInfo(nSelectIndex, INT_CLIENT_STYLE_READ_ONLY)
    End If
End Sub
'单击lstvwClientInfo 控件后,把当前选种的项目的 索引(index) 赋值到变量mSelectItem
Private Sub lstvwClientInfo_ItemClick(ByVal Item As MSComctlLib.ListItem)
    mSelectItem = Item.Index
End Sub

'显示右键菜单
Private Sub lstvwClientInfo_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim MyMenu As Menu
    If Button = vbRightButton Then
        If lstvwClientInfo.ListItems.Count > 0 Then
            Set MyMenu = mFrmMyMenu.mnuClient
            Call PopupMenu(MyMenu)
        End If
    End If
End Sub
'====================================================================

Private Sub tbClass_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim nIndex As Integer
    nIndex = cmbClass.ListIndex
    If nIndex > 0 Then
        Call mTDbClient.FilterField(gClientTitleArryStr(INT_CLIENT_TITLE_PROPERTY), cmbClass.List(nIndex), "=")    '过滤
    Else
        Call mTDbClient.CancelFilter
    End If
    Call ShowRecodeset
End Sub

'查找一个客户
Private Sub TbrFind_ButtonClick(ByVal Button As MSComctlLib.Button)
    Call FindClient
End Sub

'工具条
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "向前"
            '应做:添加 '向前' 按钮代码。
            MsgBox "添加 '向前' 按钮代码。"
        Case "返回"
            '应做:添加 '返回' 按钮代码。
            MsgBox "添加 '返回' 按钮代码。"
        Case "新建"
            Call ShowClientInfo(mSelectItem, INT_CLIENT_STYLE_NEW)
        Case "修改"
            Call ShowClientInfo(mSelectItem, INT_CLIENT_STYLE_EDIT)
        Case "删除"
            Call DeleteClient(mSelectItem)
        Case "属性"
            Call ShowClientInfo(mSelectItem, INT_CLIENT_STYLE_READ_ONLY)
        Case "刷新"
            Call ReFlashListView
        Case "大图标"
            lstvwClientInfo.View = lvwIcon
        Case "小图标"
            lstvwClientInfo.View = lvwSmallIcon
        Case "列表"
            lstvwClientInfo.View = lvwList
        Case "详细资料"
            lstvwClientInfo.View = lvwReport
    End Select
End Sub
'=====================菜单=============================
Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, gMainMDIForm
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
    Call SizeControls
End Sub


Private Sub mnuFileClose_Click()
    '卸载窗体
    Unload Me
End Sub
'=========================================================

'=============================自定义函数==============================================
'初始化lvwClientInfo控件
Private Function init_lstvwClientInfo()
    lstvwClientInfo.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    Dim i As Integer
    For i = 0 To INT_CLIENT_TITLE_COUNT_NUMBER - 1
        DoEvents
        lstvwClientInfo.ColumnHeaders.Add , , gClientTitleArryStr(i)
    Next i

End Function
'***********************************************************************************
'功能：把 数据库的记录在lstvwClientInfo（LISTVIEW控件）上显示出来
'参数：无
'返回：无
'***********************************************************************************
Private Function ShowRecodeset()
    Dim i As Integer, nRs As Integer, nRsCount As Integer, strHeader As String
    Dim lvwFirst As ListItem, strValue As String
    lstvwClientInfo.ListItems.Clear
    nRsCount = mTDbClient.GetRecordCount
    If nRsCount > 0 Then
        For nRs = 1 To nRsCount
            DoEvents
            For i = 1 To INT_CLIENT_TITLE_COUNT_NUMBER
                DoEvents
                strHeader = lstvwClientInfo.ColumnHeaders.Item(i).Text
                strValue = mTDbClient.GetRecord(strHeader)
                If i = 1 Then
                    Set lvwFirst = lstvwClientInfo.ListItems.Add(, , strValue)
                Else
                    lvwFirst.SubItems(i - 1) = strValue
                End If
            Next i
            mTDbClient.MoveNext
        Next nRs
    End If
    If lstvwClientInfo.ListItems.Count > 0 Then
        lstvwClientInfo.ListItems(1).Selected = True
        mSelectItem = 1
    Else
        mSelectItem = 0
    End If
    DataChanged = False
End Function
'********************************************************************
'功能:把lstvwClientInfo控件的各项目 格式化成clsClient 类
'参数:nIndex lstvwClientInfo的项目索引
'返回值:格式化后的 clsClient 类
'********************************************************************
Private Function FormatListViewItemToTClient(nIndex As Integer) As clsClient
    Dim TMyClient As New clsClient, i As Integer
    If nIndex < 0 Or nIndex > INT_CLIENT_TITLE_COUNT_NUMBER Then
        Set FormatListViewItemToTClient = Nothing
        Set TMyClient = Nothing
        Debug.Print "FormatListViewItemToTClient函数参数不正确"
        Exit Function
    End If
    For i = 0 To INT_CLIENT_TITLE_COUNT_NUMBER - 1
        DoEvents
        If i = 0 Then
            TMyClient.MyProperty(i) = lstvwClientInfo.ListItems(nIndex).Text
        Else
            TMyClient.MyProperty(i) = lstvwClientInfo.ListItems(nIndex).SubItems(i)
        End If
    Next i
    Set FormatListViewItemToTClient = TMyClient
End Function
'********************************************************************
'功能:显示客户详细信息
'参数:nIndex 为lstvwClientInfo的项目索引,nType 为 显示信息的模式
'为以下的值之一:
'INT_CLIENT_STYLE_READ_ONLY ,INT_CLIENT_STYLE_EDIT ,INT_CLIENT_STYLE_NEW
'返回值:
'********************************************************************
Friend Function ShowClientInfo(nIndex As Integer, nType As Integer)
    Dim TMycliet As clsClient
    Dim nCount As Integer
    If nIndex < 0 Then nIndex = mSelectItem
    nCount = lstvwClientInfo.ListItems.Count
    If (nCount > 0 And nIndex >= 0 And nIndex <= nCount) Or nType = INT_CLIENT_STYLE_NEW Then
        Select Case nType
            Case INT_CLIENT_STYLE_READ_ONLY
                Set TMycliet = FormatListViewItemToTClient(nIndex)
                mTDbClient.Move (nIndex)
            Case INT_CLIENT_STYLE_EDIT
                Set TMycliet = FormatListViewItemToTClient(nIndex)
                mTDbClient.Move (nIndex)
            Case INT_CLIENT_STYLE_NEW
                Set TMycliet = New clsClient
                mTDbClient.AddNew
                TMycliet.RegisterDate = Date
                TMycliet.Auditing = False
        End Select
        Call ShowInfoForm(TMycliet, nType)
    End If
End Function
'********************************************************************
'功能:弹出 frmClientInfo 窗口,并设置该窗口的显示模式
'参数:TClient 为 客户类 ,nType 为 显示信息的模式
'为以下的值之一:
'INT_CLIENT_STYLE_READ_ONLY ,INT_CLIENT_STYLE_EDIT ,INT_CLIENT_STYLE_NEW
'返回值:无
'********************************************************************
Private Function ShowInfoForm(TClient As clsClient, nType As Integer)
    Dim mFrmClientInfo As New frmClientInfo
    mFrmClientInfo.Style = nType
    mFrmClientInfo.TClient = TClient
    mFrmClientInfo.Show vbModal, gMainMDIForm
    '如果模式是新建 而且 数据没有变化
    If TClient.IsChangedDate = True Then
        Call SaveTClientToDataBase(TClient)
        TClient.IsChangedDate = False
        DataChanged = True
    End If
    If DataChanged = False And nType = INT_CLIENT_STYLE_NEW Then
        mTDbClient.CancelUpdate
    End If
    Call ReShowClient                                      '刷新显示
End Function
'********************************************************************
'功能:删除一个客户
'参数:nIndex 为lstvwClientInfo的项目索引
'返回值:无
'********************************************************************
Friend Function DeleteClient(nIndex As Integer)
    Dim nCount As Integer
    If nIndex < 0 Then nIndex = mSelectItem
    nCount = lstvwClientInfo.ListItems.Count
    If nCount > 0 And nIndex > 0 And nIndex <= nCount Then
        Call mTDbClient.Move(CLng(nIndex))
        mTDbClient.Delete
        DataChanged = True
        Call lstvwClientInfo.ListItems.Remove(nIndex)
    End If
End Function
'********************************************************************
'功能:重新显示客户信息
'参数:无
'返回值:无
'********************************************************************
Private Function ReShowClient()
    If DataChanged Then
        Call ShowRecodeset
    End If
End Function
'********************************************************************
'功能:刷新 lstvwClientInfo 显示
'参数:无
'返回值:无
'********************************************************************
Private Function ReFlashListView()
    Call mTDbClient.CancelFilter
    ShowRecodeset
End Function
'********************************************************************
'功能:保存数据到数据库
'参数:TClient 为 客户类
'返回值:无
'********************************************************************
Private Function SaveTClientToDataBase(TClient As clsClient)
    Dim i As Integer
    For i = 0 To INT_CLIENT_TITLE_COUNT_NUMBER - 1
        DoEvents
        Call mTDbClient.SetRecord(gClientTitleArryStr(i), TClient.MyProperty(i))
    Next i
    mTDbClient.Update
End Function
'初始化查找功能
Private Function intFind()
    Dim strTemp$, i&
    For i = 0 To INT_CLIENT_TITLE_COUNT_NUMBER - 1
        strTemp = gClientTitleArryStr(i)
        Call cmbTitleItems.AddItem(strTemp, i)
    Next i
    cmbTitleItems.ListIndex = 0
    cmbCondition.Text = cmbCondition.List(0)
End Function
'********************************************************************
'功能:查找一个用户
'参数:无
'返回值:无
'********************************************************************
Private Function FindClient()
    Dim strFilte As String, strMode As String
    If txtFilte.Text = "" Or cmbTitleItems.Text = "" Or cmbCondition.Text = "" Then
        MsgBox "条件不完全，请正确输入"
        Exit Function
    End If
    strFilte = txtFilte.Text
    Select Case cmbCondition.Text
        Case "等于"
            strMode = "="
        Case "大于"
            strMode = ">"
        Case "小于"
            strMode = "<"
        Case "大于等于"
            strMode = ">="
        Case "小于等于"
            strMode = "<="
        Case "包含"
            strMode = "LIKE"
            strFilte = "*" & strFilte & "*"
    End Select

    Call mTDbClient.FilterField(cmbTitleItems.Text, strFilte, strMode)    '过滤
    Call ShowRecodeset
End Function
'=====================================================================================