Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

xanburzum

[Resolvido] menu suspenso usando XML

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

Criar um menu suspenso do lado do servidor usando XML. Todo o processamento do XML é feito utilizando ASP no servidor. Fácil configurável no menu suspenso.

 

<%@ Language=VBScript %>

<%
 function generateMenu()
   set xmlDocument = server.CreateObject("MSXML.DOMDocument")
   sReturn = "clearMenu" & vbcr
   xmlDocument.async = false
   if instrrev(Request.ServerVariables ("SCRIPT_NAME"),"/")<>0 then
	sScriptName = mid(Request.ServerVariables ("SCRIPT_NAME"),instrrev(Request.ServerVariables ("SCRIPT_NAME"),"/"))
   else
    sScriptName = ""
   end if
   sPath =  lcase(replace(ucase(Request.ServerVariables ("PATH_INFO")),ucase(sScriptName),""))
   if sPath = "/" then sPath=""

   if xmlDocument.load("http://" & Request.ServerVariables("SERVER_NAME") & sPath & "/xml/menudef.xml") then
     set objNodeList = xmlDocument.getElementsByTagname("HEADER")
     for i = 1 to objNodeList.Length
       sSubmenu = ""
       set objNode = objNodelist.nextNode
       sID =  objNode.getAttribute("NAME")
       
       set objChildrenList = objNode.childNodes
       for each objChild in objChildrenList
         if objChild.nodeName="MENUITEM" then
 			for each objMenuDef in objChild.childNodes
 			  sTag = objMenuDef.nodeName
 			  select case sTag
 			    case "CAPTION" : sCaption = objMenuDef.text
  			    case "URL" : 
  					sURL = objMenuDef.text
 					sTarget = objMenuDef.getAttribute("TARGET")
 			    case "TARGET" : sTarget = objMenuDef.text
 			  end select
 			next 
 	        sSubMenu = sSubmenu & "createSubMenu """ & sId & """,""" & sCaption & """,""" & sURL & """,""" & sTarget & """" & vbcr
 	    elseif objChild.nodeName = "CAPTION" then
 	      sCaptionHeader = objChild.text
 	    end if
       next
       
       sReturn = sReturn & sHeader & "createHeader """ & sId & """,""" & sCaptionHeader & """" & vbcr & sSubmenu
     next
     
   else
     Response.Write "document.write ""</TD></TR></TABLE><BR><BR><BR><BR>""" & vbcr
     Response.Write "document.write ""Ocorreu um erro ao carregar a definição XML.""" & vbcr
     Response.write "document.write ""Erro : " & replace(replace(xmlDocument.parseError.reason,chr(10),""),chr(13),"") & """" & vbcr
     Response.Write "</SCRIPT>"
     Response.End
   end if
   generateMenu = sReturn & vbcr & "showMenu"
 end function  
%>
<!-- #INCLUDE FILE="clientscripts\menu.vbs" -->
<html>
 <head>

  <link rel="stylesheet" type="text/css" href="stylesheet/mainstyle.css">
  <TITLE>Free scripts page</TITLE>
 </head>

 <body>
     <span ID="Menu" CLASS="ToolBar" STYLE="display:none"></span>
     <span ID="SubMenu"></span>
     <script LANGUAGE="VBSCRIPT">	<% = generateMenu %>  </script>     
 </body>
</html>

Depois tendo uma pasta, denominada XML, com o seguinte arquivo dentro.

<?xml version="1.0"?>
<MENU>
 <HEADER NAME="empresa 1">
  <CAPTION>empresa 1</CAPTION>
  <MENUITEM NAME="Homepage">
    <CAPTION>Homepage</CAPTION>
    <URL>http://home.empresa 1.br/~xan/empresa 1</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="FreeScript">
  <CAPTION>Freescript page</CAPTION>
  <MENUITEM NAME="Homepage">
    <CAPTION>Homepage</CAPTION>
    <URL>default.asp</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="ScriptInfo">
  <CAPTION>Scripts</CAPTION>
  <MENUITEM NAME="Requirement">
    <CAPTION>XML Driven Menu</CAPTION>
    <URL>xmlmenu.asp</URL>
  </MENUITEM>
  <MENUITEM NAME="CoolMenu">
    <CAPTION>Cool Menu</CAPTION>
    <URL>coolmenu.asp</URL>
  </MENUITEM>
  <MENUITEM NAME="Needhelp">
    <CAPTION>ajuda !</CAPTION>
    <URL>mailto:xanburzum@terra.com.br</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="OutrosLInks">
  <CAPTION>Links</CAPTION>
  <MENUITEM NAME="Santos F.C.">
    <CAPTION>Santos</CAPTION>
    <URL>definction.html</URL>
  </MENUITEM>
  <MENUITEM NAME="Torcida Jovem">
    <CAPTION>Torcida Jovem</CAPTION>
    <URL>tj.html</URL>
  </MENUITEM>
 </HEADER>
</MENU>

E o conteúdo do CSS, na pasta stylesheet:

.MenuItem
{
    BACKGROUND-COLOR: black;
    COLOR: white;
    FLOAT: left;
    FONT-FAMILY: Arial;
    FONT-SIZE: xx-small;
    FONT-WEIGHT: lighter;
    LEFT: 0pt;
    POSITION: relative;
    TOP: 0pt
}
BODY
{
    MARGIN: 0px
}
.ToolBar
{
    FLOAT: right;
    MARGIN: 0px;
    PADDING-BOTTOM: 0px;
    PADDING-LEFT: 0px;
    PADDING-RIGHT: 0px;
    PADDING-TOP: 0px;
    TEXT-ALIGN: right
}
TD
{
    FONT-FAMILY: Arial;
    FONT-SIZE: x-small;
    TEXT-ALIGN: left
}
.MenuHeader
{
    BACKGROUND-COLOR: black;
    COLOR: white;
    FONT-FAMILY: Arial;
    FONT-SIZE: xx-small
}
.TDHeader
{
    BACKGROUND-COLOR: mediumblue;
    COLOR: white;
    FONT-FAMILY: Arial;
    FONT-WEIGHT: bold
}

e por fim o arquivo vbs na pasta, clientscripts:

<script LANGUAGE="VBSCRIPT">

dim menuHTML
dim currentMenu
dim x,y,x2,y2
dim defaultWidth
dim objCurrentHighLight

function resetColorMenuItem(objSubMenu)
		objSubMenu.style.color="white"
end function

function highLightMenuItem(objSubMenu)
	objSubMenu.style.color="lightBlue"
end function

function hideSubMenu()

  xClick = window.event.clientX
  yClick = window.event.clientY

  if xClick>x and xClick<x2 and yClick>y and yClick<y2 then
 
  else
	  currentMenu.style.display="none"
	  objCurrentHighLight.style.color="white"
  end if
  
  
end function

function showSubMenu(objMenuHeader,objSubMenu)
  if objCurrentHighLight <> "" then
	objCurrentHighLight.style.color="white"
  end if
  objMenuHeader.style.cursor="hand"
  set objCurrentHighLight = objMenuHeader.children("headerText")
  objCurrentHighLight.style.color="lightBlue"
  
  if currentMenu <> "" then
	currentMenu.style.zIndex = 100
	currentMenu.style.display = "none"
	
  end if
  if (objMenuHeader.offsetLeft+objSubMenu.style.pixelWidth)>document.body.clientWidth then
	objSubMenu.style.left=document.body.clientWidth-objSubMenu.style.pixelWidth
  else
    objSubMenu.style.left=objMenuHeader.offsetLeft
  end if
  objSubMenu.style.top=objMenuHeader.offsetTop+14
  objSubMenu.style.display=""
  set currentMenu=objSubMenu
  y = objSubMenu.style.pixelTop-10
  x = objSubMenu.style.pixelLeft 
  'alert(objSubMenu.offsetHeight)
  y2 = eval(objSubMenu.style.pixelTop + objSubMenu.offsetHeight)
  x2 = eval(x + objSubMenu.style.pixelWidth) 

end function

function createHeader(sId,sHeaderName)
  dim strHTML
  
  strHTML = "<TD><SPAN onMouseOver=""showSubMenu(" & sId & ",subMenuItem" & sId & ")"" onMouseOut=""hideSubMenu()""ID=""" & sID & """ CLASS=""MenuItem"" >|  <SPAN ID=""headerText"">" & sHeaderName & "</SPAN>  </SPAN></TD>"

  Menu.style.display=""
  menuHTML = menuHTML & strHTML 
end function

function clearMenu()
	menuHTML=""
	defaultWidth = 100
	currentMenu = ""
	Menu.innerHTML = ""
	objCurrentHighLight = ""
end function

function showMenu()
  Menu.innerHTML="<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR><TD><DIV></DIV></TD>" & menuHTML & "</TR></TABLE>"
end function

function createSubMenu(sId,sHeaderName,sUrl,sTarget)

  dim htmlStr
  dim iPos
  dim strHTML

  htmlStr = subMenu.innerHTML
  iPos = instr(htmlStr,"<!-- submenu" & sId & " -->")
  if sHeaderName = "-" then 
    
    strHTML = "<HR WIDTH=100%><!-- submenu" & sId & " -->" 
    SubMenu.innerHTML=replace(htmlstr,"<!-- submenu" & sID & " -->",strHTML)
  else

   if iPos<=0 then
     strHTML = "<SPAN CLASS='MenuItem' ID='subMenuItem" & sId & "' onMouseOut='hideSubMenu()' STYLE='display:none;width:" & defaultWidth & ";position:absolute;left:0;top:60;padding-top:0;padding-left:0;padding-bottom:20;z-index:118;'>" & _
               "<DIV STYLE='width:" & defaultWidth & ";position:relative;left:0;top:8;z-index:118;' >" & _
				"<A ID='AS_" & sId & "'" & _
				"   STYLE='width:" & defaultWidth & ";text-decoration:none;cursor:hand;font-family:Verdana;font-size:xx-small;font-size:10;color:white'" & _
				"   HREF='" & sUrl & "' TARGET='" & sTarget & "' onMouseOver='highLightMenuItem(this)' onMouseOut='resetColorMenuItem(this)'>" & sHeaderName & _
				"   </A>" & _
				"<!-- submenu" & sId & " --></DIV></SPAN>"
   else
     strHTML =	"<A ID='subMenuRef" & MenuIDStr & "'" & _
	          	"   STYLE='width:" & defaultWidth & ";position:relative;left:0;text-decoration:none;font-family:Verdana;font-size:xx-small;font-size:10;color:white'" & _
		        "   HREF='" & sUrl & "' TARGET='" & sTarget & "' onMouseOver='highLightMenuItem(this)' onMouseOut='resetColorMenuItem(this)'>" & _
		        sHeaderName & "</A><!-- submenu" & sId & " -->"
   end if

   if iPos<=0 then
    SubMenu.innerHTML=SubMenu.innerHTML & strHTML
   else
    SubMenu.innerHTML=replace(htmlstr,"<!-- submenu" & sID & " -->",strHTML)
   end if
  end if
end function

</SCRIPT>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito