aboutsummaryrefslogblamecommitdiffstats
path: root/Game/Code/lib/midi/Midiin.pas
blob: 32a17c51e287c716b7066bd598a40c56c058ef64 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712







































































































































































































































































































































































































































































































































































































































































































































                                                                                          
{ $Header: /MidiComp/Midiin.pas 2     10/06/97 7:33 Davec $ }

{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
  released to the public domain. }

unit MidiIn;

{
  Properties:
 DeviceID: 	Windows numeric device ID for the MIDI input device.
 Between 0 and NumDevs-1.
 Read-only while device is open, exception when changed while open

 MIDIHandle:	The input handle to the MIDI device.
 0 when device is not open
 Read-only, runtime-only

 MessageCount:	Number of input messages waiting in input buffer

 Capacity:	Number of messages input buffer can hold
 Defaults to 1024
 Limited to (64K/event size)
 Read-only when device is open (exception when changed while open)

 SysexBufferSize:	Size in bytes of each sysex buffer
 Defaults to 10K
 Minimum 0K (no buffers), Maximum 64K-1

 SysexBufferCount:	Number of sysex buffers
 Defaults to 16
 Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize)
 Check where these buffers are allocated?

 SysexOnly: True to ignore all non-sysex input events. May be changed while
 device is open. Handy for patch editors where you have lots of short MIDI
 events on the wire which you are always going to ignore anyway.

 DriverVersion: Version number of MIDI device driver. High-order byte is
 major version, low-order byte is minor version.

 ProductName: Name of product (e.g. 'MPU 401 In')

 MID and PID: Manufacturer ID and Product ID, see
 "Manufacturer and Product IDs" in MMSYSTEM.HLP for list of possible values.

  Methods:
 GetMidiEvent: Read Midi event at the head of the FIFO input buffer.
 Returns a TMyMidiEvent object containing MIDI message data, timestamp,
 and sysex data if applicable.
 This method automatically removes the event from the input buffer.
 It makes a copy of the received sysex buffer and puts the buffer back
 on the input device.
 The TMyMidiEvent object must be freed by calling MyMidiEvent.Free.

 Open: Opens device. Note no input will appear until you call the Start
 method.

 Close: Closes device. Any pending system exclusive output will be cancelled.

 Start: Starts receiving MIDI input.

 Stop: Stops receiving MIDI input.

  Events:
 OnMidiInput: Called when MIDI input data arrives. Use the GetMidiEvent to
 get the MIDI input data.

 OnOverflow: Called if the MIDI input buffer overflows. The caller must
 clear the buffer before any more MIDI input can be received.

 Notes:
 Buffering: Uses a circular buffer, separate pointers for next location
 to fill and next location to empty because a MIDI input interrupt may
 be adding data to the buffer while the buffer is being read. Buffer
 pointers wrap around from end to start of buffer automatically. If
 buffer overflows then the OnBufferOverflow event is triggered and no
 further input will be received until the buffer is emptied by calls
 to GetMidiEvent.

 Sysex buffers: There are (SysexBufferCount) buffers on the input device.
 When sysex events arrive these buffers are removed from the input device and
 added to the circular buffer by the interrupt handler in the DLL.  When the sysex events
 are removed from the circular buffer by the GetMidiEvent method the buffers are
 put back on the input. If all the buffers are used up there will be no
 more sysex input until at least one sysex event is removed from the input buffer.
 In other	words if you're expecting lots of sysex input you need to set the
 SysexBufferCount property high enough so that you won't run out of
 input buffers before you get a chance to read them with GetMidiEvent.

 If the synth sends a block of sysex that's longer than SysexBufferSize it
 will be received as separate events.
 TODO: Component derived from this one that handles >64K sysex blocks cleanly
 and can stream them to disk.

 Midi Time Code (MTC) and Active Sensing: The DLL is currently hardcoded
 to filter these short events out, so that we don't spend all our time
 processing them.
 TODO: implement a filter property to select the events that will be filtered
 out.
}

interface

uses
  Classes, SysUtils, WinTypes, Messages, WinProcs, MMSystem, MidiDefs, MidiType,
  MidiCons, Circbuf, Delphmcb;

