vb编写的电子琴,仿真实电子琴操作界面,包含与FPGA串口通信的功能1
Dim Sta As Integer
Dim Vol As Integer
Dim Syllable As String
Dim Coding As String
Dim i As Integer
Dim Key(150) As Integer '按键琴键对应
Dim Keylayout As String '键盘分布
Dim Scancode As Integer '键盘扫描码缓存器
Dim Ksc As Integer '按键编码缓存器
Dim s As String '音节储存
Dim m As Integer
Dim oput As String
Dim playbf As String
Dim num As Integer
Dim codei As Integer
Private Sub Command1_Click()
Dim t As String
Dim d As String
Dim ds As String
Dim tm As Integer
Dim dm As Integer
TextKeyCode.Text = "播放中"
TextSyllable.Text = "播放中"
ds = "CcDdEFfGgAaB"
CommonDialog1.DialogTitle = "播放"
CommonDialog1.Filter = "All File(*.*)|*.*|音乐文件|*.txt|"
CommonDialog1.FilterIndex = 2
CommonDialog1.Flags = 0
CommonDialog1.Action = 1
On Error GoTo OpenFile_Err
Open CommonDialog1.FileName For Input As #1
Input #1, d
Input #1, t
Input #1, playbf
Close #1
num = Len(playbf) - 1
tm = Val(t)
dm = InStr(1, ds, d) - 1
codei = 1
Timer1.Enabled = True
Timer1.Interval = tm
HScroll1.Value = dm
OpenFile_Err:
Exit Sub
End Sub
Private Sub Command2_Click()
Form2.Show
Form1.Hide
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
TextKeyCode.Text = ""
TextSyllable.Text = ""
TextCodeR.Text = ""
If (KeyCode = 187 And HScroll1.Value < 11) Then
HScroll1.Value = HScroll1.Value + 1
Label2.Caption = Diao(HScroll1.Value Mod 12)
End If
If (KeyCode = 189 And HScroll1.Value > 0) Then
HScroll1.Value = HScroll1.Value - 1
Label2.Caption = Diao(HScroll1.Value Mod 12)
End If
Scancode = KeyCode
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim k As Integer
If Scancode > 95 And Scancode < 112 Then
k = Scancode + 32
Else
k = KeyAscii
End If
If Key(k) > 23 And Key(k) < 89 Then
Picture1(Key(k) - 24).SetFocus
TextKeyCode = Key(k) - 36 + m
oput = TextKeyCode
MSComm1.Output = oput
TextCodeR.Text = MSComm1.Input
End If
Ksc = Key(k) - 23
keystoke Ksc, s
DiaoChange (HScroll1.Value)
End Sub
Private Sub Form_Load()
KeyPreview=True
Dim i, j As Integer
Label2.Caption = Diao(Sta Mod 12)
TextKeyCode.Text = ""
TextSyllable.Text = ""
TextCodeR.Text = ""
For i = 0 To 64
Picture1(i).DragMode = 1
Next
Keylayout = "zZxXcvVbBnNmaAsSdfFgGhHj"
Keylayout = Keylayout + "qQwWerRtTyYu1!2@34$5%6^78*9(0"
For j = 36 To 88
i = Asc(Mid(Keylayout, j - 35, 1))
Key(i) = j
Next j
Key(32) = 102
Key(129) = 24: Key(128) = 25: Key(130) = 26: Key(142) = 27: Key(131) = 28
Key(132) = 29: Key(136) = 30: Key(133) = 31: Key(137) = 32: Key(134) = 33
Key(139) = 34: Key(135) = 35
Key(143) = 36: Key(138) = 38: Key(67) = 39: Key(141) = 40: Key(77) = 46
Key(44) = 48: Key(60) = 49: Key(46) = 50: Key(62) = 51: Key(68) = 51: Key(63) = 51
Key(47) = 52: Key(74) = 58: Key(107) = 60: Key(75) = 61: Key(108) = 62: Key(58) = 63
Key(76) = 63: Key(59) = 64: Key(69) = 64: Key(39) = 65: Key(34) = 66: Key(85) = 70
Key(105) = 72: Key(73) = 73: Key(111) = 74: Key(35) = 75: Key(79) = 75: Key(80) = 75
Key(112) = 76: Key(91) = 77: Key(123) = 78: Key(93) = 79: Key(125) = 80: Key(38) = 82
Key(41) = 87: Key(43) = 102: Key(45) = 102: Key(61) = 102: Key(95) = 102: Key(96) = 102
Key(124) = 102: Key(8) = 102
Key(92) = 102
MSComm1.Settings = "9600,N,8,1"
MSComm1.PortOpen = True
End Sub
Private Sub HScroll1_Change()
Sta = HScroll1.Value
Label2.Caption = Sta = HScroll1.Value
Label2.Caption = Diao(Sta Mod 12)
End Sub
Private Function keystoke(i As Integer, s As String) As String
Dim b As Integer
Select Case Val(i)
Case Is < 13
b = i
TextSyllable.Text = "更低音" & " " & Mid(s, b, 1)
Case Is < 25
b = i - 12
TextSyllable.Text = "低音" & " " & Mid(s, b, 1)
Case Is < 37
b = i - 24
TextSyllable.Text = "中音" & " " & Mid(s, b, 1)
Case Is < 49
b = i - 36
TextSyllable.Text = "高音" & " " & Mid(s, b, 1)
Case Is < 61
b = i - 48
TextSyllable.Text = "更高音" & " " & Mid(s, b, 1)
Case Is < 66
b = i - 60
TextSyllable.Text = "最高音" & " " & Mid(s, b, 1)
End Select
'半音识别显示
If (b <> 0) Then
If (b Mod 2 <> 0) Then
If (Mid(s, b, 1) > 3) Then
TextSyllable.Text = TextSyllable.Text + " *"
End If
Else
If (Mid(s, b, 1) < 3) Then
TextSyllable.Text = TextSyllable.Text + " *"
End If
End If
End If
End Function
Private Function Diao(i As Integer) As String
Select Case i
Case 0
Diao = "C"
Case 1
Diao = "C#"
Case 2
Diao = "D"
Case 3
Diao = "D#"
Case 4
Diao = "E"
Case 5
Diao = "F"
Case 6
Diao = "F#"
Case 7
Diao = "G"
Case 8
Diao = "G#"
Case 9
Diao = "A"
Case 10
Diao = "A#"
Case 11
Diao = "B"
End Select
End Function
Private Sub MSComm1_OnComm()
TextCodeR.Text = MSComm1.Input
End Sub
Private Sub Picture1_DragOver(Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
keystoke Index + 1, s
DiaoChange (HScroll1.Value)
TextKeyCode = Index + m
MSComm1.InputLen = 0
oput = TextKeyCode
MSComm1.Output = oput
End Sub
Private Function DiaoChange(i As Integer) As String
Select Case i
Case 0
m = 0
Case 1
m = 1
Case 2
m = 2
Case 3
m = 3
Case 4
m = 4
Case 5
m = 5
Case 6
m = 6
Case 7
m = 7
Case 8
m = 8
Case 9
m = 9
Case 10
m = 10
Case 11
m = 11
End Select
End Function
Private Sub Timer1_Timer()
Dim a, af As Integer
Dim m1 As String
af = Asc(Mid(playbf, codei, 1))
Select Case af
Case Is = 67: a = 129
Case Is = 68: a = 128
Case Is = 69: a = 130
Case Is = 35: a = 142
Case Is = 77: a = 131
Case Is = 74: a = 132
Case Is = 85: a = 136
Case Is = 38: a = 133
Case Is = 63: a = 137
Case Is = 58: a = 134
Case Is = 80: a = 139
Case Is = 41: a = 135
Case Else: a = af
End Select
If Key(a) > 23 And Key(a) < 89 Then
Picture1(Key(a)).SetFocus
End If
Ksc = Key(a) - 23
m1 = Ksc
MSComm1.Output = m1
If codei > num Then
Call closeplay
TextSyllable.Text = "播放结束"
TextKeyCode.Text = "播放结束"
End If
codei = codei + 1
End Sub
Sub closeplay()
If Timer1.Enabled = True Then
Timer1.Enabled = False
End If
HScroll1.Value = 0
TextCodeR.Text = "播放结束"
End Sub