HTA VBScript和CSS3 + HTML5。 < meta>时代码无法正常运行。适用于css3

问题描述：

在我的HTA应用程序中使用CSS3和漂亮的圆形按钮时出现问题。

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

一旦启用< meta http-equiv =x-ua-compatiblecontent =ie = 9> 标签打开CSS3就可以直接进入地狱了。

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.

计数不正常工作，它看起来像是从数组 arrX 的值的副本操作。我用 msgbox 测试它，一旦点击它计数正确，然后回到 0 。

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.

当我删除 sub sub SaveData（）中的标记和括号时，和 sub ExitWindow（）并从所有 onclick 脚本中删除括号就像charm。

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会把它折断。

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?

谢谢。：）

<!--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>

答

我不能说我的答案很好 - 证明。但是，我们确实发现了传递参数引用的罪魁祸首。时代的变化，无论如何（在编程中将近50年）我敢说，所有的实施品种的通过参考概念似乎永远保持模棱两可。不仅在不同的编程语言...

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 ，例如：同一个脚本给出不同的结果， em> Windows脚本主机或（保持主题） HTA 和不同的元http- equiv 标签，例如

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 ... -->

我可以提供 HTA

主要更改：您的数组 arrX arr0（y）， arr1（y），... arr7（y）$ c>）组合在一个 quasi -matrix die2d（X）（y），并且符合传递 ByRef arrX 替换为 ByVal X 。与 onClick $ c>程序 Sub TestArray 来演示 ByRef 传递的参数处理和行为（ array type）。单击它多次可查看内部本地更改脚本public 更改。。， Sub TestScalar 显示 code> ByRef 传递参数行为（不数组类型）。

绝对不成功陷阱并禁止 Esc ， F5 和 Alt + F4 例如， F5 键清除表单和数据...

在代码中使用注释进行重要更改。 / li>
一些轻微的化妆品突变。

Option Explicit 等。

未触及逻辑中的一些不一致性，例如在 DataAreaXb.InnerHTML 显示另一个值比计算（并保存） arrX（3） >。

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.

代码如下：

<!-- <!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>

HTA VBScript和CSS3 + HTML5。 < meta>时代码无法正常运行。适用于css3

相关推荐