1. 技术文章
  2. HTA VBScript and CSS3+HTML5. Code not running correctly when <meta> for css3 applied

HTA VBScript and CSS3+HTML5. Code not running correctly when <meta> for css3 applied

由 若如初见. 提交于 2019-12-19 10:33:33

问题


I have a problem applying CSS3 and pretty round buttons to my HTA app.

As soon as I enable <meta http-equiv="x-ua-compatible" content="ie=9"> tag to turn CSS3 on the code goes straight to hell.

Counting doesn't work right and it looks like it operates on a copy of values from arrays arrX. I tested it with msgbox and once clicked it counts right but then goes back to 0.

When I remove meta tag and parenthesis in last two subs sub SaveData() and sub ExitWindow() and remove parenthesis from all onclick script works like charm.

Damn CSS3 breakes it.

Can you help me out and tell why it doesn't work and operates on a copy of arguments from arrays?

Thanks. :)

<!--DOCTYPE html-->
<html>
<head>
<meta http-equiv="x-ua-compatible" content="ie=9">
<style type="text/css">
    body {
        background-color:white;}
    table, th, td {
        border: 1px black;
        color: black;
        font-family:"Lucida Console";
        font-size:100%;}
    table {
        width:500px;}
    th {
        text-align:left;} 
    td {
        text-align:center;}
    #maintd {
        color:blue;
        text-align:left;}
    <!--#arrowtd {
        width:100px;}-->
#runbutton {
    border: 2px solid #a1a1a1;
    background: #dddddd;
    border-radius: 25px;}

</style>
<title>KPI reporting tool</title>
<HTA:APPLICATION 
     APPLICATIONNAME="KPI reporting tool"
     CAPTION="yes"
     SYSMENU="no"
     SCROLL="no"
     BORDER="thin"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
</head>
<Script language="VBscript">
'==============================================================================================================
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE
'==============================================================================================================
    Sinc = 12
    Rtask = 7
    Reassignment = 2
    Update = 2
    Transfer = 5
    Assisted = 3
    PassingBack = 3

'==============================================================================================================
'SCRIPT - DO NOT EDIT !!!
'==============================================================================================================

'==============================================================================================================
'ON LOAD SCRIPT TO SHOW KPI WEIGHTS
'==============================================================================================================
    Sub Window_OnLoad
        window.resizeTo 550,280
        UserValue1.InnerHTML = Sinc
        UserValue2.InnerHTML = Rtask
        UserValue3.InnerHTML = Reassignment
        UserValue4.InnerHTML = Update
        UserValue5.InnerHTML = Transfer
        UserValue6.InnerHTML = Assisted
        UserValue7.InnerHTML = Passingback
    End Sub

'==============================================================================================================
'REPORTING ARRAY
'==============================================================================================================
    Dim arr0,arr1,arr2,arr3,arr4,arr5,arr6,arr7,arr8
    arr0 = Array("Action",      "Weight",       "No. of times",     "Points")
    arr1 = Array("Incidents",   Sinc,           0,              0)
    arr2 = Array("Requests",    Rtask,          0,              0)
    arr3 = Array("Reassignments",Reassignment,  0,              0)
    arr4 = Array("Updates",     Update,         0,              0)
    arr5 = Array("Transfers",   Transfer,       0,              0)
    arr6 = Array("Assists",     Assisted,       0,              0)
    arr7 = Array("Passing back",Passingback,    0,              0)
    arr8 = Array()
    'msgbox(arr1(1))                            'TEST MSGBOX

'==============================================================================================================
'SUB FOR COUNTING DOWN WITH FAIL-SAFE FOR NUMBERS BELOW ZERO
'============================================================================================================== 
Sub RunScriptDown(DataAreaXa,DataAreaXb,arrX)
    If arrX(2)>0 And arrx(3)>0 Then             'No. of times >0 AND Sum cannot be <0
        arrx(2) = arrX(2) - 1
        arrx(3) = arrX(3) - arrX(1)             'Sum = Sum - Weight
        Else MsgBox "Value cannot be less than 0!",48,"ERROR"
    End If
    DataAreaXa.InnerHTML = arrX(2)              'No. of times
    DataAreaXb.InnerHTML = arrX(1)*arrX(2)      'Weight*No. of times
    DataAreaSum.InnerHTML = arr1(3)+arr2(3)+arr3(3)+arr4(3)+arr5(3)+arr6(3)+arr7(3)
    msgbox(arrX(0) &" | " & "No.of times: " & arrX(2) & " | " & "total: " & arrX(3))    'TEST MSGBOX
