SiteExperts.com Logo Home | Community | Developer's Paradise | Jobs
User Groups | Site Tools | Site Information | Search

Inside Technique : Dynamic Menus : The Script

Download Script and Sample Files

Note - The menus cannot be rendered over List Boxes or IFrames. If this is necessary, you must hide the list box or IFrame when the menu is dropped down.

<LINK TYPE="text/css" REL="stylesheet" HREF="menu.css">

<!-- Associate the library with the page -->
<SCRIPT SRC="menuBar.js" LANGUAGE="JavaScript"></SCRIPT>

<SCRIPT LANGUAGE="JavaScript">
 function MyRedirect( strSource ) {
  // This function is used to redirect to a new web-page
  // Rather than set a document location, we simulate
  // clicking on an invisible link. This provides us with
  // automatic window targeting support.

  if (document.all.navLink.href!=strSource ) {
   document.all.navLink.href = strSource
   document.all.navLink.click()
  }
 }
 document.onclick = checkMenu

</SCRIPT>
<% 
Dim objComm, sPath

' Set this to the path of your access database
' We use a DSN-less connection.
sPath = "d:\db\test.mdb"

Set objConn = Nothing

'Establish Data Connection 
SET objConn = Server.CreateObject("ADODB.Connection")
objConn.Open "Driver={Microsoft Access Driver (*.mdb)};dbq=" & sPath & ";UID=sa;PWD=;" 

'Setup the Command Object
Set objComm = Server.CreateObject("ADODB.Command")
objComm.CommandText = "qryChildren"
objComm.CommandType = 4 

'Setup the Paremeters Object
Set objParms = objComm.Parameters
objParms.Append objComm.CreateParameter( "ParentMenuItemID", 3, 1, 20 )

Set objComm.ActiveConnection = objConn       

Function HasChildren( intParentID )
  '~**********************************************************
  'Name:.........HasChildren()
  'Created by:...Juan L. Romero
  'Created on:...January 15, 2000
  'Purpose:......Given a parent ID, this function returns a 
  '       recordset of all related children.
  '
  'Assumptions:..Command Object objComm
  '
  'Inputs:.......intParentID (integer) Parent ID
  'Outputs:......objRS (Recordset Object)
  '/~*********************************************************
  Dim objRS 
  Set objRS = objComm.Execute(, intParentID )

  Set HasChildren = objRS
End Function 

Function WriteChildren( objRS2 )
  '~**********************************************************
  'Name:.........WriteChildren()
  'Created by:...Juan L. Romero
  'Created on:...January 15, 2000
  'Purpose:......Given a recordset, this function writes 
  '       out menu (children) records.
  '
  'Assumptions:..none
  '
  'Inputs:.......objRS2 - Recordset
  'Outputs:......integer - number of records processed
  '/~*********************************************************
  Dim intRecords 

  intRecords = 0

  WHILE NOT objRS2.EOF
    'Keep a counter of the records processed
    intRecords = intRecords + 1
    'If this is the first record, write the table definition.
    If intRecords = 1 Then
%>
      <TABLE CELLSPACING="0" CELLPADDING="0" TITLE="<%=Trim(objRS2.Fields("ToolTip").Value)%>"><%
    End if%>            
      <TR <%
        'If this menu option is disabled, then use the disabled CLASS
        If objRS2.Fields("Enabled").Value = False Then
          Response.Write("CLASS=" + Chr(34) + "disabled" + Chr(34) + " ")
        Else
          'If this menu option has an URL then place the OnClick Method
          If Len(objRS2.Fields("URL").Value) > 0 Then
            Response.Write("OnClick=" + Chr(34) + _
              "MyRedirect('" + objRS2.Fields("URL").Value + "');" + Chr(34) + " ")
          End If 
        End If
        %>>
      <TD TITLE="<%=objRS2.Fields("ToolTip").Value%>" NOWRAP><%
        'Is there an icon related to this item?
        If Len(objRS2.Fields("ICON").Value) > 0 Then
          Response.Write("<IMG SRC=" + Chr(34) + Trim(objRS2.Fields("ICON").Value) + Chr(34) + _ 
                  " ALIGN=top WIDTH=16 HEIGHT=16 STYLE=" + Chr(34) + _ 
                  "margin-left: -15pt;margin-right: 2pt;" + Chr(34) + ">")          
        End If 
        'Logic for Grand Children (if any)
        Set objGC = HasChildren( objRS2.Fields("ID").Value ) 
        If Not objGC.EOF Then
          Call WriteGrandChildren( objGC )
        End if 
        Set objGC = Nothing%>
        <%=objRS2.Fields("Caption").Value%></TD>
      </TR><% 
  objRS2.MoveNext 
  WEND
  
  If intRecords > 0 Then
