本文介绍了HTA VBScript和CSS3 + HTML5。 < meta>时代码无法正常运行。适用于css3的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
在我的HTA应用程序中使用CSS3和漂亮的圆形按钮时出现问题。
I have a problem applying CSS3 and pretty round buttons to my HTA app.
一旦启用 与 onClick 程序 Sub TestArray 来演示 ByRef 传递的参数处理和行为（ array type）。单击它多次可查看内部本地更改脚本public 更改。 。 ， Sub TestScalar 显示 code> ByRef 传递参数行为（不数组类型）。
- 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 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 , procedure Sub TestScalar to show ByRef passed parameters behaviour (not array type).
- Absolutely unsuccessful attempt to trap and inhibit , and + keys. For instance, the refresh 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="←" onClick="RunScriptDown(DataArea1a,DataArea1b,1)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea2a,DataArea2b,2)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea3a,DataArea3b,3)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea4a,DataArea4b,4)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea5a,DataArea5b,5)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea6a,DataArea6b,6)">
<input id=runbutton type="button" value="→" 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="←" onClick="RunScriptDown(DataArea7a,DataArea7b,7)">
<input id=runbutton type="button" value="→" 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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！