原创：由XML文档创建树型菜单类

于 2005-08-29 16:55:00 发布
阅读量977 收藏
点赞数
分类专栏： ASP技术资料 文章标签： xml 文档 function menu javascript url

类文件：ClsMenu.asp
<%
'***************************************************
' 说明：Menu类
' 作者：JinGangLi
' 时间：2005-6-27
'***************************************************

Class Cls_Menu
 Private m_strMenuID  '对应Menu节点的属性iD，通过只写属性MenuID设置
 private m_intTableWidth '菜单表格宽度，通过只写属性MenuWidth设置 
 Private m_strOutHtml '临时存储Menu的Html字符串
 
 Private m_strError  '出错信息 
 private m_intImgWidth 'Image宽度
 Private m_intI   'Tr的ID属性编号，实现隐藏、显示所用

 private m_strMenuBg   '菜单的背景色
 private m_strMouseOverBg '当鼠标移动到菜单上时TD背景色
 private m_strTdBorderColor  '菜单TD的边框颜色
 private m_strTdStyle  '菜单TD的边框样式字符串

 private m_strFontFamily  '字体样式
 private m_strFontSize  '字体大小
 private m_strFontColor  '字体颜色
 private m_strFontStyleHtml  '样式字符串

 Private m_strOpenFrame  '网页打开窗口

 '类初始化
 Private Sub Class_initialize
  m_strMenuiD = -1  'Menu的ID属性初始化为 －1，即不可用。menu的ID属性为 menu_0,menu_1的形式，一个xml文件可一存放多个Menu
  m_intTableWidth = 165 '默认菜单表格宽度为165
  m_intImgWidth = 12  'Image宽度为9
  m_intI = 0    'Tr的ID标号从0开始，（id='tr_'& m_i）
  m_strError = ""   '清空出错信息
 
  m_strMenuBg = "#DEDFDE"   '默认菜单背景色
  m_strMouseOverBg = "#EFEFEF" '默认当鼠标移动到菜单上时TD的背景色
  m_strTdBorderColor = "#EFEFEF" '默认TD边框颜色

  m_strFontFamily = "FONT-FAMILY:宋体;" '字体样式
  m_strFontSize = "FONT-SIZE:9pt;"  '字体大小 
  m_strFontColor = "COLOR:#393939;"  '字体颜色

  m_strOpenFrame = "_self"
 End Sub

 '类释放
 Private Sub Class_Terminate
    m_strError = ""
 End Sub

 '－－－属性－－－－－－－－－－－－－－－
 '设置MenuID
 Public Property Let MenuID(strID)
  m_strMenuID = strID
 End Property

 '设置Menu宽度
 Public Property Let MenuWidth(intWidth)
  m_intTableWidth = intWidth
 End Property
 
 '设置Menu背景色
 Public Property Let MenuBgColor(strColor)
  m_strMenuBg = strColor
 End Property

 '设置当鼠标移动到菜单上时的背景色
 Public Property Let OnMouseOverBg(strColor)
  m_strMouseOverBg = strColor
 End Property

 '设置菜单TD的边框颜色
 Public Property Let TdBorderColor(strColor)
  m_strTdBorderColor = strColor
 End Property
 
 '设置字体
 Public Property Let FontFamily(strFont)
  m_strFontFamily = "FONT-FAMILY:" & strFont & ";"
 End Property

 '设置字体大小
 Public Property Let FontSize(strSize)
  m_strFontSize = "FONT-SIZE:"& strSize & ";"
 End Property

 '设置字体颜色
 Public Property Let FontColor(strColor)
  m_strFontColor = "COLOR:"& strColor & ";"
 End Property

 '设置网页打开窗口
 Public Property Let OpenFrame(strFrame)
  m_strOpenFrame = strFrame
 End Property

 '-----------------------------------------------

 ' 获取错误信息
 Public Function GetLastError()
  GetLastError = m_strError
 End Function

 ' 清除错误信息
 Public Function ClearError()
  m_strError = ""
 End Function

 ' 私有方法，添加错误信息
 Private Sub AddError(strEcho)
  m_strError = m_strError + "<Div>" & strEcho & "</Div>"
 End Sub

 '私有方法，取得菜单TD的边框样式
 Private Function GetTdStyle()
  m_strTdStyle = ""
  m_strTdStyle = m_strTdStyle & "border-bottom:1px solid "& m_strTdBorderColor &";"
  m_strTdStyle = m_strTdStyle & "border-left:1px solid "& m_strTdBorderColor &";"
  m_strTdStyle = m_strTdStyle & "border-right:1px solid "& m_strTdBorderColor &";"
  m_strTdStyle = m_strTdStyle & "border-top:1px solid "& m_strTdBorderColor &";"
  m_strTdStyle = m_strTdStyle & "border-width:1px;"
  
  GetTdStyle = m_strTdStyle
 End Function

 '私有方法，取得字体样式
 Private Function GetFontStyle()
  m_strFontStyleHtml = ""
  m_strFontStyleHtml = m_strFontStyleHtml & m_strFontFamily
  m_strFontStyleHtml = m_strFontStyleHtml & m_strFontSize
  m_strFontStyleHtml = m_strFontStyleHtml & m_strFontColor
  m_strFontStyleHtml = m_strFontStyleHtml & "TEXT-DECORATION: none;"

  GetFontStyle = m_strFontStyleHtml
 End Function

 ' 从Xml中读取指定节点的数据
 ' 需要首先设置menuID
 
 Public Function CreateMenuFromXml(objXmlDoc)
  Dim rootNode
  Dim objMainMenu,objSubMenuList

  Call ClearError() '清除错误信息

  If objXmlDoc is Nothing Then
   CreateMenuFromXml = False
   AddError "Dom对象为空值"
   Exit Function
  End If

  If CStr(m_strMenuID) = "-1" OR CStr(m_strMenuID) = "" Then
   CreateMenuFromXml = False
   Call AddError("未正确设置Menu对象的ID属性")
   Exit Function
  End If

  '选择并读取Menu信息
  Set rootNode = objXmlDoc.documentElement
  Set objMainMenu = rootNode.SelectSingleNode("//Menu[@id='"& m_strMenuID &"']")

  if objMainMenu is Nothing Then
   CreateMenuFromXml = False   
   Call AddError("未正确选取节点")
   Exit Function
  Else
   On Error Resume Next
   m_strOutHtml = ""
   m_strOutHtml = m_strOutHtml & vbcrlf & "<TABLE cellSpacing=0 cellPadding=2  style='background-color:"& m_strMenuBg &";' width='"& m_intTableWidth &"'>"
   m_strOutHtml = m_strOutHtml & vbcrlf & " <TR><TD height='2'></TD></TR>"
   m_strOutHtml = m_strOutHtml & vbcrlf & " <TR>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "   <TABLE  cellSpacing=0 cellPadding=0 style='"& GetFontStyle() &"'>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "    <TR >"
   m_strOutHtml = m_strOutHtml & vbcrlf & "     <TD width='"& m_intImgWidth &"' ><img id='img_"& m_intI &"' src='img/+.gif' οnclick=""JavaScript:HideDisplay("& m_intI &")""></TD>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "     <TD style="""& GetTdStyle &""" width='"& m_intTableWidth - m_intImgWidth &"' οnclick=""JavaScript:HideDisplay("& m_intI &")"" onMouseOver=""mainMenuMouseOver(this,'"& m_strMouseOverBg &"')"" onMouseOut=""mainMenuMouseOut(this,'"& m_strMenuBg &"');"">"& objMainMenu.getAttribute("name") &"</TD>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "    <TR>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "   </TABLE>"
   m_strOutHtml = m_strOutHtml & vbcrlf & "  </TD>"
   m_strOutHtml = m_strOutHtml & vbcrlf & " </TR>"
   m_strOutHtml = m_strOutHtml & vbcrlf & " <TR id='tr_"& m_intI &"' style='display:none' >"
   m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD>"
   
  End iF

  Set objSubMenuList = objMainMenu.ChildNodes
  iF objSubMenuList.Length > 0 Then
   Call CreateSubMenu(objSubMenuList)
  End iF 

  m_strOutHtml = m_strOutHtml & vbcrlf & "  </TD>"
  m_strOutHtml = m_strOutHtml & vbcrlf & " </TR>"
  m_strOutHtml = m_strOutHtml & vbcrlf & " <TR><TD height='2'></TD></TR>"
  m_strOutHtml = m_strOutHtml & vbcrlf & "</TABLE>"

  Set rootNode = Nothing
  Set objMainMenu = Nothing
  CreateMenuFromXml = m_strOutHtml
 End Function 
 
 '创建子菜单
 Private Function CreateSubMenu(inSubMenuList)
  Dim objSubMenu,objSubMenuList
  Dim strImg,intFirstTdWidth,intSecondTdWidth

  For Each objSubMenu in inSubMenuList
   Set objSubMenuList = objSubMenu.ChildNodes
   iF objSubMenuList.Length > 0 Then
    strImg = "+.gif"
   Else
    strImg = "dot.gif"
   End iF
   intFirstTdWidth = objSubMenu.getAttribute("level") * m_intImgWidth
   intSecondTdWidth = m_intTableWidth - intFirstTdWidth

   iF objSubMenuList.Length > 0 Then
    '有子菜单时
    m_intI = m_intI + 1
    m_strOutHtml = m_strOutHtml & vbcrlf & "<TABLE  cellSpacing=0 cellPadding=0 style='"& GetFontStyle() &"'>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " <TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD width='"& intFirstTdWidth &"' align='right' ><img id='img_"& m_intI &"' src='img/"& strImg &"' οnclick=""JavaScript:HideDisplay("& m_intI &")""></TD>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD width='"& intSecondTdWidth - 6 &"' style="""& GetTdStyle() &"""  οnclick=""JavaScript:HideDisplay("& m_intI &")"" onMouseOver=""mainMenuMouseOver(this,'"& m_strMouseOverBg &"')"" onMouseOut=""mainMenuMouseOut(this,'"& m_strMenuBg &"');"">"& objSubMenu.getAttribute("name") &"</TD>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " </TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " <TR><TD height='2' colspan='2'></TD></TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " <TR id='tr_"& m_intI &"' style='display:none'>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD colspan=2 >"

    Call CreateSubMenuitem(objSubMenu,strimg)

    m_strOutHtml = m_strOutHtml & vbcrlf & "  </TD>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " </TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "</TABLE>"

   Else
    '没有子菜单时
    m_strOutHtml = m_strOutHtml & vbcrlf & "<TABLE cellSpacing=0 cellPadding=0 style='"& GetFontStyle() &"'>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " <TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD width='"& intFirstTdWidth &"' align='right' ><img src='img/dot.gif' ></TD>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "  <TD width='"& intSecondTdWidth - 6 &"' style="""& GetTdStyle() &"""  οnclick=""JavaScript:window.open('"& objSubMenu.getAttribute("url") &"','"& m_strOpenFrame &"')"" onMouseOver=""mainMenuMouseOver(this,'"& m_strMouseOverBg &"')"" onMouseOut=""mainMenuMouseOut(this,'"& m_strMenuBg &"');"">"& objSubMenu.getAttribute("name") &"</TD>"
    m_strOutHtml = m_strOutHtml & vbcrlf & " </TR>" 
    m_strOutHtml = m_strOutHtml & vbcrlf & " <TR><TD height='2' colspan='2'></TD></TR>"
    m_strOutHtml = m_strOutHtml & vbcrlf & "</TABLE>"
   End iF
  Next  
 End Function

 '递归调用
 Private Function CreateSubMenuitem(objSubMenuitem,strimg)
   Dim objSubMenuList
   Set objSubMenuList = objSubMenuitem.ChildNodes
   iF objSubMenuList.Length > 0 Then
    Call CreateSubMenu(objSubMenuList)
   End iF
 End Function

 '输出菜单到页面
 Public Function PrintMenuFromXml(objXmlDoc)
  Dim MenuHtml
   MenuHtml = CreateMenuFromXml(objXmlDoc)
  IF MenuHtml = False Then
   Response.write GetLastError()
  Else
   Response.write MenuHtml
  End IF
 End Function
End Class  
%>

—————————————————————————————————————————————－
菜单资源文件：MenuTree.xml，level表示菜单层次深度
<?xml version="1.0" encoding="gb2312"?>
<Menus>
   <Menu id="menu_1" level='1' name="主菜单" >
       <Description level='2' name="子菜单1" url="1.asp"></Description>
       <PriceTable  level='2' name="子菜单2" url="2.asp"></PriceTable>
       <Contact  level='2' name="子菜单3"  url="2.asp"></Contact>
       <Line level='2' name="子菜单4" url="4.asp"></Line>
       <Courses level='2' name="子菜单5" >
           <Course level='3' name="子菜单5_1" url="3.asp">
                <Hole level='4' name="子菜单5_1_2" url="3.asp"></Hole>
                <Hole level='4' name="子菜单5_1_3" url="3.asp"></Hole>
                <Hole level='4' name="子菜单5_1_4" url="3.asp"></Hole>
           </Course>
           <Course level='3' name="子菜单5_2" >
                <Hole level='4' name="子菜单5_2_1" url="3.asp"></Hole>
                <Hole level='4' name="子菜单5_2_2" url="3.asp"></Hole>
                <Hole level='4' name="子菜单5_2_3" url="3.asp"></Hole>
                <Hole level='4' name="子菜单5_2_4" url="3.asp"></Hole>    
           </Course>   
      </Courses>
  </Menu>
</Menus>

_______________________________________________________________________
JavaScript教本文件：Menu.js

<!--
 function HideDisplay(strID){ 
     //变化图片
    imgID = eval("img_" + strID);
    intUrlLen = imgID.src.Length;
    intPos = imgID.src.lastIndexOf("/") + 1;
    imgUrl = imgID.src.substring(0,intPos);
    imgExtName = imgID.src.substring(intPos,imgID.src.Length)
    if (imgExtName == "+.gif")
    {
         imgID.src = imgUrl + "-.gif"
    }
    else{
         imgID.src = imgUrl + "+.gif"
    }
  
    //展开收缩
    trID = eval("tr_" + strID);
    if (trID.style.display == "none"){
        trID.style.display = "block"
       //eval("tr_" + strID + ".style.display=/"/";");
    }
    else{
        trID.style.display = "none"
        //eval("tr_" + strID + ".style.display=/"none/";");
    }
 }
 function mainMenuMouseOver(src,clrOver) {
    if (!src.contains(event.fromElement)) {
         src.style.cursor = 'hand';
         src.bgColor = clrOver;
    }
 }

 function mainMenuMouseOut(src,clrIn) {
      if (!src.contains(event.toElement)) {
           src.style.cursor = 'default';
           src.bgColor = clrIn;                    
      }
 }
-->
——————————————————————————————————————————
图片：+.gif    -.gif   dot.gif  大小：12×8 pixels
_______________________________________________________________________
生成菜单文件 ：menu.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% Option Explicit %>
<!--#include file="clsMenu.asp"-->
<HTML>
<HEAD>
 <Script language="javascript" src="menu.js"></script>
</HEAD>
<Body>

<%
 Dim objXml
 Dim objMenu
 Dim strError
 
 Set objXml =Server.CreateObject("Microsoft.XMLDOM")
 objXml.Async = False
 objXml.Load(Server.MapPath("menutree.xml")) '加载菜单xml文档

 Set objMenu = New Cls_Menu '创建菜单对象
 objMenu.MenuID = "menu_1" '设置要检索的菜单ID
 objMenu.MenuWidth = "170" '设置菜单宽度
 
 objMenu.MenuBgColor = "#DEDFDE"     '设置菜单背景色
 objMenu.OnMouseOverBg = "#EFEFEF" '设置当鼠标移动到菜单上时的背景色
 objMenu.TdBorderColor = "#EFEFEF" '设置菜单项的边框颜色

 objMenu.FontFamily = "宋体"  '设置菜单字体  
 objMenu.FontSize = "9pt"  '设置字体大小
 objMenu.FontColor = "green"  '这只字体颜色

 objMenu.OpenFrame = "_blank" '网页打开窗口

 '------------方法一-----------------
 Dim MenuHTml
 MenuHTml = objMenu.CreateMenuFromXml(objXml)   '调用Cls_Person类的CreateMenuFromXml方法创建菜单，返回HTML代码
 IF MenuHtml = False Then
     Response.write objMenu.GetLastError   '输出错误信息
 Else
     Response.write MenuHtml      '输出菜单
 End IF

 '-------------方法二----------------
 '直接输出菜单，不需要判断错误，objMenu对象自动判断
 '－－－－－objMenu.PrintMenuFromXml(objXml)－－－－'直接打印菜单
 '注意：这个菜单在同一页面只能出现一次
 Set objXml = Nothing
 Set objMenu = Nothing
%>
</BODY>
</HTML>

ljg2597758
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值