controls/midi/KolDelphmcb.pas

   1 {
   2
   3        Unit: KOLDELPHIMCB
   4     purpose: Midi Callback
   5      Author: KOL translation and > 64 sysex buffering: Thaddy de Koning
   6              Original Author: David Churcher
   7   Copyright: released to the public domain
   8     Remarks: Well known Great components.
   9              Do not confuse this with my project JEDI midi translation for KOL
  10 }
  11 { $Header: /MidiComp/DELPHMCB.PAS 2     10/06/97 7:33 Davec $ }
  12
  13 {MIDI callback for Delphi, was DLL for Delphi 1}
  14
  15 unit KOLDELPHMCB;
  16
  17 interface
  18
  19 uses Kol, windows, MMsystem, KolCircbuf, KolMidiDefs, KolMidiCons;
  20
  21 procedure midiHandler(
  22                   hMidiIn: HMidiIn;
  23                   wMsg: UINT;
  24                   dwInstance: DWORD;
  25                   dwParam1: DWORD;
  26                   dwParam2: DWORD); stdcall ;//export;
  27 function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; //export;
  28
  29 implementation
  30
  31 { Add an event to the circular input buffer. }
  32 function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean;
  33 begin
  34         If (PBuffer^.EventCount < PBuffer^.Capacity) Then
  35                 begin
  36                 Inc(Pbuffer^.EventCount);
  37
  38                 { Todo: better way of copying this record }
  39                 with PBuffer^.PNextput^ do
  40                         begin
  41                         Timestamp := PTheEvent^.Timestamp;
  42                         Data := PTheEvent^.Data;
  43                         Sysex := PTheEvent^.Sysex;
  44           end;
  45
  46                 { Move to next put location, with wrap }
  47                 Inc(Pbuffer^.PNextPut);
  48                 If (PBuffer^.PNextPut = PBuffer^.PEnd) then
  49                         PBuffer^.PNextPut := PBuffer^.PStart;
  50
  51                 CircbufPutEvent := True;
  52                 end
  53         else
  54                 CircbufPutEvent := False;
  55 end;
  56
  57 { This is the callback function specified when the MIDI device was opened
  58   by midiInOpen. It's called at interrupt time when MIDI input is seen
  59   by the MIDI device driver(s). See the docs for midiInOpen for restrictions
  60   on the Windows functions that can be called in this interrupt. }
  61 procedure midiHandler(
  62                   hMidiIn: HMidiIn;
  63                   wMsg: UINT;
  64                   dwInstance: DWORD;
  65                   dwParam1: DWORD;
  66                   dwParam2: DWORD);
  67
  68 var
  69         thisEvent: TMidiBufferItem;
  70         thisCtlInfo: PMidiCtlInfo;
  71         thisBuffer: PCircularBuffer;
  72
  73 Begin
  74         case wMsg of
  75
  76                 mim_Open: {nothing};
  77
  78                 mim_Error: {TODO: handle (message to trigger exception?) };
  79
  80                 mim_Data, mim_Longdata, mim_Longerror:
  81                         { Note: mim_Longerror included because there's a bug in the Maui
  82                         input driver that sends MIM_LONGERROR for subsequent buffers when
  83                         the input buffer is smaller than the sysex block being received }
  84
  85                         begin
  86                         { TODO: Make filtered messages customisable, I'm sure someone wants to
  87                         do something with MTC! }
  88                         if (dwParam1 <> MIDI_ACTIVESENSING) and
  89                                                         (dwParam1 <> MIDI_TIMINGCLOCK) then
  90                                 begin
  91
  92                                 { The device driver passes us the instance data pointer we
  93                                 specified for midiInOpen. Use this to get the buffer address
  94                                 and window handle for the MIDI control }
  95                                 thisCtlInfo := PMidiCtlInfo(dwInstance);
  96                                 thisBuffer := thisCtlInfo^.PBuffer;
  97
  98                                 { Screen out short messages if we've been asked to }
  99                                 if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
 100                                         and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
 101                                         begin
 102                                         with thisEvent do
 103                                                 begin
 104                                                 timestamp := dwParam2;
 105                                                 if (wMsg = mim_Longdata) or
 106                                                         (wMsg = mim_Longerror) then
 107                                                         begin
 108                                                         data := 0;
 109                                                         sysex := PMidiHdr(dwParam1);
 110                                                         end
 111                                                 else
 112                                                         begin
 113                                                         data := dwParam1;
 114                                                         sysex := Nil;
 115                                                         end;
 116                                                 end;
 117                                         if CircbufPutEvent( thisBuffer, @thisEvent ) then
 118                                                 { Send a message to the control to say input's arrived }
 119                                                 PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
 120                                         else
 121                                                 { Buffer overflow }
 122                                                 PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
 123                                         end;
 124                                 end;
 125                         end;
 126
 127                 mom_Done:       { Sysex output complete, dwParam1 is pointer to MIDIHDR }
 128                         begin
 129                         { Notify the control that its sysex output is finished.
 130                           The control should call midiOutUnprepareHeader before freeing the buffer }
 131                         PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
 132                         end;
 133
 134         end;    { Case }
 135 end;
 136
 137 end.