frmplan.frm

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

                        '如果结束提醒时间大于开始提醒时间时 使结束提醒时间等于开始提醒时间
                        If DateDiff("d", .StartDate, .EndDate) < 0 Then
                            .EndDate = .StartDate
                        End If
                        If IsNumeric(strPlanID) Then
                            .PlanID = strPlanID
                        End If
                        strNeedAlarm = Trim(strNeedAlarm)
                        If strNeedAlarm = "否" Or UCase(strNeedAlarm) = "FALSE" Or strNeedAlarm = "不提醒" Then
                            .bNeedAlarm = False
                        Else
                            .bNeedAlarm = True
                        End If
                    End With
                End If
            End If
            mTDbPlan.MoveNext
        Next nRs
    End If
    If lstvwPlanInfo.ListItems.Count > 0 Then
        lstvwPlanInfo.ListItems(1).Selected = True         '选定第一个
        mSelectItem = 1
    End If
    Call ListTodayPlan                                     '显示今天的计划
    DataChanged = False
End Function
'********************************************************************
'功能:把 lstvwPlanInfo 控件的各项目 格式化成 clsPlan 类
'参数:nIndex 为 lstvwPlanInfo 的项目索引
'返回值:格式化后的 clsPlan 类
'********************************************************************
Private Function FormatListViewItemToTPlan(nIndex As Integer) As clsPlan
    Dim TMyPlan As New clsPlan, i As Integer
    If nIndex < 0 Or nIndex > INT_PLAN_TITLE_COUNT_NUMBER Then
        Set FormatListViewItemToTPlan = Nothing
        Set TMyPlan = Nothing
        Debug.Print "FormatListViewItemToTplan函数参数不正确"
        Exit Function
    End If
    For i = 0 To INT_PLAN_TITLE_COUNT_NUMBER - 1
        DoEvents
        If i = 0 Then
            TMyPlan.MyProperty(i) = lstvwPlanInfo.ListItems(nIndex).Text
        Else
            TMyPlan.MyProperty(i) = lstvwPlanInfo.ListItems(nIndex).SubItems(i)
        End If
    Next i
    Set FormatListViewItemToTPlan = TMyPlan
End Function

'********************************************************************
'功能:显示工作计划详细信息
'参数:nIndex 为 lstvwPlanInfo 的项目索引,nType 为 显示信息的模式
'为以下的值之一:
'INT_PLAN_STYLE_READ_ONLY ,INT_PLAN_STYLE_EDIT ,INT_PLAN_STYLE_NEW
'返回值:无
'********************************************************************
Friend Function ShowPlanInfo(Optional nIndex As Integer = 1, Optional nType As Integer = INT_PLAN_STYLE_READ_ONLY)
    Dim TMyPlan As clsPlan
    Dim nCount As Integer
    nCount = lstvwPlanInfo.ListItems.Count
    If nIndex < 0 Then nIndex = mSelectItem
    If (nCount > 0 And nIndex >= 0 And nIndex <= nCount) Or nType = INT_PLAN_STYLE_NEW Then
        Select Case nType
            Case INT_PLAN_STYLE_READ_ONLY
                Set TMyPlan = FormatListViewItemToTPlan(nIndex)
                mTDbPlan.Move (nIndex)
            Case INT_PLAN_STYLE_EDIT
                Set TMyPlan = FormatListViewItemToTPlan(nIndex)
                mTDbPlan.Move (nIndex)
            Case INT_PLAN_STYLE_NEW
                Set TMyPlan = New clsPlan
                mTDbPlan.AddNew
                TMyPlan.RegisterDate = Date
                TMyPlan.Auditing = False
        End Select
        Call ShowInfoForm(TMyPlan, nType)
    End If
End Function

'********************************************************************
'功能:弹出 frmPlanInfo 窗口,并设置该窗口的显示模式
'参数:TPlan 为 工作计划类 ,nType 为 显示信息的模式
'为以下的值之一:
'INT_PLAN_STYLE_READ_ONLY ,INT_PLAN_STYLE_EDIT ,INT_PLAN_STYLE_NEW
'返回值:无
'********************************************************************
Private Function ShowInfoForm(TPlan As clsPlan, nType As Integer)
    Dim mFrmPlanInfo As New frmPlanInfo

    mFrmPlanInfo.Style = nType
    mFrmPlanInfo.TPlan = TPlan
    mFrmPlanInfo.Show vbModal, gMainMDIForm
    '如果模式是新建 而且 数据没有变化
    If TPlan.IsChangedDate Then
        Call SaveTPlanToDataBase(TPlan)
        DataChanged = True
        TPlan.IsChangedDate = False
    End If
    If DataChanged = False And nType = INT_CLIENT_STYLE_NEW Then
        mTDbPlan.CancelUpdate
    End If
    Call ReShowPlan                                        '刷新显示
    Call SetDayBold(True)
End Function

