'Original Author: (unknown)
'  Original Date: (unknown)
'If you know who the original author is
'or know of the webpage link that you've
'seen code that looks very similiar to this...
'please contact me so I can update the above
'information. I've searched all the usual
'places but was not able to find the original.
'The original had comments that were in
'Spanish or French (I can't remember which).
'
'Dec.7th, 2008
'This is a remake of someone else's code in
'which I've made severval improvements and
'modifications. I broke the cardinal rule
'of "never" modifying the original code.
'When I did... I lost alot of the original
'information. But the basics are still here.
'
'Even if you're not a fan of music... this
'application will still amuse you. Why?
'Because when you start clicking on the
'canvas to produce sounds... you'll probably
'be reminded of sounds you may have heard
'in Hollywood movies. At least I did. :)
'MIDI was (and still kind of is) a big thing
'way back when. It can produce sounds that
'sound like real life things. Hollywood took
'advantage of it in alot of movies.
'Play around with it and see if you can't
'find at least ONE sound that makes you say...
'"Hey... I've heard that sound before!".

$Option EXPLICIT
$Include "RapidQ.inc"

Const MAXPNAMELEN = 32

Type MIDIOUTCAPS_UDT
   wMid As Word
   wPid As Word
   vDriverVersion As Integer
   szPname As String * MAXPNAMELEN
   wTechnology As Word
   wVoices As Word
   wNotes As Word
   wChannelMask As Word
   dwSupport As DWord
End Type   

Declare Function midiOutGetNumDevs Lib "winmm" Alias "midiOutGetNumDevs" _
        () As Integer

Declare Function midiOutGetDevCaps Lib "winmm" Alias "midiOutGetDevCapsA" _
        (uDeviceID As Long, lpCaps As MIDIOUTCAPS_UDT, uSize As Long) As Long

Declare Function midiOutOpen Lib "winmm" Alias "midiOutOpen" _
        (ByRef lphMidiOut As Long, uDeviceID As Long, dwCallback As Long, _
         dwInstance As Long, dwFlags As Long) As Long

Declare Function midiOutShortMsg Lib "winmm" Alias "midiOutShortMsg" _
        (hMidiOut As Long, dwMsg As Long) As Long

Declare Function midiOutClose Lib "winmm" Alias "midiOutClose" _
        (hMidiOut As Long) As Long

Declare Sub Form_onShow
Declare Sub Form_onClose(Action As Integer)
Declare Sub Canvas_onMouseDown(Button As Integer, X As Integer, Y As Integer, Shift As Integer)
Declare Sub Canvas_onMouseUp(Button As Integer, X As Integer, Y As Integer, Shift As Integer)
Declare Sub Canvas_onMouseMove(X As Integer, Y As Integer, Shift As Integer)
Declare Sub Canvas_onPaint
Declare Sub DeviceCombobox_onChange
Declare Sub ChannelCombobox_onChange
Declare Sub SndBtn_onClick
Declare Sub MelodicCombobox_onChange
Declare Sub InstrumentCombobox_onChange

Declare Sub ShowInstrumentNoteRange
Declare Sub PrepareMIDI
Declare Sub MidiOpen(dev As Long)

Declare Function CorrectNote(note As Long) As Long
Declare Sub Chord(ch As Long, note As Long, vol As Long)
Declare Sub NoteOn(ch As Long, note As Long, vol As Long)
Declare Sub NoteOff(ch As Long, note As Long)
Declare Sub CChange(ch As Long, control As Long, value As Long)
Declare Sub PChange(ch As Long, prgm As Long)
Declare Sub PBend(ch As Long, value As Long)

Const LB_SETHORIZONTALEXTENT = &H194

Const NO = &H90
Const PC = &HC0
Const CC = &HB0
Const PB = &HE0

Const SIZE  = 4

Const LMBTN = 0
Const RMBTN = 1

Dim Program    As Long
Dim ActiveNote As Long
Dim Channel    As Long
Dim Mode       As Long
Dim hMidiOut   As Long

Dim MouseDown  As Byte
Dim ic         As Byte
Dim Instrument As Byte

DefWord cx, cy

