<HTML>
<HEAD>
<TITLE>音高计算</TITLE>
<style>
<!--
body {
font-family: verdana,Arial, Helvetica, sans-serif,宋体(GB);
font-size: 9pt;
line-height: 13px;
color: #444444;
}
table {
font-size: 13px;
font-weight: normal;
margin: 0;
padding: 0;
font-family: verdana,Arial, Helvetica, sans-serif;
list-style-type: none;
color: #444444;
background: #ffffff;
border-collapse: collapse;
border-color: #f0fffe;
}
.tdStd {
background: black;
color: white;
}
.tdHz {
background: #2b9017;
color: yellow;
}
.fontSim {
color: blue
}
-->
</style>
</HEAD>
<SCRIPT LANGUAGE="VBScript">
<!--
Dim StdNoteName '标准音高集合
Dim SimIncArr '简谱音高增量
Dim TdMask
Dim StdTone
Dim oldidx, simnote, ToneLevel
SimIncArr = Array(0, 0, 2, 2, 1, 2, 2, 2, 1)
StdNoteNum = 12
TdMask = "@"
StdTone = "C"
Function GetFreq(Base, StdNote)
GetFreq = CInt(Base * 2 ^ (StdNote / 12))
End Function
Sub Init_StdNoteName
k = 0
Set StdNoteName = CreateObject("Scripting.Dictionary")
For i = 0 to StdNoteNum + 1
key = CStr(k)
If ((i \ 2) * 2) = i Then
itm = ""
Else
itm = "#"
End If
itm = itm & Chr(Asc("A") + i \ 2)
If itm <> "#B" And itm <> "#E" Then
StdNoteName.Add key, itm '添加键和项目
k = k + 1
End If
Next
End Sub
Function WriteRowStdNote(Mask)
Dim strRet
strRet = "<tr>"
For i = 0 to StdNoteNum - 1
itm = StdNoteName.item(CStr(i))
strRet = strRet & "<td align='center' class='tdStd'>"
If Left(itm, 1) <> Mask Then
strRet = strRet & itm
Else
strRet = strRet & " "
End If
strRet = strRet & "</td>"
Next
WriteRowStdNote = strRet & "</tr>"
End Function
Function WriteRowHz (Base, Mask)
Dim strRet
strRet = "<tr>"
For i = 0 to StdNoteNum - 1
itm = StdNoteName.item(CStr(i))
' If Mask is "NUL" Then there is a empty row
If Mask <> "NUL" And Left(itm, 1) <> Mask Then
strRet = strRet & "<td align='center' "
strRet = strRet & "class='tdHz'> " & _
GetFreq(Base, i) & " Hz</td>"
Else
strRet = strRet & "<td align='center'> </td>"
End If
Next
WriteRowHz = strRet & "</tr>"
End Function
Function WriteRowSimNote(tone, simnote, oldidx)
Dim strRet
Dim IsWhite
strRet = "<tr>"
i = 0
While i < StdNoteNum
If StdNoteName.item(CStr(i)) = tone Then
ToneLevel = ToneLevel + 1
If ToneLevel < 4 Then
simnote = 1
Else
simnote = -1
End If
End If
tdval = "<td align='center' class='fontSim'>"
tdmidval = " "
IsWhite = False
If simnote = 1 Then
IsWhite = True
ElseIf simnote > 1 Then
If (i - oldidx) = SimIncArr(simnote) Then
IsWhite = True
End If
End If
If IsWhite Then
tdmidval = ""
If ToneLevel > 0 Then
tdmidval = tdmidval & String(ToneLevel, ".")
End If
tdmidval = tdmidval & simnote
simnote = simnote + 1
oldidx = i
If ToneLevel < 0 Then
tdmidval = tdmidval & String(-ToneLevel, ".")
End If
End If
tdval = tdval & tdmidval & "</td>"
strRet = strRet & tdval
i = i + 1
Wend
WriteRowSimNote = strRet & "</tr>"
End Function
Function htmlOfTable(Tone)
Dim strRet
strRet = "<table width='800px' border='1'>"
oldidx = 0
simnote = -1
ToneLevel = -4 '低三度音(-3 - 1)
strRet = strRet & WriteRowStdNote(TdMask)
For i = -3 to 3
strRet = strRet & WriteRowHz(440 * (2 ^ i), TdMask)
strRet = strRet & WriteRowSimNote(Tone, simnote, oldidx)
strRet = strRet & WriteRowHz(0, "NUL")
oldidx = oldidx - StdNoteNum
Next
If simnote <= 7 Then
strRet = strRet & WriteRowHz(440 * (2 ^ 4), TdMask)
strRet = strRet & WriteRowSimNote(Tone, simnote, oldidx)
oldidx = oldidx - StdNoteNum
End If
htmlOfTable = strRet & "</table>"
End Function
Function WriteSelToneItem(Mask)
Dim strRet, FirstOne
strRet = ""
FirstOne = False
For i = 0 to StdNoteNum - 1
itm = StdNoteName.item(CStr(i))
If Left(itm, 1) <> Mask Then
strRet = strRet & "<OPTION VALUE='"
strRet = strRet & i & "'"
If Not FirstOne And itm = StdTone Then
FirstOne = True
strRet = strRet & " SELECTED"
End If
strRet = strRet & ">" & itm
End If
Next
WriteSelToneItem = strRet
End Function
Init_StdNoteName
-->
</SCRIPT>
<BODY style="background-image:url('images/BlankBkgrd.gif')" Bgproperties="fixed">
<DIV align="left" style="width:805px; position:absolute; left:100px; top:50px; visibility:visible">
<H1 ID="hTitle" style="position:relative; left:0px; top:0px"> C大调</H1>
<DIV ID="divFreqTable" style="visibility:inherit">
</DIV>
<SCRIPT LANGUAGE="VBScript">
<!--
Function SubmitOk()
Dim TheForm
Set TheForm = Document.ValidForm
Set divFT = Document.All.divFreqTable
StdTone = StdNoteName.item(TheForm.SelTone.Value)
hTitle.innerHTML = StdTone & "大调"
divFT.innerHTML = htmlOfTable(StdTone)
'SubmitOk = False
End Function
-->
</SCRIPT>
<FORM NAME="ValidForm" ACTION="#" METHOD="GET">
<p>请选择音调<SELECT NAME="SelTone" SIZE="1" onchange="VBScript:SubmitOk">
<SCRIPT LANGUAGE="VBScript">
<!--
hTitle.innerHTML = StdTone & "大调"
Set divFT = Window.Document.All.Tags("div").item(1)
divFT.innerHTML = htmlOfTable(StdTone)
Document.Write WriteSelToneItem("#")
-->
</SCRIPT>
</SELECT>大调</p>
<p><b>说明:</b><br>
实际的简谱低八度音打点在阿拉伯数字的下方<br>
高八度音打点在阿拉伯数字的上方<br>
这里不方便输出,所以分别将低八度音打在后面,高八度音打在前面表示<br></p>
<!--<INPUT NAME="Submit" TYPE="BUTTON" OnClick="SubmitOk" VALUE="确定">-->
</FORM>
</DIV>
</BODY>
</HTML>
效果图如下:
|
楼主
