PC World Komputer 1997 February/PCWK0297.iso/lotus/english/lotus036.dsk/SCHEDULE.MPR/SCRIPT/A007ApprGlobObj897.s

Null Bytes Alternating | 1995-11-10 | 22.4 KB | 408 lines

'++LotusScript Development Environment:2:5:(Options):0:66
Option Public

'++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(d As String)
Declare Sub clearDisplay
Declare Sub displayRooms
Declare Function modifySchedule(d As String, roomName As String, txt 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(d As String, roomName As String, t As Double) As Integer

'++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


'++LotusScript Development Environment:2:2:displayBlock:1:8
Sub displayBlock(txt As String, start As Double, finish As Double, roomName As String)
    Dim tt As textbox

    Dim h As Integer
    Dim i As Integer

    For i = 0 To Ubound(rooms)
        If rooms(i) = roomName Then
            t = i
            i = Ubound(rooms)
        End If
    Next
    t = 1635 + (330 * t)
    Set tt = New textbox(currentview.body)
    tt.text = " " + txt + " "
    tt.font.size = 8
    tt.border.style = $ltsBorderStyleNone
    tt.border.left = True
    tt.border.right = True
    tt.border.top = False
    tt.border.bottom = False
    tt.border.width = $apr1point
    tt.border.color.setrgb color_ultramarine
    tt.background.color.setrgb color_50_gray
    tt.height = 325
    tt.top = t
    tt.left = (((start - 8) * 750) + 960)
    tt.width =  (750 * (finish - start))
    tt.name = "tt" + Str$(tt.top) + Str$(tt.left)
End Sub
'++LotusScript Development Environment:2:2:readBlock:1:8
Sub readBlock(d As String)

    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet

    Dim s As Double
    Dim f As Double
    Dim row As String
    Dim n As String
    Dim tname As String

    tname = currentdocument.tables(0).tablename
    displayRooms
    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename =  currentdocument.tables(0).path + tname
        Q.SQL = "SELECT * FROM """+Q.Tablename+""""+ tname+" WHERE (("+ tname+".""Date Reserved"" = '"+d+"'))"
        Set RS.Query = Q
        Print rs.execute
        Print rs.numrows

        If (RS.Execute) Then
            If (RS.numrows) Then
                RS.firstrow
                Do
                    s = RS.getvalue("Start Time")
                    f = RS.getvalue("End Time")
                    row = RS.getvalue("Room Name/Number")
                    n = RS.getvalue("Reserved By")
                    displayBlock n, s, f, row
                Loop    While RS.nextrow
            End If
        End If
    End If
    c.disconnect
'    currentwindow.redraw = True
'    currentapplication.applicationwindow.domenucommand IDM_REFRESH
End Sub
'++LotusScript Development Environment:2:2:clearDisplay:1:8
Sub clearDisplay
    Dim f As form
    Dim cl As collection

    Set f = currentdocument.Schedule~ Display
    Set cl = f.objectlist

    Forall i In cl
        If Left$(i.name, 2) = "tt" Then
            Delete i
        End If
    End Forall

End Sub
'++LotusScript Development Environment:2:2:displayRooms:1:8
Sub displayRooms
    Dim roomText As textbox

    Dim i As Integer

    fillRoomsArray
    For i = 0 To Ubound(rooms)
        Set roomText = New textbox(currentdocument.Schedule~ Display.body)
        roomText.name = "tt"+Str$(i)
        roomText.Top = 1650 + (330 * i)
        roomText.text = rooms(i)
        roomText.width = 750
        roomText.height = 300
        roomText.left = 160
        roomText.font.size = 8
        roomText.border.style = $ltsBorderStyleNone
        roomText.border.color.setrgb(color_ivory)
        roomText.background.color.setrgb(color_ivory)
    Next
End Sub
'++LotusScript Development Environment:2:1:modifySchedule:1:8
Function modifySchedule(d As String, roomName As String, txt As String, start As Double, finish As Double, note As String, modType As Integer) As Integer
    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet

    Dim tname As String

    tname = currentdocument.tables(0).tablename
    modifySchedule = False

    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename = currentdocument.tables(0).path + tname
        If modType > 0 Then
            Q.SQL = "SELECT * FROM """+Q.Tablename+""" "+ tname + " WHERE (("+ tname + ".""Date Reserved"" = '"+d+"') AND ("+ tname + ".""Room Name/Number"" = '"+roomName+"'))"
        Elseif modType < 0 Then
            Q.SQL = "SELECT * FROM """+Q.Tablename+""" "+ tname + " WHERE (("+ tname + ".""Date Reserved"" = '"+d+"') AND ("+ tname + ".""Room Name/Number"" = '"+roomName+"') AND ("+ tname + ".""Start Time"" = '"+Trim$(Str$(start))+"') AND ("+ tname + ".""End Time"" = '"+Trim$(Str$(finish))+"'))"
        End If
        Set RS.Query = Q

        If (RS.Execute)Then
            If (RS.numrows) Then
                RS.firstrow
            End If
            modifySchedule = True
            If modType < 0 Then
                If RS.numrows Then
                    RS.deleterow
                    RS.updaterow
                Else
                    modifySchedule = False
                End If
            Else
                If (RS.numrows) Then
                    Do
                        If start <= RS.getvalue("Start Time") And finish >  RS.getvalue("Start Time") Then
                            Print rs.getvalue("Start Time")
                            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
                    Loop    While (RS.nextrow And modifySchedule = True)
                End If
                If modifySchedule = True Then
                    RS.addrow
                    RS.setvalue "Start Time", start
                    RS.setvalue "End Time", finish
                    RS.setvalue "Reserved By", txt
                    RS.setvalue "Date Reserved", d
                    RS.setvalue "Room Name/Number", roomName
                    RS.setvalue "Note", note
                    RS.updaterow
                End If
            End If
        End If
    End If
    c.disconnect

End Function
'++LotusScript Development Environment:2:2:modifyRoomsArray:1:8
Sub modifyRoomsArray(modifyType As Integer)
    Dim fbx As fieldbox
    Dim lbx As listbox
    Dim btn As button

    Dim i As Integer
    Dim ret As Integer
    Dim roomExists As Integer
    Dim newRoomName As String
    Dim tempRooms() As String
    Dim numRooms As Integer
    Dim badname As Integer

    If ((Ubound(rooms) + 1) = 20) And (modifyType > 0)Then
        Messagebox "Cannot add anymore rooms.  Maximum number of rooms is 20."
    Else
        Set fbx = currentview.body.fbxRoomName
        Set lbx = currentview.body.lbxRooms
        Set btn = currentview.body.btnDone
        If modifyType > 0 Then
            roomExists = False
            newRoomName = fbx.text
            If fbx.text = "" Then
                badname = True
            End If
            For i = 0 To Ubound(rooms)
                If Ucase$(rooms(i)) = Ucase$(newRoomName) Then
                    roomExists = True
                    i = Ubound(rooms) + 1
                End If
            Next
            If (roomExists = False And badname = False) Then
                If Ubound(rooms) = 0  And rooms(0) = "" Then
                    rooms(0) = newRoomName
                Else
                    Redim Preserve rooms(Ubound(rooms) + 1)
                    rooms(Ubound(rooms)) = newRoomName
                End If
                lbx.setlist rooms
                fbx.text = ""
                btn.enabled = True
            Elseif badname = False Then
                Messagebox "A room named """ + Ucase$(newRoomName) + """ already exists"
            End If
        Else
            ret = Messagebox( "Are you sure you want to delete this room?  Deleting this room will also delete any scheduled conferences for this room.", 4, "Delete Room")
            If ret = 6 Then
                deleteRoomName = lbx.text
                Redim Preserve deletedRooms(Ubound(deletedRooms) + 1)
                deletedRooms(Ubound(deletedRooms)) = deleteRoomName
                For i = 0 To Ubound(rooms)
                    If Ucase$(rooms(i)) = Ucase$(deleteRoomName) Then
                        numRooms = numRooms - 1
                        For j = i To (Ubound(rooms) - 1)
                            rooms(j) = rooms(j + 1)
                        Next
                        i = Ubound(rooms) + 1
                    End If
                Next
                If Ubound(rooms) Then
                    Redim Preserve rooms(Ubound(rooms) - 1)
                Else
                    rooms(0) = ""
                    currentview.body.btnRemove.enabled = False
                End If
            End If
        End If
        lbx.setlist rooms
        btn.enabled = True
        string_sort rooms
    End If

End Sub
'++LotusScript Development Environment:2:2:fillRoomsArray:1:8
Sub fillRoomsArray
    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet
    Dim roomText As textbox

    Dim numRooms As Integer
    Dim i As Integer

    i = 0
    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename = currentdocument.tables(0).path + "rooms.dbf"
        Set RS.Query = Q 'need to sort by ROOMID
        If (RS.Execute) Then
            numRooms = RS.numrows()
            If numrooms Then
                Redim rooms(numRooms - 1)
                RS.firstrow
                Do
                    rooms(i) = RS.getvalue("room")
                    i = i + 1
                Loop    While RS.nextrow
            Else
                Redim rooms(numRooms)
            End If
        End If
    End If
    c.disconnect
    string_sort rooms
End Sub
'++LotusScript Development Environment:2:1:modifyRooms:1:8
Function modifyRooms
    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet

    modifyRooms = False

    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename = currentdocument.tables(0).path + "rooms"
        Set RS.Query = Q
        If (RS.Execute)Then
            If (RS.numrows) Then
                RS.firstrow
                Do
                    RS.deleteRow
                Loop    While (RS.numrows)
            End If
            modifyRooms = True
            For i = 0 To Ubound(rooms)
                RS.addrow
                RS.setvalue "room", rooms(i)
                RS.updaterow
            Next
        End If
    End If
    c.disconnect

End Function
'++LotusScript Development Environment:2:2:deleteScheduledRemovedRooms:1:8
Sub deleteScheduledRemovedRooms
    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet

    Dim tname As String
    fillRoomsArray
    tname = currentdocument.tables(0).tablename

    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename = currentdocument.tables(0).path + tname
        For i = 1 To Ubound(deletedRooms)
            Q.SQL = "SELECT * FROM """+Q.Tablename+""""+ tname + " WHERE ("+ tname + ".""Room Name/Number"" = '"+deletedRooms(i)+"')"
            Set RS.Query = Q
            If (RS.Execute)Then
                If (RS.numrows) Then
                    RS.firstrow
                    Do
                        RS.deleteRow
                    Loop    While (RS.numrows)
                End If
            End If
        Next
        c.disconnect
    End If
End Sub
'++LotusScript Development Environment:2:2:string_sort:1:8
Sub string_sort(array() As String)
    Dim temp As String
    Dim i As Integer
    Dim j As Integer

    For i = Lbound(array) To Ubound(array)
        temp = array(i)
        For j = i + 1 To Ubound(array)
            If array(j) < array(i) Then
                array(i) = array(j)
                array(j) = temp
                temp = array(i)
            End If
        Next
    Next
End Sub
'++LotusScript Development Environment:2:1:isScheduled:1:8
Function isScheduled(d As String, roomName As String, t As Double) As Integer
    Dim C As New Connection
    Dim Q As New Query
    Dim RS As New ResultSet

    Dim tname As String

    isScheduled = False
    tname = currentdocument.tables(0).tablename
    If C.ConnectTo("dBASE IV") Then
        Set Q.Connection = C
        Q.Tablename = currentdocument.tables(0).path + tname
        Q.SQL = "SELECT * FROM """+Q.Tablename+""" "+ tname + " WHERE (("+ tname + ".""Date Reserved"" = '"+d+"') AND ("+ tname + ".""Room Name/Number"" = '"+roomName+"') AND ("+ tname + ".""Start Time"" <= "+Trim$(Str$(t))+")  AND ("+ tname + ".""End Time"" > "+Trim$(Str$(t))+"))"
        Set RS.Query = Q

        If (RS.Execute)Then
            If (RS.numrows) Then
                isScheduled = True
                GlobDateDisplay = RS.getvalue("Date Reserved")
                GlobStartTime = RS.getvalue("Start Time")
                GlobEndTime = RS.getvalue("End Time")
                GlobRoom = RS.getvalue("Room Name/Number")
                GlobReservedBy = RS.getvalue("Reserved By")
                GlobNote = RS.getvalue("Note")
            End If
        End If
        c.disconnect
    End If

End Function