'********************************************************************
'功能:删除一个计划
'参数:nIndex 为 lstvwPlanInfo 的项目索引
'返回值:无
'********************************************************************
Friend Function DeletePlan(nIndex As Integer)
    Dim nCount As Integer
    nCount = lstvwPlanInfo.ListItems.Count
    If nCount > 0 And nIndex >= 0 And nIndex <= nCount Then
        Call mTDbPlan.Move(CLng(nIndex))
        mTDbPlan.Delete
        DataChanged = True
        Call ShowRecodeset
        'Call lstvwPlanInfo.ListItems.Remove(nIndex)
    End If
    Call SetDayBold(True)
End Function
'重新显示计划信息(计划已被修改的时候)
Private Function ReShowPlan()
    If DataChanged Then
        Call ShowRecodeset
    End If
End Function
'重新显示lstvwPlanInfo
Friend Function ReFlashListView()
    Call mTDbPlan.CancelFilter
    Call ShowRecodeset
End Function
'******************************************************************************
'功能：由一个日期，找到与该日期有关的 mPlanDate 的索引
'      如果要返回所有的索引的话,请用返回的值+1做为nStart参数 连续调用,直到返回-1
'参数：dtDate:要找的日期,nStart :从哪个mPlanDate 索引开始找
'返回值:找的话返回mPlanDate 的索引,否则返回-1
'       (注:mPlanDate为 PlanDate_T 类型的数组)
'******************************************************************************
Private Function FindPlanWhithDate(dtDate As Date, nStart As Integer) As Integer
    Dim nUBound As Integer, nLBound As Integer, i As Integer
    Dim nRet As Integer
    nRet = -1
    nUBound = UBound(mPlanDateT)
    nLBound = LBound(mPlanDateT)
    If nUBound > 0 And nStart >= nLBound And nStart <= nUBound Then
        For i = nStart To nUBound
            DoEvents
            With mPlanDateT(i)
                If (DateDiff("d", .StartDate, dtDate) >= 0) And (DateDiff("d", .EndDate, dtDate) <= 0) Then
                    nRet = i
                    Exit For
                End If
            End With
        Next i
    End If
    FindPlanWhithDate = nRet
End Function
'******************************************************************************
'功能：显示计划的详细信息
'参数：dtDate:要显示的日期,bMsgBox 为 如果该日期没有任何计划,是否弹出对话框来创建一个
'返回值:无
'******************************************************************************
Friend Function ShowPlan(dtDate As Date)
    Dim nIndex As Integer, strFilter As String, strID As String
    Dim nRet As Integer
    nIndex = FindPlanWhithDate(dtDate, 1)
    If nIndex > 0 Then                                     '如果双击的日期有工作计划则显示他
        While nIndex > 0
            DoEvents
            strID = mPlanDateT(nIndex).PlanID
            If strFilter = "" Then
                strFilter = gPlanTitleArryStr(INT_PLAN_TITLE_ID) & " = '" & strID & "'"
            Else
                strFilter = strFilter & " OR " & gPlanTitleArryStr(INT_PLAN_TITLE_ID) & " = " & strID
            End If
            nIndex = FindPlanWhithDate(dtDate, nIndex + 1)
        Wend
        Call mTDbPlan.FilterString(strFilter)
        Call ShowRecodeset
    Else                                                   '没有工作计划 则新建一个
        nRet = MsgBox("该日期没有任何计划,是否要创建一个新计划", vbOKCancel + vbQuestion)
        If nRet = vbOK Then
            Call NewPlan(dtDate)
        End If
    End If
End Function

'*********************************************************************
'如果月份改变，而且该月份的日期有工作计划，则黑体显示该日期
'*********************************************************************
Private Function SetDayBold(Optional bReFlash As Boolean = False)
    Dim nUBound As Integer, nLBound As Integer, i As Integer, j As Integer
    Dim strYearMonth0 As String, strYearMonth1 As String, strYearMonth2 As String
    Dim dtStartdate As Date, dtEndDate As Date, dtDate As Date
    strYearMonth0 = mvwPlan.Year & "-" & mvwPlan.Month
    If strYearMonth0 <> mCurMonthStr Or bReFlash Then      '如果日历显示的年月为当前的年月
        nUBound = UBound(mPlanDateT)
        nLBound = LBound(mPlanDateT)
        If nUBound = 0 Then Exit Function
        For i = nLBound To nUBound                         '遍历所有工作计划
            DoEvents
            With mPlanDateT(i)
                '验证 StartDate 和 EndDate 是否是日期格式(一般情况下应该是日期格式)
                If IsDate(.StartDate) And IsDate(.EndDate) Then
                    '取得该计划的 StartDate(开始时间) EndDate(结束时间) 的 年月 信息
                    strYearMonth1 = DatePart("yyyy", .StartDate) & "-" & DatePart("m", .StartDate)
                    strYearMonth2 = DatePart("yyyy", .EndDate) & "-" & DatePart("m", .EndDate)
                    '如果StartDate(开始时间) "或" EndDate(结束时间) 的年月 和 日历显示的年月一致
                    If strYearMonth1 = strYearMonth0 Or strYearMonth2 = strYearMonth0 Then
                        If strYearMonth1 = strYearMonth0 Then
                            dtStartdate = .StartDate
                        Else
                            '如果开始的年月不是日历显示的年月 则: 设置黑体的日期从日历显示的
                            '第一个日期开始(注意:日历显示的第一个日期不一定是该月的1号,有可能是上个月的)
                            If DateDiff("d", mvwPlan.VisibleDays(1), .StartDate) >= 0 Then
                                dtStartdate = .StartDate
                            Else
                                dtStartdate = mvwPlan.VisibleDays(1)
                            End If
                        End If
                        If strYearMonth2 = strYearMonth0 Then
                            dtEndDate = .EndDate
                        Else
                            '如果结束的年月不是日历显示的年月
                            '则: 设置黑体的结束日期为日历显示的最后一个日期
                            If DateDiff("d", mvwPlan.VisibleDays(42), .EndDate) >= 0 Then
                                dtEndDate = mvwPlan.VisibleDays(42)
                            Else
                                dtEndDate = .EndDate
                            End If
                        End If
                        dtDate = dtStartdate
                        '把dtStartdate 到 dtEndDate 之间的日期设置成黑体
                        For j = 0 To DateDiff("d", dtStartdate, dtEndDate)
                            mvwPlan.DayBold(dtDate) = True
                            dtDate = DateAdd("d", 1, dtDate)
                        Next j
                    End If
                End If
            End With
        Next i
        mCurMonthStr = strYearMonth0
    End If
    'mvwPlan.Refresh
