frmalarm.frm

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

VERSION 5.00
Begin VB.Form frmAlarm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "提醒"
   ClientHeight    =   3645
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4335
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3645
   ScaleWidth      =   4335
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   375
      Left            =   2760
      TabIndex        =   3
      Top             =   3120
      Width           =   1335
   End
   Begin VB.ListBox lstDoToday 
      Height          =   2400
      ItemData        =   "frmAlarm.frx":0000
      Left            =   120
      List            =   "frmAlarm.frx":0002
      TabIndex        =   1
      Top             =   480
      Width           =   4095
   End
   Begin VB.CommandButton cmdDetails 
      Caption         =   "显示详细信息"
      Height          =   375
      Left            =   1320
      TabIndex        =   0
      Top             =   3120
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "今天要完成的事："
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   1440
   End
End
Attribute VB_Name = "frmAlarm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                 提醒模块                                            '
'                                                                                     '
'注意:本模块的代码基本上都从frmPlan复制过来                                           '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim mTDbPlan As New clsDataBase                            '工作计划实例

'显示今天的工作计划
Private Function ListTodayPlan()
    Dim nIndex As Integer, strFilter As String, strToday As String, i As Integer, nCount As Integer, strRemindMe As String
    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
            strRemindMe = mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_REMIND_ME))
            If UCase(strRemindMe) <> "FALSE" And strRemindMe <> "否" Then
                Call lstDoToday.AddItem(mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_ITEM)))
                lstDoToday.ItemData(lstDoToday.ListCount - 1) = CLng(mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_ID)))
            End If
            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

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)
        TPlan.IsChangedDate = False
        Call ListTodayPlan
    End If
End Function

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdDetails_Click()
    Call ShowPlanInfoFromLst(lstDoToday.ListIndex)
End Sub

Private Sub Form_Activate()
    If lstDoToday.ListCount = 0 Then Unload Me             '如果今天没有任何计划,则卸载本模块
End Sub

Private Sub Form_Load()
    mTDbPlan.OpenDB (DB_TABLE_PLAN)                        '打开数据库
    Call ListTodayPlan                                     '显示计划
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mTDbPlan.CloseDB                                       '关闭数据库
    Set mTDbPlan = Nothing
End Sub
'双击lstDoToday
Private Sub lstDoToday_DblClick()
    Call ShowPlanInfoFromLst(lstDoToday.ListIndex)         '显示计划的详细信息
End Sub
'保存数据到数据库
Private 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