%>
      </TABLE>
<%  
  End if 
  
  'Close and release the RecordSet
  objRS2.Close
  Set objRS2 = Nothing
  
  'Return the number of records processed
  WriteChildren = intRecords
  
End Function 

Sub WriteGrandChildren( objRS2 )
  '~**********************************************************
  'Name:.........WriteGrandChildren()
  'Created by:...Juan L. Romero
  'Created on:...January 15, 2000
  'Purpose:......Given a recordset, this function writes out 
  '       the <SPAN more> clause for grandchildren 
  '       records.
  '
  'Assumptions:..none
  '
  'Inputs:.......objRS2 - Recordset
  'Outputs:......HTML
  '/~*********************************************************
%><SPAN CLASS=more>4</SPAN><%
  Call WriteChildren( objRS2 ) 
End Sub

%>
</HEAD>

<BODY>

<!-- Menu logic starts here -->
<TABLE ID="menuBar" 
    OnSelectBar="return false" 
    OnClick="processClick()" 
    OnMouseOver="doHighlight(event.toElement)" 
    OnMouseOut="doCheckOut()" 
    OnKeyDown="processKey()">
  <TR><% 
  
  'Get all of the Menu Root Items
  Set objRootComm = Server.CreateObject("ADODB.Command")
  objRootComm.CommandText = "qryRootItems"
  objRootComm.CommandType = 4  
  
  Set objRootComm.ActiveConnection = objConn   
  Set objRS = objRootComm.Execute
  
  'Process all root menu items
  WHILE NOT objRS.EOF 
  '1/27/2000 JLR Added disabled and URL support for root items
    strClass = "root"
    'If this menu option is disabled, then use the disabled CLASS
     If objRS.Fields("Enabled").Value = False Then
       strClass = "disabled"
     End If
%>
    <TD CLASS=<%= strClass %> TITLE="<%= Trim(objRS.Fields("ToolTip").Value) %>
<%
    'Is there a URL for this root item?
    If objRS.Fields("Enabled").Value = True And Len(objRS.Fields("URL").Value) > 0 Then
      Response.Write(" OnClick=" + Chr(34) + "MyRedirect('" + objRS.Fields("URL").Value + "');" + Chr(34))
    End If 
    Response.Write(">" + Trim(objRS.Fields("Caption").Value))

    'Process all children for this menu id
    Set objChildren = HasChildren( objRS.Fields("ID").Value ) 
    If Not objChildren.EOF Then
      Call WriteChildren( objChildren )
    End if 
    Set objChildren = Nothing
%>    </TD>
<% 
  objRS.MoveNext
  WEND
  Set objComm.ActiveConnection = Nothing

  objRS.Close
  Set objConn = Nothing
  
%>   
<!-- The following is a special cell that is used to 
       extend the background to the right edge -->
    <TD WIDTH=100% CLASS=clear> </TD> 
  </TR>
</TABLE>
<!-- Hidden Link to manage navigation -->
<A ID=navLink TARGET="destination" HREF="#" STYLE="display: none"></A>
<!-- Menu logic ends here -->
Discuss and Rate this Article

Page 1:Dynamic Menus
Page 2:The Script