发新帖我要提问
返回列表
打印

单片机发音音高计算----来自00的东东

[复制链接]
2580|19
手机看帖
扫描二维码
随时随地手机跟帖
跳转到指定楼层
楼主
turmary|  楼主 | 2007-12-7 12:41 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
单片机, ST, TE, TI, se
<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;
}

-->
</style>
</HEAD>

<SCRIPT LANGUAGE="VBScript">
<!--
Dim StdNoteName                 '标准音高集合
Dim SimIncArr            '简谱音高增量
Dim Mask
Dim StdTone
Dim oldidx, simnote
SimIncArr = Array(0, 0, 2, 2, 1, 2, 2, 2, 1)
StdNoteNum = 12
Mask = "W"
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))
        If Left(itm, 1) <> Mask Then
            strRet = strRet & "<td align='center'> " & _
              itm & "</td>"
        Else 
            strRet = strRet & "<td align='center'> </td>"
        End If
    Next
    WriteRowStdNote = strRet & "</tr>"
End Function


Function WriteRowHz (Base)
    Dim strRet

    strRet = "<tr>"
    For i = 0 to StdNoteNum - 1
        itm = StdNoteName.item(CStr(i))
        If Left(itm, 1) <> Mask Then
            strRet = strRet & "<td align='center'> " & _
              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

    strRet = "<tr>"
    i = 0
    While i < StdNoteNum
        tdval = "<td align='center'>"
        If StdNoteName.item(CStr(i)) = tone Then
            simnote = -1 * Sgn(simnote)
        End If
        tdmidval = " "
        If simnote = 1 Then
            tdmidval = "" & simnote
            oldidx = i
            simnote = simnote + 1
        ElseIf simnote > 1 Then
            If (i - oldidx) = SimIncArr(simnote) Then
                tdmidval = "" & simnote
                oldidx = i
                simnote = simnote + 1
            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
    strRet = strRet & WriteRowStdNote(Mask)
    strRet = strRet & WriteRowHz(440)

    strRet = strRet & WriteRowSimNote(Tone, simnote, oldidx)

    If simnote <= 7 Then
        strRet = strRet & WriteRowHz(880)

        oldidx = oldidx - StdNoteNum
        strRet = strRet & WriteRowSimNote(Tone, simnote, oldidx)
    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">
    请选择音调<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>大调
    <!--<INPUT NAME="Submit" TYPE="BUTTON" OnClick="SubmitOk" VALUE="确定">-->
</FORM>
</DIV>
</BODY>
</HTML>



将以上内容保存到一个文本文件中,并改扩展名为html
双击打开,即可算出相应调子简谱的音高

使用特权

评论回复 赏

相关帖子
沙发
turmary|  楼主 | 2007-12-7 12:44 | 只看该作者

结果图

使用特权

评论回复 赏
板凳
computer00| | 2007-12-7 13:00 | 只看该作者

哈哈~~~不错不错~~~

VB脚本写的呀~~~~~


可以再改改程序，将范围扩展宽些，这样出来只有一个8度。

另外还有底8度的，低两个8度的等等，在数字下面加点表示。
还有高8度的，高两个8度的等等，在数字上面加两个点。不过这些字符打不出来。


使用特权

评论回复 赏
地板
yewuyi| | 2007-12-7 13:30 | 只看该作者

你牛，我还没来得及消化呢，你就整出来了……

~~，在忙着别的东西呢，那个帖子做标记放那里了，还没来得及认真消化呢……

使用特权

评论回复 赏
5楼
xwj| | 2007-12-7 13:46 | 只看该作者

呵呵，低8度除以2，高8度乘以2就行了

使用特权

评论回复 赏
6楼
computer00| | 2007-12-7 16:53 | 只看该作者

既然都已经整出来了，就干脆做宽点嘛

不然还得自己去俺按计算器...并且这里都取了整数，会有累计误差。

使用特权

评论回复 赏
7楼
huangqi412| | 2007-12-7 18:24 | 只看该作者

呵呵，不错

使用特权

评论回复 赏
8楼
turmary|  楼主 | 2007-12-7 18:30 | 只看该作者

多谢大家的意见

正在改呢!!!

使用特权

评论回复 赏
9楼
turmary|  楼主 | 2007-12-7 19:31 | 只看该作者

新版本

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








效果图如下:



使用特权

评论回复 赏
10楼
turmary|  楼主 | 2007-12-7 19:57 | 只看该作者

改点颜色

使用特权

评论回复 赏
11楼
xwj| | 2007-12-7 20:30 | 只看该作者

呵呵，这个界面不爽，建议做成琴键的图案，然后做onover()关

把它做成网页电子琴

使用特权

评论回复 赏
12楼
turmary|  楼主 | 2007-12-7 21:22 | 只看该作者

哈哈

搞单片机发声的频率表这个够用了,

网页电子琴是个不错的想法,不过是其它方面用来玩的~~~~~~

使用特权

评论回复 赏
13楼
computer00| | 2007-12-7 22:15 | 只看该作者

哈哈哈 ~~~ 还可以继续改进~~~~

自己对频率，再弄代码毕竟辛苦。

不如按照频率对应的关系，然后再搞个晶体值，计数器模式选择什么的，然后直接生成C51代码~~~~


看看我以前搞的这个汉字转unicode编码的，就是直接生成代码：

http://computer00.21ic.org/user1/2198/archives/2007/42769.html

使用特权

评论回复 赏
14楼
turmary|  楼主 | 2007-12-7 22:36 | 只看该作者

是挺方便好用的

我收藏了,
00的正则表达式很厉害,
那个正则替换好复杂啊

使用特权

评论回复 赏
15楼
平常人| | 2007-12-7 22:47 | 只看该作者

请教楼上大虾，如果真要做成琴键的图案，再加动画，用什

不好意思，借贵方宝地求教。

请教楼上大虾，如果真要做成琴键的图案，再加模拟动画，用什么软件工具最方便？

其实，我最近打算做个单片机芯片工作原理的模拟，然后以动画的形式输出模拟结果，不知这样的需求有什么样的软件工具好？目前我只会VC++和MFC，也用VC试过一个模块，效果不错，但程序写起来比较麻烦。我知道Delphi比较适合做图形界面的软件，但不知还有没有更好的，请各位指教。谢谢。

使用特权

评论回复 赏
16楼
turmary|  楼主 | 2007-12-7 22:56 | 只看该作者

我随便说说

平常人是老前辈,不能叫我大虾啊,哈哈.

在网页上搞动画,用Flash MX就可以了
Flash里画个东西很快,
每个层可以单独有自己的动作,
还可以用自带的Action Script(跟Java Script差不多)
生成复杂的动作与逻辑.
中文版有中文的帮助,很全面.
做好了可以单独用生成EXE文件,
也可以放在网页上用SWF文件.

我用过几回,呵呵~~~~~~~~~~

使用特权

评论回复 赏
17楼
computer00| | 2007-12-7 23:18 | 只看该作者

哈哈~~~其实那个正则表达式俺是拿别人的来改的拉，

自己想着也觉得头晕，一层层展开...

平常人这个用FLASH做动画是比较好的。你看我签名那个QQ的动画，就是我用FLASH MX修改出来的~~~~

使用特权

评论回复 赏
18楼
平常人| | 2007-12-8 08:22 | 只看该作者

谢谢两位的介绍

再问一下，Flash可以做交互式计算吗？ 比如说我要做一个模拟计算器，按了数字键显示相应的数字不难，但在按了等号之后可以经过计算后再显示结果吗？

最后一个问题，哪种软件制作Flash动画比较方便？其实我不需要圈圈的签名这么复杂的动画，我要求动画实体都是线条构成的，也许直接写一些Script就可以了，当然交互式的设计最直观。

今天抽空去书店看看。

使用特权

评论回复 赏
19楼
xwj| | 2007-12-8 09:11 | 只看该作者

呵呵，平常人对这个感兴趣啊？学Flash很容易的，随便找本书

就入门了，

里面当然可以跑程序啦，不然Flash游戏怎么做啊？

使用特权

评论回复 赏
20楼
平常人| | 2007-12-8 10:13 | 只看该作者

上网看了一些资料，现在基本明白了

多了解一些后发现这个Flash与我十几年前搞得一个东西差不多，只不过更加灵活，只可惜十几年前的那个东西在当时太超前，过早地夭折了。

使用特权

评论回复 赏
返回列表
发新帖 我要提问
高级模式
B Color Image Link Quote Code 收费 Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

turmary

28

主题

295

帖子

0

粉丝