home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / MIDICOMP.ZIP / DELPHMCB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-04  |  3.6 KB  |  132 lines
  1. { $Header:   F:/delphi/midi/vcs/delphmcb.pas   1.11   04 Jul 1995 09:21:18   DAVEC  $ }
  2.  
  3. {MIDI callback DLL for Delphi}
  4. { TODO: Why is Delphi linking in the whole VCL into the DLL? }
  5.  
  6. unit Delphmcb;
  7.  
  8. {$C PRELOAD FIXED PERMANENT}
  9.  
  10. interface
  11.  
  12. uses WinProcs, WinTypes, MMsystem, Circbuf, MidiIn;
  13.  
  14.  
  15. procedure midiHandler(
  16.           hMidiIn: HMidiIn;
  17.           wMsg: Word;
  18.           dwInstance: Longint;
  19.           dwParam1: Longint;
  20.           dwParam2: Longint); export;
  21.  
  22. implementation
  23.  
  24. { Add an event to the circular input buffer. }
  25. function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiInputBufferItem): Boolean;
  26. begin
  27.     If (PBuffer^.EventCount < PBuffer^.Capacity) Then
  28.         begin
  29.         Inc(Pbuffer^.EventCount);
  30.  
  31.         { Todo: better way of copying this record }
  32.         with PBuffer^.PNextput^ do
  33.             begin
  34.             Timestamp := PTheEvent^.Timestamp;
  35.             Data := PTheEvent^.Data;
  36.             Sysex := PTheEvent^.Sysex;
  37.           end;
  38.  
  39.         { Move to next put location, with wrap }
  40.         Inc(Pbuffer^.PNextPut);
  41.         If (PBuffer^.PNextPut = PBuffer^.PEnd) then
  42.             PBuffer^.PNextPut := PBuffer^.PStart;
  43.  
  44.         CircbufPutEvent := True;
  45.         end
  46.     else
  47.         CircbufPutEvent := False;
  48. end;
  49.  
  50. { This is the callback function specified when the MIDI device was opened
  51.   by midiInOpen. It's called at interrupt time when MIDI input is seen
  52.   by the MIDI device driver(s). See the docs for midiInOpen for restrictions
  53.   on the Windows functions that can be called in this interrupt. }
  54. procedure midiHandler(
  55.           hMidiIn: HMidiIn;
  56.           wMsg: Word;
  57.           dwInstance: Longint;
  58.           dwParam1: Longint;
  59.           dwParam2: Longint);
  60.  
  61. var
  62.     thisEvent: TMidiInputBufferItem;
  63.     thisCtlInfo: PMidiCtlInfo;
  64.     thisBuffer: PCircularBuffer;
  65.  
  66. Begin
  67.  
  68.     case wMsg of
  69.  
  70.         mim_Open: {nothing};
  71.  
  72.         mim_Error: {TODO: handle (message to trigger exception?) };
  73.  
  74.         mim_Data, mim_Longdata, mim_Longerror:
  75.             { Note: mim_Longerror included because there's a bug in the Maui
  76.             input driver that sends MIM_LONGERROR for subsequent buffers when
  77.             the input buffer is smaller than the sysex block being received }
  78.  
  79.             begin
  80.             { TODO: Make filtered messages customisable, I'm sure someone wants to
  81.             do something with MTC! }
  82.             if (dwParam1 <> MIDI_ACTIVESENSING) and
  83.                             (dwParam1 <> MIDI_TIMINGCLOCK) then
  84.                 begin
  85.  
  86.                 { The device driver passes us the instance data pointer we
  87.                 specified for midiInOpen. Use this to get the buffer address
  88.                 and window handle for the MIDI control }
  89.                 thisCtlInfo := PMidiCtlInfo(dwInstance);
  90.                 thisBuffer := thisCtlInfo^.PBuffer;
  91.  
  92.                 { Screen out short messages if we've been asked to }
  93.                 if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
  94.                     and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
  95.                     begin
  96.                     with thisEvent do
  97.                         begin
  98.                         timestamp := dwParam2;
  99.                         if (wMsg = mim_Longdata) or
  100.                             (wMsg = mim_Longerror) then
  101.                             begin
  102.                             data := 0;
  103.                             sysex := PMidiHdr(dwParam1);
  104.                             end
  105.                         else
  106.                             begin
  107.                             data := dwParam1;
  108.                             sysex := Nil;
  109.                             end;
  110.                         end;
  111.                     if CircbufPutEvent( thisBuffer, @thisEvent ) then
  112.                         { Send a message to the control to say input's arrived }
  113.                         PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
  114.                     else
  115.                         { Buffer overflow }
  116.                         PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
  117.                     end;
  118.                 end;
  119.             end;
  120.  
  121.         mom_Done:    { Sysex output complete, dwParam1 is pointer to MIDIHDR }
  122.             begin
  123.             { Notify the control that its sysex output is finished.
  124.               The control should call midiOutUnprepareHeader before freeing the buffer }
  125.             PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
  126.             end;
  127.  
  128.     end;    { Case }
  129. end;
  130.  
  131. end.
  132.