如何制作midi文件?(100分)

如何制作midi文件?比如模拟键盘的某个键来发出某个乐器的某个音调?
我对这方面一窍不通.大家帮忙!!!

midiOutOpen
midiOutShortMsg

可否详细告知???不要说去看msdn,我怎么也转不过来(vb2delphi):-(

或者哪里有这方面的资料啊,最好是中文:谢谢

：cAkk, cheka ) 在吗?
爱元元的哥哥,有代码吗?

软件可以编辑midi文件，但是如果制作的话，应该需要专用的硬件设备，做音乐的人应该知道。。。

我只是想用键盘来代替,然后可以把文件保存起来,怎么做啊??

我觉得软件实现不了（也许说的不对)，。。。

可以实现,cfan.net.cn有个用vb做的,我不懂,反不过来,你可以帮我吗?wolf?

怎么可能实现不了呢？

把你的VB代码贴出来！

好的,等

如果可以的话，发给我一份。smhp@163.net

Attribute VB_Name = "MidiOut"
Option Explicit

Private Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer
Private Declare Function MIDIOutOpen Lib "winmm.dll" Alias "midiOutOpen" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Function midiOutGetErrorText Lib "winmm.dll" Alias "midiOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long

Private Const MAXERRORLENGTH = 128 ' max error text length (including NULL)

Private Const MIDIMAPPER = (-1)
Private Const MIDI_MAPPER = (-1)
'MIDIOUTCAPS结构描述了Musical Instrument Digital Interface(MIDI)输入设备的性能
Type MIDIOUTCAPS
wMid As Integer
wPid As Integer ' 产品 ID
vDriverVersion As Long ' 设备版本
szPname As String * 32 ' 设备 name
wTechnology As Integer ' 设备类型
wVoices As Integer
wNotes As Integer
wChannelMask As Integer
dwSupport As Long
End Type

Dim hMidi As Long

Public Function Midi_OutDevsToList(Obj As Control) As Boolean
Dim i As Integer
Dim midicaps As MIDIOUTCAPS
Dim isAdd As Boolean

Obj.Clear
isAdd = False
If midiOutGetDevCaps(MIDIMAPPER, midicaps, Len(midicaps)) = 0 then
'若获取设备信息成功
Obj.AddItem midicaps.szPname '添加设备名称
Obj.ItemData(Obj.NewIndex) = MIDIMAPPER '这是默认设备ID = -1
isAdd = True
End If
'添加其他设备
For i = 0 To midiOutGetNumDevs() - 1
If midiOutGetDevCaps(i, midicaps, Len(midicaps)) = 0 then

Obj.AddItem midicaps.szPname
Obj.ItemData(Obj.NewIndex) = i
isAdd = True
End If
Next
Midi_OutDevsToList = isAdd
End Function
Public Function MIDI_OutOpen(ByVal dev_id As Integer) As Integer
Dim midi_error As Integer

midi_OutClose
midi_error = MIDIOutOpen(hMidi, dev_id, 0, 0, 0)
If Not midi_error = 0 then

Call midi_outerr(midi_error)
End If
MIDI_OutOpen = (hMidi <> 0)
End Function
Public Sub midi_OutClose()
Dim midi_error As Integer

If hMidi <> 0 then

midi_error = midiOutClose(hMidi)
If Not midi_error = 0 then

Call midi_outerr(midi_error)
End If
hMidi = 0
End If
End Sub
Public Sub note_on(ch As Integer, ByVal kk As Integer, v As Integer)
Call midi_outshort(&amp;H90 + ch, kk, v)
End Sub

Public Sub note_off(ch As Integer, ByVal kk As Integer)
Call midi_outshort(&amp;H80 + ch, kk, 0)
End Sub

Sub midi_outshort(b1 As Integer, b2 As Integer, b3 As Integer)
Dim midi_error As Integer

midi_error = midiOutShortMsg(hMidi, b3 * &amp;H10000 + b2 * &amp;H100 + b1)
If Not midi_error = 0 then

Call midi_outerr(midi_error)
End If
End Sub
Sub program_change(ch As Integer, cc0nr As Integer, ByVal pnr As Integer)
Call control_change(ch, 0, cc0nr)
Call midi_outshort(&amp;HC0 + ch, pnr, 0)
End Sub
Sub control_change(ch As Integer, ccnr As Integer, ByVal v As Integer)
Call midi_outshort(&amp;HB0 + ch, ccnr, v)
End Sub

Sub midisetrpn(ch As Integer, pmsb As Integer, plsb As Integer, msb As Integer, lsb As Integer)
Call midi_outshort(ch, &amp;H65, pmsb)
Call midi_outshort(ch, &amp;H64, plsb)
Call midi_outshort(ch, &amp;H6, msb)
Call midi_outshort(ch, &amp;H26, lsb)
End Sub
Sub midi_outerr(ByVal midi_error As Integer)
Dim s As String
Dim x As Integer

s = Space(MAXERRORLENGTH)
x = midiOutGetErrorText(midi_error, s, MAXERRORLENGTH)
MsgBox s

End Sub

你把整个工程都发给我吧，我帮你 B 2 D！

http://vbnew.www21.cnidc.cn/zip1/vb/dmt/m021_Play33.zip
这里是源码.谢谢爱元元的哥哥

我也想知道，顶

改好后,可否发我信箱?
delphier@163.com

你那个代码不能产生midi嘛！

?>?真的吗?等一下,我再找一个