Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMidiAPIReturn As Long
Dim tone As Integer
Dim mlmidiouthandle As Long
Dim volume As Long
Dim channel As Long
Dim p As Integer
For c = 1 To 1000
m(c) = Y"缺少陣列??
n(c) = index
p = (Y - 45) / 2.5
mlmidiouthandle = 0
lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0)
tone = 60 + 3 * p
volume = 90
channel = 0
lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
Select Case index
Case 0
Sleep 4000
Case 1
Sleep 2000
Case 2
Sleep 1000
Case 3
Sleep 500
Case 4
Sleep 250
Case 5
Sleep 125
midiOutClose mlmidiouthandle
能否把滑鼠點擊的位置儲存作為midiOutShortMsg的引數進行播放呢??
uj5u.com熱心網友回復:
僅供參考:VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1590
ClientLeft = 60
ClientTop = 345
ClientWidth = 5190
LinkTopic = "Form1"
ScaleHeight = 1590
ScaleWidth = 5190
StartUpPosition = 3 '視窗預設
Begin VB.TextBox Text1
Height = 375
Left = 360
TabIndex = 1
Text = "Text1"
Top = 360
Width = 4455
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 495
Left = 1800
TabIndex = 0
Top = 840
Width = 1215
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 midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'--------------------------------------------------------
Dim notes(1 To 8, 1 To 2) As Variant
'--------------------------------------------------------
Private Sub Form_Load()
Randomize '此陳述句應在初始化時呼叫一次即可
notes(1, 1) = "C4": notes(1, 2) = 60
notes(2, 1) = "D4": notes(2, 2) = 62
notes(3, 1) = "E4": notes(3, 2) = 64
notes(4, 1) = "F4": notes(4, 2) = 65
notes(5, 1) = "G4": notes(5, 2) = 67
notes(6, 1) = "A5": notes(6, 2) = 69
notes(7, 1) = "B5": notes(7, 2) = 71
notes(8, 1) = "C5": notes(8, 2) = 72
End Sub
'--------------------------------------------------------
Private Sub Command2_Click()
Dim lMidiAPIReturn As Long
Dim tone As Integer
Dim mlmidiouthandle As Long
Dim volume As Long
Dim channel As Long
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim t As Integer
Dim s(8) As Integer
For i = 1 To 8
s(i) = i
Next
'隨機打亂s(i)的順序 即洗牌
For i = 8 To 2 Step -1
a = i: b = Int(Rnd() * i) + 1
If a <> b Then
t = s(a): s(a) = s(b): s(b) = t
End If
Next
mlmidiouthandle = 0
lMidiAPIReturn = midiOutOpen(mlmidiouthandle, -1, 0, 0, 0)
volume = 90
channel = 0
Text1.Text = ""
For i = 1 To 8
Text1.Text = Text1.Text + CStr(s(i)) + " " + notes(s(i), 1) + ", "
Text1.Refresh
tone = notes(s(i), 2)
lMidiAPIReturn = midiOutShortMsg(mlmidiouthandle, &H90 + ((tone) * &H100) + (volume * &H10000) + channel)
Sleep 100
Next
lMidiAPIReturn = midiOutClose(mlmidiouthandle)
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/93842.html
標籤:API