End Function
'显示今天的工作计划
Private Function ListTodayPlan()
    Dim nIndex As Integer, strFilter As String, strToday As String, i As Integer, nCount As Integer
    lstDoToday.Clear
    strToday = Date
    strFilter = gPlanTitleArryStr(INT_PLAN_TITLE_START_REMIND) & " <= " & strToday & " AND " & gPlanTitleArryStr(INT_PLAN_TITLE_END_REMIND) & " >= " & strToday & ""
    Call mTDbPlan.FilterString(strFilter)                  '过滤数据库的记录
    nCount = mTDbPlan.GetRecordCount                       '数据库记录的个数
    If nCount > 0 Then
        For i = 1 To nCount                                '遍历所有记录
            'lstDoToday 添加一个项目
            Call lstDoToday.AddItem(mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_ITEM)), i - 1)
            lstDoToday.ItemData(i - 1) = CLng(mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_ID)))
            mTDbPlan.MoveNext
        Next i
        lstDoToday.ListIndex = 0
    End If
    Call mTDbPlan.CancelFilter
End Function

'******************************************************************************
'功能：显示 lstDoToday(ListBox控件)选定的项目的详细信息
'参数：nIndex 为lstDoToday 的索引
'返回值:无
'******************************************************************************
Private Function ShowPlanInfoFromLst(nIndex As Integer)
    Dim strID As String, strFilter As String, i As Integer, nCount As Integer
    Dim TMyPlan As New clsPlan
    If lstDoToday.List(nIndex) <> "" Then
        strID = lstDoToday.ItemData(nIndex)
        strFilter = gPlanTitleArryStr(INT_PLAN_TITLE_ID) & " = " & strID
        Call mTDbPlan.FilterString(strFilter)
        nCount = mTDbPlan.GetRecordCount
        If nCount > 0 Then
            For i = 0 To INT_PLAN_TITLE_COUNT_NUMBER - 1
                TMyPlan.MyProperty(i) = mTDbPlan.GetRecord(gPlanTitleArryStr(i))
            Next i
            Call ShowInfoForm(TMyPlan, INT_PLAN_STYLE_READ_ONLY)
        Else
            MsgBox "该计划已经删除"
            lstDoToday.RemoveItem (nIndex)
        End If
        Call mTDbPlan.CancelFilter
    End If
End Function

'******************************************************************************
'功能：新计划
'参数：dtDate 为 计划初始的开始和结束时间
'返回值:无
'******************************************************************************
Friend Function NewPlan(dtDate As Date)
    Dim TMyPlan As New clsPlan
    mTDbPlan.AddNew
    TMyPlan.StartRemind = dtDate
    TMyPlan.EndRemind = dtDate
    TMyPlan.RegisterDate = Date
    TMyPlan.Auditing = False
    Call ShowInfoForm(TMyPlan, INT_PLAN_STYLE_NEW)
End Function
'******************************************************************************
'功能：保存数据到数据库
'参数：TPlan 为工作计划类
'返回值:无
'******************************************************************************
Public Function SaveTPlanToDataBase(TPlan As clsPlan)
    Dim i As Integer
    For i = 0 To INT_PLAN_TITLE_COUNT_NUMBER - 1
        DoEvents
        Call mTDbPlan.SetRecord(gPlanTitleArryStr(i), TPlan.MyProperty(i))
    Next i
    mTDbPlan.Update
End Function
'=====================================================================================

Private Sub tmrSetBold_Timer()
    On Error GoTo psErr
    Call SetDayBold
    Exit Sub
psErr:
    Debug.Print "过程 tmrSetBold_Timer 错误：" & Err.Description
End Sub