MIDI-Tunes
A work that based on that of MIDI_boink's windchimes and Alyce's much earlier Piano, this program plays one of three tunes based on the tune file you open. Tunes files are very simple and can be created by anyone with a little musical knowledge. John has graciously granted me permission to publish his work here, a special version of the midi-tunes program he posted on the Yahoo's Liberty Basic list which he wrote just for the newsletter.
The code is below, but the tune files are part of the archive. They are required to successfully run the program. You will find the tune files (and a copy of the bas file) in the folder called MIDItune, which is part of the archive. You must download the newsletter from the web to get the archive.
Here is the demo with thanks to John:
'MidiTunes 'by John Richardson 'based on work done by Alyce Watson and Midi-Boink '2003 'plays one of three songs - Twinkle Twinkle (trad.), 'Minuet (J. S. Bach) and Sur le pont d'Avignon 'Modified by Brad Moore to fix long file names with spaces nomainwin note = 0 voice = 35 dim tune(1000,2) [chooseTune] filedialog "Choose a song, please!", "*.tun", FileName$ if FileName$ = "" then goto [chooseTune] 'get short path for file provided - in case it contains spaces tuneFile$ = GetShortPathName$(FileName$) type = 1 i = 0 open tuneFile$ for input as #tun while eof(#tun) = 0 i = i + 1 data$ = inputto$(#tun, " ") if data$ = "|" then type = type + 1 typePos = i end if if type = 1 then tune(i,1) = val(data$) if type = 2 then tune(i-typePos,2) = val(data$) wend close #tun lenOfTune = typePos struct m, a$ As ptr calldll #winmm, "midiOutOpen",_ m as struct,_ -1 As long,_ 0 as long,_ 0 as long,_ 0 as long,_ ret as long hMidiOut = m.a$.struct event = 192 velocity = 127 low = (voice * 256) + event hi = velocity * 256 * 256 dwMsg = low + hi calldll #winmm, "midiOutShortMsg",_ hMidiOut as ulong,_ dwMsg as ulong,_ ret as ulong [timer] timer tune(noteRef,2), [keyNote] wait [keyNote] timer 0 event = 144 low = (note * 256) + event hiZero = 0 dwMsg = low + hiZero calldll #winmm, "midiOutShortMsg",_ hMidiOut as ulong,_ dwMsg as ulong,_ ret as ulong noteRef = noteRef + 1 if noteRef = lenOfTune + 1 then goto [quit] note = tune(noteRef,1) event = 144 low = (note * 256) + event velocity = 127 hi = velocity * 256 * 256 dwMsg = low + hi calldll #winmm, "midiOutShortMsg",_ hMidiOut as ulong,_ dwMsg as ulong,_ ret as ulong goto [timer] [quit] timer 0 calldll #winmm, "midiOutClose", hMidiOut As ulong, ret As ulong end Function GetShortPathName$(lPath$) lPath$=lPath$+Chr$(0) sPath$=Space$(256) lenPath=Len(sPath$) CallDLL #kernel32, "GetShortPathNameA",lPath$ As Ptr,_ sPath$ As Ptr,lenPath As Long,r As Long GetShortPathName$=Left$(sPath$,r) End Function