frmplan.frm

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

      Width           =   150
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileClose 
         Caption         =   "关闭(&C)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A)"
      End
   End
End
Attribute VB_Name = "frmPlan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

''*************************************************************************
'//////////////////////////////////////////////////////////////////////
'//                      工作计划模块                                //
'//////////////////////////////////////////////////////////////////////
Option Explicit

Private Const LISTVIEW_MODE0 = "大图标"
Private Const LISTVIEW_MODE1 = "小图标"
Private Const LISTVIEW_MODE2 = "列表"
Private Const LISTVIEW_MODE3 = "详细资料"

Private Const sglSplitLimit = 500                          '分隔条的最小宽度

Dim mFrmMyMenu As New frmMenu                              '菜单窗口
Dim mSelectItem As Integer                                 '当前选定的 工作计划 项目的索引号
Dim mIsChangedBool As Boolean                              '数据是否更改

Dim mbMoving As Boolean                                    '分隔条是否正在移动

Dim mCurMonthStr As String                                 '日历当前显示的月份

'工作计划 类型
Private Type PlanDate_T
    StartDate As Date                                      '开始时间
    EndDate As Date                                        '结束时间
    PlanID As String                                       '工作计划的ID号
    bNeedAlarm As Boolean                                  '是否需要提醒
End Type

Dim mPlanDateT() As PlanDate_T                             '工作计划数组
Dim mTDbPlan 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 cmdDetails_Click()
    Call ShowPlanInfoFromLst(lstDoToday.ListIndex)
End Sub

Private Sub cmdNewPlan_Click()
    Dim dtDate As Date
    dtDate = mvwPlan.SelStart
    Call NewPlan(dtDate)
End Sub

Private Sub cmdViewAll_Click()
    Call ReFlashListView
End Sub

Private Sub cmdViewOne_Click()
    Dim dtDate As Date
    dtDate = mvwPlan.SelStart
    Call ShowPlan(dtDate)
End Sub

Private Sub Form_GotFocus()
    Call SizeControls(imgSplitter.Left)
End Sub

'=============================窗口===================================
Private Sub Form_Load()
    DataChanged = True
    ReDim mPlanDateT(0)
    Call mTDbPlan.OpenDB(DB_TABLE_PLAN)                    '打开数据库
    Call init_lstvwPlanInfo                                '初始化lvwplanInfo控件
    Call ShowRecodeset                                     '显示记录
    '    Unload frmMyLoading
End Sub


Private Sub Form_Paint()
    Select Case lstvwPlanInfo.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
    Call SetDayBold
End Sub


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

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

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single


    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub


Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
End Sub

'================================================================
'调整控件的大小和位置
Sub SizeControls(X As Single)
    On Error Resume Next


    'set the width
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    picPlan.Width = X
    imgSplitter.Left = X
    lstvwPlanInfo.Left = X + 40
    lstvwPlanInfo.Width = Me.Width - (picPlan.Width + 140)
    lblTitle(0).Width = picPlan.Width
    lblTitle(1).Left = lstvwPlanInfo.Left + 20
    lblTitle(1).Width = lstvwPlanInfo.Width - 40
    'set the top


    If tbToolBar.Visible Then
        picPlan.Top = tbToolBar.Height + picTitles.Height
    Else
        picPlan.Top = picTitles.Height
    End If

    lstvwPlanInfo.Top = picPlan.Top


    'set the height
    picPlan.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)


    lstvwPlanInfo.Height = picPlan.Height
    imgSplitter.Top = picPlan.Top
    imgSplitter.Height = picPlan.Height

End Sub

'lstDoToday 双击后显示该计划的详细信息
Private Sub lstDoToday_DblClick()
    Call ShowPlanInfoFromLst(lstDoToday.ListIndex)
End Sub
'=======================lstvwplanInfo控件===========================
Private Sub lstvwPlanInfo_DblClick()
    Dim nSelectIndex As Integer
    If Not (lstvwPlanInfo.SelectedItem Is Nothing) Then
        nSelectIndex = lstvwPlanInfo.SelectedItem.Index
        Call ShowPlanInfo(nSelectIndex, INT_PLAN_STYLE_READ_ONLY)
    End If
End Sub

'设置当前选定的工作计划项目
Private Sub lstvwPlanInfo_ItemClick(ByVal Item As MSComctlLib.ListItem)
    mSelectItem = Item.Index
End Sub

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

