j.txt

vb编写的电子琴

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