Dim InstrumentList As QStringList
    InstrumentList.AddItems("Acoustic Grand Piano:21:108","Bright Acoustic Piano:21:108","Electric Grand Piano:21:108","Honky-tonk Piano:21:108","Rhodes Piano:21:108","Chorused Electric Piano:21:108","Harpsicord:29:89","Clavinet:29:89")
    InstrumentList.AddItems("Celesta:60:108","Glockenspiel:79:108","Music Box:79:108","Vibraphone:53:89","Marimba:36:96","Xylophone:79:108","Tubular Bells:72:91","Dulcimer:40:76")
    InstrumentList.AddItems("Hammond Organ:36:96","Percussive Organ:36:96","Rock Organ:36:96","Church Organ:36:96","Reed Organ:36:96","French Accordion:36:96","Harmonica:36:96","Bandoneon:36:96")
    InstrumentList.AddItems("Nylon-String Guitar:40:76","Steel-String Guitar:40:76","Jazz Guitar:40:76","Clean Electric Guitar:40:76","Muted Electric Guitar:40:76","Overdriven Guitar:40:76","Distortion Guitar:40:76","Guitar Harmonics:40:76")
    InstrumentList.AddItems("Acoustic Bass:24:60","Fingered Bass:24:60","Picked Bass:24:60","Fretless Bass:24:60","Slap Bass 1:24:60","Slap Bass 2:24:60","Synth Bass 1:24:60","Synth Bass 2:24:60")
    InstrumentList.AddItems("Violin:55:105","Viola:48:88","Cello:36:84","Contrabass:24:60","Tremolo Strings:36:105","Pizzicato Strings:36:105","Harp:23:104","Timpani:36:57")
    InstrumentList.AddItems("String Ensemble:36:105","Slow String Ensemble:36:105","Synth Strings 1:36:105","Synth Strings 2:36:105","Choir Aahs:41:84","Voice Oohs:41:84","Synth Voice:41:84","Orchestra Hit:24:108")
    InstrumentList.AddItems("Trumpet:54:86","Trombone:40:77","Tuba:19:72","Muted Trumpet:54:86","French Horn:38:60","Brass Section 1:38:86","Synth Brass 1:38:86","Synth Brass 2:38:86")
    InstrumentList.AddItems("Soprano Sax:56:89","Alto Sax:52:88","Tenor Sax:46:77","Baritone Sax:40:74","Oboe:58:93","English Horn:58:93","Bassoon:34:75","Clarinet:50:106")
    InstrumentList.AddItems("Piccolo:74:110","Flute:60:98","Recorder:60:98","Pan Flute:60:98","Blown Bottle:60:98","Shakuhachi:60:98","Whistle:60:98","Ocarina:60:98")
    InstrumentList.AddItems("Square Lead:0:127","Saw Lead:0:127","Synth Calliope:0:127","Chiffer Lead:0:127","Charang:0:127","Solo Synth Vox:0:127","5th Saw Wave:0:127","Bass & Lead:0:127")
    InstrumentList.AddItems("Fantasia Pad:0:127","Warm Pad:0:127","Polysynth Pad:0:127","Space Voice Pad:0:127","Bowed Glass Pad:0:127","Metal Pad:0:127","Halo Pad:0:127","Sweep Pad:0:127")
    InstrumentList.AddItems("Ice Rain:0:127","Soundtrack:0:127","Crystal:0:127","Atmosphere:0:127","Brightness:0:127","Goblins:0:127","Echo Drops:0:127","Echo Pan:0:127")
    InstrumentList.AddItems("Sitar:0:127","Banjo:48:96","Shamisen:0:127","Koto:0:127","Kalimba:0:127","Bagpipe:0:127","Fiddle:0:127","Shanai:0:127")
    InstrumentList.AddItems("Tinkle Bell:0:127","Agogo:0:127","Steel Drums:0:127","Woodblock:0:127","Taiko:0:127","Melodic Tom 1:0:127","Synth Drum:0:127","Reverse Cymbal:0:127")
    InstrumentList.AddItems("Guitar Fret Noise:0:127","Breath Noise:0:127","Seashore:0:127","Bird:0:127","Telephone 1:0:127","Helicopter:0:127","Applause:0:127","Gun Shot:0:127")

