Made some changes and the errors went away in the "send MIDI" program (but still don't have my MIDI keyboard so can't test),
and fixed most of the errors in the "read MIDI" except for:
line 25: defines an array inside of a TYPE used by an API function, not sure what to do, but the code doesn't seem to use this property, so maybe not an issue?
dwReserved2(3) as long
line 62: supposed to define a callback function, not sure how to do this in QB64PE?
midiCallbackAddress& = VARSEG(MidiInProc) * &H10000 + VARPTR(MidiInProc) ' Callback address
Code is below, and also attached required library file (place it in the same folder as the code)...
Send MIDI note to keyboard:
Read MIDI note from keyboard (lines 25 and 62 need fixing):
and fixed most of the errors in the "read MIDI" except for:
line 25: defines an array inside of a TYPE used by an API function, not sure what to do, but the code doesn't seem to use this property, so maybe not an issue?
dwReserved2(3) as long
line 62: supposed to define a callback function, not sure how to do this in QB64PE?
midiCallbackAddress& = VARSEG(MidiInProc) * &H10000 + VARPTR(MidiInProc) ' Callback address
Code is below, and also attached required library file (place it in the same folder as the code)...
Send MIDI note to keyboard:
Code: (Select All)
' Send MIDI notes/pitch wheel info to keyboard
' Be sure to include "winmm.h" in the same folder as the program
' winmm.h can be found at https://github.com/github/VisualStudio/blob/master/tools/Debugging%20Tools%20for%20Windows/winext/manifest/winmm.h
Const MIDI_MAPPER = -1
Const MIDI_NOTEON = &H90
Const MIDI_NOTEOFF = &H80
Const MIDI_PITCHWHEEL = &HE0
'DECLARE LIBRARY "winmm.dll"
Declare Library "winmm"
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midioutopen
Function midiOutOpen& (lphMidiOut&, uDeviceID&, dwCallback&, dwCallbackInstance&, dwFlags&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midioutshortmsg
Function midiOutShortMsg& (hMidiOut&, dwMsg&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midioutclose
Function midiOutClose& (hMidiOut&)
End Declare
Dim Shared midiHandle&
' Example Usage
OpenMidi
PlayNoteWithPitchWheel 0, 60, 100, 2000, 8192, 0 ' Middle C, 2 sec, no bend to full bend down.
CloseMidi
End
Sub OpenMidi
Dim result&
result& = midiOutOpen&(midiHandle&, MIDI_MAPPER, 0, 0, 0)
If result& <> 0 Then
Print "Could not open MIDI device."
End
End If
End Sub ' OpenMidi
Sub CloseMidi
Dim value1&
If midiHandle& <> 0 Then
value1& = midiOutClose&(midiHandle&)
midiHandle& = 0
End If
End Sub ' CloseMidi
Sub SendMidiNote (channel%, note%, velocity%)
Dim msg&
Dim value1&
If midiHandle& = 0 Then
Print "MIDI device not open."
Exit Sub
End If
' Note On
msg& = velocity% * 65536 + note% * 256 + (MIDI_NOTEON Or channel%)
value1& = midiOutShortMsg&(midiHandle&, msg&)
End Sub ' SendMidiNote
Sub SendMidiNoteOff (channel%, note%, velocity%)
Dim msg&
Dim value1&
If midiHandle& = 0 Then
Print "MIDI device not open."
Exit Sub
End If
' Note Off
msg& = velocity% * 65536 + note% * 256 + (MIDI_NOTEOFF Or channel%)
value1& = midiOutShortMsg&(midiHandle&, msg&)
End Sub ' SendMidiNoteOff
Sub SendPitchWheel (channel%, pitchWheelValue%)
Dim lsb%
Dim msb%
Dim msg&
Dim value1&
If midiHandle& = 0 Then
Print "MIDI device not open."
Exit Sub
End If
lsb% = pitchWheelValue% And &H7F
msb% = (pitchWheelValue% \ 128) And &H7F
msg& = lsb% + msb% * 256 + (MIDI_PITCHWHEEL Or channel%)
value1& = midiOutShortMsg&(midiHandle&, msg&)
End Sub ' SendPitchWheel
Sub PlayNoteWithPitchWheel (channel%, note%, velocity%, durationMS%, pitchWheelStart%, pitchWheelEnd%)
Dim startTime!, currentTime!, elapsedTime!
Dim pitchWheelValue%
Dim currentMS%
OpenMidi
SendMidiNote channel%, note%, velocity%
startTime! = Timer
Do While (Timer - startTime!) * 1000 < durationMS%
currentTime! = Timer
elapsedTime! = (currentTime! - startTime!) * 1000
' Calculate pitch wheel value (linear interpolation)
pitchWheelValue% = pitchWheelStart% + (pitchWheelEnd% - pitchWheelStart%) * (elapsedTime! / durationMS%)
SendPitchWheel channel%, pitchWheelValue%
'Delay to reduce cpu usage.
currentMS% = (Timer - startTime!) * 1000
Do While ((Timer - startTime!) * 1000) < currentMS% + 1: Loop
Loop
SendMidiNoteOff channel%, note%, velocity%
SendPitchWheel channel%, 8192 ' Reset pitch wheel to center
CloseMidi
End Sub ' PlayNoteWithPitchWheelRead MIDI note from keyboard (lines 25 and 62 need fixing):
Code: (Select All)
' Read MIDI notes/pitch wheel from keyboard
' Be sure to include "winmm.h" in the same folder as the program
' winmm.h can be found at https://github.com/github/VisualStudio/blob/master/tools/Debugging%20Tools%20for%20Windows/winext/manifest/winmm.h
Const MIDI_MAPPER = -1
Const MIDI_NOTEON = &H90
Const MIDI_NOTEOFF = &H80
Const MIDI_PITCHWHEEL = &HE0
Const MM_MIM_DATA = &H3C1
Const CALLBACK_FUNCTION = 1
Type MIDIHDR
lpData As Long
dwBufferLength As Long
dwBytesRecorded As Long
dwUser As Long
dwFlags As Long
lpNext As Long
dwReserved As Long
dwOffset As Long
'********************************************************************************
'*** HOW DO YOU DECLARE THIS IN A TYPE IN QB64PE, AN ARRAY IN A TYPE?
dwReserved2(3) as long
'********************************************************************************
End Type ' MIDIHDR
'DECLARE LIBRARY "winmm.dll"
Declare Library "winmm"
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midiinopen
Function midiInOpen& (lphMidiIn&, uDeviceID&, dwCallback&, dwCallbackInstance&, dwFlags&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midiinclose
Function midiInClose& (hMidiIn&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midiinstart
Function midiInStart& (hMidiIn&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midiinstop
Function midiInStop& (hMidiIn&)
'https://learn.microsoft.com/en-us/windows/win32/api/mmeapi/nf-mmeapi-midiinreset
Function midiInReset& (hMidiIn&)
End Declare
Dim Shared midiInHandle&
Dim Shared midiCallbackAddress&
Dim Shared midiBuffer%(0 To 0) ' Single byte buffer
Dim Shared midiHeader As MIDIHDR
' Example Usage
OpenMidiInput
Print "Listening for MIDI input. Press any key to stop."
Do
If InKey$ <> "" Then Exit Do
Loop
CloseMidiInput
End
Sub OpenMidiInput
Dim result&
Dim value1&
'********************************************************************************
'***THIS IS SUPPOSED TO BE A CALLBACK, NOT SURE HOW TO DO THIS IN QB64PE:
midiCallbackAddress& = VARSEG(MidiInProc) * &H10000 + VARPTR(MidiInProc) ' Callback address
'********************************************************************************
result& = midiInOpen&(midiInHandle&, MIDI_MAPPER, midiCallbackAddress&, 0, CALLBACK_FUNCTION)
If result& <> 0 Then
Print "Could not open MIDI input device."
End
End If
result& = midiInStart&(midiInHandle&)
If result& <> 0 Then
Print "Could not start MIDI input."
value1& = midiInClose&(midiInHandle&)
midiInHandle& = 0
End
End If
midiHeader.lpData = VarPtr(midiBuffer%(0))
midiHeader.dwBufferLength = 1
'Add midiInAddBuffer here if needed.
End Sub ' OpenMidiInput
Sub CloseMidiInput
Dim value1&
If midiInHandle& <> 0 Then
value1& = midiInStop&(midiInHandle&)
value1& = midiInReset&(midiInHandle&)
value1& = midiInClose&(midiInHandle&)
midiInHandle& = 0
End If
End Sub ' CloseMidiInput
Sub MidiInProc (hMidiIn&, wMsg&, dwInstance&, dwParam1&, dwParam2&)
Dim status&
Dim data1%
Dim data2%
Dim channel%
Dim note%
Dim velocity%
Dim pitchWheelLSB%
Dim pitchWheelMSB%
Dim pitchWheelValue%
If wMsg& = MM_MIM_DATA Then
status& = dwParam1& And &HF0
channel% = dwParam1& And &HF
data1% = (dwParam1& \ &H100) And &H7F
data2% = (dwParam1& \ &H10000) And &H7F
Select Case status&
Case MIDI_NOTEON
note% = data1%
velocity% = data2%
Print "Note On: Channel="; channel% + 1; ", Note="; note%; ", Velocity="; velocity%
Case MIDI_NOTEOFF
note% = data1%
velocity% = data2%
Print "Note Off: Channel="; channel% + 1; ", Note="; note%; ", Velocity="; velocity%
Case MIDI_PITCHWHEEL
pitchWheelLSB% = data1%
pitchWheelMSB% = data2%
pitchWheelValue% = pitchWheelLSB% + (pitchWheelMSB% * 128)
Print "Pitch Wheel: Channel="; channel% + 1; ", Value="; pitchWheelValue%
Case Else
Print "MIDI Message: Status="; Hex$(status&); ", Data1="; data1%; ", Data2="; data2%
End Select
End If
End Sub ' MidiInProc