home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / MIDICOMP.ZIP / MONPROCS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-03  |  3.4 KB  |  145 lines
  1. { $Header:   F:/delphi/midi/vcs/monprocs.pas   1.1   03 Jul 1995 01:51:06   DAVEC  $ }
  2.  
  3. unit Monprocs;
  4.  
  5. interface
  6.  
  7. uses Sysutils, MidiIn;
  8.  
  9. type
  10.     TEventNames = array[1..8] of string[24];
  11.     TSysMsgNames = array[1..16] of string[24];
  12. const
  13.     EventNames: TEventNames = (
  14.         'Note Off',
  15.         'Note On',
  16.         'Key Aftertouch',
  17.         'Control Change',
  18.         'Program Change',
  19.         'Channel Aftertouch',
  20.         'Pitch Bend',
  21.         'System Message' );
  22.         SysMsgNames: TSysMsgNames = (
  23.         'System Exclusive',
  24.         'MTC Quarter Frame',
  25.         'Song Position Pointer',
  26.         'Song Select',
  27.         'Undefined',
  28.         'Undefined',
  29.         'Tune Request',
  30.         'System Exclusive End',
  31.         'Timing Clock',
  32.         'Undefined',
  33.         'Start',
  34.         'Continue',
  35.         'Stop',
  36.         'Undefined',
  37.         'Active Sensing',
  38.         'System Reset');
  39.  
  40.     format3 = '%4.4x%4.4x   %2.2x       %2.2x    %2.2x     %s';
  41.     format2 = '%4.4x%4.4x   %2.2x       %2.2x           %s';
  42.     format1 = '%4.4x%4.4x   %2.2x                    %s';
  43.  
  44.     function BinaryToHexList( bin: PChar; binSize: Word ): String;
  45.     function MonitorMessageText( ThisEvent: TMidiEvent ): String;
  46.  
  47. implementation
  48.  
  49. function BinaryToHexList( bin: PChar; binSize: Word ): String;
  50. var
  51.     ctr: Word;
  52.     thisChar: Char;
  53. begin
  54.     if binSize > 200 then
  55.         binSize := 200;
  56.  
  57.     Result := '';
  58.     for ctr := 0 to binSize-1 do
  59.     begin
  60.         thisChar := bin^;
  61.         Result := Result + Format('%2.2x ', [Integer(thisChar)]);
  62.         Inc(bin);
  63.     end;
  64. end;
  65.  
  66. { Converts MIDI event to text description. Straight out of Microsoft MIDIMON example }
  67. function MonitorMessageText( ThisEvent: TMidiEvent ): String;
  68. var
  69.     bStatus: Byte;
  70.     EventDesc: String;
  71.     TimeLow: Word;
  72.     TimeHigh: Word;
  73. begin
  74.     bStatus := ThisEvent.MidiMessage And $f0;
  75.     TimeHigh := Word(ThisEvent.Time Div 65536);
  76.     TimeLow := Word(ThisEvent.Time MOD 65536);
  77.  
  78.     EventDesc := 'Unrecognized MIDI Event';
  79.  
  80.     case bStatus of
  81.  
  82.     { 3-byte events }
  83.     MIDI_NOTEOFF,
  84.     MIDI_NOTEON,
  85.     MIDI_KEYAFTERTOUCH,
  86.     MIDI_CONTROLCHANGE,
  87.     MIDI_PITCHBEND:
  88.         begin
  89.             { Note on with velocity of 0 is a Note Off }
  90.             if (bStatus = MIDI_NOTEON) And (ThisEvent.Data2 = 0) then
  91.                 bStatus := MIDI_NOTEOFF;
  92.             EventDesc := Format(format3,
  93.                 [TimeHigh, TimeLow,
  94.                 ThisEvent.MidiMessage,
  95.                 ThisEvent.Data1,
  96.                 ThisEvent.Data2,
  97.                 EventNames[ ((ThisEvent.MidiMessage-$80) Div 16) + 1 ]]);
  98.         end;
  99.     { 2-byte events }
  100.     MIDI_PROGRAMCHANGE,
  101.     MIDI_CHANAFTERTOUCH:
  102.         begin
  103.             EventDesc := Format(format2,[TimeHigh, TimeLow,
  104.                 ThisEvent.MidiMessage,
  105.                 ThisEvent.Data1,
  106.                 EventNames[ ((ThisEvent.MidiMessage-$80) Div 16) + 1 ]]);
  107.         end;
  108.  
  109.     { System events $f0-$ff }
  110.     MIDI_BEGINSYSEX:
  111.         begin
  112.             case ThisEvent.MidiMessage of
  113.             MIDI_BEGINSYSEX:
  114.                 EventDesc := Format('Sysex (%d): ', [ThisEvent.SysexLength]) +
  115.                     BinaryToHexList(ThisEvent.Sysex, ThisEvent.SysexLength);
  116.  
  117.             {2-byte system events}
  118.             MIDI_MTCQUARTERFRAME,
  119.             MIDI_SONGSELECT:
  120.                 EventDesc := Format(format1,[TimeHigh, TimeLow,
  121.                                     ThisEvent.MidiMessage,
  122.                     ThisEvent.Data1,
  123.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  124.  
  125.             {3-byte system events}
  126.             MIDI_SONGPOSPTR:
  127.                 EventDesc := Format(format3,[TimeHigh, TimeLow,
  128.                     ThisEvent.MidiMessage,
  129.                     ThisEvent.Data1,
  130.                     ThisEvent.Data2,
  131.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  132.  
  133.             {1-byte system events}
  134.             else
  135.                 EventDesc := Format(format1,[TimeHigh, TimeLow,
  136.                     ThisEvent.MidiMessage,
  137.                     SysMsgNames[ (ThisEvent.MidiMessage And $f) +1 ]]);
  138.             end;
  139.         end;
  140.     end;
  141.     Result := EventDesc;
  142. end;
  143.  
  144. end.
  145.