type
  MidiInputState = (misOpen, misClosed, misCreating, misDestroying);
  EMidiInputError = class(Exception);

 {-------------------------------------------------------------------}
  TMidiInput = class(TComponent)
  private
    Handle: THandle; { Window handle used for callback notification }
    FDeviceID: Word; { MIDI device ID }
    FMIDIHandle: HMIDIIn; { Handle to input device }
    FState: MidiInputState; { Current device state }

    FError: Word;
    FSysexOnly: Boolean;

 { Stuff from MIDIINCAPS }
    FDriverVersion: Version;
    FProductName: string;
    FMID: Word; { Manufacturer ID }
    FPID: Word; { Product ID }

 { Queue }
    FCapacity: Word; { Buffer capacity }
    PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method }
    FNumdevs: Word; { Number of input devices on system }

 { Events }
    FOnMIDIInput: TNotifyEvent; { MIDI Input arrived }
    FOnOverflow: TNotifyEvent; { Input buffer overflow }
 { TODO: Some sort of error handling event for MIM_ERROR }

 { Sysex }
    FSysexBufferSize: Word;
    FSysexBufferCount: Word;
    MidiHdrs: Tlist;

    PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }

  protected
    procedure Prepareheaders;
    procedure UnprepareHeaders;
    procedure AddBuffers;
    procedure SetDeviceID(DeviceID: Word);
    procedure SetProductName(NewProductName: string);
    function GetEventCount: Word;
    procedure SetSysexBufferSize(BufferSize: Word);
    procedure SetSysexBufferCount(BufferCount: Word);
    procedure SetSysexOnly(bSysexOnly: Boolean);
    function MidiInErrorString(WError: Word): string;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property MIDIHandle: HMIDIIn read FMIDIHandle;

    property DriverVersion: Version read FDriverVersion;
    property MID: Word read FMID; { Manufacturer ID }
    property PID: Word read FPID; { Product ID }

    property Numdevs: Word read FNumdevs;

    property MessageCount: Word read GetEventCount;
 { TODO: property to select which incoming messages get filtered out }

    procedure Open;
    procedure Close;
    procedure Start;
    procedure Stop;
 { Get first message in input queue }
    function GetMidiEvent: TMyMidiEvent;
    procedure MidiInput(var Message: TMessage);

   { Some functions to decode and classify incoming messages would be good }

  published

 { TODO: Property editor with dropdown list of product names }
    property ProductName: string read FProductName write SetProductName;

    property DeviceID: Word read FDeviceID write SetDeviceID default 0;
    property Capacity: Word read FCapacity write FCapacity default 1024;
    property Error: Word read FError;
    property SysexBufferSize: Word
      read FSysexBufferSize
      write SetSysexBufferSize
      default 10000;
    property SysexBufferCount: Word
      read FSysexBufferCount
      write SetSysexBufferCount
      default 16;
    property SysexOnly: Boolean
      read FSysexOnly
      write SetSysexOnly
      default False;

 { Events }
    property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput;
    property OnOverflow: TNotifyEvent read FOnOverflow write FOnOverflow;

  end;

procedure Register;

{====================================================================}
implementation

uses Controls,
     Forms,
     Graphics;