End Sub

'==============================================================================================================
'SUB FOR COUNTING UP
'==============================================================================================================
Sub RunScriptUp(DataAreaXa,DataAreaXb,arrX)
    arrX(2) = arrX(2) + 1
    arrx(3) = arrX(3) + arrX(1)
    DataAreaXa.InnerHTML = arrX(2)
    DataAreaXb.InnerHTML = arrX(1)*arrX(2)
    DataAreaSum.InnerHTML = arr1(3)+arr2(3)+arr3(3)+arr4(3)+arr5(3)+arr6(3)+arr7(3)
    msgbox(arrX(0) &" | " & "No.of times: " & arrX(2) & " | " & "total: " & arrX(3))    'TEST MSGBOX
End Sub

'==============================================================================================================
'SUB FOR SAVING STATS TO A FILE
'==============================================================================================================
Sub SaveData()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set WshShell = CreateObject("WScript.Shell")
        relativePath = wshShell.CurrentDirectory
        path = relativePath & "\KPI_STATS\"
    statDate = Now
    statFile = Month(statDate) & "-" & Day(statDate) & "-" & Year(statDate) & ".tsv"
    Set objNetwork = CreateObject("WScript.Network")
        statUser = objNetwork.UserDomain & "\" & objNetwork.UserName
    If objFSO.FolderExists(path) Then
    'DO NOTHING
        Else Set objFolder = objFSO.CreateFolder(path)
    End If
    msgbox(path & statFile)
    If objFSO.FileExists (path & statFile) Then
       MsgBox "File already exists!",48,"ERROR"
       Else objFSO.CreateTextFile (path & statFile)
    End If
    Set objFile = objFSO.OpenTextFile (path & statFile, 8)
        strLine =   statUser & vbTab & statDate & vbCrLf & _
                    "--------------------------------------------------------" & vbCrLf & _
                    arr0(0) & vbTab & vbTab & arr0(1) & vbTab & arr0(2) & vbTab & arr0(3) & vbCrLf & _
                    arr1(0) & vbTab & arr1(1) & vbTab & arr1(2) & vbTab & vbTab & arr1(3) & vbCrLf & _
                    arr2(0) & vbTab & arr2(1) & vbTab & arr2(2) & vbTab & vbTab & arr2(3) & vbCrLf & _
                    arr3(0) & vbTab & arr3(1) & vbTab & arr3(2) & vbTab & vbTab & arr3(3) & vbCrLf & _
                    arr4(0) & vbTab & vbTab & arr4(1) & vbTab & arr4(2) & vbTab & vbTab & arr4(3) & vbCrLf & _
                    arr5(0) & vbTab & arr5(1) & vbTab & arr5(2) & vbTab & vbTab & arr5(3) & vbCrLf & _
                    arr6(0) & vbTab & vbTab & arr6(1) & vbTab & arr6(2) & vbTab & vbTab & arr6(3) & vbCrLf & _
                    arr7(0) & vbTab & arr7(1) & vbTab & arr7(2) & vbTab & vbTab & arr7(3) & vbCrLf & _
                    "--------------------------------------------------------" & vbCrLf & _
                    vbTab & vbTab & vbTab & vbTab & vbTab & arr1(3)+arr2(3)+arr3(3)+arr4(3)+arr5(3)+arr6(3)+arr7(3) & " TOTAL points"
        objFile.WriteLine strLine
    objFile.Close
End Sub

'==============================================================================================================
'EXIT SUB
'==============================================================================================================
Sub ExitWindow()
    usrExit = MsgBox("Do you really want to exit?" & vbCrLf & "All unsaved data will be lost!",52,"WARNING!")
    If usrExit = vbYes Then
    self.close()
    Else
    End If
