'++LotusScript Development Environment:2:5:(Options):0:74
Option Public
Option Declare
'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Sub displayBlock(txt As String, start As Double, finish As Double, roomName As String)
Declare Sub readBlock(dateReserved As String)
Declare Sub clearDisplay
Declare Sub displayRooms
Declare Function modifySchedule(dateReserved As String, roomName As String, ReservedBy As String, start As Double, finish As Double, note As String, modType As Integer) As Integer
Declare Sub modifyRoomsArray(modifyType As Integer)
Declare Sub fillRoomsArray
Declare Function modifyRooms
Declare Sub deleteScheduledRemovedRooms
Declare Sub string_sort(array() As String)
Declare Function isScheduled (schedDate As String, roomName As String, schedTime As Double) As Integer
Declare Sub displaySchedule(dateToDisplay As String)
Declare Sub processDate
'++LotusScript Development Environment:2:5:(Declarations):0:10
Dim rooms() As String
Dim deletedRooms() As String
Dim GlobDateDisplay As String
Dim GlobStartTime As String
Dim GlobEndTime As String
Dim GlobRoom As String
Dim GlobReservedBy As String
Dim GlobNote As String
%INCLUDE "LSCONST.lss"
'++LotusScript Development Environment:2:2:displayBlock:1:8
Sub displayBlock(txt As String, start As Double, finish As Double, roomName As String)
'Displays the reservation owner in the correct time slot
'on the current view body.
'Called from readBlock
' txt reservation owner
' start reservation start time
' finish reservation end time
' roomName reservation room name or number
'RUNTIME DEPENDENCIES
'Constants: Uses constants defined by LotusScript defined in
'LSCONST.LSS.
'Globals: Uses the global array Rooms() filled by the readBlock
'sub.
'Declare variables
Dim tt As textbox 'New textbox to hold the reservation
'owner name on the view
Dim i As Integer 'Index of array with the room names
'Index of the room that matches the roomName passed in.
'Used to determine the vertical placement of the reservation
'info on the view.
Dim matchedRoom As Integer
'Offset and multiplier for the vertical placement of the
'reservation info.
Dim verticalPlacement As Integer
'Search through the global array Rooms to find the room passed
'in from the schedule database using the sub readBlock.
'Set matchedRoom to the index of the room passed in.
For i = 0 To Ubound(Rooms)
If Rooms(i) = roomName Then
matchedRoom = i
i = Ubound(Rooms)
End If 'If element matches the room passed in.
Next
'Set position and display for the reservation info.
'Header on the view takes up 1635 twips, each row in the table
'is 330 twips tall
verticalPlacement = 1635 + (330 * matchedRoom)
'Create the textbox to hold the reservation info
Set tt = New textbox(currentview.body)
'Fill the text of the textbox with the reservation owner name
'and spaces to center the text properly
tt.Text = " " + txt + " "
'Set display properties for the textbox to match the form
tt.Font.Size = 8
' Use LotusScript constants for border style
tt.Border.Style = $ltsBorderStyleNone
tt.Border.Left = True
tt.Border.Right = True
tt.Border.Top = False
tt.Border.Bottom = False
' Use Approach constants for line width
tt.Border.Width = $apr1point
' Use LotusScript constants for color
Call tt.Border.Color.SetRGB(COLOR_ULTRAMARINE)
Call tt.Background.Color.SetRGB (COLOR_50_GRAY)
'Set up the position of the textbox to correspond to the
'correct room and time.
tt.Height = 325
tt.Top = verticalPlacement 'Current offset from top of
'form
'Convert reservation time (passed in) to the horizontal
'location and length on the form.
tt.Left = (((start - 8) * 750) + 945)
tt.Width = (750 * (finish - start))
'Add a prefix to the name of the textbox so the clearDisplay
'function can delete the reservation info.
tt.Name = "tt" + Str$(tt.Top) + Str$(tt.Left)
End Sub 'displayBlock
'++LotusScript Development Environment:2:2:readBlock:1:8
Sub readBlock(dateReserved As String)
' Retrieves the reservation information from the database for the date passed in
' Called from click events for the following:
' btnToday, txtSeeToday on Start view
' fbxDateDisplay, btnRefresh, btnNext, btnPrev on Schedule Display view
' btnOK, fbxDate on Enter Date view
' btnDone on Reservation view
' dateReserved Date formatted as a string
' Declare objects for connecting to the reservation database
Dim C As New Connection
Dim Q As New Query
Dim RS As New ResultSet
Dim s As Double ' Start time of existing reservation
Dim f As Double ' End time of existing reservation
Dim row As String ' Room reserved
Dim n As String ' Reservation owner
Dim tname As String ' A shorter reservation table name reference
' Collect the name of the main table associated with the
' document, which is the first table, numbered starting at zero.
tname = CurrentDocument.Tables(0).TableName
' Place the names of the current rooms on the view.
Call displayRooms()
' Build the connection to retrieve the reservation information for
' the passed-in date. This is a standard data-access sequence,
' modify SQL SELECT statement as needed.
' Note that the database is dBASE IV in this case.
If C.ConnectTo("dBASE IV") Then
Set Q.Connection = C
' Tablename for the query needs to have full path.
' Use the result set to fill in the reservation information on
' the display.
' If the result set was created successfully, then.
If (RS.Execute) Then
' Confirm that there are reservations for this date.
If (RS.numrows) Then
RS.firstrow ' Go to the first record in the result set
' Loop through all of the records in the result set and
' display the reservation information on the view.
Do
s = RS.getvalue("Start Time")
f = RS.getvalue("End Time")
row = RS.getvalue("Room Name/Number")
n = RS.getvalue("Reserved By")
' Build a text box on the view with the reservation
' info from this pass through the loop.
Call displayBlock(n, s, f, row)
Loop While RS.nextrow
End If ' Numrows not zero
End If ' Result set successful
End If ' Connection successful
' Close the connection to allow other connections to this database
C.Disconnect
End Sub ' readBlock
'++LotusScript Development Environment:2:2:clearDisplay:1:8
Sub clearDisplay
' Clears the reservations from the Schedule Display view
' Only clears the text boxes that were tagged with "tt" by displayBlock
' Called by the click events for the following objects:
' btnToday, txtSeeToday on Start view
' fbxDateDisplay, btnRefresh, btnNext, btnPrev on Schedule Display view
' btnOK, fbxDate on Enter Date view
' btnDone on Reservation view
Dim f As form ' Holds the name of the view to clear
Dim cl As collection ' Holds the list of tagged objects
Set f = currentdocument.Schedule~ Display
Set cl = f.objectlist
' Loop through all items in the collection, and delete if the object is tagged
Forall i In cl
If Left$(i.name, 2) = "tt" Then ' tt is the tag prefix
Delete i
End If ' Check for tag
End Forall ' End of objectlist
End Sub ' clearDisplay
'++LotusScript Development Environment:2:2:displayRooms:1:8
Sub displayRooms
' Displays the room names as stored in the global variable rooms()
' The room names are displayed in new text boxes on the Schedule Display view
' Called from readBlock
Dim roomText As textbox ' New textbox
Dim i As Integer ' Index for rooms() array
' Fill rooms() with the most recent information from the rooms database
' by calling the sub fillRoomsArray
Call fillRoomsArray()
' Loop through rooms(), creating a new text box for each room in the array.
' Each text box is positioned on the view in order
For i = 0 To Ubound(rooms) ' from 0 to upperbound of rooms()
' Create the text box
Set roomText = New textbox(currentdocument.Schedule~ Display.body)
' Name the text box with a prefix so it can be easily cleared from the view
' using clearDisplay.
roomText.name = "tt"+Str$(i)
' Fill the text box with the room name
roomText.text = rooms(i)
' Position the text box on the view
roomText.Top = 1650 + (330 * i) ' 1650 is the offset from top of the view
' 330 is the vertical size of each text box
roomText.width = 750
roomText.height = 300
roomText.left = 160
' Set the display properties of the text box to match the view
roomText.font.size = 8
roomText.border.style = $ltsBorderStyleNone
roomText.border.color.setrgb(COLOR_TRANSPARENT)
roomText.background.color.setrgb(COLOR_IVORY)
Next ' Loop through rooms()
End Sub 'displayRooms
'++LotusScript Development Environment:2:1:modifySchedule:1:8
Function modifySchedule(dateReserved As String, roomName As String, ReservedBy As String, start As Double, finish As Double, note As String, modType As Integer) As Integer
' Compares reservation information with the schedule database; if no overlapping
' reservation exists, modifies the schedule database.
' Select the records from the schedule database that match the passed-in
' reservation information. Different information is appropriate whether the
' user is removing a reservation or creating a reservation
If modType > 0 Then ' Reserving
' Retrieve all the reservations for the date specified
Q.SQL = "SELECT * FROM """+Q.Tablename+""" "+ tname + " WHERE (("+ tname + ".""Date Reserved"" = '"+dateReserved+"') AND ("+ tname + ".""Room Name/Number"" = '"+ModRoomNm+"'))"
Elseif modType < 0 Then ' Removing
' Retrieve the specific reservation to be removed
Q.SQL = "SELECT * FROM """+Q.Tablename+""" "+ tname + " WHERE (("+ tname + ".""Date Reserved"" = '"+dateReserved+"') AND ("+ tname + ".""Room Name/Number"" = '"+ModRoomNm+"') AND ("+ tname + ".""Start Time"" = '"+Trim$(Str$(start))+"') AND ("+ tname + ".""End Time"" = '"+Trim$(Str$(finish))+"'))"
End If ' select for modification type
' Assign the query to the declared result set
Set RS.Query = Q
' Create the result set and perform the modification
If (RS.Execute)Then ' if the result set was successful
If (RS.NumRows) Then ' if there are records in the result set,
RS.FirstRow ' go to the first record
End If ' result set has records
' Set the return value for the function. If there is a schedule conflict, this flag is set to False
modifySchedule = True
' Modify the schedule for the appropriate modification type
If modType < 0 Then ' Remove reservations
If RS.NumRows Then ' If there are more than 0 records in the result set
' the reservation passed-in,
RS.DeleteRow ' then delete the reservation record
Else ' If there are no reservations to remove, don't modify the schedule
modifySchedule = False
End If ' If the result set is empty
Else ' Create new reservations
If (RS.NumRows) Then ' If there are more than 0 records in the result set
' Check to see that the new reservation does not overlap an existing
' reservation.
Do ' For each record in the result set and if there hasn't
' already been an overlap identified
' If the new reservation:
' 1. Starts before and ends after an existing reservation
' 2. Finishes between the start and end of an existing reservation
' 3. Starts between the start and end of an existing reservation
' then it conflicts with an existing reservation and the schedule is not
' modified.
If start <= RS.GetValue("Start Time") And finish > RS.getvalue("Start Time") Then
modifySchedule = False
Elseif finish <= RS.GetValue("End Time") And finish > RS.getvalue("Start Time") Then
modifySchedule = False
Elseif start < RS.GetValue("End Time") And start >= RS.getvalue("Start Time") Then
modifySchedule = False
End If ' If there is a conflict, then do not modify the schedule
Loop While (RS.NextRow And modifySchedule = True) ' For each record in the result set
End If ' If there are more than zero records in the result set
' If the new reservation did not conflict with an existing reservation, then add
' a record to the result set with the new reservation information
If modifySchedule = True Then ' If there is a new reservation, then
RS.AddRow ' Add a row to the result set
' Enter the reservation information to each of the fields in the reservation record:
RS.SetValue "Start Time", start
RS.SetValue "End Time", finish
RS.SetValue "Reserved By", ReservedBy
RS.SetValue "Date Reserved", dateReserved
RS.SetValue "Room Name/Number", roomName
RS.SetValue "Note", note
' Commit the new record to the table
RS.UpdateRow
End If ' If a new reservation did not conflict with an existing one, update the result set
End If ' If modification type was add or remove
End If ' Result set is successful
End If ' Connection is successful
' Close the connection so it is available for other subs or functions
C.Disconnect
End Function ' modifySchedule
'++LotusScript Development Environment:2:2:modifyRoomsArray:1:8
Sub modifyRoomsArray(modifyType As Integer)
' Adds or removes rooms( from) the rooms() array according to changes
' made in the Room Setup view. This routine contains the limit on the
' number of rooms that the system allows (MaxRooms).
' Called by click evens on the btnAdd and btnRemove on the Room Setup view
' modifyType 1 = Add a room; 0 = Remove
' Declare display objects to use as shorthand for objects on the view
Dim fbx As fieldbox ' Room name field box; the user can type into this box
Dim lbx As listbox ' List of confirmed rooms; Cannot type into it, but can select from
Dim btn As button ' Button that completes the current tast
' It starts out as "Done"
Dim i As Integer ' Index for the rooms() array during an add
Dim j As Integer ' Index for the rooms() array during a remove
Dim ret As Integer ' Return from user prompt for confirming room deletion
Dim roomExists As Integer ' Flag indicating whether a room with the name of a
' new room already exists in the room() arry
Dim newRoomName As String ' Stores the name of a room being added
Dim numRooms As Integer ' Stores the actual number of rooms in the system, from
' rooms() array
Dim badname As Integer ' Flag indicating that the name submitted is blank
Dim deleteRoomName As String ' Stores the name of a room selected for deletion
Dim MaxRooms As Integer ' Stores the ceiling for the number of rooms allowed
Dim CheckValue As Integer ' Store return values for error checking
' Define the total number of rooms allowed in the reservation system
maxrooms = 20
' If the modification to occur is an Add, check to make sure there can be another
' entry in the rooms() array.
' If there are already the maximum number of rooms and this is an Add, then
If ((Ubound(rooms) + 1) = MaxRooms) And (modifyType > 0)Then
' Indicate to the user that no more rooms can be added.
Messagebox "Cannot add anymore rooms. Maximum number of rooms is"+Str$(MaxRooms)+"."
Else ' If there can be more rooms, or the modification is a Remove, then
' Create a shorter reference name for the display objects this section uses
Set fbx = currentview.body.fbxRoomName ' The box the user enters a new room name in
Set lbx = currentview.body.lbxRooms ' The list of rooms displayed in the view
Set btn = currentview.body.btnDone ' The button that the user clicks to perform the
' indicated operation
' If the modification is to Add a room to the list, then
If modifyType > 0 Then
roomExists = False ' Initialize this flag to False.
newRoomName = fbx.text ' Record the new room name from the UI
If fbx.text = "" Then ' If the new room name is blank, then
badname = True ' Set this flag to True: this name is not acceptible
End If ' New room name is blank
' Loop through the rooms() array to see if the new room name already exists
For i = 0 To Ubound(rooms) ' From 0 to the upper bound of the rooms() array
' (remember array starts at 0)
' Compare the current name from rooms() to the new room name.
' Make the comparison case-insensitive by comparing the names
' in upper case.
If Ucase$(rooms(i)) = Ucase$(newRoomName) Then ' If the names match, then
roomExists = True ' Set this flag to True: the new room name is in the list already
' Because there is a conflict, we don't need to stay in the loop anymore;
' Set the index to a value beyond the limit on the loop.
i = Ubound(rooms) + 1
End If ' If the new room name matches the current rooms() array value
Next ' Increment through the rooms() array
' Add the new room to the rooms() array.
' A True value in BadName or RoomExists would cancel the modification
If (roomExists = False And badname = False) Then ' If both flags are false, then
' Check to see if the rooms() array needs more space to store the new room
' If there are no rooms already in the rooms() array, then add the room name
' to the first entry in the array (array increments from zero)
If Ubound(rooms) = 0 And rooms(0) = "" Then
rooms(0) = newRoomName ' Set the array element to the new room name
' If there are rooms already or the first room in the array is not blank,
' then add more space to the rooms array and add the new name to the
' last entry
Else ' The upper bound is not zero or the first element in rooms() is not blank
Redim Preserve rooms(Ubound(rooms) + 1) ' Create space for one more
' element in the array
rooms(Ubound(rooms)) = newRoomName ' Set the last element to the new
' room name
End If ' adding the new room name to the array
' Update the view with the new information
CheckValue = lbx.setlist(rooms) ' Fill the room list box with the new values from rooms()
fbx.text = "" ' Remove the new room name from the text box
btn.enabled = True ' Enable the Done button
' If the RoomExists flag was set, indicate to the user that the name already exists.
Elseif roomExists = True Then ' If flag was set to True above, then
Messagebox "A room named """ + Ucase$(newRoomName) + """ already exists"
End If ' If the room name already exists
Else ' If the modification type is not Add, then
' Allow the user to confirm the room deletion
' The message box has these arguments:
' "Are you ..." The message
' MB_YESNO The box has buttons for Yes and No
' "Delete Room" The title of the box
' The message box returns IDYES or IDNO (LotusScript constants)
ret = Messagebox( "Are you sure you want to delete this room? Deleting this room will also delete any scheduled conferences for this room.", MB_YESNO, "Delete Room")
' If the return from the message box is Yes, delete the room selected in the Room Name list box
If ret = IDYES Then ' If response is Yes--the room is being deleted--then
deleteRoomName = lbx.text ' Store the name selected in the list box
'Make space in the list of deleted rooms and add the new room name to the list
(.txt)