ActiveX Samples
Add a ScheduleItem
You can add a ScheduleItem by using the Add method of the ScheduleItems collection. Since there are more properties of a ScheduleItem than the Add method allows, there may come a time when you want to modify an added item. The following code shows you how to add and item and get a reference to the new item. After that you can modify the newly added item's properties.
|
Dim oNewEl As clsScheduleEl
Set oNewEl = ScheduleItems.Add(....)
oNewEl.StartDate = #1/1/2002#
...
...
Set oNewEl = Nothing
|
Load/Save a Schedule from/to a database
Below is code to load and save schedules from a form. The LoadSchedule should be place in the Form_Load or some load event. The SaveSchedule can be put in the Form_QueryUnload or a save button. The name of the Schedule object is "Schedule1". This is sitting on the oChild/oNewChild form. "ScheduleItems" is the list of appointments for the specified schedule. If you more than one schedule, you will have to load/save EACH one of them. This example assume that you have an Access database "schedule.mdb" and that you have a table named "tblSchedule" with the fields "Date", "Time", "Length", "Description".
|
Public Sub LoadSchedule()
'This procedure Loads a Schedules from the database
Dim db As ADODB.Connection
Dim rs As ADODB.Recordset
Set db = New ADODB.Connection
db.ConnectionString = GetConnectString & AppPath & "schedule.mdb"
Call db.Open
Set rs = New ADODB.Recordset
Set rs = db.Execute("select * from tblSchedule")
While Not rs.EOF
Call Schedule1.ScheduleItems.Add("", & _
rs!Date, rs!Time, _
rs!Length, rs!Description)
Call rs.MoveNext
Wend
End Sub
Private Sub SaveSchedule(oChild As frmChild)
'This procedure saves the ActiveWindow to the database
Dim db As ADODB.Connection
Dim ii As Long
Dim sSql As String
Set db = New ADODB.Connection
db.ConnectionString = GetConnectString & AppPath & "schedule.mdb"
Call db.Open
For ii = 1 To oChild.Schedule1.ScheduleItems.Count
With oChild.Schedule1.ScheduleItems(ii)
sSql = "insert into tblSchedule (Description, "
sSql = sSql & "[Date], [Time], Length) values ("
sSql = sSql & "'" & .DisplayText & "',"
sSql = sSql & "#" & .StartDate & "#,"
sSql = sSql & "#" & .StartTime & "#,"
sSql = sSql & .Length & ")"
End With
Call db.Execute(sSql)
Next ii
End Sub
|
Add a Category
You can have categories on any schedule. A category can anything that you wish to assign to an appointment. For example, in the example below, you may rent automobiles. Below are defined several automobiles as categories. When you make an appointment, you could assign the "Category" property of the newly added appointment to the "Chevy" and the appointment would have a red bar next to it.
|
Dim NewEl As clsCategoryCol
Set NewEl = Schedule1.ScheduleItems.Categories.Add
("Vehicles")
Call NewEl.Add("Ford Truck1", vbBlue)
Call NewEl.Add("Ford Truck2", vbYellow)
Call NewEl.Add("Chevy", vbRed)
Call NewEl.Add("BMW", vbBlack)
Set NewEl = Nothing
|
Add a Room
If the Viewmode property of a schedule is set to display rooms then you will need to setup the Rooms collection. A schedule can have as many rooms as you wish. A room is nothing more than a caption. When adding an appointment it will be necessary to specify in which room the appointment belongs. Each appointment has a "Room" property.
|
If Schedule1.Rooms.Exists(sRoom) Then
Call MsgBox ("The room already exists!", & _
vbExclamation, "Error!")
Else
Call Schedule1.Rooms.Add(sRoom)
End If
|
Conflicts
Conflicts can happen when two or more appointments are scheduled for the same time slot. When the "ConflictWarn" property is True, the user will be prompted for a move or copy confirmation should the moved or copied appointment cause a conflict. If this property is False then the is no warning of a conflict. In the course of using the schedule there may be numerous conflicts. There are times when the developer needs to know where conflicts exists so that some processing may be done. The "Conflicts" collection will give you an index of all the ScheduleItem that are conflicting. For example, assume that there are two appointments on the schedule:
Appointment 1: Jan 2, 2002 @ 8:00 AM for 120 Minutes
Appointment 2: Jan 2, 2002 @ 9:00AM for 120 Minutes
Now the first appointment has a duration form 8:00 AM - 10:00AM and the second from 9:00 AM - 11:00AM. Clearly there is a conflict from 9:00AM - 10:00AM. If you looked at the "Conflicts" collection there would be two entries because the first conflicts with the second and the second conflicts with the first.
Using the following code we can iterate through the collection.
|
Private Sub cmdConflicts_Click()
Dim oConflict As CConflictEl
Dim oSI As CScheduleCol
Dim oAppt As CScheduleEl
Dim sText As String
Dim sMsg As String
Dim lCount As Long
'Set a reference to the ScheduleItems collection
Set oSI = Schedule1.ScheduleItems
For Each oConflict In Schedule1.Conflicts
If oConflict.Index <> -1 Then
sMsg = sMsg & oSI(oConflict.Index).StartDate & " " & _
oSI(oConflict.Index).StartTime & " : " & _
oSI(oConflict.Index).Length & " minutes" & vbCrLf
Else
sMsg = sMsg & "Custom Appointment" & vbCrLf
End If
'Loop through the sub items this is
'a list of the scheduled items that are
'in conflict with the specifed scheduled item
For Each oAppt In oConflict.ScheduleItems
If oAppt.Index <> -1 Then
sMsg = sMsg & vbTab & oAppt.Name & " " & _
oAppt.StartDate & " " & _
oAppt.StartTime & " : " & _
oAppt.Length & " minutes" & vbCrLf
Else
sMsg = sMsg & vbTab & "Custom Appointment" & vbCrLf
End If
Next
'Calculate the number of conflicts
If oConflict.ScheduleItems.Count > 1 Then
lCount = lCount + oConflict.ScheduleItems.Count
End If
sMsg = sMsg & "" & vbCrLf
Next
Set oSI = Nothing
sMsg = "Conflicting Appointments: " & lCount & vbCrLf & vbCrLf & sMsg
Call MsgBox(sMsg, vbInformation)
End Sub
|
The following message will be displayed. It shows the two appointments and what is conflicting with each appointment. So for every conflicting appointment 1 that conflicts with appointment 2, appointment 2 must also conflict with appointment 1.
Printing
When you choose to print it is extremely simple just make sure the Schedule is in the mode that you wish (DayTopTimeLeft, RoomTopTimeLeft, etc....). Just specify the MinDate and MaxDate and the start time and time length. There are slightly different parameters for the different viewmodes. For example there is no need to specfy dates when printing a room/time schedule (one with no dates). Also in the day/room modes there are no times therefore the time need not be specified in this case. Below is an example of printing in two different viewmodes.
You must be careful of the parameters that you specify, as errors may occur when calling the GoPrint method. First if the printer information is invalid, an error will occur. Also if any of the parameters are out of range an error will occur. For example, if there are 3 rooms in the Rooms collection and you specify to print rooms 1 to 4 then an error will be raised "Subscript out of range". The same goes for dates and times. A specified date range must be in the range of MinDate to MaxDate. Also a specified time must be between the StartTime and (StartTime+Daylength).
|
Dim dtEndTime As Date
Dim oPrinterParameter As CPrinterParameter
Set oPrinterParameter = New CPrinterParameter
oPrinterParameter.PrinterDeviceName = Printer.DeviceName
oPrinterParameter.Orientation = 1 'Portrait
oPrinterParameter.PaperSize = sppcLetter
dtEndTime = DateAdd("h", Schedule1.DayLength, Schedule1.StartTime)
If Schedule1.ViewMode = vmcNormalRoomTopTimeLeft Then
'Room Top / Time Left
Call Schedule1.GoPrint(1, Schedule1.Rooms.Count, _
Schedule1.StartTime, dtEndTime, _
oPrinterParameter)
ElseIf Schedule1.ViewMode = vmcNormalDayTopTimeLeft Then
'Day Top / Time Left
Call Schedule1.GoPrint(Schedule1.MinDate, Schedule1.MaxDate, _
Schedule1.StartTime, dtEndTime, _
oPrinterParameter)
ElseIf Schedule1.ViewMode = vmcNormalDayTopRoomLeftNoTime Then
'Day Top / Time Left
Call Schedule1.GoPrint(Schedule1.MinDate, Schedule1.MaxDate, _
1, Schedule1.Rooms.Count, _
oPrinterParameter)
End If
|
Resize without conflicts
There are times when you may not want the user to resize an appointment so that it conflicts with another appointment. There is a simple solution for this matter. In the "WhileItemResize" event you can check for a conflict. If there is one, you may cancel the operation. The event has "NewStartTime" and "NewLength" parameters that let you check to see if the new values will cause a conflict and if so set the Cancel parameter to True and no resize occurs.
|
Private Sub Schedule1_WhileItemResize(ByVal Index As Long, ByVal NewStartTime As Date, ByVal NewLength As Long, Cancel As Boolean)
Dim oAppt As CScheduleEl
Set oAppt = Schedule1.ScheduleItems(Index)
Cancel = Schedule1.Conflicts.IsConflictByData(oAppt.StartDate, _
Schedule1.Rooms.Index(oAppt.Room), _
NewStartTime, NewLength, Index)
Set oAppt = Nothing
End Sub
|
Moving/Copying without conflicts
As with resizing, you may not want a user to move (or copy) an appointment to a position that will conflict with an existing appointment. The "DragOverSchedule" event will allow you to check for conflicts and disallow a move if necessary. The event gives you all the information you need to check for conflicts. If you wish to disallow a move then set the "Effect" parameter to vbDropEffectNone (0). This makes the mousepointer a no-drop symbol. The schedule will not accept a drop if the user releases the mouse button while the no-drop is displayed.
|
Private Sub Schedule1_DragOverScheduleItem(ByVal ApptDate As Date, _
ByVal ApptRoom As Long, _
ByVal ApptTime As Date, _
ApptLength As Long, _
ByVal DragOperation As Scheduler.DragOperationConstants, _
ByVal X As Long, _
ByVal Y As Long, _
Effect As Long)
If Schedule1.Conflicts.IsConflictByData(Now, _
ApptRoom, _
ApptTime, 30) Then
Effect = 0
End If
End Sub
|
Add, Move, Or Copy?
When a user is dragging an appointment over a schedule, you may wish to perform some processing based on the dragging operation. You may need to do something some special code for adds perhaps. There is a simple way to check the current operation. In the "DragOverSchedule" event there is a "DragOperation" parameter that evaluates to Add, Copy, Move, or None. If the <CTRL> key is pressed then the operation is a "Copy" otherwise it is a "Move". Note that if the property "AllowOtherDrops" is True and the user is dragging a non-schedule item onto the schedule (files, text, etc...), then this parameter is always "Add", since when dropped this foreign object will be a new appointment.
|
Private Sub Schedule1_DragOverScheduleItem(ByVal ApptDate As Date, _
ByVal ApptRoom As Long, _
ByVal ApptTime As Date, _
ApptLength As Long, _
ByVal DragOperation As Scheduler.DragOperationConstants, _
ByVal X As Long, _
ByVal Y As Long, _
Effect As Long)
If DragOperation = dragAdd Then
Debug.Print "Add"
ElseIf DragOperation = dragCopy Then
Debug.Print "Copy"
ElseIf DragOperation = dragMove Then
Debug.Print "Move"
End If
End Sub
|
NoDrop Area
You can define areas of a schedule NoDrop areas. These areas will not allow an appointment to stick in that range. For example, you could a schedule and wish to define a lunch hour from 12:00 PM to 1:00 PM. You do not want anyone to put a schedule in this area of the schedule. You would use the 'NoDropAreas' collection as shown below.
This would make a NoDrop zone at 12:00 PM that lasts for 60 minutes. You can use this collection to define any area of the schedule as NoDrop zone in any viewmode.
|
Call Schedule1.NoDropAreas.Add(, , #12:00:00 PM#, 60)
Call Schedule1.NoDropDates.Add(#1/3/2002#)
|
Export HTML
There may come a time when you wish to take your schedule and publish it on the Internet. GbSchedule will generate an HTML page with the current schedule using the following code.
This code will export to the file "c:\myschedule.htm". The name of the page will be "Schedule for Today". This file will be overwritten if it exists as indicated. There are also parameters "HTMLHeader", and "HTMLFooter" that allow you to construct a complex page with a schedule displayed somewhere in it.
|
Dim oHTMLParameters As CHTMLParameters
Set oHTMLParameters = New CHTMLParameters
oHTMLParameters.HTMLHeader = "Schedule I"
oHTMLParameters.FileName = "c:\myschedule.htm"
oHTMLParameters.TableOnly = False
oHTMLParameters.PageTitle = "Schedule for Today"
oHTMLParameters.UseFrames = False
oHTMLParameters.Overwrite = True
Call Schedule1.ExportHTML(oHTMLParameters)
|
Find Free Slot
There may come a time when you wish to add some advanced functionality to your schedule in form of helping the user to find a free spot for an appointment on the schedule. If you have many appointments on a schedule, it may not be easy to just look at it and find a free space for an appointment. Luckily, there is functionality to perform this for you already. Given a starting position on the schedule the 'GetNextFreeSlot' method will return an appointment with the next available date, room, and time. This functionality allows you to add with little effort the ability to let your users specify a starting position and get the next free appointment slot after that specified position that will fit the appointment.
|
Dim oAppt As CScheduleEl
'Find free appointment slot
Set oAppt = Schedule1.GetNextFreeSlot("", #1/1/2003#, _
"Room1", #2:00:00 PM#, 60, _
Schedule1.ScheduleItems("Test").Index)
'Move the appointment to the newly found position
Schedule1.ScheduleItems("Test").StartDate = oAppt.StartDate
Schedule1.ScheduleItems("Test").Room = oAppt.Room
Schedule1.ScheduleItems("Test").StartTime = oAppt.StartTime
|
|