Create Form As QForm
  BorderStyle = bsDialog
  Caption = " MIDI Demo:  Left-Click = Single Note / Right-Click = Chords"
  Width = 760
  Height = 590
  Left = (Screen.Width\2) - (Form.Width\2)
  Top = (Screen.Height\2) - (Form.Height\2)
  Color = &H000000
  onShow = Form_onShow
  onClose = Form_onClose
  Create NoteLabel As QLabel
    AutoSize = False
    Font.Name = "Arial"
    Font.Size = 10
    Font.Bold = True
    Font.Color = &HFFFFFF
    Caption = "NOTE"
    Angle = 0
    Left = 256
    Top = 2
    Width = 68
    Height = 16
  End Create
  Create VolumeLabel As QLabel
    AutoSize = False
    Font.Name = "Arial"
    Font.Size = 11
    Font.Bold = True
    Font.Color = &HFFFFFF
    Caption = "VOLUME"
    Angle = 90
    Left = 2
    Top = 230
    Width = 18
    Height = 104
  End Create
  Create Canvas As QCanvas
    Left = 22
    Top = 20
    Width = 528
    Height = 528
    onMouseDown = Canvas_onMouseDown
    onMouseUp = Canvas_onMouseUp
    onMouseMove = Canvas_onMouseMove
    onPaint = Canvas_onPaint
  End Create
  Create ControlPanel As QPanel
    Left = Form.ClientWidth - 186
    Top = 2
    Width = 185
    Height = Form.ClientHeight - 3
    Create DeviceLabel As QLabel
      Left = 8
      Top = 2
      Height = 18
      Caption = "Device"
    End Create
    Create DeviceCombobox As QCombobox
      Left = 8
      Top = 20
      Width = 172
      onChange = DeviceCombobox_onChange
    End Create
    Create ChannelLabel As QLabel
      Caption = "Channel"
      Left = 8
      Top = 52
    End Create
    Create ChannelCombobox As QCombobox
      Left = 56
      Top = 48
      Width = 38
      AddItems("1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16")
      onChange = ChannelCombobox_onChange
      Hint = "Channel 10 is reserved"&Chr$(10)&"for percussion only."
      ShowHint = True
    End Create
    Create SndBtn As QButton
      Left = 100
      Top = 48
      Width = 76
      Height = 24
      Caption = "Kill Sound"
      onClick = SndBtn_onClick
      TabOrder = 0
      Hint = "Click this to force"&Chr$(10)&"the sound to stop"
      ShowHint = True
    End Create
    Create InstrumentGroupBox As QGroupbox
      Caption = " Instrument "
      Left = 8
      Top = 74
      Width = 170
      Height = 148
      Create MelodicLabel As QLabel
        Left = 8
        Top = 24
        Height = 18
        Caption = "Melodic Sounds"
        Visible = True
      End Create
      Create MelodicCombobox As QCombobox
        Left = 8
        Top = 40
        Width = 154
        AddItems("Piano")
        AddItems("Chromatic Percussion")
        AddItems("Organ")
        AddItems("Guitar")
        AddItems("Bass")
        AddItems("Strings")
        AddItems("Ensemble")
        AddItems("Brass")
        AddItems("Reed")
        AddItems("Pipe")
        AddItems("Synth Lead")
        AddItems("Synth")
        AddItems("Synth Effects")
        AddItems("Ethnic")
        AddItems("Percussive")
        AddItems("Sound Effects")
        onChange = MelodicCombobox_onChange
        Visible = True
      End Create
      Create InstrumentLabel As QLabel
        Left = 8
        Top = 72
        Height = 18
        Visible = True
        Caption = "Instrument"
      End Create
      Create InstrumentCombobox As QCombobox
        Left = 8
        Top = 88
        Width = 154
        onChange = InstrumentCombobox_onChange
        Visible = True
      End Create
      Create NoteRangeLabel As QLabel
        AutoSize = False
        Alignment = taCenter
        Left = 8
        Top = 120
        Width = 154
        Height = 18
        Font.Name = "Arial"
        Font.Size = 10
        Font.Bold = True
        Visible = True
      End Create
      Create Channel10ReservedListbox As QListbox
        Left = 8
        Top = 24
        Width = 154
        Height = 434
        Font.Name = "Courier New"
        Font.Size = 9
        AddItems("Note | Instrument")
        AddItems(" 27  | High Q")
        AddItems(" 28  | Slap")
        AddItems(" 29  | Scratch High")
        AddItems(" 30  | Scratch Low")
        AddItems(" 31  | Sticks")
        AddItems(" 32  | Square")
        AddItems(" 33  | Metronome 2")
        AddItems(" 34  | Metronome 1")
        AddItems(" 35  | Bass Drum 2")
        AddItems(" 36  | Bass Drum 1")
        AddItems(" 37  | Side Stick")
        AddItems(" 38  | Snare Drum 1")
        AddItems(" 39  | Hand Clap")
        AddItems(" 40  | Snare Drum 2")
        AddItems(" 41  | Low Tom 2")
        AddItems(" 42  | Closed Hi-hat")
        AddItems(" 43  | Low Tom 1")
        AddItems(" 44  | Pedal Hi-hat")
        AddItems(" 45  | Mid Tom 2")
        AddItems(" 46  | Open Hi-hat")
        AddItems(" 47  | Mid Tom 1")
        AddItems(" 48  | High Tom 2")
        AddItems(" 49  | Crash Cymbal 1")
        AddItems(" 50  | High Tom 1")
        AddItems(" 51  | Ride Cymbal 1")
        AddItems(" 52  | Chinese Cymbal")
        AddItems(" 53  | Ride Bell")
        AddItems(" 54  | Tambourine")
        AddItems(" 55  | Splash Cymbal")
        AddItems(" 56  | Cowbell")
        AddItems(" 57  | Crash Cymbal 2")
        AddItems(" 58  | Vibra Slap")
        AddItems(" 59  | Ride Cymbal 2")
        AddItems(" 60  | High Bongo")
        AddItems(" 61  | Low Bongo")
        AddItems(" 62  | Mute High Conga")
        AddItems(" 63  | Open High Conga")
        AddItems(" 64  | Low Conga")
        AddItems(" 65  | High Timbale")
        AddItems(" 66  | Low Timbale")
        AddItems(" 67  | High Agogo")
        AddItems(" 68  | Low Agogo")
        AddItems(" 69  | Cabasa")
        AddItems(" 70  | Maracas")
        AddItems(" 71  | Short Whistle")
        AddItems(" 72  | Long Whistle")
        AddItems(" 73  | Short Guiro")
        AddItems(" 74  | Long Guiro")
        AddItems(" 75  | Claves")
        AddItems(" 76  | High Wood Block")
        AddItems(" 77  | Low Wood Block")
        AddItems(" 78  | Mute Cuica")
        AddItems(" 79  | Open Cuica")
        AddItems(" 80  | Mute Triangle")
        AddItems(" 81  | Open Triangle")
        AddItems(" 82  | Shaker")
        AddItems(" 83  | Jingle Bell")
        AddItems(" 84  | Belltree")
        AddItems(" 85  | Casanets")
        AddItems(" 86  | Mute Surdo")
        AddItems(" 87  | Open Surdo")
        Visible = False
      End Create
    End Create
  End Create
End Create

Form.ShowModal

Sub Form_onShow
    SendMessage(Channel10ReservedListbox.Handle, LB_SETHORIZONTALEXTENT, 180, 0)
    For ic = 0 To 7
      InstrumentCombobox.AddItems(Field$(InstrumentList.Item(ic),":",1))
    Next ic
    Instrument = 0
    ShowInstrumentNoteRange
    PrepareMIDI
    MidiOpen(DeviceCombobox.ItemIndex)
    DeviceCombobox.ItemIndex = 0
    ChannelCombobox.ItemIndex = 0
    MelodicCombobox.ItemIndex = 0
    InstrumentCombobox.ItemIndex = 0
End Sub

Sub Form_onClose(Action As Integer)
    midiOutShortMsg(hMidiOut, &H78B0 Or Channel)
    midiOutClose(hMidiOut)
    Application.Terminate
End Sub

Sub Canvas_onMouseDown(Button As Integer, X As Integer, Y As Integer, Shift As Integer)
    Dim ValidNote As Integer
        ValidNote = Int((X-(SIZE*2)) / SIZE)
    Dim Min As Integer
        Min = Val(Field$(InstrumentList.Item(Instrument),":",2))
    Dim Max As Integer
        Max = Val(Field$(InstrumentList.Item(Instrument),":",3))
    If ValidNote < Min Or ValidNote > Max Then Exit Sub
    Dim ValidVolume As Integer
        ValidVolume = Int((Y-(SIZE*2)) / SIZE)
    If ValidVolume < 0 Or ValidVolume > 127 Then Exit Sub

    Dim Volume As Long
    Volume = 127 - ValidVolume
    CChange(Channel, 7, Volume)
    If Mode = 1 Then
      ActiveNote = ValidNote
      NoteOn(Channel, ActiveNote, Volume)
    ElseIf Mode = 0 Then
      ActiveNote = CorrectNote(ValidNote)
      If Button = RMBTN Then
        Chord(Channel, ActiveNote, Volume)
      Else
        NoteOn(Channel, ActiveNote, Volume)
      End If
    End If
    MouseDown = True
