-
November 12th, 2003, 08:11 PM
#1
some help with sheridan calendar widgets please...
hi guys,
in vb6, i have a single form.
on it, i have the following controls.
command button
SSMonth Control (sheridan)
SS Day Control (sheridan)
I have the month control displayed above the day control on the form.
The form reads and writes from an ms access database which is named "samplecalendar.mdb"
the data base has only one table which is named "Main"
this table contains the following fields:
Date - Date/Time
BeginTime - Date/Time
EndTime - Date/Time
Description - Text
What I want to do is if there is an appt on a day, i want the month calendar to be colored , checkmarked or something to indicate that there is something happening on that day., or it
would be even nicer if it just displayed a number indicating how
many things are scheduled for that day.
the code I have behind the form and controls is this:
Code:
Private Sub Command1_Click()
If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
Data1.Recordset.MoveFirst
For i = 1 To SSDay1.TaskSelected
Data1.Recordset.MoveNext
Next i
Data1.Recordset.Delete
SSDay1.X.Tasks.Remove SSDay1.TaskSelected
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "delete task"
End Sub
Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)
If changed And Not cancelled Then
If Action = 0 Then
Data1.Recordset.AddNew
Data1.Recordset("Date") = SSMonth1.Date
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
Else
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("Date") = SSMonth1.Date
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
End If
End If
End Sub
Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
Call Command1_Click
End Sub
Private Sub SSMonth1_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)
SSDay1.X.Tasks.RemoveAll
Data1.RecordSource = "Select * from Main where Date = #" & SelDate & "#"
Data1.Refresh
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveFirst
Do While Not Data1.Recordset.EOF
SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("Description")
Data1.Recordset.MoveNext
Loop
End If
End Sub
-
November 12th, 2003, 11:35 PM
#2
Well, u could use the styleset method of ssmonth. You can have a procedure like:
Private Sub CreateCalendarStylesets()
shmMontStyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "Appointments"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"
shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Appointments").BackColor = &HFF& 'Red
end sub
U can then apply these stylesets on any day u want. The logic u have to sort out. U can also use the Tagvariant ptoperty of Monthview control. For e.g., if u have a recordset that fetches all appointments for a month, then u can add these days into the selected days collection. For each such day u can set the Tagvariant. For e.g:
If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strApptName & "'" & lngApptID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strApptName & "'" & lngApptID 'The single " ' " is used as a delimiter to separate a the appointment id and name of the same appointment. The double " '' " has been used to delimit each such occurence of an appointment. I have used this schema to handle multiple occurences of appointments on a single day.
End If
The above tagvariant information u can utilize to display a tooltip on a day that will highlight for e.g., "Presentation 0900 - 1200 hrs, Tech meeting 1500 - 1600 hrs" etc. on the month calendar. Ofcourse u have to do a little bit of programming in the mousemove event (see also DayFromPos property) of the month control to utilize the tagvariant information that has been stored earlier.
Hope u have grabbed the idea. Wishing u a good programming session!!
While BUG_IN_PROGRAM
ApplyPatch
wend
Private Sub ApplyPatch
BUG_IN_PROGRAM = True
End Sub
-
November 13th, 2003, 11:27 AM
#3
well,,
thank you very very much bhardwaj.
But, I am still a newbie at vb..
I have not figured out how to incorporate your code into my project.
Do I put it in the form or in a module.., and then how do I call it ?
thanks,
kevin
-
November 14th, 2003, 09:37 AM
#4
Sorry for being a bit late for the response. The code I have provided is an illustration of how to proceed for ur problem. U can create the CreateCalendarStyleSets procedure in ur form module and call it in the form_load event.
General Declarations
Dim mblnMarkCalenderInProgress as Boolean
Private sub Form_Load()
.
.
shmMonth.StartOfWeek = ssStartOfWeekSunday
shmMonth.SelectionType = ssSelectionTypeSingleSelect
shmMonth.AutoSelect = True
shmMonth.DefaultDate = Date
shmMonth.FocusDate = Date
shmMonth.Refresh
Call CreateCalendarStyleSets
.
.
Call MarkEventsOnYearCalendar(Date);
.
.
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.
Dim intMonth As Integer
Dim intYear As Integer
Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long
On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
mblnMarkCalenderInProgress = True
'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""
If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "WorkingDay"
End If
shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend
'Write here query to fetch event data for the current month. Create a recordset, say: objRecordSet
While Not objRecordSet.EOF
strEventName = objRecordSet!EventName
strEventType = objRecordSet!EventType
lngEventID = objRecordSet!EventID
strDueDate = objRecordSet!EventDueDate
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True
If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If
If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
shmMonth.SelectedDays(0).StyleSet = strEventType
Endif
objRecordSet.MoveNext
Wend
If Not objRecordSet Is Nothing Then
If objRecordSet.State <> adStateClosed Then
'Close Recordset
objRecordSet.Close
End If
'Release Recordset FROM memory
Set objRecordSet = Nothing
End If
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False
Exit Sub
ErrorHandler_MarkEventsOnMonthCalendar:
If Not objRecordSet Is Nothing Then
If objRecordSet.State <> adStateClosed Then
'Close Recordset
objRecordSet.Close
End If
'Release Recordset FROM memory
Set objRecordSet = Nothing
End If
mblnMarkCalenderInProgress = False
End Sub
Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events
If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If
shmMonth.SelectedDays.Add FocusDate
End If
End Sub
Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub
Remember this is just an example of how u can get along with ur problem. U have to make changes in the above procedures according to ur requirement. Try to catch the logic.
Hope it works!!
Last edited by bhardwaj_kamal; November 14th, 2003 at 09:48 AM.
While BUG_IN_PROGRAM
ApplyPatch
wend
Private Sub ApplyPatch
BUG_IN_PROGRAM = True
End Sub
-
November 14th, 2003, 09:41 AM
#5
Correction!!
Hi there is a minor correction. I had called proc: MarkEventsOnYearCalendar in Form Load. It is a typing mistake. Call MarkEventsOnMonthCalendar instead.
Bye!!
While BUG_IN_PROGRAM
ApplyPatch
wend
Private Sub ApplyPatch
BUG_IN_PROGRAM = True
End Sub
-
November 14th, 2003, 05:39 PM
#6
ok bhardwaj....
i think i am getting closer.., thank you so much for your help..
it seems to highlight the weekdays and weekends with different colors, but it is not doing it for the days that have something scheduled..
here is the full code in the form that i have so far:
again, thank you so much for your help.
kevin
Code:
Dim mblnMarkCalenderInProgress As Boolean
Private Sub CreateCalendarStylesets()
SSMonth1.StyleSets.Add "DayCaptionAlignment"
SSMonth1.StyleSets.Add "Meetings"
SSMonth1.StyleSets.Add "Appointments"
SSMonth1.StyleSets.Add "WeekEnd"
SSMonth1.StyleSets.Add "WorkingDay"
SSMonth1.StyleSets("DayCaptionAlignment").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("DayCaptionAlignment").ForeColor = SSMonth1.ForeColor
SSMonth1.StyleSets("WorkingDay").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("WorkingDay").ForeColor = SSMonth1.ForeColor
SSMonth1.StyleSets("WeekEnd").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
SSMonth1.StyleSets("Meetings").BackColor = &H80FF80 'Green
SSMonth1.StyleSets("Appointments").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.
Dim intMonth As Integer
Dim intYear As Integer
Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long
'On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
'On Error Resume Next
mblnMarkCalenderInProgress = True
'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth
If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If
While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
SSMonth1.SelectedDays.Add strTempStartDate
SSMonth1.SelectedDays(0).TagVariant = Null
SSMonth1.SelectedDays(0).Caption = ""
If Weekday(SSMonth1.SelectedDays(0).Date) = 1 Or Weekday(SSMonth1.SelectedDays(0).Date) = 7 Then
SSMonth1.SelectedDays(0).StyleSet = "WeekEnd"
Else
SSMonth1.SelectedDays(0).StyleSet = "WorkingDay"
End If
SSMonth1.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend
'Write here query to fetch event data for the current month. Create a recordset
'say: data1.Recordset
While Not Data1.Recordset.EOF
While Not Data1.Recordset.EOF
strEventName = Data1.Recordset!EventName
strEventType = Data1.Recordset!EventType
lngEventID = Data1.Recordset!EventID
strDueDate = Data1.Recordset!EventDueDate
If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If
SSMonth1.SelectedDays.Add strDueDate
SSMonth1.SelectedDays(0).Enabled = True
If IsNull(SSMonth1.SelectedDays(0).TagVariant) Then
SSMonth1.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
SSMonth1.SelectedDays(0).TagVariant = SSMonth1.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If
If SSMonth1.SelectedDays(0).StyleSet <> "WorkingDay" And SSMonth1.SelectedDays(0).StyleSet <> "WeekEnd" Then
SSMonth1.SelectedDays(0).StyleSet = "MultipleEvents"
Else
SSMonth1.SelectedDays(0).StyleSet = strEventType
End If
Data1.Recordset.MoveNext
Wend
If Not Data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
Data1.Recordset.Close
End If
'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If
SSMonth1.FocusDate = strSelDate
mblnMarkCalenderInProgress = False
Exit Sub
'ErrorHandler_MarkEventsOnMonthCalendar:
'If Not data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
'data1.Recordset.Close
'End If
'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
Wend
mblnMarkCalenderInProgress = False
End Sub
Private Sub Command1_Click()
If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
Data1.Recordset.MoveFirst
For i = 1 To SSDay1.TaskSelected
Data1.Recordset.MoveNext
Next i
Data1.Recordset.Delete
SSDay1.X.Tasks.Remove SSDay1.TaskSelected
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "delete task"
SSMonth1.Date = Date
SSMonth1.StartOfWeek = ssStartOfWeekSunday
SSMonth1.SelectionType = ssSelectionTypeSingleSelect
SSMonth1.AutoSelect = True
SSMonth1.DefaultDate = Date
SSMonth1.FocusDate = Date
SSMonth1.Refresh
Call CreateCalendarStylesets
Call MarkEventsOnMonthCalendar(Date)
End Sub
Private Sub SSMonth1_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events
If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If
SSMonth1.SelectedDays.Add FocusDate
End If
End Sub
Private Sub SSMonth1_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
SSMonth1.Refresh
End Sub
Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)
If changed And Not cancelled Then
If Action = 0 Then
Data1.Recordset.AddNew
Data1.Recordset("Date") = SSMonth1.Date
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
Else
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("Date") = SSMonth1.Date
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
End If
End If
End Sub
Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
Call Command1_Click
End Sub
Private Sub SSMonth1_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)
SSDay1.X.Tasks.RemoveAll
Data1.RecordSource = "Select * from Main where Date = #" & SelDate & "#"
Data1.Refresh
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveFirst
Do While Not Data1.Recordset.EOF
SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("Description")
Data1.Recordset.MoveNext
Loop
End If
End Sub
-
November 17th, 2003, 01:27 AM
#7
Please confirm the following:
Are u first testing the code I have provided? or have u integrated it with ur stuff?
Well if u r testing my code then u have to have the following tables in ur database:
Table: EventArchive: Will store the info about the events for e.g, meetings, appointments etc
-------
Name Type Description
------- -----
EventID Integer Primary Key column
EventName VarChar(50) Name of the event
EventTypeID Integer Foreign Key to EventType.EventTypeID
DueDate DateTime The due date of the event
Table: EventType: Will store the the type of events for e.g., meetings, appointments etc
-----
Name Type Description
------- -----
EventTypeID Integer Primary Key column
EventType VarChar(50) Identifies Eventtype viz., Meeting, Appointment etc.
So the query in the MarkEventsOnMonthCalendar procedure will look something like:
strSQL = "SELECT EA.EventID, EA.EventName, EA.DueDate, ET.EventType FROM EventArchive EA, EventType ET"
strSQL = strSQL & " WHERE EA.EventTypeID = ET.EventTypeID AND Month(EA.DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(EA.DueDate) = Year('" & strSelDate & "') Order By EA.DueDate"
If u want to incorporate my code in ur stuff, then priority should be given to ur requirements. What I mean to say is u should create as many stylesets as the number of event types u can have for e.g., holiday, meetings, appointments etc. U can have different combination of Forecolor, Backcolor etc for each of these stylesets. So that when u fetch events for a particular month using the proc: MarkEventsOnMonthCalendar, u can set ur selected days collection styleset property set accordingly. There might be a case when in a single day, u can have more than one event. U can have a separate Styleset: MultipleEvents. The code in proc: MarkEventsOnMonthCalendar handles this situation:
If SSMonth1.SelectedDays(0).StyleSet <> "WorkingDay" And SSMonth1.SelectedDays(0).StyleSet <> "WeekEnd" Then
SSMonth1.SelectedDays(0).StyleSet = "MultipleEvents"
Else
SSMonth1.SelectedDays(0).StyleSet = strEventType
End If
We are assuming the default styleset to be either one of "WorkingDay" or "WeekEnd".
I suppose u have sufficient information to test my code.
As far as ur code is concerned, U said u have only one table: Main. Ok rename it as EventArchieve. Rename Date field as DueDate. Add other fields to this table that I have listed above. Add another table EventType as listed above. Provide an interface from ur application GUI from where the user can define EventTypes. Store these eventtypes in EventType table. Rename ur Monthview control SSMonth1 to shmMonth
Alter ur event procedure: SSDay1_CloseEdit to something like:
Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)
If changed And Not cancelled Then
shmMonth.Enabled=False
If Action = 0 Then
Data1.Recordset.AddNew
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
Else
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
End If
Call subMarkEventsOnMonthCalendar(shmMonth.FocusDate)
shmMonth.SelectedDays.Add shmMonth.FocusDate
shmMonth.Enabled=True
End If
End Sub
Rgds,
Last edited by bhardwaj_kamal; November 17th, 2003 at 01:57 AM.
While BUG_IN_PROGRAM
ApplyPatch
wend
Private Sub ApplyPatch
BUG_IN_PROGRAM = True
End Sub
-
November 17th, 2003, 07:47 AM
#8
yes
I have intetgrated into my program.
the code i posted is the whole program with your code in it.
ok, here is what i have so far.. i still can not get the appt days to highlight... only the weekend and week days are highlighting..
Code:
Dim mblnMarkCalenderInProgress As Boolean
Private sSelectedMonth As String
Private Sub CreateCalendarStylesets()
shmMonth.StyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"
shmMonth.StyleSets.Add "Charter"
shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Charter").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.
Dim intMonth As Integer
Dim intYear As Integer
Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long
'On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
On Error Resume Next
strSQL = "SELECT EventID, EventName, DueDate, EventType, BeginTime, EndTime FROM EventArchive, EventType"
strSQL = strSQL & " WHERE EventTypeID = EventTypeID AND Month(DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(DueDate) = Year('" & strSelDate & "') Order By DueDate"
mblnMarkCalenderInProgress = True
'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""
'markings for days are here
If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "Weekday"
End If
shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend
'Write here query to fetch event data for the current month. Create a recordset
'say: data1.Recordset
While Not Data1.Recordset.EOF
While Not Data1.Recordset.EOF
strEventName = Data1.Recordset!EventName
strEventType = Data1.Recordset!EventType
lngEventID = Data1.Recordset!EventID
strDueDate = Data1.Recordset!EventDueDate
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True
If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If
If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
'shmMonth.SelectedDays(0).StyleSet = strEventType
shmMonth.SelectedDays(0).StyleSet = Charter
End If
Data1.Recordset.MoveNext
Wend
If Not Data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
Data1.Recordset.Close
End If
'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False
Exit Sub
'ErrorHandler_MarkEventsOnMonthCalendar:
'If Not data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
'data1.Recordset.Close
'End If
'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
Wend
mblnMarkCalenderInProgress = False
End Sub
Private Sub cboMonth_Click()
sSelectedMonth = cboMonth.Text
End Sub
Private Sub Command1_Click()
If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
Data1.Recordset.MoveFirst
For i = 1 To SSDay1.TaskSelected
Data1.Recordset.MoveNext
Next i
Data1.Recordset.Delete
SSDay1.X.Tasks.Remove SSDay1.TaskSelected
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "delete task"
shmMonth.Date = Date
Me.appttype.Text = "Charter"
shmMonth.StartOfWeek = ssStartOfWeekSunday
shmMonth.SelectionType = ssSelectionTypeSingleSelect
shmMonth.AutoSelect = True
shmMonth.DefaultDate = Date
shmMonth.FocusDate = Date
shmMonth.Refresh
Call CreateCalendarStylesets
Call MarkEventsOnMonthCalendar(Date)
cboMonth.AddItem "January"
cboMonth.AddItem "February"
cboMonth.AddItem "March"
cboMonth.AddItem "April"
cboMonth.AddItem "May"
cboMonth.AddItem "June"
cboMonth.AddItem "July"
cboMonth.AddItem "August"
cboMonth.AddItem "September"
cboMonth.AddItem "October"
cboMonth.AddItem "November"
cboMonth.AddItem "December"
cboMonth.Text = "January"
End Sub
Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events
If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If
shmMonth.SelectedDays.Add FocusDate
End If
End Sub
Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub
Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)
If changed And Not cancelled Then
shmMonth.Enabled = False
If Action = 0 Then
Form1.appttype.Text = Form2.List1.Text
Unload Form2
Data1.Recordset.AddNew
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset("EventType") = Me.appttype.Text
Data1.Recordset.Update
Else
Form1.appttype.Text = Form2.List1.Text
Unload Form2
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and EventName ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset("EventType") = Me.appttype.Text
Data1.Recordset.Update
End If
Call MarkEventsOnMonthCalendar(shmMonth.FocusDate)
shmMonth.SelectedDays.Add shmMonth.FocusDate
shmMonth.Enabled = True
End If
End Sub
Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
Call Command1_Click
End Sub
Private Sub shmMonth_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)
SSDay1.X.Tasks.RemoveAll
Data1.RecordSource = "Select * from EventArchive where DueDate = #" & SelDate & "#"
Data1.Refresh
If Data1.Recordset.RecordCount > 0 Then
Data1.Recordset.MoveFirst
Do While Not Data1.Recordset.EOF
SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("EventName")
Data1.Recordset.MoveNext
Loop
End If
End Sub
Last edited by kevinrea; November 17th, 2003 at 06:25 PM.
-
November 18th, 2003, 04:31 PM
#9
-
November 24th, 2003, 04:08 AM
#10
Hi Kevin, I was busy in the last few days so couldn't keep track of ur progress. Well, I saw the code u last posted. Please don't mind if I say that u never bothered to scan the code for bugs. U have to check the procedure: MarkEventsOnMonthCalendar. U have inserted the query strSQL = "..., but did not bother to create a recordset using this query. If u do not create a recordset in the first place how do u expect to retrieve records from the database. This is the first problem. The second problem is that u have used the while statement (While Not Data1.Recordset.EOF
) two times in the same procedure. Thirdly, never use On error resume next statement. If u do this u will never be announced errors by VB. So uncomment the line On error goto ...
I would advise u to create an ADO recordset using the query stored in strSQL. I presume that u know how to create an ADO recordset. Name this recordset say, objRecordset. Replace Data1.Recordset with objRecordset at all occurences in this procedure. And then tell me if ur code does not work.
Good luck!
Kamal
While BUG_IN_PROGRAM
ApplyPatch
wend
Private Sub ApplyPatch
BUG_IN_PROGRAM = True
End Sub
-
November 25th, 2003, 04:11 PM
#11
ok...
thank you for your patience and help..
here is what I have so far...
it is not highlighting the events yet...
remember, i really am a beginner at this still...,
kevin
Code:
Dim mblnMarkCalenderInProgress As Boolean
Private sSelectedMonth As String
Private Sub CreateCalendarStylesets()
shmMonth.StyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"
shmMonth.StyleSets.Add "Charter"
shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Charter").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.
Dim intMonth As Integer
Dim intYear As Integer
Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long
On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
'On Error Resume Next
strSQL = "SELECT EventID, EventName, DueDate, EventType, BeginTime, EndTime FROM tblEventArchive, EventType"
strSQL = strSQL & " WHERE EventTypeID = EventTypeID AND Month(DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(DueDate) = Year('" & strSelDate & "') Order By DueDate"
mblnMarkCalenderInProgress = True
'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""
'markings for days are here
If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "Weekday"
End If
shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend
'Write here query to fetch event data for the current month. Create a recordset
'say: objRecordset
While Not objRecordset.Recordset.EOF
strEventName = objRecordset.Recordset!EventName
strEventType = objRecordset.Recordset!EventType
lngEventID = objRecordset.Recordset!EventID
strDueDate = objRecordset.Recordset!EventDueDate
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True
If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If
If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
'shmMonth.SelectedDays(0).StyleSet = strEventType
shmMonth.SelectedDays(0).StyleSet = Charter
End If
objRecordset.Recordset.MoveNext
Wend
If Not objRecordset Is Nothing Then
If objRecordset.Recordset.Type <> adStateClosed Then
'Close Recordset
objRecordset.Recordset.Close
End If
'Release Recordset FROM memory
Set objRecordset.Recordset = Nothing
End If
If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If
shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False
Exit Sub
ErrorHandler_MarkEventsOnMonthCalendar:
If Not objRecordset Is Nothing Then
'If objRecordset.State <> adStateClosed Then
Close Recordset
objRecordset.Recordset.Close
End If
'Release Recordset FROM memory
Set objRecordset.Recordset = Nothing
mblnMarkCalenderInProgress = False
End Sub
Private Sub cboMonth_Click()
sSelectedMonth = cboMonth.Text
End Sub
Private Sub Command1_Click()
If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
objRecordset.MoveFirst
For i = 1 To SSDay1.TaskSelected
objRecordset.MoveNext
Next i
objRecordset.Delete
SSDay1.X.Tasks.Remove SSDay1.TaskSelected
End If
End Sub
Private Sub Form_Load()
Dim adoConn As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Set adoConn = New ADODB.Connection
adoConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source= " & App.Path & "\samplecalendar.mdb"
adoConn.Open
Set objRecordset = New ADODB.Recordset
objRecordset.Open "tblEventArchive", adoConn, adOpenKeyset, adLockPessimistic, adCmdTable
Command1.Caption = "delete task"
shmMonth.Date = Date
shmMonth.StartOfWeek = ssStartOfWeekSunday
shmMonth.SelectionType = ssSelectionTypeSingleSelect
shmMonth.AutoSelect = True
shmMonth.DefaultDate = Date
shmMonth.FocusDate = Date
shmMonth.Refresh
Call CreateCalendarStylesets
Call MarkEventsOnMonthCalendar(Date)
cboMonth.AddItem "January"
cboMonth.AddItem "February"
cboMonth.AddItem "March"
cboMonth.AddItem "April"
cboMonth.AddItem "May"
cboMonth.AddItem "June"
cboMonth.AddItem "July"
cboMonth.AddItem "August"
cboMonth.AddItem "September"
cboMonth.AddItem "October"
cboMonth.AddItem "November"
cboMonth.AddItem "December"
cboMonth.Text = "January"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set adoConn = Nothing
Set objRecordset.Recordset = Nothing
End Sub
Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events
If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If
shmMonth.SelectedDays.Add FocusDate
End If
End Sub
Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub
Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)
If changed And Not cancelled Then
shmMonth.Enabled = False
If Action = 0 Then
objRecordset.Recordset.AddNew
objRecordset.Recordset("DueDate") = shmMonth.FocusDate
objRecordset.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
objRecordset.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
objRecordset.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
'objRecordset.Recordset("EventType") = Me.appttype.Text
objRecordset.Recordset.Update
Else
objRecordset.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and EventName ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
objRecordset.Recordset.Edit
objRecordset.Recordset("DueDate") = shmMonth.FocusDate
objRecordset.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
objRecordset.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
objRecordset.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
objRecordset.Recordset.Update
End If
Call MarkEventsOnMonthCalendar(shmMonth.FocusDate)
shmMonth.SelectedDays.Add shmMonth.FocusDate
shmMonth.Enabled = True
End If
End Sub
Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
Call Command1_Click
End Sub
Private Sub shmMonth_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)
SSDay1.X.Tasks.RemoveAll
objRecordset.RecordSource = "Select * from tblEventArchive where DueDate = #" & SelDate & "#"
objRecordset.Refresh
If objRecordset.Recordset.RecordCount > 0 Then
'If objRecordset.Recordset.Count Then
objRecordset.Recordset.MoveFirst
Do While Not objRecordset.Recordset.EOF
SSDay1.X.Tasks.Add objRecordset.Recordset("BeginTime"), objRecordset.Recordset("EndTime"), objRecordset.Recordset("EventName")
objRecordset.Recordset.MoveNext
Loop
End If
End Sub
Last edited by kevinrea; November 25th, 2003 at 04:44 PM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|