frmcalendar.frm

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

Private Sub cboStartTime_DropDown()

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

Private Sub comboTimeType_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub DTPdate_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub


Private Sub Form_Resize()
    
    Dim tmprstCustomers As Recordset
    Dim tmpLinkman As String
    Dim tmpType As String
    Dim i As Integer
    
'    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'    ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WndProc)
    
    frameThing.BorderStyle = 0
    framePlan.BorderStyle = 0
    
    If frameThing.Visible = True Then
        
        '进入任务处理,显示任务页
        TabStrip1.Tabs(1).Caption = "任务"
        frameThing.Move TabStrip1.ClientLeft, TabStrip1.ClientTop, TabStrip1.ClientWidth, TabStrip1.ClientHeight
        txtStartDate.SetFocus
        lngchkValue = 0
        chkThing.Value = 0
        lngStatus = 0
        cboStatus.ListIndex = lngStatus
        
    Else
    
        '进入计划处理,显示计划页
        TabStrip1.Tabs(1).Caption = "日程安排"
        framePlan.Move TabStrip1.ClientLeft, TabStrip1.ClientTop, TabStrip1.ClientWidth, TabStrip1.ClientHeight
        cboStartTime.SetFocus
        
        '日程安排时,在开始时间和结束时间下拉列表框中加入整点和半点的时间
        For i = 0 To 23
            cboStartTime.List(cboStartTime.ListCount) = Trim(Str(i)) & ":00"
            cboStartTime.List(cboStartTime.ListCount) = Trim(Str(i)) & ":30"
            cboEndTime.List(cboEndTime.ListCount) = Trim(Str(i)) & ":00"
            cboEndTime.List(cboEndTime.ListCount) = Trim(Str(i)) & ":30"
        Next i
        
        dtpDate.Value = DateValue(Now())
        lngchkValue = 1
        
    End If
    
    If Me.Tag = "" Then
    
        '新增任务或日程安排
        lblThing(0).Enabled = False
        lblThing(1).Enabled = False
        txtThingAwoke.Enabled = False
        txtThingAwoke.BackColor = &H8000000A
        chkPlan.Value = 1
        txtPlanawoke.Text = "15"
        cboTimeType.ListIndex = 0
        
    End If
    
    If Me.Tag <> "" And frameThing.Visible = True Then
        
        '查看或修改任务时,显示该任务的各项资料
        strQry = "select * from thing where ID='" & UserID & "' and thing_ID=" & Trim(Me.Tag)
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        '当程序改控件的值是时,防止执行控件Change事件的代码!
        blnTextFlag = True
        txtStartDate.Text = IIf(IsNull(rstCustomers!StartDate), "", rstCustomers!StartDate)
        txtEndDate.Text = IIf(IsNull(rstCustomers!EndDate), "", rstCustomers!EndDate)
        cboStatus.ListIndex = IIf(IsNull(rstCustomers!Status), "", rstCustomers!Status)
        lngStatus = cboStatus.ListIndex
        txtThing.Text = IIf(IsNull(rstCustomers!Contain), "", rstCustomers!Contain)
        chkThing.Value = IIf(rstCustomers!awoke, 1, 0)
        lngchkValue = chkThing.Value
        
        If chkThing.Value = 1 Then
        
            '任务提醒
            txtThingAwoke.Text = Trim(Str(rstCustomers!awokedays))
        Else
        
            '任务不提醒
            txtThingAwoke.Text = Trim(Str(rstCustomers!awokedays))
            txtThingAwoke.Enabled = False
            txtThingAwoke.BackColor = &H8000000A
            lblThing(0).Enabled = False
            lblThing(1).Enabled = False
        End If
        
        blnTextFlag = False
        
        tmpLinkman = rstCustomers!linkman
        tmpType = rstCustomers!Type
        
        If tmpLinkman <> "" Then
        
            '检查联系人设置是否有效
            strQry = "select name,personal_ID from linkman where personal_ID in (" & tmpLinkman & ")"
            Set tmprstCustomers = GetRecordSet(cnnConnection, strQry)
            If tmprstCustomers.RecordCount <> 0 Then
            
                tmprstCustomers.MoveFirst
                
                While Not tmprstCustomers.EOF
                    txtThinglinkman.Text = txtThinglinkman.Text & tmprstCustomers!Name & "、"
                    strNewlinkman = strNewlinkman & Trim(Str(tmprstCustomers!personal_ID)) & ","
                    tmprstCustomers.MoveNext
                Wend
                
                strNewlinkman = Left(strNewlinkman, Len(strNewlinkman) - 1)
                txtThinglinkman.Text = Left(txtThinglinkman.Text, Len(txtThinglinkman.Text) - 1)
                
            Else
                strNewlinkman = ""
            End If
            
            If Len(tmpLinkman) <> Len(strNewlinkman) Then
            
                '由于某些联系人被删除,更新任务的联系人设置
                rstCustomers!linkman = strNewlinkman
                rstCustomers.Update
            End If
            
        End If
        
        If tmpType <> "" Then
        
            '检查类别设置是否有效
            strQry = "select typename,type_ID from thingtype where type_ID in (" & tmpType & ")"
            Set tmprstCustomers = GetRecordSet(cnnConnection, strQry)
            
            If tmprstCustomers.RecordCount <> 0 Then
                tmprstCustomers.MoveFirst
                
                While tmprstCustomers.EOF = False
                    txtThingtype.Text = txtThingtype.Text & tmprstCustomers!TypeName & "、"
                    strNewType = strNewType & Trim(Str(tmprstCustomers!type_ID)) & ","
                    tmprstCustomers.MoveNext
                Wend
                
                strNewType = Left(strNewType, Len(strNewType) - 1)
                txtThingtype.Text = Left(txtThingtype.Text, Len(txtThingtype.Text) - 1)
            Else
                strNewType = ""
            End If
            
            If Len(tmpType) <> Len(strNewType) Then
            
                '由于某些类别被删除,更新任务的类别设置
                rstCustomers!linkman = strNewType
                rstCustomers.Update
            End If
            
        End If
    End If
    
    If Me.Tag <> "" And framePlan.Visible = True Then
        
        '查看或修改日程安排时,显示该日程安排的各项资料
        strQry = "select * from plan where ID='" & UserID & "' and plan_ID=" & Trim(Me.Tag)
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        '当程序改控件的值是时,防止执行控件Change事件的代码!
        blnTextFlag = True
        dtpDate.Value = rstCustomers!Date
        cboStartTime.Text = rstCustomers!starttime
        cboEndTime.Text = rstCustomers!endtime
        txtPlan.Text = rstCustomers!Contain
        chkPlan.Value = IIf(rstCustomers!awoke, 1, 0)
        lngchkValue = chkPlan.Value
        
        If chkThing.Value = 1 Then
        
            '日程安排提醒
            txtPlanawoke.Text = rstCustomers!awoketime
            comboTimeType.ListIndex = rstCustomers!timetype
        Else
        
            '日程安排不提醒
            txtPlanawoke.Text = rstCustomers!awoketime
            cboTimeType.ListIndex = rstCustomers!timetype
            txtPlanawoke.Enabled = False
            txtPlanawoke.BackColor = &H8000000A
            lblPlan.Enabled = False
            cboTimeType.Enabled = False
        End If
        
        blnTextFlag = False
        
        tmpLinkman = rstCustomers!linkman
        tmpType = rstCustomers!Type
        
        If tmpLinkman <> "" Then
        
            '检查联系人设置是否有效
            strQry = "select name,personal_ID from linkman where personal_ID in (" & tmpLinkman & ")"
            Set tmprstCustomers = GetRecordSet(cnnConnection, strQry)
            
            If tmprstCustomers.RecordCount <> 0 Then
                tmprstCustomers.MoveFirst
                
                While tmprstCustomers.EOF = False
                    txtPlanlinkman.Text = txtPlanlinkman.Text & tmprstCustomers!Name & "、"
                    strNewlinkman = strNewlinkman & Trim(Str(tmprstCustomers!personal_ID)) & ","
                    tmprstCustomers.MoveNext
                Wend
                
                strNewlinkman = Left(strNewlinkman, Len(strNewlinkman) - 1)
                txtPlanlinkman.Text = Left(txtPlanlinkman.Text, Len(txtPlanlinkman.Text) - 1)
                
            Else
                strNewlinkman = ""
            End If
            
            If Len(tmpLinkman) <> Len(strNewlinkman) Then
            
                '由于某些联系人被删除,更新日程安排的联系人设置
                rstCustomers!linkman = strNewlinkman
                rstCustomers.Update
            End If
            
        End If
        
        If tmpType <> "" Then
        
            '检查类别设置是否有效
            strQry = "select typename,type_ID from thingtype where type_ID in (" & tmpType & ")"
            Set tmprstCustomers = GetRecordSet(cnnConnection, strQry)
            
            If tmprstCustomers.RecordCount <> 0 Then
                tmprstCustomers.MoveFirst
                While rstCustomers.EOF = False
                    txtolantype.Text = txtPlantype.Text & tmprstCustomers!TypeName & "、"
                    strNewType = strNewType & Trim(Str(tmprstCustomers!type_ID)) & ","
                    tmprstCustomers.MoveNext
                Wend
                
                strNewType = Left(strNewType, Len(strNewType) - 1)
                txtPlantype.Text = Left(txtPlantype.Text, Len(txtPlantype.Text) - 1)
                
            Else
                strNewType = ""
            End If
            
            If Len(tmpType) <> Len(strNewType) Then
            
                '由于某些类别被删除,更新日程安排的类别设置
                rstCustomers!linkman = strNewType
                rstCustomers.Update
            End If
            
        End If
        
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Dim i As Integer
    
    '维护 frmCalendar 窗体对象数组
    '当系统退出时，如果对象数组中还有对象，
    '则说明还有 frmCalendar 窗体没有退出,应作出相应处理
    
    '搜索当前窗体在数组中的位置
    For i = 0 To UBound(objfrmCalendar())
        If objfrmCalendar(i).hWnd = Me.hWnd Then
            Exit For
        End If
    Next i
    
    '卸载某个窗体时,将其相应窗体对象变量后面的窗体对象变量全部往数组头部移一位
    For i = i To UBound(objfrmCalendar()) - 2
            Set objfrmCalendar(i) = objfrmCalendar(i + 1)
    Next i
    
    IndexfrmCalendar = IndexfrmCalendar - 1
    ReDim Preserve objfrmCalendar(IndexfrmCalendar)
       
'    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    
End Sub

Private Sub txtEndDate_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub txtPlan_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub txtPlanawoke_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub txtStartDate_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub txtThing_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub

Private Sub txtThingAwoke_Change()

    If Not blnTextFlag Then
        blnChangedFlag = True
    End If
    
End Sub