frmcalendar.frm

用vb编写的能管理自己日程计划的程序。后台用access数据库

    SelectedLinkman = m_SelectedLinkman
    
End Property

Public Property Let SelectedType(newValue As String)

    m_SelectedType = newValue
    
End Property

Public Property Get SelectedType() As String

     SelectedType = m_SelectedType
    
End Property

'日程安排是否提醒
Private Sub chkPlan_Click()

    If chkPlan.Value = 1 Then
    
        '提醒
        lblPlan.Enabled = True
        txtPlanawoke.Enabled = True
        txtPlanawoke.BackColor = &HFFFFFF
        cboTimeType.Enabled = True
    Else
    
        '不提醒
        lblPlan.Enabled = False
        txtPlanawoke.Enabled = False
        txtPlanawoke.BackColor = &H8000000A
        cboTimeType.Enabled = False
    End If
    
End Sub

'任务是否提醒
Private Sub chkThing_Click()

    If chkThing.Value = 1 Then
    
        '提醒
        lblThing(0).Enabled = True
        lblThing(1).Enabled = True
        txtThingAwoke.Enabled = True
        txtThingAwoke.BackColor = &HFFFFFF
    Else
    
        '不提醒
        lblThing(0).Enabled = False
        lblThing(1).Enabled = False
        txtThingAwoke.Enabled = False
        txtThingAwoke.BackColor = &H8000000A
    End If
    
End Sub

Private Sub cmdCancel_Click()
    
    Unload Me

End Sub

Private Sub cmdOK_Click()

    Dim p_rstCustomers As ADODB.Recordset
    Dim strTmpTime As String
    
    If (lngchkValue <> chkPlan.Value And framePlan.Visible = True) Or (lngchkValue <> chkThing.Value And frameThing.Visible = True) Then
        blnblnChangedFlag = True
    End If
    
    If lngStatus <> cboStatus.ListIndex Then
        blnChangedFlag = True
    End If
    
    If Not blnChangedFlag Then
        Unload Me
        Exit Sub
    End If
    
    Set p_rstCustomers = New Recordset
    
    If framePlan.Visible Then
        
        If Trim(cboStartTime.Text) <> "" And IsDate(Trim(cboStartTime.Text)) = False Then
            MsgBox "日程安排的开始时间的格式无效！", vbCritical, SYSTEMCAPTION
            cboStartTime.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        
        If Trim(cboEndTime.Text) <> "" And IsDate(Trim(cboEndTime.Text)) = False Then
            MsgBox "日程安排的结束时间的格式无效！", vbCritical, SYSTEMCAPTION
            cboEndTime.SetFocus
            SendKeys "{HOME} +{END}"
            Exit Sub
        End If
        
        If Trim(txtPlan.Text) = "" Then
            MsgBox "日程安排的内容不能为空！", vbCritical, SYSTEMCAPTION
            txtPlan.SetFocus
            Exit Sub
        End If
        
        If chkPlan = 1 And IsNumeric(Trim(txtPlanawoke.Text)) = False Then
            MsgBox "日程安排的提醒设置无效！", vbCritical, SYSTEMCAPTION
            txtPlanawoke.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        
        If (DateValue(dtpDate.Value) < DateValue(Now())) Or (TimeValue(cboEndTime.Text) < TimeValue(Now())) Or (TimeValue(cboStartTime.Text) < TimeValue(Now()) And Trim(cboEndTime.Text) = "") Then
            If MsgBox("日程安排的时间安排已经过时！是否继续保存？", vbOKCancel + vbDefaultButton2, SYSTEMCAPTION) = vbCancel Then
                Exit Sub
            End If
        End If
        
        strQry = "select plan_ID from plan where id='" & UserID & "' and date=#" & DateValue(Now()) & "# and ((starttime>=#" & TimeValue(cboStartTime.Text) & "# and starttime<=#" & TimeValue(cboEndTime.Text) & "#) or  (endtime>=#" & TimeValue(cboStartTime.Text) & "# and endtime<=#" & TimeValue(cboEndTime.Text) & "#))"
        Set p_rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        If p_rstCustomers.RecordCount <> 0 Then
            If MsgBox("日程安排的时间与已存在的日程安排的时间存在冲突！是否继续保存？", vbOKCancel + vbDefaultButton2, SYSTEMCAPTION) = vbCancel Then
                Exit Sub
            End If
        End If
        
        If TimeValue(cboStartTime.Text) > TimeValue(cboEndTime.Text) Then
            strTmpTime = cboStartTime.Text
            cboStartTime.Text = cboEndTime.Text
            cboEndTime.Text = strTmpTime
        End If
        
        If Me.Tag = "" Then
            p_rstCustomers.Close
            strQry = "select * from plan where id=''"
            p_rstCustomers.Open strQry, cnnConnection, adOpenDynamic, adLockOptimistic
            p_rstCustomers.AddNew
            p_rstCustomers!ID = UserID
        Else
            strQry = "select * from plan where id='" & UserID & "' and " & "plan_ID=" & Trim(Me.Tag)
            Set p_rstCustomers = GetRecordSet(cnnConnection, strQry)
        End If
        
        p_rstCustomers!Date = dtpDate.Value
        p_rstCustomers!starttime = TimeValue(Trim(cboStartTime.Text))
        
        If cboEndTime.Text <> "" Then
            p_rstCustomers!endtime = TimeValue(Trim(cboEndTime.Text))
        End If
        
        p_rstCustomers!Contain = txtPlan.Text
        
        If chkPlan = 1 Then
            p_rstCustomers!awoke = True
            p_rstCustomers!awoketime = Val(Trim(txtPlanawoke.Text))
            p_rstCustomers!timetype = cboTimeType.ListIndex
        Else
            p_rstCustomers!awoke = False
        End If
            
        p_rstCustomers!Type = strNewType
        p_rstCustomers!linkman = strNewlinkman
        p_rstCustomers.Update
        
        frmMain.RefreshPlan
        
    End If
                         
    If frameThing.Visible Then
    
        
        If IsDate(Trim(txtStartDate.Text)) = False And Trim(txtStartDate.Text) <> "" Then
            MsgBox "任务的开始日期的格式无效！", vbCritical, SYSTEMCAPTION
            txtStartDate.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        
        If IsDate(Trim(txtEndDate.Text)) = False And Trim(txtEndDate.Text) <> "" Then
            MsgBox "任务的结束日期的格式无效！", vbCritical, SYSTEMCAPTION
            txtEndDate.SetFocus
            SendKeys "{HOME} +{END}"
            Exit Sub
        End If
        
        If Trim(txtThing.Text) = "" Then
            MsgBox "任务的内容不能为空！", vbCritical, SYSTEMCAPTION
            txtThing.SetFocus
            Exit Sub
        End If
        
        If chkThing = 1 And IsNumeric(Trim(txtThingAwoke.Text)) = False Then
            MsgBox "任务的提醒设置无效！", vbCritical, SYSTEMCAPTION
            txtThingAwoke.SetFocus
            SendKeys "{HOME}+{END}"
            Exit Sub
        End If
        
        If Trim(txtStartDate.Text) <> "" And Trim(txtEndDate.Text) <> "" Then
            If DateValue(Trim(txtStartDate.Text)) < DateValue(Now()) And DateValue(txtEndDate.Text) < DateValue(Now) Then
            
                If MsgBox("任务的日期安排已经过期！是否继续保存？", vbOKCancel + vbDefaultButton2, SYSTEMCAPTION) = vbCancel Then
                    Exit Sub
                End If
                
            End If
        End If
        
        If Me.Tag = "" Then
            strQry = "select * from thing where id=''"
            p_rstCustomers.Open strQry, cnnConnection, adOpenDynamic, adLockOptimistic
            p_rstCustomers.AddNew
            p_rstCustomers!ID = UserID
        Else
            strQry = "select * from thing where id='" & UserID & "' and thing_ID=" & Me.Tag
            Set p_rstCustomers = GetRecordSet(cnnConnection, strQry)
        End If
        
        If Trim(txtStartDate.Text) <> "" Then
            p_rstCustomers!StartDate = DateValue(Trim(txtStartDate.Text))
        End If
        
        If Trim(txtEndDate.Text) <> "" Then
            p_rstCustomers!EndDate = DateValue(Trim(txtEndDate.Text))
        End If
        
        p_rstCustomers!Contain = txtThing.Text
        
        If chkThing = 1 Then
            p_rstCustomers!awoke = True
            p_rstCustomers!awokedays = Val(Trim(txtThingAwoke.Text))
        Else
            p_rstCustomers!awoke = False
        End If
            
        p_rstCustomers!Type = strNewType
        p_rstCustomers!linkman = strNewlinkman
        p_rstCustomers!Status = cboStatus.ListIndex
        p_rstCustomers.Update
        
        frmMain.RefreshThing
        
    End If
       
    Unload Me
    
    End Sub
    
    '*********************修改或增加任务或计划的联系人,类别*************************
    '*********************修改或增加任务或计划的联系人,类别*************************
    Private Sub cmdPlanlinkman_Click()
        
        '装入联系人选择窗体
        Load frmSelectlinkman
        
        frmSelectlinkman.Tag = strNewlinkman
        frmSelectlinkman.Show vbModal
        
        If frmSelectlinkman.Tag <> "" Then
            blnChangedFlag = True
            txtPlanlinkman.Text = frmCalendar.SelectedLinkman
            strNewlinkman = frmSelectlinkman.Tag
            
            If strNewlinkman = "clear" Then
                strNewlinkman = ""
            End If
            
        End If
    
    Unload frmSelectlinkman
    
