📄 pl33_1.frm
字号:
ScaleWidth = 225
TabIndex = 14
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 23
Left = 3240
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 13
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 21
Left = 3000
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 12
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 19
Left = 2760
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 11
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 17
Left = 2520
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 10
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 16
Left = 2280
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 9
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 14
Left = 2040
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 8
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 12
Left = 1800
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 7
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 11
Left = 1560
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 6
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 9
Left = 1320
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 5
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 7
Left = 1080
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 4
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 5
Left = 840
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 3
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 4
Left = 600
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 2
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 2
Left = 360
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 1
Top = 1380
Width = 255
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1035
Index = 0
Left = 120
ScaleHeight = 1005
ScaleWidth = 225
TabIndex = 0
Top = 1380
Width = 255
End
Begin VB.Line Line3
BorderColor = &H00FF8080&
X1 = 60
X2 = 60
Y1 = 1320
Y2 = 2280
End
Begin VB.Line Line2
BorderColor = &H00FF8080&
X1 = 9300
X2 = 9300
Y1 = 1320
Y2 = 2280
End
Begin VB.Line Line1
BorderColor = &H00FF8080&
X1 = 60
X2 = 9300
Y1 = 1320
Y2 = 1320
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "VB MIDI PIANO"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 315
Left = 540
TabIndex = 66
Top = 60
Width = 2655
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00800000&
Caption = "消音板"
ForeColor = &H00FFFFFF&
Height = 315
Left = 240
TabIndex = 65
Top = 1020
Width = 8895
End
Begin VB.Menu mnu_File
Caption = "文件"
Begin VB.Menu mnu_Close
Caption = "关闭"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetKeyState% Lib "user32" (ByVal nVirtKey As Long)
Private sudu As Integer
Private Const VK_LBUTTON& = &H1
Private isOgain As Boolean '是否重复按键
Private Sta As Integer
Private Sub ComDevies_Click()
Dim dl As Integer
dl = MIDI_OutOpen(ComDevies.ItemData(ComDevies.ListIndex))
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Open App.Path & "\haap.txt" For Input As #1
ComDevies.ListIndex = 0
ComSounds.ListIndex = 9
HScroll1.Value = 32
Timer2.Enabled = True
Command2.Enabled = False
End Sub
Private Sub ComSounds_Click()
Call program_change(0, 0, ComSounds.ListIndex)
End Sub
Private Sub Form_Load()
Dim Retu As Boolean
Dim i As Integer
Retu = Midi_OutDevsToList(ComDevies)
ComDevies.ListIndex = 0
Call fill_sound_list
For i = 0 To 64
Picture1(i).DragMode = 1
Next
HScroll1.Value = 36
HScroll2.Value = 127
End Sub
Private Sub fill_sound_list()
Dim s As String
Open App.Path & "\genmidi.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, s
ComSounds.AddItem s
Loop
ComSounds.ListIndex = 0
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
midi_OutClose
End
End Sub
Private Sub HScroll1_Change()
Sta = HScroll1.Value
Label2.Caption = Diao(Sta Mod 12)
End Sub
Private Sub HScroll2_Change()
sudu = HScroll2.Value
End Sub
Private Sub HScroll3_Change()
Label6.Caption = HScroll3.Value
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim i As Integer
For i = 0 To 64 '关闭所有的发音
Call note_off(0, i + Sta)
Next
End Sub
Private Sub mnu_Close_Click()
Unload Me
End Sub
Private Sub Picture1_DragOver(Index As Integer, Source As Control, x As Single, Y As Single, State As Integer)
'完成发音
Static OldNote As Integer
If (OldNote <> Index) Or (isOgain = True) Then
Call note_off(0, OldNote + Sta)
Call note_on(0, Index + Sta, sudu) '参数分别为通道编号，音调，速度
OldNote = Index
isOgain = False
End If
End Sub
Private Sub Timer1_Timer()
Dim MyKey As Integer
MyKey% = GetKeyState(VK_LBUTTON)
If MyKey% And &H4000 Then
isOgain = False
Else
isOgain = True
End If
End Sub
Private Sub Timer2_Timer()
Dim s As String
Dim Index As Integer
Line Input #1, s
s = Trim(s)
If s = "End" Then
Close #1
Timer2.Enabled = False
Command2.Enabled = True
Label1_MouseMove 0, 0, 1, 1
Exit Sub
End If
Index = Val(s)
If Index < 100 Then
Index = Index + 7
Picture1_DragOver Index, Picture1(Index), 1, 1, 1
Index = Index + 24
Picture1_DragOver Index, Picture1(Index), 1, 1, 1
End If
isOgain = True
End Sub
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -