There's millions of these kind of menus written already I know, mine is dedicated to HTA apps only and has some unique features....kind of. No matter how nice your <div> style menu looks, it'll always have problems with <select> boxes, so I thought "why not make a context menu using a select box?" This sacrifices good looks with small code and robustness........and at the end of the day, what do you really need?
The bad:-
Looks a bit crap since it's a <select> box which can't be styled 100% (especially the notorious z-index)
No sub menus, check boxes or hot-keys
The good:-
Stays on screen all the time regardless where you right click (even after window a resize)
Highlights the menu item under the mouse.
Can use any font and any font size and not interfere with the two features mentioned above. (You don't need to know the font-size, just how high the menu is divided by how many options it has)
Knows what control is under the mouse when the menu pops up (good for context sensitive help) and re-focuses the control when the menu disappears (needed for text copy\paste)
Since it's a <select> box and has a high z-index, it can never be hidden by other <select> boxes (a common problem with these kind of menus). Also you get the added benefits of select box <options> like a unique value per menu item and easy to set background\foreground colours, as well as the ability to delete menu options (not very useful though)
Menu separators...almost :-\
Lightweight; about one page in code, easy to use, one global variable! :-)
<HTML><HEAD>
<TITLE>Tiny context menu</TITLE>
<HTA:APPLICATION CONTEXTMENU = "No"/>
<!-- '--- Menu style (try setting a large font-size like 40px) ---' -->
<STYLE TYPE="text/css">
.styContextMenu {
Background-Color : ButtonFace ;
Font-Family : "Microsoft Sans Serif" ;
Font-Size : 12px ;
Position : Absolute ;
Visibility : Hidden ;
Z-Index : 999999 ;
}
</STYLE>
</HEAD>
<BODY SCROLL="no" STYLE="margin:0px" BGCOLOR="AppWorkspace">
<!-- '--- Menu ---' -->
<SELECT ID="ContextMenu" class="styContextMenu"></SELECT>
<!-- '--- Some test contols (delete these) ---' -->
<TEXTAREA ID="TextArea1" Rows=22 Cols=32></TEXTAREA>
<INPUT ID="Button1" TYPE="BUTTON" VALUE="I Do nothing!"/>
<SELECT ID="SelectBox2" SIZE=3><OPTION>Another</OPTION><OPTION>select</OPTION><OPTION>box</OPTION></SELECT>
</BODY>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim ElementUnderMouse ' The SET element under the mouse, used for re-focusing and other stuff.'
'---- Build the menu. Empty strings in this array get converted to separators'
BuildMenu Array("Cut","Copy","Paste","","Selected control ID","About","","DON'T CLICK ME!")
'---- How to colour and set values for different menu options (delete these)'
ContextMenu.Options(7).Style.Color="Red"
ContextMenu.Options(7).Style.BackgroundColor="#500A0A"
ContextMenu.Options(7).Value = 66.6
'------------------------- Subs ---------------------------'
'---- Add a string array of options to the menu'
Sub BuildMenu(strNames)
Dim mOption,L
For L = 0 To UBound(strNames)
Set mOption = Document.CreateElement("Option")
mOption.Text = strNames(L)
ContextMenu.Add(mOption)
ContextMenu.Size = ContextMenu.Size + 1
Next
'---- Set the menu's PixelWidth to it's OffSetWidth. This freezes the width of the menu so any'
' new options added will not change it's size. Used for adding large separators below'
ContextMenu.Style.PixelWidth = ContextMenu.OffSetWidth
'---- Expand separators'
For L = 0 To ContextMenu.Size-1
With ContextMenu.Options(L)
If .Text = "" Then
.Text=String(200,"—") '<-- Closest to a beveled line you can get in a <select>'
.Style.Color="ButtonHighlight"
.Value="!separator!" '<-- For mouse-over highlight skipping'
End If
End With
Next
End Sub
'---- Right click anywhere to show menu'
Sub Document_OnContextMenu()
'--- Store active control (used in menu events)'
Set ElementUnderMouse = Document.ActiveElement
With ContextMenu.Style
'---- Position menu at mouse X,Y'
.PixelLeft = Window.Event.ClientX-5
.PixelTop = Window.Event.ClientY-5
'---- Stop the menu going off screen (+-4 pixels = unclassable select box border)'
If .PixelLeft + ContextMenu.OffSetWidth > Document.Body.OffSetWidth+4 Then
.PixelLeft=Document.Body.OffSetWidth - ContextMenu.OffSetWidth-4
End If
If .PixelTop + ContextMenu.OffsetHeight > Document.Body.OffsetHeight+4 Then
.PixelTop=Document.Body.OffsetHeight - ContextMenu.OffsetHeight-4
End If
'---- Show it'
.Visibility="Visible"
End With
End Sub
'---- Left click anywhere to hide menu'
Sub Document_OnClick()
ContextMenu.Style.Visibility="Hidden"
End Sub
'---- Hover mouse on menu to highlight options (optional)'
Sub ContextMenu_OnMouseMove()
Dim intSelected
'---- Find the option under the mouse. (MouseY-MenuY)/(MenuHeight/MenuOptionCount)'
intSelected=Int((Window.Event.ClientY - Me.Style.PixelTop ) / (Me.OffsetHeight/Me.Size))
'---- Fixes very bottom option (due to unclassable select box border)'
If intSelected=>Me.Size Then Exit Sub
'---- Don't Highlight option if already selected (stops it flickering)'
If Me.SelectedIndex = intSelected then Exit Sub
'---- Don't Highlight a separator'
If Me.Options(intSelected).Value="!separator!" Then Exit Sub
'---- OK to highlight'
Me.Options(intSelected).Selected = True
End Sub
'---- Events for menu option clicks'
Sub ContextMenu_OnClick()
'---- Focus element under mouse first (needed for text paste etc)'
ElementUnderMouse.Focus
'---- Select case by name, not index (more flexible and easier to read)'
Select Case Me.Options(Me.SelectedIndex).Text
Case "Cut"
Document.ExecCommand("Cut")
Case "Copy"
Document.ExecCommand("Copy")
Case "Paste"
Document.ExecCommand("Paste")
Case "Selected control ID"
Msgbox ElementUnderMouse.ID
Case "About"
MsgBox "Tiny context menu - By Alan Bond 2010"
Case "DON'T CLICK ME!"
Window.Close '<-- Sorry ;-)'
End Select
End Sub
</SCRIPT>
</HTML> Save it as whatever.HTA and double click to run. Here's the same code without the comments and demo stuff:-
<HTML><HEAD>
<TITLE>Tinier context menu ;-)</TITLE>
<HTA:APPLICATION CONTEXTMENU = "No"/>
<!-- '--- Menu style (try setting a large font-size like 40px) ---' -->
<STYLE TYPE="text/css">
.styContextMenu {
Background-Color : ButtonFace ;
Font-Family : "Microsoft Sans Serif" ;
Font-Size : 12px ;
Position : Absolute ;
Visibility : Hidden ;
Z-Index : 999999 ;
}
</STYLE>
</HEAD>
<BODY SCROLL="no" STYLE="margin:0px" BGCOLOR="AppWorkspace">
<!-- '--- Menu ---' -->
<SELECT ID="ContextMenu" class="styContextMenu"></SELECT>
</BODY>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim ElementUnderMouse
'---- Build the menu. Empty strings in this array get converted to separators'
BuildMenu Array("Copy","Paste")
'---- Add a string array of options to the menu'
Sub BuildMenu(strNames)
Dim mOption,L
For L = 0 To UBound(strNames)
Set mOption = Document.CreateElement("Option")
mOption.Text = strNames(L)
ContextMenu.Add(mOption)
ContextMenu.Size = ContextMenu.Size + 1
Next
ContextMenu.Style.PixelWidth = ContextMenu.OffSetWidth
For L = 0 To ContextMenu.Size-1
With ContextMenu.Options(L)
If .Text = "" Then
.Text=String(200,"—")
.Style.Color="ButtonHighlight"
.Value="!separator!"
End If
End With
Next
End Sub
'---- Right click anywhere to show menu'
Sub Document_OnContextMenu()
Set ElementUnderMouse = Document.ActiveElement
With ContextMenu.Style
.PixelLeft = Window.Event.ClientX-5
.PixelTop = Window.Event.ClientY-5
If .PixelLeft + ContextMenu.OffSetWidth > Document.Body.OffSetWidth+4 Then
.PixelLeft=Document.Body.OffSetWidth - ContextMenu.OffSetWidth-4
End If
If .PixelTop + ContextMenu.OffsetHeight > Document.Body.OffsetHeight+4 Then
.PixelTop=Document.Body.OffsetHeight - ContextMenu.OffsetHeight-4
End If
.Visibility="Visible"
End With
End Sub
'---- Left click anywhere to hide menu'
Sub Document_OnClick()
ContextMenu.Style.Visibility="Hidden"
End Sub
'---- Hover mouse on menu to highlight options (optional)'
Sub ContextMenu_OnMouseMove()
Dim intSelected
intSelected=Int((Window.Event.ClientY - Me.Style.PixelTop ) / (Me.OffsetHeight/Me.Size))
If intSelected=>Me.Size Then Exit Sub
If Me.SelectedIndex = intSelected then Exit Sub
If Me.Options(intSelected).Value="!separator!" Then Exit Sub
Me.Options(intSelected).Selected = True
End Sub
'---- Events for menu option clicks'
Sub ContextMenu_OnClick()
ElementUnderMouse.Focus
Select Case Me.Options(Me.SelectedIndex).Text
Case "Copy"
Document.ExecCommand("Copy")
Case "Paste"
Document.ExecCommand("Paste")
End Select
End Sub
</SCRIPT>
</HTML> Have fun!