End Sub

Private Sub cmdPlantype_Click()
    
    '装载类别选择窗体
    Load frmType
    frmType.Tag = strNewType
    frmType.TypeLib = "plantype"
    frmType.Show vbModal
    
    If frmType.Tag <> "cancel" Then
        blnChangedFlag = True
        strNewType = frmType.Tag
        txtPlantype.Text = frmCalendar.SelectedType
    End If
    
    Unload frmType
    
End Sub

Private Sub cmdThinglinkman_Click()
    
    '装入联系人选择窗体
    Load frmSelectlinkman
    frmSelectlinkman.Tag = strNewlinkman
    frmSelectlinkman.Show vbModal
    
    If frmSelectlinkman.Tag <> "" Then
        blnChangedFlag = True
        txtThinglinkman.Text = frmCalendar.SelectedLinkman
        strNewlinkman = frmSelectlinkman.Tag
        
        If strNewlinkman = "clear" Then
            strNewlinkman = ""
        End If
        
    End If
    
    Unload frmSelectlinkman
    
End Sub

Private Sub cmdThingtype_Click()
    
    '装载类别选择窗体
    Load frmType
    frmType.TypeLib = "thingtype"
    frmType.Tag = strNewType
    frmType.Show vbModal
    
    If frmType.Tag <> "cancel" Then
        blnChangedFlag = True
        strNewType = frmType.Tag
        txtThingtype.Text = frmCalendar.SelectedType
    End If
    
    Unload frmType
    
End Sub
'************************************************************

Private Sub cboEndTime_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub cboEndTime_DropDown()

    If cboEndTime.Text = "" Then
        cboEndTime.ListIndex = 12
    End If
    
End Sub

Private Sub cboStartTime_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub