| |
 |
|
|
| Genii Weblog |
 |
|
|
|
Ogres have layers, and now the Sessions db does as well
Thu 20 Jan 2005, 01:32 PM
Like Shrek with his layers, Notes/Domino 6.x and abive has layers, and ever since Notes 6 was released, I have thought it would be fun to create an application using them, but I have never gotten around to it. Recently, Mike Midas wrote about a case where he used layers, and it appealed to me so much I had him add them to the Lotusphere 2005 Sessions DB in Version 3. Here is a sneak peek:
It is an interesting experiment. Let me know what you think.
Here is the code used. I don't know how redable this will be in here, so I left the agent in the Sessions database itself if you want to take a look (I color coded this, but it exceeded the limit for the blog, so I made it plain again):
'Create location subforms:
Option Public
Option Declare
Uselsx "*lsxrtc"
Dim layer_count As Integer
Dim repid As String
Dim viewid As String
Dim room_w As Integer
Dim computed_x As Integer
Dim computed_y As Integer
Dim layer_id As String
Dim sublayer As GeniiRTChunk
Dim pos As Integer
Dim linktext As String
Dim url As String
Sub Initialize
' *** Notes backend class objects
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim collection As NotesDocumentCollection
Dim view As NotesView
Dim viewnav As NotesViewNavigator
Dim viewentry As NotesViewEntry
' *** These four "constants" are critical. They determine the width and height of a
' *** unit, and therefore the width and height of everything around then, and the number of
' *** rows and columns to create. In this version, they cannot be altered, as we have taken an
' *** image of the original to save space. Now there is just one layer with a graphic.
Dim w As Integer
Dim h As Integer
Dim rows As Integer
Dim columns As Integer
Dim full_w As Integer
Dim full_h As Integer
w = 10
h = 20
rows = 13
columns = 14
layer_count = 0
room_w = 120
full_w = (w*(columns*4))+room_w
full_h = (h*rows)+40
' *** Midas Rich Text LSX class objects
Dim gSession As New GeniiSession
Dim rtitem As GeniiRTItem
Dim rtchunk As GeniiRTChunk
Dim rtLayer As GeniiRTChunk
' *** Miscellaneous processing vars
Dim col As Integer
Dim cols As Integer
Dim row As Integer
Dim loca As String
Dim timestr As String
' *** Cycle through the selected documents
Set db = session.CurrentDatabase
Set collection = db.UnprocessedDocuments
Set doc = collection.GetFirstDocument
While Not (doc Is Nothing)
repid = db.ReplicaID
viewid = db.GetView("BySessionID").UniversalID
loca = doc.SessionLocation(0)
If Left(loca, 3) = "Y&B" Then
loca = "Y-B"+Right(loca, Len(loca)-3)
End If
loca = doc.SessionDate(0)+" in "+loca
Set rtitem = New GeniiRTItem
' *** Check to see if the subform already exists. If so, just skip it
rtitem.SuppressMessages = True
Call rtitem.ConnectSubformBody(db.Server, db.FilePath, loca)
If rtitem.IsConnected Then
Goto skipit
End If
Delete rtitem
' *** Create a subform of the appropriate name
Set rtitem = gSession.CreateSubform(db.Server, db.FilePath, loca, "Overwrite='Yes'")
Call rtitem.DefineFont("Arial")
Call rtitem.DefineFont("Verdana")
rtitem.URLFont = "7pt White Verdana'"
rtitem.HyperlinkFont = "7pt White Verdana'"
rtitem.ActionHotspotFont = "7pt White Verdana'"
Set rtchunk = rtitem.DefineChunk("Everything")
rtchunk.SetImpliedProperties = True
rtchunk.ParagraphStyle = "LeftMarginOffset=1 RightMarginPercent=100"
rtchunk.Font = "Arial 1pt"
Call rtchunk.AppendLayer("auto", "auto", "300px", "678px", 0, |LayerHTMLID='Layer' BackgroundImage='sched.gif' BackgroundColor='White' Text=' '|, "LeftMarginPercent=0 FirstLineLeftMarginPercent=0 RightMarginPercent=100" )
Set rtLayer = rtitem.DefineChunk("Inside Layer 1")
rtLayer.SetImpliedProperties = True
Set view = db.GetView("(embedded byLocDay)")
Set viewnav = view.CreateViewNavFromCategory(doc.SessionDate(0)+":"+doc.SessionLocation(0))
Set viewentry = viewnav.GetFirst
While Not (viewentry Is Nothing)
row = 0
' *** Use the session ID to figure out which track, and thus which row
Select Case Left(viewentry.Document.SessionID(0), 2)
Case "JM"
row =13
Case "BD"
row = 12
Case "ST"
row = 11
Case "AD"
row = 10
Case "ID"
row = 9
Case "BP"
row = 8
Case "CS"
row = 7
Case "GU"
row = 6
Case "FR"
row = 5
Case "BO"
row = 4
Case "CF"
row = 3
Case "SP"
row = 2
Case "HN"
row =1
End Select
' *** Use the time range to figure out which column to start and and how many to use
' *** In a "real" application, I would use NotesDateTime objects and calculate all of
' *** this, but it was easier to brute force this for right now
col = 0
cols = 0
Select Case viewentry.ColumnValues(2)
Case " 7:00am - 8:00am"
col = 0
cols = 4
Case " 8:00am - 10:00am"
col =4
cols = 8
Case " 8:30am - 9:30am"
col =6
cols = 4
Case " 8:30am - 10:15am"
col =6
cols = 7
Case "10:00am - 11:00am"
col =12
cols = 4
Case "10:30am - 12:30pm"
col =14
cols = 8
Case "11:00am - 12:00pm"
col =16
cols = 4
Case "11:00am - 12:15pm"
col =16
cols = 5
Case "11:15am - 12:15pm"
col =17
cols = 4
Case "12:00pm - 1:00pm"
col =20
cols = 4
Case " 1:00pm - 2:00pm"
col =24
cols = 4
Case " 1:30pm - 2:30pm"
col =26
cols = 4
Case " 1:30pm - 2:45pm"
col =26
cols = 5
Case " 1:30pm - 3:30pm"
col =26
cols = 8
Case " 1:45pm - 3:00pm"
col =27
cols = 5
Case " 2:15pm - 3:15pm"
col =29
cols = 4
Case " 2:30pm - 4:15pm"
col =30
cols = 7
Case " 3:00pm - 4:00pm"
col =32
cols = 4
Case " 3:00pm - 4:15pm"
col =32
cols = 5
Case " 3:45pm - 4:45pm"
col =35
cols = 4
Case " 4:00pm - 6:00pm"
col =36
cols = 8
Case " 4:15pm - 5:15pm"
col =37
cols = 4
Case " 4:45pm - 6:00pm"
col =39
cols = 5
Case " 5:00pm - 6:00pm"
col =40
cols = 4
Case " 5:45pm - 7:00pm"
col =43
cols = 5
Case " 6:15pm - 7:30pm"
col =45
cols = 5
Case " 7:45pm - 9:00pm"
col =51
cols = 5
Case Else
Print "Need slot for " + viewentry.ColumnValues(2)
End Select
' *** Create a layer for the specified track and times, using the session id as the text and
' *** the title and speakers as the mouseover text
If cols > 0 Then
Call CreateCell(rtLayer, col*w, (w*cols)-1, ((row+1)*h), (h-1), full_w, full_h, "Red", _
viewentry.Document.SessionID(0)+"|"+viewentry.ColumnValues(3)+" ("+Join(viewentry.Document.Speaker, ", ")+")", "7pt White Verdana'", "Justify=Center LeftMarginPercent=0 FirstLineLeftMarginPercent=0 RightMarginPercent=100", "", 0)
End If
Set viewentry = viewnav.GetNext(viewentry)
Wend
rtitem.Save
skipit:
Delete rtitem
Set doc = collection.GetNextDocument(doc)
Wend
End Sub
Sub CreateCell(rtLayer As GeniiRTChunk, x As Integer, xlen As Integer, y As Integer, ylen As Integer, max_x As Integer, max_y As Integer, color As String, textval As String, font As String, parastyle As String, hideformula As String, zindex As Integer)
' *** Use our special synax to create a mouse over hotspot
pos = Instr(textval, "|")
If pos > 0 Then
linktext=Left(textval, pos-1)
url = Mid(textval, pos+1, Len(textval)-pos)
pos = Instr(url, |"|)
While pos > 0
Mid$(url, pos, 1) = |'|
pos = Instr(url, |"|)
Wend
textval = ""
Else
linktext = ""
url = ""
End If
computed_x = x+room_w
computed_y = max_y-y
layer_count = layer_count + 1
layer_id = "L"+Cstr(layer_count)
Call rtLayer.AppendLayer(Cstr(computed_y)+"px", Cstr(computed_x)+"px", Cstr(ylen)+"px", Cstr(xlen)+"px", zindex, |LayerHTMLID='|+layer_id+|' BackgroundColor='|+color+|' Text='|+textval+|' TextFont='|+font+|'|, parastyle)
If linktext <> "" Then
' *** Using the ability to find a named layer, get a handle on the layer to set the hotspot.
Set sublayer = rtLayer.RTItem.Everything.FindNamedChunk(True, "Layer", layer_id, "Exact")
If Not (sublayer Is Nothing) Then
Call sublayer.ZoomIn("Text 1")
sublayer.GetLastTarget
Call sublayer.AppendHotspot("Mouseover", |"|+url+|"|, "", linktext)
Call sublayer.ZoomOut()
End If
End If
End Sub
|
|
|
|
| |
|
| |
- Ben Langhinrichs
