HTA 菜单条生成示例

[ 2859 查看 / 2 回复 ]

返回列表
发新话题 回复该主题
梦想成真
头像

梦想成真

  • 管理员
  • 728
  • 8073
  • 2010-05-17
2010-06-07 16:31 |只看楼主 1#
t T
  1. <html>
  2. <!-- An editable menu bar that looks like a standard Windows menu for use in an HTA -->
  3. <head>
  4. <title>Example Menu System</title>
  5. <script language=vbs>
  6. resizeto 640, 480
  7. ' Copyright 2010, Tom Lavedas, tlavedas at hotmail dot com
  8. ' Released for non-commercial use, only.

  10. ' Define menu items
  11. Const sMenuItems = "File,Edit,Font,Help"

  13. ' Define one submenu constant for each menu item as illustrated below
  14. ' Each is a comma separated list in a single string
  15. Const sFile = "Open,Close,Save,Save As ...,Exit"
  16. Const sEdit = "Cut,Copy,Paste,Select All,Deselect All"
  17. Const sFont = "Arial,Century Gothic,Times"
  18. Const sHelp = "Help, About"
  19. Const sHTML = "&nbsp;&nbsp;&nbsp;#sItem#&nbsp;&nbsp;&nbsp;"

  21. Dim dMenus, sMenuOpen

  23. sub Window_onload
  24. Dim entry

  26.   set dMenus = createObject("Scripting.Dictionary")
  27.   for each entry in Split(sMenuItems, ",")
  28.     menu.innerHTML = menu.innerHTML & "&nbsp;<span id=" & entry _
  29.                   & " style='padding-bottom:2px' onselectstart=cancelEvent>&nbsp;" _
  30.                   & entry & "&nbsp;</span>&nbsp;&nbsp;"
  31.     dMenus.Add entry, Split(eval("s" & entry), ",")
  32.   next
  33.   sMenuOpen = ""

  35. end sub

  37. Sub menu_onmouseover
  38.  
  39.   clearmenu
  40.   with window.event.srcElement
  41.     if .parentElement.ID = "menu" then
  42.       .style.border = "thin outset"
  43.       .style.cursor = "arrow"
  44.     end if
  45.   end with

  47. end sub

  49. Sub menu_onmouseout

  51.   with window.event.srcElement
  52.     .style.border = "none"
  53.     .style.cursor = "default"
  54.   end with ' srcElement

  56. end sub

  58. Sub dropmenu_onmouseover
  59.  
  60.   with window.event
  61.     .srcElement.style.cursor = "arrow"
  62.     .cancelbubble = true
  63.     .returnvalue = false
  64.   end with

  66. end sub

  68. sub SubMenuOver

  70.   with window.event.srcElement
  71.     if .ID = "dropmenu" then exit sub
  72.     .style.backgroundcolor = "darkblue"
  73.     .style.color = "white"
  74.     .style.cursor = "arrow"
  75.   end with

  77. end sub

  79. sub SubMenuOut

  81.   with window.event.srcElement
  82.     .style.backgroundcolor = "lightgrey"
  83.     .style.color = "black"
  84.     .style.cursor = "default"
  85.   end with

  87. end sub

  89. Sub menu_onclick
  90. Dim oEL, oItem

  92.   if sMenuOpen <> "" then exit sub
  93.   with window.event.srcElement
  94.     if .ID <> "menu" then
  95.       .style.border = "thin inset"
  96.       nLeft = .offsetLeft
  97.       ntop  = .offsetTop + replace(menu.style.Height, "px", "") - 5
  98.       sMenuOpen = trim(.innertext)
  99.       with dropmenu
  100.         with .style
  101.           .border = "thin outset"
  102.           .backgroundcolor = "lightgrey"
  103.           .position = "absolute"
  104.           .left = nLeft
  105.           .top = nTop
  106.           .width = "100px"
  107.         end with ' style
  108.         for each sItem in dMenus.Item(sMenuOpen)
  109.           set oEL = document.createElement("SPAN")
  110.           .appendChild(oEL)
  111.           with oEl
  112.             .ID = sItem
  113.             .style.height = "20px"
  114.             .style.width = dropmenu.style.width
  115.             .innerHTML = Replace(sHTML, "#sItem#", trim(sItem))
  116.             set .onmouseover = getRef("SubMenuOver")
  117.             set .onmouseout = getRef("SubMenuOut")
  118.             set .onclick = getRef("SubMenuClick")
  119.             set .onselectstart = getRef("cancelEvent")
  120.           end with ' child node
  121.           set oEL = document.createElement("BR")
  122.           .appendChild(oEL)
  123.         next
  124.       end with ' dropmenu
  125.     end if
  126.   end with ' srcEement

  128. end sub

  130. sub cancelEvent
  131.   window.event.returnValue = false
  132. end sub ' cancelEvent

  134. sub clearmenu

  136.   dropmenu.innerHTML = ""
  137.   dropmenu.style.border = "none"
  138.   dropmenu.style.backgroundcolor = "transparent"
  139.   if sMenuOpen <> "" then
  140.     document.getElementByID(sMenuOpen).style.border = "none"
  141.     sMenuOpen = ""
  142.   end if
  143. end sub

  145. ' ###################  IMPORTANT  ###################
  146. ' Code to accomplish each submenu item defined above
  147. ' Can be as simple as a subroutine call
  148. '
  149. Sub SubMenuClick

  151.   sItem = trim(window.event.srcElement.innerText)
  152.   clearmenu
  153.   Select Case lcase(sItem)
  154.     case "open"
  155.       msgbox "Sorry, " & sItem & " is not implemented"
  156.     case "close"
  157.       msgbox "Sorry, " & sItem & " is not implemented"
  158.     case "save"
  159.       msgbox "Sorry, " & sItem & " is not implemented"
  160.     case "save as ..."
  161.       msgbox "Sorry, " & sItem & " is not implemented"
  162.     case "exit"
  163.       window.close
  164.     case "cut"
  165.       msgbox "Sorry, " & sItem & " is not implemented"
  166.     case "copy"
  167.     case "paste"
  168.       msgbox "Sorry, " & sItem & " is not implemented"
  169.     case "select all"
  170.       msgbox "Sorry, " & sItem & " is not implemented"
  171.     case "deselect all"
  172.       msgbox "Sorry, " & sItem & " is not implemented"
  173.     case "arial"
  174.       document.body.style.font = "12pt Arial"
  175.     case "century gothic"
  176.       document.body.style.font = "12pt Century Gothic"
  177.     case "times"
  178.       document.body.style.font = "11pt Times New Roman"
  179.     case "help"
  180.       msgbox "Help under construction", vbOKOnly + vbInformation, "Help"
  181.     case "about"
  182.       msgbox "Copyright, 2010" & vbCRLF & "Tom Lavedas"_
  183.               & vbCRLF & "Released for non-commercial use only",_
  184.               vbOKOnly + vbInformation, "About Menu"
  185.     case else ' catch all for undefined menu items
  186.       msgbox "Sorry, " & sItem & " is not implemented"
  187.   end Select

  189. end sub

  191. </script>
  192. </head>
  193. <!--
  194.     Page layout follows
  195. -->
  196. <body onmouseover=menu_onmouseover style="font:12pt Arial">
  197. <div id=menu style="position:absolute;left:0;top:0;width:110%;height:23px;
  198.                     padding-top:2px;background-color:lightgrey;
  199.                     font:normal 9pt Microsoft Sans Serif;z_Index:100">
  200. </div>
  201. <span id=dropmenu style="font:normal 9pt Microsoft Sans Serif"></span>
  202. <br><br><br>
  203. <center>
  204. <b>Build-Your-Own Menu Example</b><br>
  205. Copyright, 2010 Tom Lavedas<br>
  206. For non-commercial use, only.
  207. </center>
  208. <span id=msg style="z_Index:10"></span>
  209. </body>
  210. </html>
复制代码
分享 转发
TOP
swine
头像

  • 新手上路
  • 1
  • 16
  • 2010-06-18
2010-06-18 15:33 |只看该用户 2#
t T

const 中文間題

' Define menu items

Const sMenuItems = "File,Edit,Font,Help"



' Define one submenu constant for each menu item as illustrated below

' Each is a comma separated list in a single string

Const sFile = "Open,Close,Save,Save As ...,Exit"

Const sEdit = "Cut,Copy,Paste,Select All,Deselect All"

Const sFont = "Arial,Century Gothic,Times"

Const sHelp = "Help, About"

Const sHTML = "  #sItem#  "



Menu const  中文有錯  不接受
TOP
梦想成真
头像

梦想成真

  • 管理员
  • 728
  • 8073
  • 2010-05-17
2010-06-19 09:03 |只看楼主 3#
t T

你可以这样修改一下
添加html字符集声明,简体中文gb2312，繁体中文big5
<html>
<!-- An editable menu bar that looks like a standard Windows menu for use in an HTA -->
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<head>


或者在页面头部添加
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>  简体中文

<%@LANGUAGE="VBSCRIPT" CODEPAGE="950"%>  繁体中文
TOP
返回列表
上一主题 | 下一主题