Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

OnMouseOver in VBScript IE Button Menu

Status
Not open for further replies.

zoodaddy

Technical User
May 13, 2010
10
US
Hello ! First Time asking for help online.
I have put together a simple VBScript to create an IE Menu that when a button is pressed it passes an Argument to a cmd file. I am trying to figure out how to use OnMouseOver
and OnMOuseOff Event in my script to change the button color when mouse is over the button. I have searched on line but just wasn't able to figure out how to Implement the code that I had found in to my code. Can any one help me?

Code:
Option Explicit
' File:    Menu.vbs  --------------------------------------

'Declaring ------------------------------------------------
Dim oWSH, oDic, oIE, shell, sHTML, sEXE
Dim strDrive, strImageFile, FileStatus, strInfo
Dim sWidth, sHeight

'Set Objects ----------------------------------------------
Set oWSH  = WScript.CreateObject("WScript.Shell")
Set oDic  = WScript.CreateObject("Scripting.Dictionary")
Set oIE   = WScript.CreateObject("InternetExplorer.Application","IE_")
Set shell = WScript.CreateObject("Shell.Application")

'Configure variables -------------------------------------- 
strDrive     = "C:\VBScript"
strImageFile = strDrive & "\Image.jpg"
FileStatus = ReportFileStatus(strImageFile)
strInfo = "My Company Co. " & "<br>" & _
          "For Help Contact XXX" & "<br>" & _
          "05398 or 05212"
          
oDic("Choice Number 01") = 1  ' 1st Button
oDic("Choice Number 02") = 2  ' 2nd Button
oDic("Choice Number 03") = 3  ' 3rd Button
oDic("     EXIT     ") = 4  ' 4th Button
                            'more  buttons can be entered
'--- Minimize all open windows so menu can be seen -------- 
'shell.MinimizeAll
Set shell = Nothing

On Error Resume Next

'--- Configure the Internet Explorer window ---------------
' specify some of the IE window's settings
oIE.Navigate "about:blank"

Do Until oIE.ReadyState = 4
  WScript.Sleep 100
Loop

sWidth  = oIE.Document.ParentWindow.Screen.AvailWidth * 0.5
sHeight = oIE.Document.ParentWindow.Screen.Availheight * 0.25

With oIE
  .AddressBar = False: .RegisterAsDropTarget = False
  .Toolbar    = False
  .StatusBar  = False
  .Width      = 390
  .Height     = 390
  .Resizable  = False
  With .Document
    .Title = "Manager Menu" & String(80, Chr(160))
    .Body.scroll = "no"
    With .ParentWindow
      .moveto sWidth - (oIE.Width * 0.5), sHeight
      With .Document
      If FileStatus = True Then
        .body.style.backgroundImage = "url(" & strImageFile & ")"
        .body.style.backgroundRepeat = "no-repeat"
        .body.style.backgroundAttachment = "fixed"
        .body.style.backgroundPosition = "Center Center" 
        .body.style.zoom = 1
      Else
        .Body.Style.backgroundcolor = "#FFFFFF"
      End If
        .Body.Style.Font = "12pt 'Courier New'"
        .Body.Style.borderColor = "#FFFFFF"
        .Body.Style.borderStyle = "inset" '"outset"
        .Body.Style.borderWidth = "4px"
      End With
    End With
  End With
  .Visible = True
End With

'--- Begin the generated sHTML to Internet Explorer -------
sHTML = "<div align=center><font color=#0000FF face=Verdana size=5><P><b>" _
    & "Manager Menu" & "<hr/>" & "<font color=Black face=Courier size=1>" _
    & "Please Make a Selection" & "</font></b></P><br>" & vbCrLf

'--- Loop through the dictionary & create application -----buttons 
For Each sEXE In oDic
sHTML = sHTML & "<button style='width:42%' id='" & sEXE  _
    &  "'>" & sEXE & "</button><br>" & "</P>" & vbCrLf
Next

'--- Write the generated sHTML to Internet Explorer -------
sHTML = sHTML & "<DIV align=""right""><font color=#0000FF size=1><P>" _
    & strInfo & "</p></div>"

