<%
'=============================================================
'//
'// Popup Menu Control
'//
'// version: 0.4
'// last modified: 09-May-2004 03:03 by Sasha Vukovic
'=============================================================
%>
<%
Class PopupMenuControl
Private mArrPopupMenuDef()
Private mobjNameDefMap ' Item can be accesed by name. Must be unique within one page
Private mobjIdDefMap ' Item can be accesed by id. Must be unique within one page. If NULL, ubound is assigned to it
Private mobjSeparator ' Has a name of item after separator is applied
Private mPreCodeTemplate
Private mPostCodeTemplate
Private mMenuItemTemplate
Private mSeparatorTemplate
Private mNumOfItemProperties
Private mLastItemPropertyInx
Private mbHideAll
Private mbDisableAll
Private InxItemTableName
Private InxdbAccessManagerObjID
Private InxdbName
Private InxTxt
Private InxImg
Private InxImgOff
Private InxLink
Private InxEventHandler
Private InxHint
Private InxActive
Private InxVisible
Public Property Let AllVisible ( cVal )
If cVal = enumDB_YES Then
mbHideAll = FALSE
Else
mbHideAll = TRUE
End If
End Property
Public Property Let AllActive ( cVal )
If cVal = enumDB_YES Then
mbDisableAll = FALSE
Else
mbDisableAll = TRUE
End If
End Property
'-----------------------------------------------------------------------------------------------------------------
Public Sub PopupMenuStyle( sTemplateDoc, sStyleId )
Dim mobjTemplateManager
Set mobjTemplateManager = New TemplateManager
mobjTemplateManager.TemplateDoc = sTemplateDoc
' Set Templates
mPreCodeTemplate = mobjTemplateManager.getElementValue ( sStyleId &"/PreMenuCode" )
mMenuItemTemplate = mobjTemplateManager.getElementValue ( sStyleId &"/MenuItem" )
mSeparatorTemplate = mobjTemplateManager.getElementValue ( sStyleId &"/Separator" )
mPostCodeTemplate = mobjTemplateManager.getElementValue ( sStyleId &"/PostMenuCode" )
Set mobjTemplateManager = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Private Sub SetItemPropertyByIndex ( nInx, nProperty, Value )
If nInx = "" OR nProperty = "" OR Value = "" Then Err.Raise 8, "Method SetItemPropertyByIndex", "Empty parameters found. nInx="& nInx &", nProperty="& nProperty &", Value="& Value
mArrPopupMenuDef ( nProperty, nInx ) = Value
'Response.write "mArrPopupMenuDef ( "& nProperty &", "& nInx &" ) = "& Value &"
"
End Sub
'-----------------------------------------------------------------------------------------------------------------
Private Function LastItemInx ()
LastItemInx = UBound ( mArrPopupMenuDef, 2 )
End Function
'-----------------------------------------------------------------------------------------------------------------
Public Sub LoadRows ( aRows )
' Pass the full array row matching the columns of mArrPopupMenuDef()
Dim nProperty, newArrayDim, numOfRows, rowNum
numOfRows = UBound( aRows, 2 )
For rowNum = 0 To numOfRows
' Increase array by 1
newArrayDim = LastItemInx() + 1
ReDim Preserve mArrPopupMenuDef( mNumOfItemProperties, newArrayDim )
mobjNameDefMap.Add ( Cstr( aRows ( InxdbName, rowNum ) ) ), CStr( newArrayDim )
For nProperty = 0 To mLastItemPropertyInx
If (nProperty = InxLink) OR (nProperty = InxEventHandler) Then
' Link And EventHandlers need to be evaluated
mArrPopupMenuDef ( nProperty, newArrayDim ) = Eval ( aRows ( nProperty, rowNum ) )
Else
mArrPopupMenuDef ( nProperty, newArrayDim ) = aRows ( nProperty, rowNum )
End If
Next
Next
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub AddMenuItem ( sItemName, nItemID )
Dim newArrayDim
If InStr( sItemName, " " ) > 0 Then Err.Raise 8, "Method AddMenuItem", "Item Name '"& sItemName &"' cannot have spaces."
If NOT mobjNameDefMap.Exists (CStr( sItemName )) Then
newArrayDim = LastItemInx() + 1
ReDim Preserve mArrPopupMenuDef( mNumOfItemProperties, newArrayDim )
' Store name
Call SetItemPropertyByIndex ( newArrayDim, InxdbName, sItemName )
mobjNameDefMap.Add ( Cstr( sItemName ) ), CStr( newArrayDim )
If Not IsNull(nItemID) Then
' If ID is supplied, map it to array index
mobjIdDefMap.Add Cstr( nItemID ), CStr( newArrayDim )
' Store ID
Call SetItemPropertyByIndex ( newArrayDim, InxdbAccessManagerObjID, nItemID )
Else
' else use array index as ID
mobjIdDefMap.Add Cstr( newArrayDim ), CStr( newArrayDim )
' Store array index as ID
Call SetItemPropertyByIndex ( newArrayDim, InxdbAccessManagerObjID, newArrayDim )
End If
' Set Defaults
'Call SetItemDefaults ( sItemName )
Else
'TODO
End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
Private Sub RenderItem ( itemIndex, bIsActiveByAccessControl )
Dim sMenuItem
sMenuItem = mMenuItemTemplate ' Get menu item template
' --- Menu Item ---
' Check Active state
If bIsActiveByAccessControl AND mArrPopupMenuDef( InxActive, itemIndex ) <> enumDB_NO Then ' Check if menu item is Active
sMenuItem = Replace ( sMenuItem, "%TEXT%", "" )
If NOT IsNull(mArrPopupMenuDef( InxImg, itemIndex )) AND (mArrPopupMenuDef( InxImg, itemIndex ) <> "") Then
sMenuItem = Replace ( sMenuItem, "%IMAGE%", "![]("& mArrPopupMenuDef( InxImg, itemIndex ) &")
" )
Else
' No image supplied
sMenuItem = Replace ( sMenuItem, "%IMAGE%", "
" )
End If
Else
' Render DISABLE menu item
sMenuItem = Replace ( sMenuItem, "%TEXT%", mArrPopupMenuDef( InxTxt, itemIndex ) )
If NOT IsNull(mArrPopupMenuDef( InxImgOff, itemIndex )) AND (mArrPopupMenuDef( InxImgOff, itemIndex ) <> "") Then
sMenuItem = Replace ( sMenuItem, "%IMAGE%", "![]("& mArrPopupMenuDef( InxImgOff, itemIndex ) &" "\"& mArrPopupMenuDef( InxHint, itemIndex ) &\"")
" )
Else
' No image supplied
sMenuItem = Replace ( sMenuItem, "%IMAGE%", Empty )
End If
End If
Response.write sMenuItem ' Finally render Menu Item
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub RenderInOrder ( sDivName, aItemsList, oAccessControl, cObjectName )
Dim itemInx, itemName, nLastItemInx, bIsVisible, bIsActive
Response.write ""
Response.write mPreCodeTemplate
For Each itemName in aItemsList
itemInx = mobjNameDefMap.Item (Cstr(itemName))
'If itemInx = "" Then Err.Raise 8, "Method Render", "Definition for item name '"& itemName &"' not found."
'===== Access Control =====
If IsObject(oAccessControl) Then
' Access Control takes priority
bIsVisible = oAccessControl.IsDataVisible ( mArrPopupMenuDef( InxItemTableName, itemInx ), mArrPopupMenuDef( InxdbAccessManagerObjID, itemInx ), cObjectName )
bIsActive = oAccessControl.IsDataActive ( mArrPopupMenuDef( InxItemTableName, itemInx ), mArrPopupMenuDef( InxdbAccessManagerObjID, itemInx ), cObjectName )
Else
' set Visible
If mArrPopupMenuDef( InxVisible, itemInx ) = enumDB_YES Then
bIsVisible = TRUE
Else
bIsVisible = FALSE
End If
' set Active
If NOT mbDisableAll AND (mArrPopupMenuDef( InxActive, itemInx ) = enumDB_YES) Then
bIsActive = TRUE
Else
bIsActive = FALSE
End If
End If
'=========================
If itemName = enumSEPARATOR_LABEL AND bIsVisible Then
Response.write mSeparatorTemplate
Else
'TODO
If bIsVisible Then
Call RenderItem ( itemInx, bIsActive )
End If
End If
' --- Separators added manually using method AddSeparator or AddSeparatorAfter ---
If mobjSeparator.Exists ( Cstr(mArrPopupMenuDef( InxdbName, itemInx )) ) AND bIsVisible Then
Response.write mSeparatorTemplate
End If
Next
Response.write mPostCodeTemplate
Response.write "
"
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Render ( sDivName )
Dim item, nLastItemInx, sMenuItem
' --- Check if GLOBAL Visible
If NOT mbHideAll Then
Response.write ""
Response.write mPreCodeTemplate
nLastItemInx = LastItemInx()
For item = 0 To nLastItemInx
' --- Check if GLOBAL Active
'If mArrPopupMenuDef( InxdbName, item ) Then
Call RenderItem ( item, TRUE ) ' TODO
' --- Separator ---
If mobjSeparator.Exists ( Cstr(mArrPopupMenuDef( InxdbName, item )) ) Then
Response.write mSeparatorTemplate
End If
'End If
Next
Response.write mPostCodeTemplate
Response.write "
"
End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub AddSeparatorAfter ( sItemName )
If InStr( sItemName, " " ) > 0 Then Err.Raise 8, "Method AddSeparatorAfter", "Item Name '"& sItemName &"' cannot have spaces."
mobjSeparator.Add (Cstr(sItemName)), ""
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub AddSeparator ()
mobjSeparator.Add ( Cstr(mArrPopupMenuDef(InxdbName, LastItemInx())) ), ""
End Sub
'-----------------------------------------------------------------------------------------------------------------
'Private Sub SetItemDefaults ( sItemName )
' ' Additional default setup
' 'Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxActive, enumDB_YES ) ' Default Active = enumDB_YES
' 'Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxVisible, enumDB_YES ) ' Default Active = enumDB_YES
'End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Text ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxTxt, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Image ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImg, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImgOff, Value ) ' Default image disable to be the same as image
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub ImageOff ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxImgOff, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Link ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxLink, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub EventHandler ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxEventHandler, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Hint ( sItemName, Value )
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxHint, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Active ( sItemName, Value )
' Y = enabled, N = disabled
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxActive, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Public Sub Visible ( sItemName, Value )
' Y = show, N = hide
Call SetItemPropertyByIndex ( mobjNameDefMap.Item (Cstr(sItemName)), InxVisible, Value )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
'// Perform action on creation of object. e.g. Set myObj = New ThisClassName
Set mobjNameDefMap = CreateObject("Scripting.Dictionary")
Set mobjIdDefMap = CreateObject("Scripting.Dictionary")
Set mobjSeparator = CreateObject("Scripting.Dictionary")
mNumOfItemProperties = 11 ' Number of properties in array which define one menu item.
mLastItemPropertyInx = mNumOfItemProperties - 1
mbHideAll = FALSE
mbDisableAll = FALSE
ReDim mArrPopupMenuDef ( mNumOfItemProperties, -1 )
InxItemTableName = 0
InxdbAccessManagerObjID = 1
InxdbName = 2
InxTxt = 3
InxLink = 4
InxEventHandler = 5
InxImg = 6
InxImgOff = 7
InxHint = 8
InxVisible = 9
InxActive = 10
End Sub
'-----------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
'// Perform action on object disposal. e.g. Set myObj = Nothing
Set mobjNameDefMap = Nothing
Set mobjIdDefMap = Nothing
Set mobjSeparator = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
End Class
%>