End Sub

</Script>

<!--HTML PART OF THE SCRIPT. WAY THE WINDOW LOOKS-->
<body>
<table>
<tr>
    <th>Event</th>
    <th></th>
    <th>Weight</th>
    <th>Times done</th>
    <th>TOTAL</th>
</tr>
<tr>
        <td id="maintd">INCIDENTS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea1a,DataArea1b,arr1)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea1a,DataArea1b,arr1)"></td>
    <td><span id=UserValue1></span></td>
    <td><span id=DataArea1a name=a></span></td>
    <td><span id=DataArea1b name=a></span></td>
</tr>
<tr>
    <td id="maintd">REQUESTS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea2a,DataArea2b,arr2)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea2a,DataArea2b,arr2)"></td>
    <td><span id=UserValue2></span></td>
    <td><span id=DataArea2a name=b></span></td>
    <td><span id=DataArea2b name=a></span></td>
</tr>
<tr>
    <td id="maintd">REASSIGNMENTS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea3a,DataArea3b,arr3)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea3a,DataArea3b,arr3)"></td>
    <td><span id=UserValue3></span></td>
    <td><span id=DataArea3a name=c></span></td>
    <td><span id=DataArea3b name=a></span></td>
</tr>
<tr>
    <td id="maintd">UPDATES:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea4a,DataArea4b,arr4)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea4a,DataArea4b,arr4)"></td>
    <td><span id=UserValue4></span></td>
    <td><span id=DataArea4a name=d></span></td>
    <td><span id=DataArea4b name=a></span></td>
</tr>
<tr>
    <td id="maintd">TRANSFERS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea5a,DataArea5b,arr5)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea5a,DataArea5b,arr5)"></td>
    <td><span id=UserValue5></span></td>
    <td><span id=DataArea5a name=e></span></td>
    <td><span id=DataArea5b name=a></span></td>
</tr>
<tr>
    <td id="maintd">ASSISTS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea6a,DataArea6b,arr6)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea6a,DataArea6b,arr6)"></td>
    <td><span id=UserValue6></span></td>
    <td><span id=DataArea6a name=f></span></td>
    <td><span id=DataArea6b name=a></span></td>
</tr>
<tr>
    <td id="maintd">PASSINGS:</td>
    <td id="arrowtd"><input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea7a,DataArea7b,arr7)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea7a,DataArea7b,arr7)"></td>
    <td><span id=UserValue7></span></td>
    <td><span id=DataArea7a name=g></span></td>
    <td><span id=DataArea7b name=a></span></td>
</tr>
<tr>
    <td><input id=runbutton  type="button" value="Exit" onClick="ExitWindow"></td>
    <td><input id=runbutton  type="button" value="Show Report" onClick="RunReport"></td>
    <td><input id=runbutton  type="button" value="Save Data" onClick="SaveData"></td>
    <td><span id=DataAreaSum name=Sum></span></td>
</tr>
</table>

</body>
</html>

回答1:


I can't say my answer could be considered well-documented. However, we do find a culprit in passing parameters by reference, undoubtedly. Times change, none the less (being nearly 50 years in programming) I dare say that all the implementation variety of the pass by reference concept seems to keep equivocalness eternally. Not only in different programming languages...

VBScript, for instance: the same script gives different results with Windows script host, or (to keep in topic) with HTA and different meta http-equiv tags, e.g.

<meta http-equiv="x-ua-compatible" content="IE=9">
<!-- or <meta http-equiv="x-ua-compatible" content="IE=edge">  -->
<!-- or <meta http-equiv="content-type" content="text/html">   -->
<!-- or ... -->