oIE.Document.Body.InnerHTML = sHTML
'--- Create references for the buttons created above ------ 
For Each sEXE In oDic
  Select Case oDic(sEXE)
    Case 1    'Choice Number 01
      oIE.document.getElementById(sEXE).style.backgroundcolor = "GREEN"
      oIE.document.getElementById(sEXE).style.Color           = "YELLOW"
      oIE.document.getElementById(sEXE).style.bordercolor     = "#FFFFFF"
    Case 2    'Choice Number 02
      oIE.document.getElementById(sEXE).style.backgroundcolor = "RED"
      oIE.document.getElementById(sEXE).style.Color           = "BLUE"
      oIE.document.getElementById(sEXE).style.bordercolor     = "#FFFFFF"
    Case 3    'Choice Number 03
      oIE.document.getElementById(sEXE).style.backgroundcolor = "BLUE"
      oIE.document.getElementById(sEXE).style.Color           = "#FFFFFF"
      oIE.document.getElementById(sEXE).style.bordercolor     = "#FFFFFF"
    Case 4    'EXIT
      oIE.document.getElementById(sEXE).style.backgroundcolor = "transparent"
      oIE.document.getElementById(sEXE).style.Color           = "#000000"
      oIE.document.getElementById(sEXE).style.bordercolor     = "transparent"
    Case Else
  End Select
  oIE.document.getElementById(sEXE).style.cursor = "Hand"
  oIE.Document.getElementById(sEXE).onClick      = GetRef("Click")
Next

'--- Make the Internet Explorer windows visible & focus it -
'oIE.Visible = True
'oWSH.AppActivate (oIE.Document.Title)
oIE.document.focus()

'--- Sit in an endless loop until Internet Explorer is----- closed 
Do
  'oIE.document.focus()
  WScript.Sleep 100
Loop

'--- Terminate the VBScript when the IE window is closed --
Sub IE_OnQuit()
  ' Clean Up
  Set oWSH = Nothing
  Set oDic = Nothing
  oIE.Quit
  Set oIE = Nothing
  WScript.Quit
End Sub

'--- When a button is clicked, launch the associated------- program 
Sub Click()
  Dim sProgram, WshShell
  sProgram = oDic(oIE.Document.ParentWindow.event.srcElement.ID)

  if sProgram = 4 THEN IE_OnQuit

  Set WshShell = WScript.CreateObject("WScript.Shell")
  WshShell.CurrentDirectory = strDrive
  Set WshShell = Nothing

  'Run command and pass an Argument
  'oWSH.Run """STRT.CMD"" " & sProgram & ""
  msgbox "Your Choice was Button " & sProgram

  IE_OnQuit
End Sub

'--- Check if file Exist----------------------------------- 
Function ReportFileStatus(filespec)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FileExists(filespec)) Then
    ReportFileStatus = True
  Else
    ReportFileStatus = False
  End If
End Function
 
[0] Bascially you have all the ingredients on hand.

[0.1] Add these two lines to the select case in the loop.
[tt]
For Each sEXE In oDic
Select Case oDic(sEXE)
'etc etc
Case Else
End Select
oIE.document.getElementById(sEXE).style.cursor = "Hand"
oIE.Document.getElementById(sEXE).onClick = GetRef("Click")
[blue]oIE.document.getElementById(sEXE).onmouseover=getRef("over")
oIE.document.getElementById(sEXE).onmouseout=getRef("out")[/blue]
Next
[/tt]
[0.2] Then you create two function "over" and "out". Like this.
[tt]
function over
dim obj
set obj=oIE.Document.ParentWindow.event.srcElement
select case oDic(obj.id)
case 1
obj.style.backgroundcolor="white"
obj.style.color="black"
case 2
'etc
'etc
case 3
'etc
'etc
case 4
'etc
'etc
case else
end select
set obj=nothing
end function
function out
dim obj
set obj=oIE.Document.ParentWindow.event.srcElement
select case oDic(obj.id)
select case oDic(obj.id)
case 1
'reverse back to original design
obj.style.backgroundcolor="green"
obj.style.color="yellow"
case 2
'etc
'etc
case 3
'etc
'etc
case 4
'etc
'etc
case else
end select
set obj=nothing
end function
[/tt]
[0.3] Then you're done.

[1] But to my displeasure, I see you have assigned their id attributes like "Choice Number 01" etc. This is very dissatisfactory, if you've some concern with the html technology. The id shouldn't be of value like that, namely, apart from they are unique which they are, they should not contain whitespace. If you instead put oDic() value, ie, 1,2,3,4 to them, it is again not satisfactory. id should only start with alphabets or underscore. Do they break the functionality as such? Not really at this level of complexity. Do I strongly suggest you rectify that? I do.
 
Thank you Tsuji
It worked great! and I agree with your last comment.
I am self taught and I am always trying to develop good programming habits.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top