 |
||||
 Un programa de la Biblioteca Pública de Hartford |
 |
 |
||
|
<% Class MX_Menu
Private menuName
Private menuDepthSeparator
Private menuItems
Private DBItems ' cache items from database
Private previousItemLevel
Private menuLevel
Private menuHighlight
Private isStatic
Private menuOutput
Private MenuRecordset
Private menuPK
Private menuFK
Private menuNameField
Private menuLink
Private menuURLParameter
Private menuTarget
Private menuTitleField
Private menuLinkField
Private menuTargetField
Private hasDynamicURL
' div-related properties
Private menuSkin
Private menuLayout
Private menuShowTimeout
Private menuHideTimeout
Private menuImgReplace
Private menuImgReplaceStyle
Private menuImgDir
Private menuImgNames
' end div-related properties
Private Sub Class_Initialize()
menuDepthSeparator = " "
menuItems = Array()
Set DBItems = Server.CreateObject("Scripting.Dictionary") ' cache db items into a dictionary structure rather then an Array
previousItemLevel = -1
menuLevel = -1 ' no level limitation
menuHighlight = false
isStatic = true
hasDynamicURL = false
menuOutput = ""
' div-related defaults
menuSkin = "default"
menuLayout = "horizontal"
menuShowTimeout = "40"
menuHideTimeout = "400"
menuImgReplace = "no"
menuImgReplaceStyle = "img"
menuImgDir = ""
menuImgNames = ""
End Sub
Private Sub Class_terminate()
Set menuItems = nothing
End Sub
Public Sub Init (mName)
menuName = mName
End Sub
Public Sub highlightCurrent(boolHighlight)
menuHighlight = boolHighlight
End Sub
Public sub setQuery(query)
If not IsObject(query) Then
Response.write "Please use a valid recordset object"
Response.End()
End If
Set MenuRecordset = query
' reset the cursor to the beginning
isStatic = false
End Sub
Public Sub setPK (pk)
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(pk)
If err.number<>0 Then
Response.write "Primary key specified '" & pk & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuPK = pk
End Sub
Public Sub setFK (fk)
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(fk)
If err.number<>0 Then
Response.write "Foreign key specified '" & fk & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuFK = fk
End Sub
Public Sub setNameField (nField)
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(nField)
If err.number<>0 Then
Response.write "Name field specified '" & nField & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuNameField = nField
End Sub
Public Sub setLink (mLink)
menuLink = mLink
End Sub
Public Sub setURLParameter (urlParam)
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(urlParam)
If err.number<>0 Then
Response.write "URL field specified '" & urlParam & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuURLParameter = urlParam
End Sub
Public Sub setTarget (mTarget)
menuTarget = mTarget
End Sub
Public Sub setTitleField (tField)
If tField = "" Then
Exit Sub
End If
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(tField)
If err.number<>0 Then
Response.write "Title field specified '" & tField & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuTitleField = tField
End Sub
Public Sub setLinkField (lField)
hasDynamicURL = true
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(lField)
If err.number<>0 Then
Response.write "Link field specified '" & lField & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuLinkField = lField
End Sub
Public Sub setTargetField (tgField)
If tgField = "" Then
Exit Sub
End If
IF not MenuRecordset.EOF Then
On Error resume next
val = MenuRecordset(tgField)
If err.number<>0 Then
Response.write "Target field specified '" & tgField & "' is not a recordset column"
Response.End()
End If
On Error GoTo 0
End If
menuTargetField = tgField
End Sub
Public Sub setLevel (mLevel)
' can be negative -> all records
menuLevel = mLevel
End Sub
' div-related setters
Public Sub setSkin (mSkin)
menuSkin = mSkin
End Sub
Public Sub setLayout (mLayout)
If lcase(mLayout) = "tab" Then
menuLayout = "horizontal2"
Else
menuLayout = mLayout
End If
End Sub
Public Sub setShowTimeout (mShowTimeout)
menuShowTimeout = mShowTimeout
End Sub
Public Sub setHideTimeout (mHideTimeout)
menuHideTimeout = mHideTimeout
End Sub
Public Sub setImgReplace (mImgReplace)
If mImgReplace Then
menuImgReplace = "yes"
Else
menuImgReplace = "no"
End If
End Sub
Public Sub setImgReplaceStyle (mImgReplaceStyle)
menuImgReplaceStyle = mImgReplaceStyle
End Sub
Public Sub setImgDir (mImgDir)
menuImgDir = Server.URLEncode(mImgDir)
End Sub
Public Sub setImgNames (mImgNames)
menuImgNames = Server.URLEncode(mImgNames)
End Sub
' end div-related setters
Public Sub addItem (itemName, itemURL, itemTitle, itemTarget)
' sets static menu renderer
iName = itemName
isStatic = true
level = 0
do while instr(iName, menuDepthSeparator) = 1
level = level + 1
iName = mid (iName, 2)
loop
useThisEntry = true
If (level > previousItemLevel) and ((level - previousItemLevel) > 1) Then
useThisEntry = false ' / ignore this entry because more than 2 spaces from the previous level have been detected
level = previousItemLevel + 1
End If
If useThisEntry Then
Dim myItem: Set myItem = Server.CreateObject("Scripting.Dictionary")
myItem("itemName") = trim(iName)
myItem("itemURL") = trim(itemURL)
myItem("itemLevel") = level
myItem("itemTitle") = itemTitle
myItem("itemTarget") = itemTarget
menuItems = array_push_obj_CSSMfnc(menuItems, myItem)
previousItemLevel = level
End If
End Sub
Public Function render()
If menuOutput <> "" Then
render = menuOutput
Exit Function
End If
If isStatic Then
menuOutput = renderStatic
Else
menuOutput = renderDynamic
End If
If ubound(menuItems) < 0 Then
render = "No data to render"
Exit Function
End If
render = menuOutput
End Function
Private Function renderStatic
Dim objReturnString: Set objReturnString = new MX_Menu_StringBuilder
objReturnString.Concat " " & vbNewLine & _
" " & vbNewLine
renderStatic = objReturnString.ToString()
End Function
Private Function isURLAbsolute(url)
If instr(1, url, "http://", 1) = 1 Or instr(1, url, "https://", 1) = 1 Then
isURLAbsolute = True
Else
isURLAbsolute = False
End If
End Function
Private Function isURLRelativeToDoc(url)
If instr(1, url, "/", 1) = 1 or isURLAbsolute(url) Then
isURLRelativeToDoc = False
Else
isURLRelativeToDoc = True
End If
End Function
Private Function checkHighlight(url_par)
urlFromMenu = url_par
checkHighlight = false
url = Request.ServerVariables("URL")
If right(urlFromMenu,1) = "/" Then
urlFromMenu = urlFromMenu & mid(url, instrrev(url, "/")+1)
End If
qstring = Request.ServerVariables("QUERY_STRING")
If qstring <> "" Then
url = url & "?" & qstring
End If
If isURLRelativeToDoc(urlFromMenu) Then
' try to find urlFromMenu in the current pages' url
pos = instr(1, url, urlFromMenu, 1)
If pos <> 0 Then
remain = mid(url, pos+len(urlFromMenu))
If remain = "" Then
checkHighlight = true
menuHighlight = false
End If
End If
Else
' try to match page's url in urlFromMenu
pos = instr(1, urlFromMenu, url, 1)
If pos <> 0 Then
remain = mid(urlFromMenu, pos+len(url))
If remain = "" Then
checkHighlight = true
menuHighlight = false
End If
End If
End If
End Function
Private Function renderDynamic
On Error resume next
MenuRecordset.MoveFirst
On Error GoTo 0
getUnformatedData
formatData 0, 0, menuLevel
renderDynamic = renderStatic
End Function
Private Sub getUnformatedData
Dim idx: idx = 1
while not MenuRecordset.EOF
Dim myItem: Set myItem = Server.CreateObject("Scripting.Dictionary")
myItem("itemName") = trim(MenuRecordset(menuNameField))
myItem("itemLevel") = 0
If hasDynamicURL Then
If menuLinkField = "" Then
Response.write "Please select the Link Field column from the recordset"
Response.End()
End If
myItem("itemURL") = trim(MenuRecordset(menuLinkField))
Else
myItem("itemURL") = trim(menuLink & MenuRecordset(menuURLParameter))
End If
If hasDynamicURL Then
If menuTargetField <> "" Then
myItem("itemTarget") = trim(MenuRecordset(menuTargetField))
Else
myItem("itemTarget") = ""
End If
Else
myItem("itemTarget") = menuTarget ' for build url
End If
If menuTitleField <> "" Then
myItem("itemTitle") = MenuRecordset(menuTitleField)
End If
pk = MenuRecordset(menuPK)
If isnull(MenuRecordset(menuFK)) or MenuRecordset(menuFK) = "" Then
fk = 0
Else
fk = MenuRecordset(menuFK)
End If
Dim myArr: Set myArr = Server.CreateObject("Scripting.Dictionary")
myArr("fk") = fk
myArr("pk") = pk
Set myArr("data") = myItem
' add this item to the cache structures
'Set DBItems(idx) = myArr
'idx = idx + 1
If not isObject (DBItems(fk)) Then
Set DBItems(fk) = Server.CreateObject("Scripting.Dictionary")
End If
Set DBItems(fk)(pk) = myArr
MenuRecordset.MoveNext
wend
End Sub
Private Sub formatData(key, level, maxLevel)
'Dim idx
'For each idx in DBItems
' Set myArr = DBItems(idx)
' pk = myArr("pk")
' fk = myArr("fk")
' If key = fk Then
' myArr("data")("itemLevel") = level
' menuItems = array_push_obj_CSSMfnc(menuItems, myArr("data"))
' DBItems.remove(idx)
' If maxLevel < 0 Or level + 1 < maxLevel Then
' formatData pk, level+1, maxLevel
' End If
' End If
'Next
If isObject (DBItems(key)) Then
For each pk in DBItems(key)
Set myArr = DBItems(key)(pk)
myArr("data")("itemLevel") = level
menuItems = array_push_obj_CSSMfnc(menuItems, myArr("data"))
If maxLevel < 0 Or level + 1 < maxLevel Then
formatData pk, level+1, maxLevel
End If
Next
End If
End Sub
Private Function array_push_obj_CSSMfnc (ByRef m_array, byRef m_item )
Dim initialsize : initialsize = ubound(m_array)
ReDim preserve m_array(initialsize+1)
Set m_array(initialsize+1) = m_item
array_push_obj_CSSMfnc = m_array
End Function
End Class
Class MX_Menu_StringBuilder
Dim arr 'the array of strings to concatenate
Dim growthRate 'the rate at which the array grows
Dim itemCount 'the number of items in the array
Private Sub Class_Initialize()
growthRate = 50
itemCount = 0
ReDim arr(growthRate)
End Sub
Public Sub Concat(ByVal strValue)
If itemCount > UBound(arr) Then
ReDim Preserve arr(UBound(arr) + growthRate)
End If
arr(itemCount) = strValue
itemCount = itemCount + 1
End Sub
Public Function ToString()
ToString = Join(arr, "")
End Function
End Class
%>
<%
'Static Menu
Dim CSSMenu1: Set CSSMenu1 = new MX_Menu
'start addItem
CSSMenu1.addItem "Datos de la comunidad", "/community_data.asp", "", ""
CSSMenu1.addItem " Vecindarios de Hartford", "/Snapshots/neighborhood_data.asp?pRegion=Vecindarios de Hartford", "", ""
CSSMenu1.addItem " Zonas NRZ de Hartford", "/Snapshots/neighborhood_data.asp?pRegion=Zonas NRZ de Hartford", "", ""
CSSMenu1.addItem " Ciudad de Hartford y alrededores", "/Snapshots/neighborhood_data.asp?pRegion=Ciudad de Hartford y alrededores", "", ""
CSSMenu1.addItem " Tendencias de Hartford", "/ht/", "", ""
CSSMenu1.addItem " Información sobre las Escuelas", "/hps/", "", ""
CSSMenu1.addItem " Datos sobre criminalidad", "/hpd/", "", ""
CSSMenu1.addItem " Datos sobre Niños y Familia", "/dcf/", "", ""
CSSMenu1.addItem " Datos sobre Servicios Sociales", "/dss/", "", ""
'CSSMenu1.addItem " Datos sobre Hipotecas", "/hmda/", "", ""
CSSMenu1.addItem " Datos Sobre Estadística Demográfica", "/vital_stats/", "", ""
CSSMenu1.addItem " Datos Sobre Elecciones", "/voting/voting_2006_to_2002.xls", "", ""
CSSMenu1.addItem "Sitios Web, Documentos y Artículos", "/issues/default.asp", "", ""
CSSMenu1.addItem " Sitios Web y Documentos", "/issues/wsd/", "", ""
CSSMenu1.addItem " Artículos de noticias", "/issues/documents/", "", ""
CSSMenu1.addItem "Acerca de HartfordInfo.org", "/about_the_hcdc/the_hcdc.asp", "", ""
CSSMenu1.addItem " Presentación", "/about_the_hcdc/the_hcdc.asp", "", ""
CSSMenu1.addItem " Participación", "/about_the_hcdc/the_hcdc_memberships.asp", "", ""
CSSMenu1.addItem " Socios HCDC", "/about_the_hcdc/the_hcdc_partners.asp", "", ""
CSSMenu1.addItem "Preguntas Frecuentes", "/faq/faq.asp", "", ""
CSSMenu1.addItem "Mapa del Sitio", "/site_map.asp", "", ""
'end addItem
'CSSMenu1 Layout
CSSMenu1.highlightCurrent true
CSSMenu1.setLayout "horizontal"
CSSMenu1.setSkin "aqua_warm"
CSSMenu1.setShowTimeout 100
CSSMenu1.setHideTimeout 400
CSSMenu1.setImgReplace false
'CSSMenu1 End
%>
<%
'Static CSS menu, Layout: horizontal, Skin: aqua_warm
Response.write (CSSMenu1.render)
%>
" & vbNewLine
objReturnString.Concat "
|
||||
| Información sobre las Escuelas Públicas de Hartford > Notas | |||||||
 |
|||||||
|
|||||||
| Última actualización: 13 de Octubre de 2008 |
|
|||||||
|
||||||
|