End Sub

Sub Canvas_onMouseUp(Button As Integer, X As Integer, Y As Integer, Shift As Integer)
    midiOutShortMsg(hMidiOut, &H78B0 Or Channel)
    MouseDown = False
End Sub 

Sub Canvas_onMouseMove(X As Integer, Y As Integer, Shift As Integer)
    Dim xi As Integer
        xi = Int((X-(SIZE*2)) / SIZE)
    Dim yi As Integer
        yi = 127 - Int((Y-(SIZE*2)) / SIZE)
    Dim Min As Integer
        Min = Val(Field$(InstrumentList.Item(Instrument),":",2))
    Dim Max As Integer
        Max = Val(Field$(InstrumentList.Item(Instrument),":",3))
    If (xi < Min Or xi > Max) Or (yi < 0 Or yi > 127) Then
      midiOutShortMsg(hMidiOut, &H78B0 Or Channel)
      MouseDown = False
    End If
    If MouseDown = True Then
      If xi >= 0 And xi <= 127 Then PBend(Channel, xi * 255)
      If yi >= 0 And yi <= 127 Then CChange(Channel, 7, yi)
    End If
    If (xi >= Min And xi <= Max) Then
      NoteLabel.Caption = "NOTE: " & Str$(xi)
    Else
      NoteLabel.Caption = "NOTE: "
    End If
    If (yi >= 0 And yi <= 127) Then
      VolumeLabel.Caption = "VOLUME: " & Str$(yi) & Chr$(32)
    End If
End Sub

Sub Canvas_onPaint
    Canvas.FillRect(8,8,Canvas.Width-8, Canvas.Height-8, &HFFFFFF)
    For cy = (SIZE*2) To (Canvas.Height-(SIZE*2)) Step SIZE
      Canvas.Line(8,cy,Canvas.Width-8,cy,&HC0C0C0)
    Next
    For cx = (SIZE*2) To (Canvas.Width-(SIZE*2)) Step SIZE
      Canvas.Line(cx,8,cx,Canvas.Height-8,&HC0C0C0)
    Next
End Sub

Sub DeviceCombobox_onChange
    If DeviceCombobox.ItemIndex >= 0 Then 
      MidiOpen(DeviceCombobox.ItemIndex)
    End If
End Sub

Sub ChannelCombobox_onChange
    If ChannelCombobox.ItemIndex = 9 Then
      InstrumentGroupBox.Height = 468
      MelodicCombobox.Visible = False
      InstrumentCombobox.Visible = False
      NoteRangeLabel.Visible = False
      Channel10ReservedListbox.Visible = True
      Mode = 1
      Form.Caption = " MIDI Demo:  Left-Click or Right-Click = Single Note"
    Else
      InstrumentGroupBox.Height = 148
      MelodicCombobox.Visible = True
      InstrumentCombobox.Visible = True
      NoteRangeLabel.Visible = True
      Channel10ReservedListbox.Visible = False
      Mode = 0
      Form.Caption = " MIDI Demo:  Left-Click = Single Note / Right-Click = Chords"
    End If
    Channel = ChannelCombobox.ItemIndex
    PChange(Channel, Program)