I can offer working version of your HTA

  • Main change: your arrays arrX (i.e. arr0(y), arr1(y), … arr7(y)) combined in one quasi-matrix die2d(X)(y) and accordant passing ByRef arrX replaced with ByVal X. More explanation in code comments.
  • Additional button Test Array with corresponding onClick procedure Sub TestArray to demonstrate ByRef passed parameters treatment and behaviour (array type). Click it more than once to see in-sub local changes versus script public changes. Cf. also comments in code.
  • Additional (alike) button Test Scalar, procedure Sub TestScalar to show ByRef passed parameters behaviour (not array type).
  • Absolutely unsuccessful attempt to trap and inhibit Esc, F5 and Alt+F4 keys. For instance, the refresh F5 key clears the form and data at all...
  • Crucial changes with comments in code.
  • Some minor cosmetic mutations.
  • Some minor debugging leavings, e.g. Option Explicit etc.
  • Untouched some inconsistency in logic, e.g. in DataAreaXb.InnerHTML displayed another value than computed (and saved) arrX(3) Points.

Here's the code:

<!-- <!DOCTYPE html> -->
<html>
<title>KPI reporting tool</title>

<HTA:APPLICATION 
     ID="KPI"
     APPLICATIONNAME="KPI reporting tool"
     CAPTION="yes"
     SYSMENU="no"
     SCROLL="auto"
     BORDER="thin"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>

<head>
<meta http-equiv="x-ua-compatible" content="ie=9">

<style type="text/css">

    body {
        background-color:white;
        }
    table, th, td {
        border: 1px black;
        color: black;
        font-family:"Lucida Console";
        font-size:100%;
        }
    table {
        width:550px;
        }
    th {
        text-align:left;
        } 
    td {
        text-align:center;
        }

    #maintd {
        color:blue;
        text-align:left;
        }
/*
    #arrowtd {
        width:100px;}
*/
    #runbutton {
        border: 2px solid #a1a1a1;
        background: #dddddd;
        border-radius: 25px;
        }

</style>

<Script type="text/vbscript"> ' language="VBscript">
'=============================================================================
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE 
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE
'=============================================================================

    Option Explicit
    Dim Sinc, Rtask, Reassignment, Update, Transfer, Assisted, PassingBack

    Sinc = 12
    Rtask = 7
    Reassignment = 2
    Update = 2
    Transfer = 5
    Assisted = 3
    PassingBack = 3

'=============================================================================
'SCRIPT - DO NOT EDIT !!!
'=============================================================================

'=============================================================================
'REPORTING ARRAY
'=============================================================================
    Dim die2d
    die2d = Array _
      ( Array("Action  _ _ _", "Weight",    "times#","Points") _
      , Array("Incidents _ _",  Sinc,        0,0) _
      , Array("Requests  _ _",  Rtask,       0,0) _
      , Array("Reassignments",  Reassignment,0,0) _
      , Array("Updates _ _ _",  Update,      0,0) _
      , Array("Transfers _ _",  Transfer,    0,0) _
      , Array("Assists _ _ _",  Assisted,    0,0) _
      , Array("Passing  back",  PassingBack, 0,0) _   
    )
    ' In fact, die2d is not a matrix, i.e. a two-dimensional array
    ' It's a one-dimensional array in which every element
    ' is a one-dimensional array as well. Therefore use
    ' die2d(row)(col) reference instead of 2D matrices' die2d(row,col)
    'msgbox Join(die2d(0),";") & vbNewLine & UBound(die2d) & vbTab & UBound(die2d(0))    'TEST MSGBOX

'=============================================================================
'ON LOAD SCRIPT TO SHOW KPI WEIGHTS
'=============================================================================
    Sub Window_OnLoad
        window.resizeTo 550,280
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' astonishing (note procedure name initial letter capitalization):
    '
    ' Window_OnLoad (uppercase) then   resizeTo succeeds 
    '                           but .InnerHTML= fails
    ' window_OnLoad (lowercase) then   resizeTo fails  
    '                           but .InnerHTML= succeeds
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End Sub

    Sub ShowWeights
        UserValue1.InnerHTML = Sinc
        UserValue2.InnerHTML = Rtask
        UserValue3.InnerHTML = Reassignment
        UserValue4.InnerHTML = Update
        UserValue5.InnerHTML = Transfer
        UserValue6.InnerHTML = Assisted
        UserValue7.InnerHTML = PassingBack
    End Sub