(* Not used in Delphi 3
{ This is the callback procedure in the external DLL.
  It's used when midiInOpen is called by the Open method.
  There are special requirements and restrictions for this callback
  procedure (see midiInOpen in MMSYSTEM.HLP) so it's impractical to
  make it an object method }
{$IFDEF WIN32}
function midiHandler(
    hMidiIn: HMidiIn;
    wMsg: UINT;
    dwInstance: DWORD;
    dwParam1: DWORD;
    dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
{$ELSE}
procedure midiHandler(
    hMidiIn: HMidiIn;
    wMsg: Word;
    dwInstance: DWORD;
    dwParam1: DWORD;
    dwParam2: DWORD); far; external 'DELPHMID';
{$ENDIF}
*)
{-------------------------------------------------------------------}

constructor TMidiInput.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FState := misCreating;

  FSysexOnly := False;
  FNumDevs := midiInGetNumDevs;
  MidiHdrs := nil;

 { Set defaults }
  if  (FNumDevs > 0) then
    SetDeviceID(0);
  FCapacity := 1024;
  FSysexBufferSize := 4096;
  FSysexBufferCount := 16;

 { Create the window for callback notification }
  if not (csDesigning in ComponentState) then
  begin
    Handle := AllocateHwnd(MidiInput);
  end;

  FState := misClosed;

end;

{-------------------------------------------------------------------}
{ Close the device if it's open }

destructor TMidiInput.Destroy;
begin
  if (FMidiHandle <> 0) then
  begin
    Close;
    FMidiHandle := 0;
  end;

  if (PCtlInfo <> nil) then
    GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);

  DeallocateHwnd(Handle);
  inherited Destroy;
end;

{-------------------------------------------------------------------}
{ Convert the numeric return code from an MMSYSTEM function to a string
  using midiInGetErrorText. TODO: These errors aren't very helpful
  (e.g. "an invalid parameter was passed to a system function") so
  sort out some proper error strings. }

function TMidiInput.MidiInErrorString(WError: Word): string;
var
  errorDesc: PChar;
begin
  errorDesc := nil;
  try
    errorDesc := StrAlloc(MAXERRORLENGTH);
    if midiInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
      result := StrPas(errorDesc)
    else
      result := 'Specified error number is out of range';
  finally
    if errorDesc <> nil then StrDispose(errorDesc);
  end;
end;

{-------------------------------------------------------------------}
{ Set the sysex buffer size, fail if device is already open }

procedure TMidiInput.SetSysexBufferSize(BufferSize: Word);
begin
  if FState = misOpen then
    raise EMidiInputError.Create('Change to SysexBufferSize while device was open')
  else
  { TODO: Validate the sysex buffer size. Is this necessary for WIN32? }
    FSysexBufferSize := BufferSize;
end;

{-------------------------------------------------------------------}
{ Set the sysex buffer count, fail if device is already open }

procedure TMidiInput.SetSysexBuffercount(Buffercount: Word);
begin
  if FState = misOpen then
    raise EMidiInputError.Create('Change to SysexBuffercount while device was open')
  else
  { TODO: Validate the sysex buffer count }
    FSysexBuffercount := Buffercount;
end;

{-------------------------------------------------------------------}
{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages }

procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean);
begin
  FSysexOnly := bSysexOnly;
 { Update the interrupt handler's copy of this property }
  if PCtlInfo <> nil then
    PCtlInfo^.SysexOnly := bSysexOnly;
end;

{-------------------------------------------------------------------}
{ Set the Device ID to select a new MIDI input device
  Note: If no MIDI devices are installed, throws an 'Invalid Device ID' exception }

procedure TMidiInput.SetDeviceID(DeviceID: Word);
var
  MidiInCaps: TMidiInCaps;
begin
  if FState = misOpen then
    raise EMidiInputError.Create('Change to DeviceID while device was open')
  else
    if (DeviceID >= midiInGetNumDevs) then
      raise EMidiInputError.Create('Invalid device ID')
    else
    begin
      FDeviceID := DeviceID;

   { Set the name and other MIDIINCAPS properties to match the ID }
      FError :=
        midiInGetDevCaps(DeviceID, @MidiInCaps, sizeof(TMidiInCaps));
      if Ferror <> MMSYSERR_NOERROR then
        raise EMidiInputError.Create(MidiInErrorString(FError));

      FProductName := StrPas(MidiInCaps.szPname);
      FDriverVersion := MidiInCaps.vDriverVersion;
      FMID := MidiInCaps.wMID;
      FPID := MidiInCaps.wPID;

    end;
end;

{-------------------------------------------------------------------}
{ Set the product name and put the matching input device number in FDeviceID.
  This is handy if you want to save a configured input/output device
  by device name instead of device number, because device numbers may
  change if users add or remove MIDI devices.
  Exception if input device with matching name not found,
  or if input device is open }

procedure TMidiInput.SetProductName(NewProductName: string);
var
  MidiInCaps: TMidiInCaps;
  testDeviceID: Word;
  testProductName: string;
begin
  if FState = misOpen then
    raise EMidiInputError.Create('Change to ProductName while device was open')
  else
  { Don't set the name if the component is reading properties because
 the saved Productname will be from the machine the application was compiled
 on, which may not be the same for the corresponding DeviceID on the user's
 machine. The FProductname property will still be set by SetDeviceID }
    if not (csLoading in ComponentState) then
    begin
      begin
        for testDeviceID := 0 to (midiInGetNumDevs - 1) do
        begin
          FError :=
            midiInGetDevCaps(testDeviceID, @MidiInCaps, sizeof(TMidiInCaps));
          if Ferror <> MMSYSERR_NOERROR then
            raise EMidiInputError.Create(MidiInErrorString(FError));
          testProductName := StrPas(MidiInCaps.szPname);
          if testProductName = NewProductName then
          begin
            FProductName := NewProductName;
            Break;
          end;
        end;
        if FProductName <> NewProductName then
          raise EMidiInputError.Create('MIDI Input Device ' +
            NewProductName + ' not installed ')
        else
          SetDeviceID(testDeviceID);
      end;
    end;
end;


{-------------------------------------------------------------------}
{ Get the sysex buffers ready }

procedure TMidiInput.PrepareHeaders;
var
  ctr: Word;
  MyMidiHdr: TMyMidiHdr;
begin
  if (FSysexBufferCount > 0) and (FSysexBufferSize > 0)
    and (FMidiHandle <> 0) then
  begin
    Midihdrs := TList.Create;
    for ctr := 1 to FSysexBufferCount do
    begin
   { Initialize the header and allocate buffer memory }
      MyMidiHdr := TMyMidiHdr.Create(FSysexBufferSize);

   { Store the address of the MyMidiHdr object in the contained MIDIHDR
              structure so we can get back to the object when a pointer to the
              MIDIHDR is received.
              E.g. see TMidiOutput.Output method }
      MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);

   { Get MMSYSTEM's blessing for this header }
      FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
        sizeof(TMIDIHDR));
      if Ferror <> MMSYSERR_NOERROR then
        raise EMidiInputError.Create(MidiInErrorString(FError));

   { Save it in our list }
      MidiHdrs.Add(MyMidiHdr);
    end;
  end;