End Sub

Sub SndBtn_onClick
    midiOutShortMsg(hMidiOut, &H78B0 Or Channel)
    MouseDown = False
End Sub

Sub MelodicCombobox_OnChange
    InstrumentCombobox.Clear
    Program = MelodicCombobox.ItemIndex * 8
    For ic = Program To (Program + 7)
      InstrumentCombobox.AddItems(Field$(InstrumentList.Item(ic),":",1))
    Next ic
    InstrumentCombobox.ItemIndex = 0
    PChange(Channel, Program)
    Instrument = Program
    ShowInstrumentNoteRange
End Sub

Sub InstrumentCombobox_OnChange
    Program = (MelodicCombobox.ItemIndex * 8) + InstrumentCombobox.ItemIndex
    PChange(Channel, Program)
    Instrument = Program
    ShowInstrumentNoteRange
End Sub

Sub ShowInstrumentNoteRange
    Dim Min As Integer
        Min = Val(Field$(InstrumentList.Item(Instrument),":",2))
    Dim Max As Integer
        Max = Val(Field$(InstrumentList.Item(Instrument),":",3))
    NoteRangeLabel.Caption = " Note Range: " & Str$(Min) & " to " & Str$(Max)
End Sub

Sub PrepareMIDI
    Dim n As Integer
        n = midiOutGetNumDevs()
    Dim MIDIOUTCAPS As MIDIOUTCAPS_UDT
    Dim i As Integer
    For i = 0 To n - 1
      midiOutGetDevCaps(i, MIDIOUTCAPS, Sizeof(MIDIOUTCAPS))
      DeviceCombobox.AddItems(MIDIOUTCAPS.szPname)
    Next i
End Sub

Sub MidiOpen(dev As Long)
    midiOutClose(hMidiOut)
    midiOutOpen(hMidiOut, dev, Form.Handle, 0, &H10000)
End Sub

Function CorrectNote(note As Long) As Long
    Dim lRet As Long
    Dim octave As Long
        octave = note Mod 12
    If octave = 1 Or octave = 3 Or octave = 6 Or octave = 8 Or octave = 10 Then
      lRet = note - 1
    Else
      lRet = note
    End If
    Result = lRet
End Function

Sub Chord(ch As Long, note As Long, vol As Long)
    Static third As Long
    Static fifth As Long

    If vol = 0 Then
      NoteOff(ch, note)
      NoteOff(ch, third)
      NoteOff(ch, fifth)
    Else
      Select Case (note Mod 12)
        Case 0
          third = 4
          fifth = 7
        Case 2
          third = 5
          fifth = 9
        Case 4
          third = 7
          fifth = 11
        Case 5
          third = 9
          fifth = 12
        Case 7
          third = 11
          fifth = 14
        Case 9
          third = 12
          fifth = 16
        Case 11
          third = 14
          fifth = 17
      End Select
      third = note + third
      fifth = note + fifth
      While third > 127
        third = third - 12
      Wend
      While fifth > 127
        fifth = fifth - 12
      Wend
      NoteOn(ch, note, vol)
      NoteOn(ch, third, vol)
      NoteOn(ch, fifth, vol)
    End If
End Sub

Sub NoteOn(ch As Long, note As Long, vol As Long)
    Dim msg As Long
        msg = (vol * 65536) Or (note * 256) Or NO Or ch
    midiOutShortMsg(hMidiOut, msg)
End Sub

Sub NoteOff(ch As Long, note As Long)
    Dim msg As Long
        msg = (note * 256) Or NO Or ch
    midiOutShortMsg(hMidiOut, msg)
End Sub

Sub CChange(ch As Long, control As Long, value As Long)
    Dim msg As Long
        msg = (value * 65536) Or (control * 256) Or CC Or ch
    midiOutShortMsg(hMidiOut, msg)
End Sub

Sub PChange(ch As Long, prgm As Long)
    Dim msg As Long
        msg = prgm * 256 Or PC Or ch
    midiOutShortMsg(hMidiOut, msg)
End Sub

Sub PBend(ch As Long, value As Long)
    Dim msg As Long
        msg = (value * 256) Or PB Or ch
    midiOutShortMsg(hMidiOut, msg)
End Sub