'=============================================================================
'SUB FOR COUNTING DOWN WITH FAIL-SAFE FOR NUMBERS BELOW ZERO
'============================================================================= 
Sub RunScriptDown(DataAreaXa,DataAreaXb,byVal arrIDX)
    If die2d(arrIDX)(2)>0 And die2d(arrIDX)(3)>0 Then          'No. of times >0 AND Sum cannot be <0
        die2d(arrIDX)(2) = die2d(arrIDX)(2) - 1
        die2d(arrIDX)(3) = die2d(arrIDX)(3) - die2d(arrIDX)(1) 'Sum = Sum - Weight
    Else 'MsgBox "Value cannot be less than 0!",48,"ERROR"
    End If
    DataAreaXa.InnerHTML = die2d(arrIDX)(2)                    'No. of times
    DataAreaXb.InnerHTML = die2d(arrIDX)(1)*die2d(arrIDX)(2)   'Weight*No. of times
    ''' ??? why not DataAreaXb.InnerHTML = die2d(arrIDX)(3)
    DataAreaFoo.InnerHTML = SumColumn(2)
    DataAreaSum.InnerHTML = SumColumn(3)
End Sub

'=============================================================================
'SUB FOR COUNTING UP
'=============================================================================
Sub RunScriptUp(DataAreaXa,DataAreaXb,byVal arrIDX)
    die2d(arrIDX)(2) = die2d(arrIDX)(2) + 1
    die2d(arrIDX)(3) = die2d(arrIDX)(3) + die2d(arrIDX)(1)
    DataAreaXa.InnerHTML = die2d(arrIDX)(2)
    DataAreaXb.InnerHTML = die2d(arrIDX)(1)*die2d(arrIDX)(2) 
    ''' ??? why not DataAreaXb.InnerHTML = die2d(arrIDX)(3)
    DataAreaFoo.InnerHTML = SumColumn(2)
    DataAreaSum.InnerHTML = SumColumn(3)
End Sub

'=============================================================================
'SUB FOR SAVING STATS TO A FILE
'=============================================================================
Sub SaveData()
    Dim objFSO, WshShell, objFolder, objNetwork, objFile
    Dim relativePath, path, statDate, statFile, statUser, strLine
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set WshShell = CreateObject("WScript.Shell")
        relativePath = wshShell.CurrentDirectory
        path = relativePath & "\KPI_STATS\"
        statDate = Now
        statFile = Month(statDate) & "-" & Day(statDate) & "-" & Year(statDate) & ".tsv"
    Set objNetwork = CreateObject("WScript.Network")
        statUser = objNetwork.UserDomain & "\" & objNetwork.UserName
    If objFSO.FolderExists(path) Then
    'DO NOTHING
    Else Set objFolder = objFSO.CreateFolder(path)
    End If
    msgbox(path & statFile)
    If objFSO.FileExists (path & statFile) Then
       MsgBox "File already exists!",48,"ERROR"
       Else objFSO.CreateTextFile (path & statFile)
    End If
    Set objFile = objFSO.OpenTextFile (path & statFile, 8)
        strLine = statUser & vbTab & statDate & vbCrLf & _
          String( 52, "-") & vbCrLf & _
          Join(die2d(0), vbTab) & vbCrLf & _
          Join(die2d(1), vbTab) & vbCrLf & _
          Join(die2d(2), vbTab) & vbCrLf & _
          Join(die2d(3), vbTab) & vbCrLf & _
          Join(die2d(4), vbTab) & vbCrLf & _
          Join(die2d(5), vbTab) & vbCrLf & _
          Join(die2d(6), vbTab) & vbCrLf & _
          Join(die2d(7), vbTab) & vbCrLf & _
          String( 52, "-") & vbCrLf & _
          vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points"
        objFile.WriteLine strLine
    objFile.Close
End Sub

'=============================================================================
'EXIT SUB
'=============================================================================
Sub ExitWindow()
    Dim usrExit
  usrExit = vbYes
    'usrExit = MsgBox("Do you really want to exit?" & vbCrLf & "All unsaved data will be lost!",52,"WARNING!")
    If usrExit = vbYes Then
        self.close()
    Else
    End If
End Sub