end;

{-------------------------------------------------------------------}
{ Clean up from PrepareHeaders }

procedure TMidiInput.UnprepareHeaders;
var
  ctr: Word;
begin
  if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers }
  begin
    for ctr := 0 to MidiHdrs.Count - 1 do
    begin
      FError := midiInUnprepareHeader(FMidiHandle,
        TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
        sizeof(TMIDIHDR));
      if Ferror <> MMSYSERR_NOERROR then
        raise EMidiInputError.Create(MidiInErrorString(FError));
      TMyMidiHdr(MidiHdrs.Items[ctr]).Free;
    end;
    MidiHdrs.Free;
    MidiHdrs := nil;
  end;
end;

{-------------------------------------------------------------------}
{ Add sysex buffers, if required, to input device }

procedure TMidiInput.AddBuffers;
var
  ctr: Word;
begin
  if MidiHdrs <> nil then { will be Nil if 0 sysex buffers }
  begin
    if MidiHdrs.Count > 0 then
    begin
      for ctr := 0 to MidiHdrs.Count - 1 do
      begin
        FError := midiInAddBuffer(FMidiHandle,
          TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
          sizeof(TMIDIHDR));
        if FError <> MMSYSERR_NOERROR then
          raise EMidiInputError.Create(MidiInErrorString(FError));
      end;
    end;
  end;
end;

{-------------------------------------------------------------------}

procedure TMidiInput.Open;
var
  hMem: THandle;