'==============================菜单==================================
Private Sub mnuFileClose_Click()
    Unload Me
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, gMainMDIForm
End Sub

Private Sub mvwPlan_DateDblClick(ByVal DateDblClicked As Date)
    Call ShowPlan(DateDblClicked)
End Sub

Private Sub mvwPlan_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim MyMenu As Menu, dtDate As Date
    If Button = vbRightButton Then
        'Call mvwPlan.HitTest(X, Y, dtDate)
        'mvwPlan.SelStart = dtDate
        'mvwPlan.SelEnd = dtDate
        dtDate = mvwPlan.SelStart
        If mvwPlan.DayBold(dtDate) = False Then
            mFrmMyMenu.mnuCalendarViewOne.Enabled = False
        Else
            mFrmMyMenu.mnuCalendarViewOne.Enabled = True
        End If
        Set MyMenu = mFrmMyMenu.mnuCalendar
        Call PopupMenu(MyMenu)
    End If
End Sub

'=====================================================================
'工具条
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    '    On Error Resume Next
    Select Case Button.Key
        Case "新建"
            Call ShowPlanInfo(mSelectItem, INT_PLAN_STYLE_NEW)
        Case "修改"
            Call ShowPlanInfo(mSelectItem, INT_PLAN_STYLE_EDIT)
        Case "删除"
            Call DeletePlan(mSelectItem)
        Case "属性"
            Call ShowPlanInfo(mSelectItem, INT_PLAN_STYLE_READ_ONLY)
        Case "预览"
        Case "刷新"
            Call ReFlashListView

        Case "大图标"
            lstvwPlanInfo.View = lvwIcon
        Case "小图标"
            lstvwPlanInfo.View = lvwSmallIcon
        Case "列表"
            lstvwPlanInfo.View = lvwList
        Case "详细资料"
            lstvwPlanInfo.View = lvwReport
    End Select
End Sub

'=============================自定义函数==============================================
'初始化lvwplanInfo控件
Private Function init_lstvwPlanInfo()
    Dim i As Integer, strTitle As String
    lstvwPlanInfo.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    For i = 0 To INT_PLAN_TITLE_COUNT_NUMBER - 1
        DoEvents
        lstvwPlanInfo.ColumnHeaders.Add , , gPlanTitleArryStr(i)
    Next i
End Function
'***********************************************************************************
'功能：把 数据库的记录在lstvwplanInfo（LISTVIEW控件）上显示出来
'参数：无
'返回：无
'***********************************************************************************
Private Function ShowRecodeset()
    Dim i As Integer, nRs As Integer, nRsCount As Integer, strHeader As String, nDateCount As Integer
    Dim lvwFirst As ListItem, strValue As String
    Dim strStartDate As String, strEndDate As String, strPlanID As String, strNeedAlarm As String
    lstvwPlanInfo.ListItems.Clear
    nRsCount = mTDbPlan.GetRecordCount                     '数据库记录的个数
    If nRsCount > 0 Then
        '使 mPlanDateT(工作计划数组)的个数等于数据库记录的个数
        If DataChanged Then ReDim mPlanDateT(1 To nRsCount)
        For nRs = 1 To nRsCount                            '遍历所有的记录
            DoEvents
            For i = 1 To INT_PLAN_TITLE_COUNT_NUMBER
                DoEvents
                If Not (lstvwPlanInfo.ColumnHeaders.Item(i) Is Nothing) Then
                    strHeader = lstvwPlanInfo.ColumnHeaders.Item(i).Text
                    strValue = mTDbPlan.GetRecord(strHeader)    '取得数据
                    '把数据显示在lstvwPlanInfo控件上
                    If i = 1 Then
                        Set lvwFirst = lstvwPlanInfo.ListItems.Add(, , strValue)
                    Else
                        lvwFirst.SubItems(i - 1) = strValue
                    End If
                End If
            Next i

            '重数据库里读取数据到缓冲区
            If DataChanged Then                            '如果数据已经修改则
                strStartDate = mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_START_REMIND))
                strEndDate = mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_END_REMIND))
                strPlanID = mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_ID))
                strNeedAlarm = mTDbPlan.GetRecord(gPlanTitleArryStr(INT_PLAN_TITLE_REMIND_ME))
                '验证数据是否正确
                If IsDate(strStartDate) And IsDate(strEndDate) Then
                    With mPlanDateT(nRs)                   '初始一个mPlanDateT 结构
                        .StartDate = CDate(strStartDate)
                        .EndDate = CDate(strEndDate)