'=============================================================================
'SUB FOR showing STATS
'=============================================================================
Sub RunReport()
    Dim objNetwork
    Dim strLine, statDate, statUser
    statDate = Now
    Set objNetwork = CreateObject("WScript.Network")
    statUser = objNetwork.UserDomain & "\" & objNetwork.UserName
    Set objNetwork = Nothing
    strLine = statUser & vbTab & statDate & vbCrLf & _
        String( 52, "-") & vbCrLf & _
        Join(die2d(0), vbTab) & vbCrLf & _
        Join(die2d(1), vbTab) & vbCrLf & _
        Join(die2d(2), vbTab) & vbCrLf & _
        Join(die2d(3), vbTab) & vbCrLf & _
        Join(die2d(4), vbTab) & vbCrLf & _
        Join(die2d(5), vbTab) & vbCrLf & _
        Join(die2d(6), vbTab) & vbCrLf & _
        Join(die2d(7), vbTab) & vbCrLf & _
        vbCrLf & _
        vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points"
    msgbox( strLine)
End Sub

'=============================================================================
' TestArray SUB
'=============================================================================
Sub TestArray(byRef dieAd)
dieAd(1)(2)=dieAd(1)(2)+100 ' this change is "in SUB" local
                            ' even thought the dieAd == die2d passed by reference  
die2d(7)(2)=die2d(7)(2)+100 ' this change is "script" global
Sinc=Sinc+1                 ' this change is "script" global
    Dim strLine
    strLine = "TestArray SUB" & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(dieAd(0), vbTab) & vbCrLf & _
      Join(dieAd(1), vbTab) & vbCrLf & _
      Join(dieAd(2), vbTab) & vbCrLf & _
      Join(dieAd(3), vbTab) & vbCrLf & _
      Join(dieAd(4), vbTab) & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(5), vbTab) & vbCrLf & _
      Join(die2d(6), vbTab) & vbCrLf & _
      Join(die2d(7), vbTab) & vbCrLf & _
      vbCrLf & _
      vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points" _ 
      & vbCrLf & Sinc
    msgbox( strLine)

End Sub
'=============================================================================
' TestScalar SUB
'=============================================================================
Sub TestScalar(byRef nmbrS, byRef nmbrR)
die2d(7)(2)=die2d(7)(2)+50 ' this change is "script" global
Rtask = Rtask + 1          ' this change is "script" global
                           ' but nmbrR stays unchanged (!!!)
                           ' even thought the nmbrR == Rtask passed by reference
nmbrS = nmbrS + 1          ' this change is "in SUB" local
                           ' even thought the nmbrS == Sinc  passed by reference
    Dim strLine
    strLine = "TestScalar SUB" & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(0), vbTab) & vbCrLf & _
      Join(die2d(1), vbTab) & vbCrLf & _
      Join(die2d(2), vbTab) & vbCrLf & _
      Join(die2d(3), vbTab) & vbCrLf & _
      Join(die2d(4), vbTab) & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(5), vbTab) & vbCrLf & _
      Join(die2d(6), vbTab) & vbCrLf & _
      Join(die2d(7), vbTab) & vbCrLf & _
      vbCrLf & _
      vbTab & vbTab & vbTab & vbTab & SumColumn(3)  & " TOTAL points" _ 
      & vbCrLf & "nmbrS" & vbTab & "Sinc" & vbTab & "Rtask" & vbTab & "nmbrR" _
      & vbCrLf &  nmbrS  & vbTab &  Sinc  & vbTab &  Rtask  & vbTab &  nmbrR 
    msgbox( strLine)
End Sub

'=============================================================================
' SumColumn FUNCTION
'=============================================================================
Function SumColumn(byVal col)
    Dim ii
    SumColumn = 0
    For ii = 1 To UBound(die2d)
        SumColumn = SumColumn + die2d(ii)(col)
    Next
End Function

'=============================================================================
' KeyCheck FUNCTION
'=============================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Absolutely unsuccessful attempt:
' Escape, F5 and Alt+F4 keys should be trapped to ensure 
'  no HTA window refreshes occur & proper exit-code runs
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function KeyCheck(byRef myEvent)
    Dim kk
    'kk=myEvent.KeyCode
    kk=myEvent.Key
    If     kk = "F5"  _
        Or kk = "Esc" Then 
        KeyCheck = False
    Else
        KeyCheck = True
    End If
    'msgbox (VarType(kk) & " " & TypeName(kk) & " '" &  kk & "' " & myEvent.keyCode)
