<% '====================================================== ' VP-ASP 6.50 ' Nov 12, 2005 'left menu controls 'first number controls the distance of the fly out menu from the arrow from the top nav 'higher numbers mean further away from the left side of the page 'second number controls the height 'higher numbers with a minus symbol mean up '====================================================== const xleftdistance="-45" const xleftheight="-25" '====================================================== '====================================================== 'top nav bar controls 'first number controls the distance of the fly out menu from the arrow on the left of page 'higher numbers mean further away from the left 'second number controls the height 'higher numbers mean further away from the top of the page '====================================================== const xtopdistance="0" const xtopheight="12" '====================================================== '====================================================== 'closer menu controls 'first number controls the top closer layers height 'second number controls the distance from the top of the 2nd closer layer 'third number creates a line around the closer images so you can test to see where the layer is positioned. 'set to 0 when finished '====================================================== const xtopcloser="80" const xbottomcloser="118" const xborder="0" '====================================================== dim thisrsmenuitem,secthisrsmenuitem dim anothermenucount dim countmenuitems(100) dim countmenuitemstrimmed(100) dim countmenuidsbottom(100) dim menuurlarray(100) dim menuopenin(100) dim menucounthasdiv(100) dim anothericount dim cmysql,cnewsql dim cconn dim ccount dim fsobj,recordobj dim widthpixels dim thewidth dim remainder 'dim tablewidth dim firstwidthpixels dim menurowcount dim iewidth dim nswidth dim jsonmouseoverhide dim i dim dw dim howmany dim stopnow 'dim anotherdivcountit dim ycount dim alterwidth dim menubody dim browsertype dim fileno anothericount=0 anothermenucount=0 sub writethetextfile dim ga dw="" menubody="" getthearrays() menubody="" navbody writethecloser writetheoutsidefiles "horonavbar.html",menubody writetheoutsidefiles "horonavbar_divs.html",dw menubody="" writethecloserleft navbodyverticle writetheoutsidefiles "vertinavbar.html",menubody writetheoutsidefiles "vertinavbar_divs.html",dw end sub sub getthearrays() 'VP-ASP 6.50 - productmatch menus cmysql="select * from menuitem where pmenuitemid=0 AND ((productmatch = '" & xproductmatch & "') OR (productmatch IS NULL) OR (productmatch = '')) order by seq" 'cmysql="select * from menuitem where pmenuitemid=0 order by seq" shopopendatabase dbc set thisrsmenuitem=dbc.execute(cmysql) while not thisrsmenuitem.eof countmenuitems(anothermenucount)=thisrsmenuitem("name") countmenuitemstrimmed(anothermenucount)=replace(countmenuitems(anothermenucount)," ","") countmenuidsbottom(anothermenucount)=thisrsmenuitem("id") menuurlarray(anothermenucount)=thisrsmenuitem("url") if thisrsmenuitem("openin")="" or isnull(thisrsmenuitem("openin")) then menuopenin(anothermenucount)="_self" else menuopenin(anothermenucount)=thisrsmenuitem("openin") end if writethedivs thisrsmenuitem("id"),anothermenucount thisrsmenuitem.movenext anothermenucount=anothermenucount+1 wend closerecordset thisrsmenuitem shopclosedatabase dbc jsonmouseoverhide="mm_showhidelayers(" for i= 1 to anothermenucount if i<>1 then jsonmouseoverhide=jsonmouseoverhide & "," end if jsonmouseoverhide=jsonmouseoverhide &"'sub" & i & "','','hide'" next jsonmouseoverhide=jsonmouseoverhide & ",'closer','','hide'" jsonmouseoverhide=jsonmouseoverhide & ")" 'tablewidth=getconfig("xhoromenuwidth") tablewidthleft=getconfig("xleftmenuwidth") tablewidth=698 widthpixels=cint((anothermenucount/tablewidth)*100) remainder=tablewidth-(widthpixels*(anothermenucount-1)) firstwidthpixels=remainder end sub sub writethecloser dw=dw&"
" & vbcrlf dw=dw&"" & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"" & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf end sub sub writethecloserleft dw=dw&"
" & vbcrlf dw=dw&"" & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"" & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf end sub sub writethedivs (id,anotherdivcountit) anothericount=0 shopopendatabase dbc 'do while countmenuitems(anotherdivcountit)<>"" 'VP-ASP 6.50 - product match menu items cnewsql="select * from menuitem where pmenuitemid="&id&" AND ((productmatch = '" & xproductmatch & "') OR (productmatch IS NULL)) order by seq" 'cnewsql="select * from menuitem where pmenuitemid="&id&" order by seq" set secthisrsmenuitem=dbc.execute(cnewsql) if secthisrsmenuitem.eof then exit sub end if secthisrsmenuitem.close 'response.write cnewsql dw=dw&"
" & vbcrlf dw=dw&"" & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&" " & vbcrlf set secthisrsmenuitem=dbc.execute(cnewsql) menucounthasdiv(anotherdivcountit)=false do while not secthisrsmenuitem.eof writethedropdown secthisrsmenuitem("url"),secthisrsmenuitem("name"),secthisrsmenuitem("openin") secthisrsmenuitem.movenext menucounthasdiv(anotherdivcountit)=true loop dw=dw&" " & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf dw=dw&"
" & vbcrlf anothericount=0 shopclosedatabase dbc end sub sub writethedropdown(url,content,openit) dim tc dw=dw&" " & vbcrlf dw=dw&" " & vbcrlf if lcase(left(content, 4)) = "lang" then if lcase(left(content, 8)) <> "language" then content = "<%= getlang(""" & content & """)%>" content = replace(content, "<", "<") content = replace(content, ">", ">") dw=dw&content else dw=dw&content end if else dw=dw&content end if 'dw=dw&content dw=dw&"" & vbcrlf dw=dw&"" dw=dw&" " & vbcrlf end sub sub navbody dim width menubody="" menubody=menubody&""& vbcrlf anothermenucount=0 do while countmenuitems(anothermenucount)<>"" If anothermenucount = 0 Then menubody=menubody&" "& vbcrlf anothermenucount=anothermenucount+1 loop menubody=menubody&"
" & vbcrlf ElseIf countmenuitems(anothermenucount+1)="" Then menubody=menubody&" " & vbcrlf Else menubody=menubody&" " & vbcrlf End If writecelltable "image"&anothermenucount,countmenuitems(anothermenucount),"dropdown" & anothermenucount,anothermenucount,menuurlarray(anothermenucount),menuopenin(anothermenucount) writedropdown anothermenucount,menuopenin(anothermenucount) menubody=menubody& "
"& vbcrlf end sub sub writecelltable (image,displaymessage,dropdown,num,url,openit) if lcase(left(displaymessage, 4)) = "lang" then if lcase(left(displaymessage, 8)) <> "language" then displaymessage = "<%= getlang(""" & displaymessage & """)%>" displaymessage = replace(displaymessage, "<", "<") displaymessage = replace(displaymessage, ">", ">") end if end if menubody=menubody&"" menubody=menubody&displaymessage if menucounthasdiv(num)=true then menubody=menubody&"..." & vbcrlf end if menubody=menubody&"" & vbcrlf end sub sub writedropdown (num,openit) Dim menusql,rs menusql="select * from menuitem where pmenuitemid=" & countmenuidsbottom(num) & " order by seq" shopopendatabase dbc set rs=dbc.execute(menusql) If Not rs.EOF Then menubody = menubody & "" End If shopclosedatabase dbc end sub sub writetheoutsidefiles (filename,bodythis) dim filepath filepath="editor/" &filename set fsobj = server.createobject("scripting.filesystemobject") set recordobj= fsobj.createtextfile(server.mappath(filepath),true,false) recordobj.write bodythis recordobj.close set recordobj=nothing set fsobj=nothing end sub sub navbodyverticle 'writethecloserleft menubody="" menubody=menubody&""& vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&"
"& vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&" " & vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&"
" & vbcrlf menubody=menubody&" "& vbcrlf anothermenucount=0 do while countmenuitems(anothermenucount)<>"" menubody=menubody&" " & vbcrlf menubody=menubody&" "& vbcrlf menubody=menubody&" "& vbcrlf anothermenucount=anothermenucount+1 loop menubody=menubody&"
" writecelltable2 "image"&anothermenucount,countmenuitems(anothermenucount),"dropdown" & anothermenucount,anothermenucount,menuurlarray(anothermenucount),menuopenin(anothermenucount) menubody=menubody&"
"& vbcrlf menubody=menubody&"
"& vbcrlf menubody=menubody&"
"& vbcrlf end sub sub writecelltable2 (image,displaymessage,dropdown,num,url,openit) if lcase(left(displaymessage, 4)) = "lang" then if lcase(left(displaymessage, 8)) <> "language" then displaymessage = getlang(displaymessage) end if end if '====================================================== menubody=menubody&" " & vbcrlf menubody=menubody&" " & vbcrlf menubody=menubody&" " & vbcrlf if menucounthasdiv(num)=true then menubody=menubody&" " & vbcrlf else menubody=menubody&" " & vbcrlf end if menubody=menubody&" " & vbcrlf menubody=menubody&" " & vbcrlf menubody=menubody&"
" menubody=menubody&displaymessage menubody=menubody&"" menubody=menubody&"" menubody=menubody&"" menubody=menubody&"" menubody=menubody&"" menubody=menubody&"" menubody=menubody&"
" & vbcrlf end sub %>