begin
  try
  { Create the buffer for the MIDI input messages }
    if (PBuffer = nil) then
      PBuffer := CircBufAlloc(FCapacity);

  { Create the control info for the DLL }
    if (PCtlInfo = nil) then
    begin
      PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
      PctlInfo^.hMem := hMem;
    end;
    PctlInfo^.pBuffer := PBuffer;
    Pctlinfo^.hWindow := Handle; { Control's window handle }
    PCtlInfo^.SysexOnly := FSysexOnly;
    FError := midiInOpen(@FMidiHandle, FDeviceId,
      DWORD(@midiHandler),
      DWORD(PCtlInfo),
      CALLBACK_FUNCTION);

    if (FError <> MMSYSERR_NOERROR) then
   { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
      raise EMidiInputError.Create(MidiInErrorString(FError));

  { Get sysex buffers ready }
    PrepareHeaders;

  { Add them to the input }
    AddBuffers;

    FState := misOpen;

  except
    if PBuffer <> nil then
    begin
      CircBufFree(PBuffer);
      PBuffer := nil;
    end;

    if PCtlInfo <> nil then
    begin
      GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
      PCtlInfo := nil;
    end;

  end;

end;

{-------------------------------------------------------------------}

function TMidiInput.GetMidiEvent: TMyMidiEvent;
var
  thisItem: TMidiBufferItem;
begin
  if (FState = misOpen) and
    CircBufReadEvent(PBuffer, @thisItem) then
  begin
    Result := TMyMidiEvent.Create;
    with thisItem do
    begin
      Result.Time := Timestamp;
      if (Sysex = nil) then
      begin
    { Short message }
        Result.MidiMessage := LoByte(LoWord(Data));
        Result.Data1 := HiByte(LoWord(Data));
        Result.Data2 := LoByte(HiWord(Data));
        Result.Sysex := nil;
        Result.SysexLength := 0;
      end
      else
             { Long Sysex message }
      begin
        Result.MidiMessage := MIDI_BEGINSYSEX;
        Result.Data1 := 0;
        Result.Data2 := 0;
        Result.SysexLength := Sysex^.dwBytesRecorded;
        if Sysex^.dwBytesRecorded <> 0 then
        begin
     { Put a copy of the sysex buffer in the object }
          GetMem(Result.Sysex, Sysex^.dwBytesRecorded);
          StrMove(Result.Sysex, Sysex^.lpData, Sysex^.dwBytesRecorded);
        end;

    { Put the header back on the input buffer }
        FError := midiInPrepareHeader(FMidiHandle, Sysex,
          sizeof(TMIDIHDR));
        if Ferror = 0 then
          FError := midiInAddBuffer(FMidiHandle,
            Sysex, sizeof(TMIDIHDR));
        if Ferror <> MMSYSERR_NOERROR then
          raise EMidiInputError.Create(MidiInErrorString(FError));
      end;
    end;
    CircbufRemoveEvent(PBuffer);
  end
  else
  { Device isn't open, return a nil event }
    Result := nil;
end;

{-------------------------------------------------------------------}

function TMidiInput.GetEventCount: Word;
begin
  if FState = misOpen then
    Result := PBuffer^.EventCount
  else
    Result := 0;
end;

{-------------------------------------------------------------------}

procedure TMidiInput.Close;
begin
  if FState = misOpen then
  begin
    FState := misClosed;

  { MidiInReset cancels any pending output.
  Note that midiInReset causes an MIM_LONGDATA callback for each sysex
  buffer on the input, so the callback function and Midi input buffer
  should still be viable at this stage.
  All the resulting MIM_LONGDATA callbacks will be completed by the time
  MidiInReset returns, though. }
    FError := MidiInReset(FMidiHandle);
    if Ferror <> MMSYSERR_NOERROR then
      raise EMidiInputError.Create(MidiInErrorString(FError));

  { Remove sysex buffers from input device and free them }
    UnPrepareHeaders;

  { Close the device (finally!) }
    FError := MidiInClose(FMidiHandle);
    if Ferror <> MMSYSERR_NOERROR then
      raise EMidiInputError.Create(MidiInErrorString(FError));

    FMidiHandle := 0;

    if (PBuffer <> nil) then
    begin
      CircBufFree(PBuffer);
      PBuffer := nil;
    end;
  end;
end;

{-------------------------------------------------------------------}

procedure TMidiInput.Start;
begin
  if FState = misOpen then
  begin
    FError := MidiInStart(FMidiHandle);
    if Ferror <> MMSYSERR_NOERROR then
      raise EMidiInputError.Create(MidiInErrorString(FError));
  end;
end;

{-------------------------------------------------------------------}

procedure TMidiInput.Stop;
begin
  if FState = misOpen then
  begin
    FError := MidiInStop(FMidiHandle);
    if Ferror <> MMSYSERR_NOERROR then
      raise EMidiInputError.Create(MidiInErrorString(FError));
  end;
end;

{-------------------------------------------------------------------}

procedure TMidiInput.MidiInput(var Message: TMessage);
{ Triggered by incoming message from DLL.
  Note DLL has already put the message in the queue }
begin
  case Message.Msg of
    mim_data:
  { Trigger the user's MIDI input event, if they've specified one and
  we're not in the process of closing the device. The check for
  GetEventCount > 0 prevents unnecessary event calls where the user has
  already cleared all the events from the input buffer using a GetMidiEvent
  loop in the OnMidiInput event handler }
      if Assigned(FOnMIDIInput) and (FState = misOpen)
        and (GetEventCount > 0) then
        FOnMIDIInput(Self);

    mim_Overflow: { input circular buffer overflow }
      if Assigned(FOnOverflow) and (FState = misOpen) then
        FOnOverflow(Self);
  end;
end;

{-------------------------------------------------------------------}

procedure Register;
begin
  RegisterComponents('Synth', [TMIDIInput]);
end;

end.