End Function

</Script>

</head>

<!--HTML PART OF THE SCRIPT. WAY THE WINDOW LOOKS-->
<body onKeyUp="self.event.returnValue=KeyCheck(event)" onload=ShowWeights()>
<table>
<tr>
    <th>Event</th>
    <th></th>
    <th>Weight</th>
    <th>Times done</th>
    <th>TOTAL</th>
</tr>
<tr>
    <td id="maintd">INCIDENTS:</td>
    <td id="arrowtd">
        <input id=runbutton type="button" value="&#8592;" onClick="RunScriptDown(DataArea1a,DataArea1b,1)">
        <input id=runbutton type="button" value="&#8594;" onClick="RunScriptUp(DataArea1a,DataArea1b,1)">
    </td>
    <td><span id=UserValue1 name=UserValue1 value=Sinc></span></td>
    <td><span id=DataArea1a name=1a></span></td>
    <td><span id=DataArea1b name=1b></span></td>
</tr>
<tr>
    <td id="maintd">REQUESTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea2a,DataArea2b,2)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea2a,DataArea2b,2)">
    </td>
    <td><span id=UserValue2 value=Rtask></span></td>
    <td><span id=DataArea2a name=2a></span></td>
    <td><span id=DataArea2b name=2b></span></td>
</tr>
<tr>
    <td id="maintd">REASSIGNMENTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea3a,DataArea3b,3)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea3a,DataArea3b,3)"></td>
    <td><span id=UserValue3 value=Reassignment></span></td>
    <td><span id=DataArea3a name=3a></span></td>
    <td><span id=DataArea3b name=3b></span></td>
</tr>
<tr>
    <td id="maintd">UPDATES:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea4a,DataArea4b,4)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea4a,DataArea4b,4)"></td>
    <td><span id=UserValue4 value=Update></span></td>
    <td><span id=DataArea4a name=4a></span></td>
    <td><span id=DataArea4b name=4b></span></td>
</tr>
<tr>
    <td id="maintd">TRANSFERS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea5a,DataArea5b,5)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea5a,DataArea5b,5)"></td>
    <td><span id=UserValue5></span></td>
    <td><span id=DataArea5a name=5a></span></td>
    <td><span id=DataArea5b name=5b></span></td>
</tr>
<tr>
    <td id="maintd">ASSISTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea6a,DataArea6b,6)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea6a,DataArea6b,6)"></td>
    <td><span id=UserValue6></span></td>
    <td><span id=DataArea6a name=6a></span></td>
    <td><span id=DataArea6b name=6b></span></td>
</tr>
<tr>
    <td id="maintd">PASSINGS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea7a,DataArea7b,7)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea7a,DataArea7b,7)"></td>
    <td><span id=UserValue7></span></td>
    <td><span id=DataArea7a name=7a></span></td>
    <td><span id=DataArea7b name=7b></span></td>
</tr>
<tr>
    <td><input id=runbutton  type="button" value="Exit" onClick="ExitWindow()"></td>
    <td><input id=runbutton  type="button" value="Show Report" onClick="RunReport()"></td>
    <td><input id=runbutton  type="button" value="Save Data" onClick="SaveData()"></td>
    <td><span id=DataAreaFoo name=DataAreaFoo></span></td>
    <td><span id=DataAreaSum name=DataAreaSum></span></td>
</tr>
<tr>
    <td><input id=runbutton  type="button" value="Test Array" onClick="TestArray(die2d)"></td>
    <td><input id=runbutton  type="button" value="Test Scalar" onClick="TestScalar(Sinc, Rtask)"></td>
</tr>
</table>

</body>
</html>


来源：https://stackoverflow.com/questions/28465094/hta-vbscript-and-css3html5-code-not-running-correctly-when-meta-for-css3-app

标签
html5
css3
vbscript
hta
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!