- set svn:eol-style to native

- removed some svn:executable properties from non-executable files

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1144 b956fd51-792f-4845-bead-9b4dfca2ff2c

13 files changed, 3374 insertions, 3374 deletions

diff --git a/Game/Code/lib/midi/CIRCBUF.PAS b/Game/Code/lib/midi/CIRCBUF.PAS
index c741230e..77cb3643 100644
--- a/Game/Code/lib/midi/CIRCBUF.PAS
+++ b/Game/Code/lib/midi/CIRCBUF.PAS
@@ -1,183 +1,183 @@
-{ $Header: /MidiComp/CIRCBUF.PAS 2     10/06/97 7:33 Davec $ }

-

-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,

-  released to the public domain. }

-

-

-{ A First-In First-Out circular buffer.

-  Port of circbuf.c from Microsoft's Windows MIDI monitor example.

-  I did do a version of this as an object (see Rev 1.1) but it was getting too 

-  complicated and I couldn't see any real benefits to it so I dumped it 

-  for an ordinary memory buffer with pointers. 

-

-  This unit is a bit C-like, everything is done with pointers and extensive

-  use is made of the undocumented feature of the Inc() function that 

-  increments pointers by the size of the object pointed to.

-  All of this could probably be done using Pascal array notation with

-  range-checking turned off, but I'm not sure it's worth it.

-}

-

-Unit Circbuf;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-Uses

-  Windows,

-  MMSystem;

-

-type

-	{ MIDI input event }

-	TMidiBufferItem = record

-	  	timestamp: DWORD;	{ Timestamp in milliseconds after midiInStart }

-		data: DWORD;		{ MIDI message received }

-		sysex: PMidiHdr;	{ Pointer to sysex MIDIHDR, nil if not sysex }

-	end;

-	PMidiBufferItem = ^TMidiBufferItem;

-

-	{ MIDI input buffer }

-	TCircularBuffer = record

-		RecordHandle: HGLOBAL;		{ Windows memory handle for this record }

-		BufferHandle: HGLOBAL;		{ Windows memory handle for the buffer }

-		pStart: PMidiBufferItem;		{ ptr to start of buffer }

-		pEnd: PMidiBufferItem;			{ ptr to end of buffer }

-		pNextPut: PMidiBufferItem;		{ next location to fill }

-		pNextGet: PMidiBufferItem;		{ next location to empty }

-		Error: Word;		 		{ error code from MMSYSTEM functions }

-		Capacity: Word;				{ buffer size (in TMidiBufferItems) }

-		EventCount: Word;			{ Number of events in buffer }

-	end;

-

-   PCircularBuffer = ^TCircularBuffer;

-

-function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;

-procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );

-

-function CircbufAlloc( Capacity: Word ): PCircularBuffer;

-procedure CircbufFree( PBuffer: PCircularBuffer );

-function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;

-function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;

-{ Note: The PutEvent function is in the DLL }

-

-implementation

-

-{ Allocates in global shared memory, returns pointer and handle }

-function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;

-var

-	ptr: Pointer;

-begin

-	{ Allocate the buffer memory }

-	hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );

-

-	if (hMem = 0) then

-		ptr := Nil

-	else

-		begin

-		ptr := GlobalLock(hMem);

-		if (ptr = Nil) then

-			GlobalFree(hMem);

-		end;

-

-	GlobalSharedLockedAlloc := Ptr;

-end;

-

-procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );

-begin

-	if (hMem <> 0) then

-		begin

-		GlobalUnlock(hMem);

-		GlobalFree(hMem);

-		end;

-end;

-

-function CircbufAlloc( Capacity: Word ): PCircularBuffer;

-var

-	NewCircularBuffer: PCircularBuffer;

-	NewMIDIBuffer: PMidiBufferItem;

-	hMem: HGLOBAL;

-begin

-	{ TODO: Validate circbuf size, <64K }

-	NewCircularBuffer :=

-		GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );

-	if (NewCircularBuffer <> Nil) then

-		begin

-		NewCircularBuffer^.RecordHandle := hMem;

-		NewMIDIBuffer :=

-			GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );

-		if (NewMIDIBuffer = Nil) then

-			begin

-			{ TODO: Exception here? }

-			GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,

-											NewCircularBuffer );

-			NewCircularBuffer := Nil;

-			end

-		else

-			begin

-                	NewCircularBuffer^.pStart := NewMidiBuffer;

-			{ Point to item at end of buffer }

-			NewCircularBuffer^.pEnd := NewMidiBuffer;

-			Inc(NewCircularBuffer^.pEnd, Capacity);

-			{ Start off the get and put pointers in the same position. These

-			  will get out of sync as the interrupts start rolling in }

-			NewCircularBuffer^.pNextPut := NewMidiBuffer;

-			NewCircularBuffer^.pNextGet := NewMidiBuffer;

-			NewCircularBuffer^.Error := 0;

-			NewCircularBuffer^.Capacity := Capacity;

-			NewCircularBuffer^.EventCount := 0;

-			end;

-		end;

-	CircbufAlloc := NewCircularBuffer;

-end;

-

-procedure CircbufFree( pBuffer: PCircularBuffer );

-begin

-	if (pBuffer <> Nil) then

-		begin

-		GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);

-		GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);

-		end;

-end;

-

-{ Reads first event in queue without removing it.

-  Returns true if successful, False if no events in queue }

-function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;

-var

-	PCurrentEvent: PMidiBufferItem;

-begin

-	if (PBuffer^.EventCount <= 0) then

-			CircbufReadEvent := False

-	else

-		begin

-		PCurrentEvent := PBuffer^.PNextget;

-

-		{ Copy the object from the "tail" of the buffer to the caller's object }

-		PEvent^.Timestamp := PCurrentEvent^.Timestamp;

-		PEvent^.Data := PCurrentEvent^.Data;

-        PEvent^.Sysex := PCurrentEvent^.Sysex;

-		CircbufReadEvent := True;

-		end;

-end;

-

-{ Remove current event from the queue }

-function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;

-begin

-	if (PBuffer^.EventCount > 0) then

-		begin

-		Dec( Pbuffer^.EventCount);

-

-		{ Advance the buffer pointer, with wrap }

-		Inc( Pbuffer^.PNextGet );

-		If (PBuffer^.PNextGet = PBuffer^.PEnd) then

-			PBuffer^.PNextGet := PBuffer^.PStart;

-

-		CircbufRemoveEvent := True;

-		end

-	else

-		CircbufRemoveEvent := False;

-end;

-

-end.

+{ $Header: /MidiComp/CIRCBUF.PAS 2     10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+  released to the public domain. }
+
+
+{ A First-In First-Out circular buffer.
+  Port of circbuf.c from Microsoft's Windows MIDI monitor example.
+  I did do a version of this as an object (see Rev 1.1) but it was getting too 
+  complicated and I couldn't see any real benefits to it so I dumped it 
+  for an ordinary memory buffer with pointers. 
+
+  This unit is a bit C-like, everything is done with pointers and extensive
+  use is made of the undocumented feature of the Inc() function that 
+  increments pointers by the size of the object pointed to.
+  All of this could probably be done using Pascal array notation with
+  range-checking turned off, but I'm not sure it's worth it.
+}
+
+Unit Circbuf;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+Uses
+  Windows,
+  MMSystem;
+
+type
+	{ MIDI input event }
+	TMidiBufferItem = record
+	  	timestamp: DWORD;	{ Timestamp in milliseconds after midiInStart }
+		data: DWORD;		{ MIDI message received }
+		sysex: PMidiHdr;	{ Pointer to sysex MIDIHDR, nil if not sysex }
+	end;
+	PMidiBufferItem = ^TMidiBufferItem;
+
+	{ MIDI input buffer }
+	TCircularBuffer = record
+		RecordHandle: HGLOBAL;		{ Windows memory handle for this record }
+		BufferHandle: HGLOBAL;		{ Windows memory handle for the buffer }
+		pStart: PMidiBufferItem;		{ ptr to start of buffer }
+		pEnd: PMidiBufferItem;			{ ptr to end of buffer }
+		pNextPut: PMidiBufferItem;		{ next location to fill }
+		pNextGet: PMidiBufferItem;		{ next location to empty }
+		Error: Word;		 		{ error code from MMSYSTEM functions }
+		Capacity: Word;				{ buffer size (in TMidiBufferItems) }
+		EventCount: Word;			{ Number of events in buffer }
+	end;
+
+   PCircularBuffer = ^TCircularBuffer;
+
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+procedure CircbufFree( PBuffer: PCircularBuffer );
+function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+{ Note: The PutEvent function is in the DLL }
+
+implementation
+
+{ Allocates in global shared memory, returns pointer and handle }
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+var
+	ptr: Pointer;
+begin
+	{ Allocate the buffer memory }
+	hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
+
+	if (hMem = 0) then
+		ptr := Nil
+	else
+		begin
+		ptr := GlobalLock(hMem);
+		if (ptr = Nil) then
+			GlobalFree(hMem);
+		end;
+
+	GlobalSharedLockedAlloc := Ptr;
+end;
+
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+begin
+	if (hMem <> 0) then
+		begin
+		GlobalUnlock(hMem);
+		GlobalFree(hMem);
+		end;
+end;
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+var
+	NewCircularBuffer: PCircularBuffer;
+	NewMIDIBuffer: PMidiBufferItem;
+	hMem: HGLOBAL;
+begin
+	{ TODO: Validate circbuf size, <64K }
+	NewCircularBuffer :=
+		GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
+	if (NewCircularBuffer <> Nil) then
+		begin
+		NewCircularBuffer^.RecordHandle := hMem;
+		NewMIDIBuffer :=
+			GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );
+		if (NewMIDIBuffer = Nil) then
+			begin
+			{ TODO: Exception here? }
+			GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,
+											NewCircularBuffer );
+			NewCircularBuffer := Nil;
+			end
+		else
+			begin
+                	NewCircularBuffer^.pStart := NewMidiBuffer;
+			{ Point to item at end of buffer }
+			NewCircularBuffer^.pEnd := NewMidiBuffer;
+			Inc(NewCircularBuffer^.pEnd, Capacity);
+			{ Start off the get and put pointers in the same position. These
+			  will get out of sync as the interrupts start rolling in }
+			NewCircularBuffer^.pNextPut := NewMidiBuffer;
+			NewCircularBuffer^.pNextGet := NewMidiBuffer;
+			NewCircularBuffer^.Error := 0;
+			NewCircularBuffer^.Capacity := Capacity;
+			NewCircularBuffer^.EventCount := 0;
+			end;
+		end;
+	CircbufAlloc := NewCircularBuffer;
+end;
+
+procedure CircbufFree( pBuffer: PCircularBuffer );
+begin
+	if (pBuffer <> Nil) then
+		begin
+		GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
+		GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
+		end;
+end;
+
+{ Reads first event in queue without removing it.
+  Returns true if successful, False if no events in queue }
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+var
+	PCurrentEvent: PMidiBufferItem;
+begin
+	if (PBuffer^.EventCount <= 0) then
+			CircbufReadEvent := False
+	else
+		begin
+		PCurrentEvent := PBuffer^.PNextget;
+
+		{ Copy the object from the "tail" of the buffer to the caller's object }
+		PEvent^.Timestamp := PCurrentEvent^.Timestamp;
+		PEvent^.Data := PCurrentEvent^.Data;
+        PEvent^.Sysex := PCurrentEvent^.Sysex;
+		CircbufReadEvent := True;
+		end;
+end;
+
+{ Remove current event from the queue }
+function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
+begin
+	if (PBuffer^.EventCount > 0) then
+		begin
+		Dec( Pbuffer^.EventCount);
+
+		{ Advance the buffer pointer, with wrap }
+		Inc( Pbuffer^.PNextGet );
+		If (PBuffer^.PNextGet = PBuffer^.PEnd) then
+			PBuffer^.PNextGet := PBuffer^.PStart;
+
+		CircbufRemoveEvent := True;
+		end
+	else
+		CircbufRemoveEvent := False;
+end;
+
+end.
diff --git a/Game/Code/lib/midi/DELPHMCB.PAS b/Game/Code/lib/midi/DELPHMCB.PAS
index 5d4ad75a..f7ceaa5e 100644
--- a/Game/Code/lib/midi/DELPHMCB.PAS
+++ b/Game/Code/lib/midi/DELPHMCB.PAS
@@ -1,138 +1,138 @@
-{ $Header: /MidiComp/DELPHMCB.PAS 2     10/06/97 7:33 Davec $ }

-

-{MIDI callback for Delphi, was DLL for Delphi 1}

-

-unit Delphmcb;

-

-{ These segment options required for the MIDI callback functions }

-{$C PRELOAD FIXED PERMANENT}

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Windows,

-  MMsystem,

-  Circbuf,

-  MidiDefs,

-  MidiCons;

-

-procedure midiHandler(

-		  hMidiIn: HMidiIn;

-		  wMsg: UINT;

-		  dwInstance: DWORD;

-		  dwParam1: DWORD;

-		  dwParam2: DWORD); stdcall; export;

-function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export;

-

-implementation

-

-{ Add an event to the circular input buffer. }

-function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall;

-begin

-	If (PBuffer^.EventCount < PBuffer^.Capacity) Then

-		begin

-		Inc(Pbuffer^.EventCount);

-

-		{ Todo: better way of copying this record }

-		with PBuffer^.PNextput^ do

-			begin

-			Timestamp := PTheEvent^.Timestamp;

-			Data := PTheEvent^.Data;

-			Sysex := PTheEvent^.Sysex;

-          end;

-

-		{ Move to next put location, with wrap }

-		Inc(Pbuffer^.PNextPut);

-		If (PBuffer^.PNextPut = PBuffer^.PEnd) then

-			PBuffer^.PNextPut := PBuffer^.PStart;

-

-		CircbufPutEvent := True;

-		end

-	else

-		CircbufPutEvent := False;

-end;

-

-{ This is the callback function specified when the MIDI device was opened

-  by midiInOpen. It's called at interrupt time when MIDI input is seen

-  by the MIDI device driver(s). See the docs for midiInOpen for restrictions

-  on the Windows functions that can be called in this interrupt. }

-procedure midiHandler(

-		  hMidiIn: HMidiIn;

-		  wMsg: UINT;

-		  dwInstance: DWORD;

-		  dwParam1: DWORD;

-		  dwParam2: DWORD); stdcall;

-var

-	thisEvent: TMidiBufferItem;

-	thisCtlInfo: PMidiCtlInfo;

-	thisBuffer: PCircularBuffer;

-Begin

-	case wMsg of

-

-		mim_Open: {nothing};

-

-		mim_Error: {TODO: handle (message to trigger exception?) };

-

-		mim_Data, mim_Longdata, mim_Longerror:

-			{ Note: mim_Longerror included because there's a bug in the Maui

-			input driver that sends MIM_LONGERROR for subsequent buffers when

-			the input buffer is smaller than the sysex block being received }

-

-			begin

-			{ TODO: Make filtered messages customisable, I'm sure someone wants to

-			do something with MTC! }

-			if (dwParam1 <> MIDI_ACTIVESENSING) and

-							(dwParam1 <> MIDI_TIMINGCLOCK) then

-				begin

-

-				{ The device driver passes us the instance data pointer we

-				specified for midiInOpen. Use this to get the buffer address

-				and window handle for the MIDI control }

-				thisCtlInfo := PMidiCtlInfo(dwInstance);

-				thisBuffer := thisCtlInfo^.PBuffer;

-

-				{ Screen out short messages if we've been asked to }

-				if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))

-					and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then

-					begin

-					with thisEvent do

-						begin

-						timestamp := dwParam2;

-						if (wMsg = mim_Longdata) or

-							(wMsg = mim_Longerror) then

-							begin

-							data := 0;

-							sysex := PMidiHdr(dwParam1);

-							end

-						else

-							begin

-							data := dwParam1;

-							sysex := Nil;

-							end;

-						end;

-					if CircbufPutEvent( thisBuffer, @thisEvent ) then

-						{ Send a message to the control to say input's arrived }

-						PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)

-					else

-						{ Buffer overflow }

-						PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);

-					end;

-				end;

-			end;

-

-		mom_Done:	{ Sysex output complete, dwParam1 is pointer to MIDIHDR }

-			begin

-			{ Notify the control that its sysex output is finished.

-			  The control should call midiOutUnprepareHeader before freeing the buffer }

-			PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);

-			end;

-

-	end;	{ Case }

-end;

-

-end.

+{ $Header: /MidiComp/DELPHMCB.PAS 2     10/06/97 7:33 Davec $ }
+
+{MIDI callback for Delphi, was DLL for Delphi 1}
+
+unit Delphmcb;
+
+{ These segment options required for the MIDI callback functions }
+{$C PRELOAD FIXED PERMANENT}
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Windows,
+  MMsystem,
+  Circbuf,
+  MidiDefs,
+  MidiCons;
+
+procedure midiHandler(
+		  hMidiIn: HMidiIn;
+		  wMsg: UINT;
+		  dwInstance: DWORD;
+		  dwParam1: DWORD;
+		  dwParam2: DWORD); stdcall; export;
+function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export;
+
+implementation
+
+{ Add an event to the circular input buffer. }
+function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall;
+begin
+	If (PBuffer^.EventCount < PBuffer^.Capacity) Then
+		begin
+		Inc(Pbuffer^.EventCount);
+
+		{ Todo: better way of copying this record }
+		with PBuffer^.PNextput^ do
+			begin
+			Timestamp := PTheEvent^.Timestamp;
+			Data := PTheEvent^.Data;
+			Sysex := PTheEvent^.Sysex;
+          end;
+
+		{ Move to next put location, with wrap }
+		Inc(Pbuffer^.PNextPut);
+		If (PBuffer^.PNextPut = PBuffer^.PEnd) then
+			PBuffer^.PNextPut := PBuffer^.PStart;
+
+		CircbufPutEvent := True;
+		end
+	else
+		CircbufPutEvent := False;
+end;
+
+{ This is the callback function specified when the MIDI device was opened
+  by midiInOpen. It's called at interrupt time when MIDI input is seen
+  by the MIDI device driver(s). See the docs for midiInOpen for restrictions
+  on the Windows functions that can be called in this interrupt. }
+procedure midiHandler(
+		  hMidiIn: HMidiIn;
+		  wMsg: UINT;
+		  dwInstance: DWORD;
+		  dwParam1: DWORD;
+		  dwParam2: DWORD); stdcall;
+var
+	thisEvent: TMidiBufferItem;
+	thisCtlInfo: PMidiCtlInfo;
+	thisBuffer: PCircularBuffer;
+Begin
+	case wMsg of
+
+		mim_Open: {nothing};
+
+		mim_Error: {TODO: handle (message to trigger exception?) };
+
+		mim_Data, mim_Longdata, mim_Longerror:
+			{ Note: mim_Longerror included because there's a bug in the Maui
+			input driver that sends MIM_LONGERROR for subsequent buffers when
+			the input buffer is smaller than the sysex block being received }
+
+			begin
+			{ TODO: Make filtered messages customisable, I'm sure someone wants to
+			do something with MTC! }
+			if (dwParam1 <> MIDI_ACTIVESENSING) and
+							(dwParam1 <> MIDI_TIMINGCLOCK) then
+				begin
+
+				{ The device driver passes us the instance data pointer we
+				specified for midiInOpen. Use this to get the buffer address
+				and window handle for the MIDI control }
+				thisCtlInfo := PMidiCtlInfo(dwInstance);
+				thisBuffer := thisCtlInfo^.PBuffer;
+
+				{ Screen out short messages if we've been asked to }
+				if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
+					and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
+					begin
+					with thisEvent do
+						begin
+						timestamp := dwParam2;
+						if (wMsg = mim_Longdata) or
+							(wMsg = mim_Longerror) then
+							begin
+							data := 0;
+							sysex := PMidiHdr(dwParam1);
+							end
+						else
+							begin
+							data := dwParam1;
+							sysex := Nil;
+							end;
+						end;
+					if CircbufPutEvent( thisBuffer, @thisEvent ) then
+						{ Send a message to the control to say input's arrived }
+						PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
+					else
+						{ Buffer overflow }
+						PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
+					end;
+				end;
+			end;
+
+		mom_Done:	{ Sysex output complete, dwParam1 is pointer to MIDIHDR }
+			begin
+			{ Notify the control that its sysex output is finished.
+			  The control should call midiOutUnprepareHeader before freeing the buffer }
+			PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
+			end;
+
+	end;	{ Case }
+end;
+
+end.
diff --git a/Game/Code/lib/midi/MIDIDEFS.PAS b/Game/Code/lib/midi/MIDIDEFS.PAS
index e97a8627..fc8eed26 100644
--- a/Game/Code/lib/midi/MIDIDEFS.PAS
+++ b/Game/Code/lib/midi/MIDIDEFS.PAS
@@ -1,55 +1,55 @@
-{ $Header: /MidiComp/MIDIDEFS.PAS 2     10/06/97 7:33 Davec $ }

-

-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,

-  released to the public domain. }

-

-

-{ Common definitions used by DELPHMID.DPR and the MIDI components.

-  This must be a separate unit to prevent large chunks of the VCL being

-  linked into the DLL. }

-unit Mididefs;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Windows,

-  MMsystem,

-  Circbuf;

-

-type

-

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

-	{ This is the information about the control that must be accessed by

-	  the MIDI input callback function in the DLL at interrupt time }

-	PMidiCtlInfo = ^TMidiCtlInfo;

-	TMidiCtlInfo = record

-		hMem: THandle; 				{ Memory handle for this record }

-		PBuffer: PCircularBuffer;	{ Pointer to the MIDI input data buffer }

-		hWindow: HWnd;					{ Control's window handle }

-		SysexOnly: Boolean;			{ Only process System Exclusive input }

-	end;

-

-	{ Information for the output timer callback function, also required at

-	  interrupt time. }

-	PMidiOutTimerInfo = ^TMidiOutTimerInfo;

-	TMidiOutTimerInfo = record

-		hMem: THandle;				{ Memory handle for this record }

-		PBuffer: PCircularBuffer;	{ Pointer to MIDI output data buffer }

-		hWindow: HWnd;				{ Control's window handle }

-		TimeToNextEvent: DWORD;	{ Delay to next event after timer set }

-		MIDIHandle: HMidiOut;		{ MIDI handle to send output to 

-									(copy of component's FMidiHandle property) }

-		PeriodMin: Word;			{ Multimedia timer minimum period supported }

-		PeriodMax: Word;			{ Multimedia timer maximum period supported }

-		TimerId: Word;				{ Multimedia timer ID of current event }

-	end;

-

-implementation

-

-

-end.

+{ $Header: /MidiComp/MIDIDEFS.PAS 2     10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+  released to the public domain. }
+
+
+{ Common definitions used by DELPHMID.DPR and the MIDI components.
+  This must be a separate unit to prevent large chunks of the VCL being
+  linked into the DLL. }
+unit Mididefs;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Windows,
+  MMsystem,
+  Circbuf;
+
+type
+
+	{-------------------------------------------------------------------}
+	{ This is the information about the control that must be accessed by
+	  the MIDI input callback function in the DLL at interrupt time }
+	PMidiCtlInfo = ^TMidiCtlInfo;
+	TMidiCtlInfo = record
+		hMem: THandle; 				{ Memory handle for this record }
+		PBuffer: PCircularBuffer;	{ Pointer to the MIDI input data buffer }
+		hWindow: HWnd;					{ Control's window handle }
+		SysexOnly: Boolean;			{ Only process System Exclusive input }
+	end;
+
+	{ Information for the output timer callback function, also required at
+	  interrupt time. }
+	PMidiOutTimerInfo = ^TMidiOutTimerInfo;
+	TMidiOutTimerInfo = record
+		hMem: THandle;				{ Memory handle for this record }
+		PBuffer: PCircularBuffer;	{ Pointer to MIDI output data buffer }
+		hWindow: HWnd;				{ Control's window handle }
+		TimeToNextEvent: DWORD;	{ Delay to next event after timer set }
+		MIDIHandle: HMidiOut;		{ MIDI handle to send output to 
+									(copy of component's FMidiHandle property) }
+		PeriodMin: Word;			{ Multimedia timer minimum period supported }
+		PeriodMax: Word;			{ Multimedia timer maximum period supported }
+		TimerId: Word;				{ Multimedia timer ID of current event }
+	end;
+
+implementation
+
+
+end.
diff --git a/Game/Code/lib/midi/MIDITYPE.PAS b/Game/Code/lib/midi/MIDITYPE.PAS
index a4166c42..b1ec1bdd 100644
--- a/Game/Code/lib/midi/MIDITYPE.PAS
+++ b/Game/Code/lib/midi/MIDITYPE.PAS
@@ -1,90 +1,90 @@
-{ $Header: /MidiComp/MIDITYPE.PAS 2     10/06/97 7:33 Davec $ }

-

-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,

-  released to the public domain. }

-

-

-unit Miditype;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Classes,

-  Windows,

-  Messages,

-  MMSystem,

-  MidiDefs,

-  Circbuf;

-

-type

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

-	{ A MIDI input/output event }

-	TMyMidiEvent = class(TPersistent)

-	public

-		MidiMessage: Byte;          { MIDI message status byte }

-		Data1: Byte;            { MIDI message data 1 byte }

-		Data2: Byte;            { MIDI message data 2 byte }

-		Time: DWORD;          { Time in ms since midiInOpen }

-		SysexLength: Word;  { Length of sysex data (0 if none) }

-		Sysex: PChar;           { Pointer to sysex data buffer }

-		destructor Destroy; override;   { Frees sysex data buffer if nec. }

-	end;

-	PMyMidiEvent = ^TMyMidiEvent;

-

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

-	{ Encapsulates the MIDIHDR with its memory handle and sysex buffer }

-	PMyMidiHdr = ^TMyMidiHdr;

-	TMyMidiHdr = class(TObject)

-	public

-		hdrHandle: THandle;

-		hdrPointer: PMIDIHDR;

-		sysexHandle: THandle;

-		sysexPointer: Pointer;

-		constructor Create(BufferSize: Word);

-		destructor Destroy; override;

-	end;

-

-implementation

-

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

-{ Free any sysex buffer associated with the event }

-destructor TMyMidiEvent.Destroy;

-begin

-	if (Sysex <> Nil) then

-		Freemem(Sysex, SysexLength);

-

-	inherited Destroy;

-end;

-

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

-{ Allocate memory for the sysex header and buffer }

-constructor TMyMidiHdr.Create(BufferSize:Word);

-begin

-	inherited Create;

-

-	if BufferSize > 0 then

-		begin

-		hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);

-		sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);

-

-		hdrPointer^.lpData := sysexPointer;

-		hdrPointer^.dwBufferLength := BufferSize;

-		end;

-end;

-

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

-destructor TMyMidiHdr.Destroy;

-begin

-	GlobalSharedLockedFree( hdrHandle, hdrPointer );

-	GlobalSharedLockedFree( sysexHandle, sysexPointer );

-	inherited Destroy;

-end;

-

-

-

-end.

+{ $Header: /MidiComp/MIDITYPE.PAS 2     10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+  released to the public domain. }
+
+
+unit Miditype;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Classes,
+  Windows,
+  Messages,
+  MMSystem,
+  MidiDefs,
+  Circbuf;
+
+type
+	{-------------------------------------------------------------------}
+	{ A MIDI input/output event }
+	TMyMidiEvent = class(TPersistent)
+	public
+		MidiMessage: Byte;          { MIDI message status byte }
+		Data1: Byte;            { MIDI message data 1 byte }
+		Data2: Byte;            { MIDI message data 2 byte }
+		Time: DWORD;          { Time in ms since midiInOpen }
+		SysexLength: Word;  { Length of sysex data (0 if none) }
+		Sysex: PChar;           { Pointer to sysex data buffer }
+		destructor Destroy; override;   { Frees sysex data buffer if nec. }
+	end;
+	PMyMidiEvent = ^TMyMidiEvent;
+
+	{-------------------------------------------------------------------}
+	{ Encapsulates the MIDIHDR with its memory handle and sysex buffer }
+	PMyMidiHdr = ^TMyMidiHdr;
+	TMyMidiHdr = class(TObject)
+	public
+		hdrHandle: THandle;
+		hdrPointer: PMIDIHDR;
+		sysexHandle: THandle;
+		sysexPointer: Pointer;
+		constructor Create(BufferSize: Word);
+		destructor Destroy; override;
+	end;
+
+implementation
+
+{-------------------------------------------------------------------}
+{ Free any sysex buffer associated with the event }
+destructor TMyMidiEvent.Destroy;
+begin
+	if (Sysex <> Nil) then
+		Freemem(Sysex, SysexLength);
+
+	inherited Destroy;
+end;
+
+{-------------------------------------------------------------------}
+{ Allocate memory for the sysex header and buffer }
+constructor TMyMidiHdr.Create(BufferSize:Word);
+begin
+	inherited Create;
+
+	if BufferSize > 0 then
+		begin
+		hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);
+		sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);
+
+		hdrPointer^.lpData := sysexPointer;
+		hdrPointer^.dwBufferLength := BufferSize;
+		end;
+end;
+
+{-------------------------------------------------------------------}
+destructor TMyMidiHdr.Destroy;
+begin
+	GlobalSharedLockedFree( hdrHandle, hdrPointer );
+	GlobalSharedLockedFree( sysexHandle, sysexPointer );
+	inherited Destroy;
+end;
+
+
+
+end.
diff --git a/Game/Code/lib/midi/MidiFile.pas b/Game/Code/lib/midi/MidiFile.pas
index 2da052f4..4279d305 100644
--- a/Game/Code/lib/midi/MidiFile.pas
+++ b/Game/Code/lib/midi/MidiFile.pas
@@ -1,964 +1,964 @@
-{

-  Load a midifile and get access to tracks and events

-  I did build this component to convert midifiles to wave files

-  or play the files on a software synthesizer which I'm currenly

-  building.

-

-  version 1.0 first release

-

-  version 1.1

-    added some function

-    function KeyToStr(key : integer) : string;

-    function MyTimeToStr(val : integer) : string;

-    Bpm can be set to change speed

-

-  version 1.2

-    added some functions

-    function  GetTrackLength:integer;

-    function  Ready: boolean;

-

-  version 1.3

-    update by Chulwoong,

-    He knows how to use the MM timer, the timing is much better now, thank you

-

-  for comments/bugs

-  F.Bouwmans

-  fbouwmans@spiditel.nl

-

-  if you think this component is nice and you use it, sent me a short email.

-  I've seen that other of my components have been downloaded a lot, but I've

-  got no clue wether they are actually used.

-  Don't worry because you are free to use these components

-

-  Timing has improved, however because the messages are handled by the normal

-  windows message loop (of the main window) it is still influenced by actions

-  done on the window (minimize/maximize ..).

-  Use of a second thread with higher priority which only handles the

-  timer message should increase performance. If somebody knows such a component

-  which is freeware please let me know.

-

-  interface description:

-

-  procedure ReadFile:

-    actually read the file which is set in Filename

-

-  function GetTrack(index: integer) : TMidiTrack;

-

-  property Filename

-    set/read filename of midifile

-

-  property NumberOfTracks

-    read number of tracks in current file

-

-  property TicksPerQuarter: integer

-    ticks per quarter, tells how to interpret the time value in midi events

-

-  property FileFormat: TFileFormat

-    tells the format of the current midifile

-

-  property Bpm:integer

-    tells Beats per minut

-

-  property OnMidiEvent:TOnMidiEvent

-    called while playing for each midi event

-

-  procedure StartPlaying;

-    start playing the current loaded midifile from the beginning

-

-  procedure StopPlaying;

-    stop playing the current midifile

-

-  procedure PlayToTime(time : integer);

-    if playing yourself then events from last time to this time are produced

-

-

-  function KeyToStr(key : integer) : string;

-      give note string on key value:  e.g. C4

-

-  function MyTimeToStr(val : integer) : string;

-      give time string from msec time

-

-  function  GetTrackLength:integer;

-      gives the track lenght in msec (assuming the bpm at the start oof the file)

-

-  function  Ready: boolean;

-      now you can check wether the playback is finished

-

-}

-

-unit MidiFile;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Windows,

-  //Forms,

-  Messages,

-  SysUtils,

-  UCommon,

-  Classes;

-

-type

-  TChunkType = (illegal, header, track);

-  TFileFormat = (single, multi_synch, multi_asynch);

-  PByte = ^byte;

-

-  TMidiEvent = record

-    event: byte;

-    data1: byte;

-    data2: byte;

-    str: string;

-    dticks: integer;

-    time: integer;

-    mtime: integer;

-    len: integer;

-  end;

-  PMidiEvent = ^TMidiEvent;

-

-  TOnMidiEvent = procedure(event: PMidiEvent) of object;

-  TEvent = procedure of object;

-

-  TMidiTrack = class(TObject)

-  protected

-    events: TList;

-      name: string;

-    instrument: string;

-    currentTime: integer;

-    currentPos: integer;

-    ready: boolean;

-    trackLenght: integer;

-    procedure checkReady;

-  public

-    OnMidiEvent: TOnMidiEvent;

-    OnTrackReady: TEvent;

-    constructor Create;

-    destructor Destroy; override;

-

-    procedure Rewind(pos: integer);

-    procedure PlayUntil(pos: integer);

-    procedure GoUntil(pos: integer);

-

-    procedure putEvent(event: PMidiEvent);

-    function getEvent(index: integer): PMidiEvent;

-    function getName: string;

-    function getInstrument: string;

-    function getEventCount: integer;

-    function getCurrentTime: integer;

-    function getTrackLength: integer;

-    function isReady:boolean;

-  end;

-

-  TMidiFile = class(TComponent)

-  private

-    { Private declarations }

-    procedure MidiTimer(sender : TObject);

-    procedure WndProc(var Msg : TMessage);

-  protected

-    { Protected declarations }

-    midiFile: file of byte;

-    chunkType: TChunkType;

-    chunkLength: integer;

-    chunkData: PByte;

-    chunkIndex: PByte;

-    chunkEnd: PByte;

-    FPriority: DWORD;

-

-    // midi file attributes

-    FFileFormat: TFileFormat;

-    numberTracks: integer;

-    deltaTicks: integer;

-    FBpm: integer;

-    FBeatsPerMeasure: integer;

-    FusPerTick: double;

-    FFilename: string;

-

-    Tracks: TList;

-    currentTrack: TMidiTrack;

-    FOnMidiEvent: TOnMidiEvent;

-    FOnUpdateEvent: TNotifyEvent;

-

-    // playing attributes

-    playing: boolean;

-    PlayStartTime: integer;

-    currentTime: integer; // Current playtime in msec

-    currentPos: Double; // Current Position in ticks

-

-    procedure OnTrackReady;

-    procedure setFilename(val: string);

-    procedure ReadChunkHeader;

-    procedure ReadChunkContent;

-    procedure ReadChunk;

-    procedure ProcessHeaderChunk;

-    procedure ProcessTrackChunk;

-    function ReadVarLength: integer;

-    function ReadString(l: integer): string;

-    procedure SetOnMidiEvent(handler: TOnMidiEvent);

-    procedure SetBpm(val: integer);

-  public

-    { Public declarations }

-    constructor Create(AOwner: TComponent); override;

-    destructor Destroy; override;

-

-    procedure ReadFile;

-    function GetTrack(index: integer): TMidiTrack;

-

-    procedure StartPlaying;

-    procedure StopPlaying;

-    procedure ContinuePlaying;

-

-    procedure PlayToTime(time: integer);

-    procedure GoToTime(time: integer);

-    function GetCurrentTime: integer;

-    function GetFusPerTick : Double;

-    function  GetTrackLength:integer;

-    function  Ready: boolean;

-  published

-    { Published declarations }

-    property Filename: string read FFilename write setFilename;

-    property NumberOfTracks: integer read numberTracks;

-    property TicksPerQuarter: integer read deltaTicks;

-    property FileFormat: TFileFormat read FFileFormat;

-    property Bpm: integer read FBpm write SetBpm;

-    property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent;

-    property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent;

-  end;

-

-function KeyToStr(key: integer): string;

-function MyTimeToStr(val: integer): string;

-procedure Register;

-

-implementation

-

-uses mmsystem;

-

-type

-{$IFDEF FPC}

-  TTimerProc = TTIMECALLBACK;

-  TTimeCaps = TIMECAPS;

-{$ELSE}

-  TTimerProc = TFNTimeCallBack;

-{$ENDIF}

-

-const TIMER_RESOLUTION=10;

-const WM_MULTIMEDIA_TIMER=WM_USER+127;

-

-var MIDIFileHandle : HWND;

-    TimerProc      : TTimerProc;

-    MIDITimerID    : Integer;

-    TimerPeriod     : Integer;

-

-procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall;

-begin

-     PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);

-end;

-

-procedure SetMIDITimer;

-  var TimeCaps    : TTimeCaps;

-begin

-  timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));

-  if TIMER_RESOLUTION < TimeCaps.wPeriodMin then

-    TimerPeriod:=TimeCaps.wPeriodMin

-  else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then

-    TimerPeriod:=TimeCaps.wPeriodMax

-  else

-    TimerPeriod:=TIMER_RESOLUTION;

-

-  timeBeginPeriod(TimerPeriod);

-  MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc,

-                            DWORD(MIDIFileHandle),TIME_PERIODIC);

-  if MIDITimerID=0 then

-    timeEndPeriod(TimerPeriod);

-end;

-

-procedure KillMIDITimer;

-begin

-  timeKillEvent(MIDITimerID);

-  timeEndPeriod(TimerPeriod);

-end;

-

-constructor TMidiTrack.Create;

-begin

-  inherited Create;

-  events := TList.Create;

-  currentTime := 0;

-  currentPos := 0;

-end;

-

-destructor TMidiTrack.Destroy;

-var

-  i: integer;

-begin

-  for i := 0 to events.count - 1 do

-    Dispose(PMidiEvent(events.items[i]));

-  events.Free;

-  inherited Destroy;

-end;

-

-procedure TMidiTRack.putEvent(event: PMidiEvent);

-var

-  command: integer;

-  i: integer;

-  pevent: PMidiEvent;

-begin

-  if (event.event = $FF) then

-  begin

-    if (event.data1 = 3) then

-      name := event.str;

-    if (event.data1 = 4) then

-      instrument := event.str;

-  end;

-  currentTime := currentTime + event.dticks;

-  event.time := currentTime; // for the moment just add dticks

-  event.len := 0;

-  events.add(TObject(event));

-  command := event.event and $F0;

-

-  if ((command = $80) // note off

-    or ((command = $90) and (event.data2 = 0))) //note on with speed 0

-  then

-  begin

-    // this is a note off, try to find the accompanion note on

-    command := event.event or $90;

-    i := events.count - 2;

-    while i >= 0 do

-    begin

-      pevent := PMidiEvent(events[i]);

-      if (pevent.event = command) and

-        (pevent.data1 = event.data1)

-        then

-      begin

-        pevent.len := currentTIme - pevent.time;

-        i := 0;

-        event.len := -1;

-      end;

-      dec(i);

-    end;

-  end;

-end;

-

-function TMidiTrack.getName: string;

-begin

-  result := name;

-end;

-

-function TMidiTrack.getInstrument: string;

-begin

-  result := instrument;

-end;

-

-function TMiditrack.getEventCount: integer;

-begin

-  result := events.count;

-end;

-

-function TMiditrack.getEvent(index: integer): PMidiEvent;

-begin

-  if ((index < events.count) and (index >= 0)) then

-    result := events[index]

-  else

-    result := nil;

-end;

-

-function TMiditrack.getCurrentTime: integer;

-begin

-  result := currentTime;

-end;

-

-procedure TMiditrack.Rewind(pos: integer);

-begin

-  if currentPos = events.count then

-    dec(currentPos);

-  while ((currentPos > 0) and

-    (PMidiEvent(events[currentPos]).time > pos))

-    do

-  begin

-    dec(currentPos);

-  end;

-  checkReady;

-end;

-

-procedure TMiditrack.PlayUntil(pos: integer);

-begin

-  if assigned(OnMidiEvent) then

-  begin

-    while ((currentPos < events.count) and

-      (PMidiEvent(events[currentPos]).time < pos)) do

-    begin

-      OnMidiEvent(PMidiEvent(events[currentPos]));

-      inc(currentPos);

-    end;

-  end;

-  checkReady;

-end;

-

-procedure TMidiTrack.GoUntil(pos: integer);

-begin

-  while ((currentPos < events.count) and

-    (PMidiEvent(events[currentPos]).time < pos)) do

-  begin

-    inc(currentPos);

-  end;

-  checkReady;

-end;

-

-procedure TMidiTrack.checkReady;

-begin

-  if currentPos >= events.count then

-  begin

-    ready := true;

-    if assigned(OnTrackReady) then

-      OnTrackReady;

-  end

-  else

-    ready := false;

-end;

-

-function TMidiTrack.getTrackLength: integer;

-begin

-  result := PMidiEvent(events[events.count-1]).time

-end;

-

-function TMidiTrack.isReady: boolean;

-begin

-  result := ready;

-end;

-

-constructor TMidifile.Create(AOwner: TComponent);

-begin

-  inherited Create(AOWner);

-  MIDIFileHandle:=AllocateHWnd(WndProc);

-  chunkData := nil;

-  chunkType := illegal;

-  Tracks := TList.Create;

-  TimerProc:=@TimerCallBackProc;

-  FPriority:=GetPriorityClass(MIDIFileHandle);

-end;

-

-destructor TMidifile.Destroy;

-var

-  i: integer;

-begin

-  if not (chunkData = nil) then FreeMem(chunkData);

-  for i := 0 to Tracks.Count - 1 do

-    TMidiTrack(Tracks.Items[i]).Free;

-  Tracks.Free;

-  SetPriorityClass(MIDIFileHandle,FPriority);

-

-  if MIDITimerID<>0 then KillMIDITimer;

-

-  DeallocateHWnd(MIDIFileHandle);

-

-  inherited Destroy;

-end;

-

-function TMidiFile.GetTrack(index: integer): TMidiTrack;

-begin

-  result := Tracks.Items[index];

-end;

-

-procedure TMidifile.setFilename(val: string);

-begin

-  FFilename := val;

-//  ReadFile;

-end;

-

-procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent);

-var

-  i: integer;

-begin

-//  if not (FOnMidiEvent = handler) then

-//  begin

-  FOnMidiEvent := handler;

-  for i := 0 to tracks.count - 1 do

-    TMidiTrack(tracks.items[i]).OnMidiEvent := handler;

-//  end;

-end;

-

-procedure TMidifile.MidiTimer(Sender: TObject);

-begin

-  if playing then

-  begin

-    PlayToTime(GetTickCount - PlayStartTime);

-    if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);

-  end;

-end;

-

-procedure TMidifile.StartPlaying;

-var

-  i: integer;

-begin

-  for i := 0 to tracks.count - 1 do

-    TMidiTrack(tracks[i]).Rewind(0);

-  playStartTime := getTickCount;

-  playing := true;

-

-  SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);

-

-  SetMIDITimer;

-  currentPos := 0.0;

-  currentTime := 0;

-end;

-

-procedure TMidifile.ContinuePlaying;

-begin

-  PlayStartTime := GetTickCount - currentTime;

-  playing := true;

-

-  SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);

-

-  SetMIDITimer;

-end;

-

-procedure TMidifile.StopPlaying;

-begin

-  playing := false;

-  KillMIDITimer;

-  SetPriorityClass(MIDIFileHandle,FPriority);

-end;

-

-function TMidiFile.GetCurrentTime: integer;

-begin

-  Result := currentTime;

-end;

-

-procedure TMidifile.PlayToTime(time: integer);

-var

-  i: integer;

-  track: TMidiTrack;

-  pos: integer;

-  deltaTime: integer;

-begin

-  // calculate the pos in the file.

-  // pos is actually tick

-  // Current FusPerTick is uses to determine the actual pos

-

-  deltaTime := time - currentTime;

-  currentPos := currentPos + (deltaTime * 1000) / FusPerTick;

-  pos := round(currentPos);

-

-  for i := 0 to tracks.count - 1 do

-  begin

-    TMidiTrack(tracks.items[i]).PlayUntil(pos);

-  end;

-  currentTime := time;

-end;

-

-procedure TMidifile.GoToTime(time: integer);

-var

-  i: integer;

-  track: TMidiTrack;

-  pos: integer;

-begin

-  // this function should be changed because FusPerTick might not be constant

-  pos := round((time * 1000) / FusPerTick);

-  for i := 0 to tracks.count - 1 do

-  begin

-    TMidiTrack(tracks.items[i]).Rewind(0);

-    TMidiTrack(tracks.items[i]).GoUntil(pos);

-  end;

-end;

-

-procedure TMidifile.SetBpm(val: integer);

-var

-  us_per_quarter: integer;

-begin

-  if not (val = FBpm) then

-  begin

-    us_per_quarter := 60000000 div val;

-

-    FBpm := 60000000 div us_per_quarter;

-    FusPerTick := us_per_quarter / deltaTicks;

-  end;

-end;

-

-procedure TMidifile.ReadChunkHeader;

-var

-  theByte: array[0..7] of byte;

-begin

-  BlockRead(midiFile, theByte, 8);

-  if (theByte[0] = $4D) and (theByte[1] = $54) then

-  begin

-    if (theByte[2] = $68) and (theByte[3] = $64) then

-      chunkType := header

-    else if (theByte[2] = $72) and (theByte[3] = $6B) then

-      chunkType := track

-    else

-      chunkType := illegal;

-  end

-  else

-  begin

-    chunkType := illegal;

-  end;

-  chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;

-end;

-

-procedure TMidifile.ReadChunkContent;

-begin

-  if not (chunkData = nil) then

-    FreeMem(chunkData);

-  GetMem(chunkData, chunkLength + 10);

-  BlockRead(midiFile, chunkData^, chunkLength);

-  chunkIndex := chunkData;

-  chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);

-end;

-

-procedure TMidifile.ReadChunk;

-begin

-  ReadChunkHeader;

-  ReadChunkContent;

-  case chunkType of

-    header:

-      ProcessHeaderChunk;

-    track:

-      ProcessTrackCHunk;

-  end;

-end;

-

-procedure TMidifile.ProcessHeaderChunk;

-begin

-  chunkIndex := chunkData;

-  inc(chunkIndex);

-  if chunkType = header then

-  begin

-    case chunkIndex^ of

-      0: FfileFormat := single;

-      1: FfileFormat := multi_synch;

-      2: FfileFormat := multi_asynch;

-    end;

-    inc(chunkIndex);

-    numberTracks := chunkIndex^ * $100;

-    inc(chunkIndex);

-    numberTracks := numberTracks + chunkIndex^;

-    inc(chunkIndex);

-    deltaTicks := chunkIndex^ * $100;

-    inc(chunkIndex);

-    deltaTicks := deltaTicks + chunkIndex^;

-  end;

-end;

-

-procedure TMidifile.ProcessTrackChunk;

-var

-  dTime: integer;

-  event: integer;

-  len: integer;

-  str: string;

-  midiEvent: PMidiEvent;

-  i: integer;

-  us_per_quarter: integer;

-begin

-  chunkIndex := chunkData;

-//  inc(chunkIndex);

-  event := 0;

-  if chunkType = track then

-  begin

-    currentTrack := TMidiTrack.Create;

-    currentTrack.OnMidiEvent := FOnMidiEvent;

-    Tracks.add(currentTrack);

-    while integer(chunkIndex) < integer(chunkEnd) do

-    begin

-      // each event starts with var length delta time

-      dTime := ReadVarLength;

-      if chunkIndex^ >= $80 then

-      begin

-        event := chunkIndex^;

-        inc(chunkIndex);

-      end;

-      // else it is a running status event (just the same event as before)

-

-      if event = $FF then

-      begin

-{        case chunkIndex^ of

-        $00: // sequence number, not implemented jet

-            begin

-              inc(chunkIndex); // $02

-              inc(chunkIndex);

-            end;

-        $01 .. $0f: // text events  FF ty len text

-            begin

-              New(midiEvent);

-              midiEvent.event := $FF;

-              midiEvent.data1 := chunkIndex^;     // type is stored in data1

-              midiEvent.dticks := dtime;

-

-              inc(chunkIndex);

-              len := ReadVarLength;

-              midiEvent.str    := ReadString(len);

-

-              currentTrack.putEvent(midiEvent);

-            end;

-        $20: // Midi channel prefix  FF 20 01 cc

-             begin

-               inc(chunkIndex); // $01

-               inc(chunkIndex); // channel

-               inc(chunkIndex);

-             end;

-        $2F: // End of track FF 2F 00

-             begin

-               inc(chunkIndex); // $00

-               inc(chunkIndex);

-             end;

-        $51: // Set Tempo  FF 51 03 tttttt

-             begin

-               inc(chunkIndex); // $03

-               inc(chunkIndex); // tt

-               inc(chunkIndex); // tt

-               inc(chunkIndex); // tt

-               inc(chunkIndex);

-             end;

-        $54: // SMPTE offset  FF 54 05 hr mn se fr ff

-             begin

-               inc(chunkIndex); // $05

-               inc(chunkIndex); // hr

-               inc(chunkIndex); // mn

-               inc(chunkIndex); // se

-               inc(chunkIndex); // fr

-               inc(chunkIndex); // ff

-               inc(chunkIndex);

-             end;

-        $58: // Time signature FF 58 04 nn dd cc bb

-             begin

-               inc(chunkIndex); // $04

-               inc(chunkIndex); // nn

-               inc(chunkIndex); // dd

-               inc(chunkIndex); // cc

-               inc(chunkIndex); // bb

-               inc(chunkIndex);

-             end;

-        $59: // Key signature FF 59 02 df mi

-             begin

-               inc(chunkIndex); // $02

-               inc(chunkIndex); // df

-               inc(chunkIndex); // mi

-               inc(chunkIndex);

-             end;

-        $7F: // Sequence specific Meta-event

-            begin

-              inc(chunkIndex);

-              len := ReadVarLength;

-              str := ReadString(len);

-            end;

-        else // unknown meta event

-        }

-        begin

-          New(midiEvent);

-          midiEvent.event := $FF;

-          midiEvent.data1 := chunkIndex^; // type is stored in data1

-          midiEvent.dticks := dtime;

-

-          inc(chunkIndex);

-          len := ReadVarLength;

-          midiEvent.str := ReadString(len);

-          currentTrack.putEvent(midiEvent);

-

-          case midiEvent.data1 of

-            $51:

-              begin

-                us_per_quarter :=

-                  (integer(byte(midiEvent.str[1])) shl 16 +

-                  integer(byte(midiEvent.str[2])) shl 8 +

-                  integer(byte(midiEvent.str[3])));

-                FBpm := 60000000 div us_per_quarter;

-                FusPerTick := us_per_quarter / deltaTicks;

-              end;

-          end;

-        end;

-//        end;

-      end

-      else

-      begin

-      // these are all midi events

-        New(midiEvent);

-        midiEvent.event := event;

-        midiEvent.dticks := dtime;

-//         inc(chunkIndex);

-        case event of

-          $80..$8F, // note off

-          $90..$9F, // note on

-          $A0..$AF, // key aftertouch

-          $B0..$BF, // control change

-          $E0..$EF: // pitch wheel change

-            begin

-              midiEvent.data1 := chunkIndex^; inc(chunkIndex);

-              midiEvent.data2 := chunkIndex^; inc(chunkIndex);

-            end;

-          $C0..$CF, // program change

-          $D0..$DF: // channel aftertouch

-            begin

-              midiEvent.data1 := chunkIndex^; inc(chunkIndex);

-            end;

-        else

-           // error

-        end;

-        currentTrack.putEvent(midiEvent);

-      end;

-    end;

-  end;

-end;

-

-

-function TMidifile.ReadVarLength: integer;

-var

-  i: integer;

-  b: byte;

-begin

-  b := 128;

-  i := 0;

-  while b > 127 do

-  begin

-    i := i shl 7;

-    b := chunkIndex^;

-    i := i + b and $7F;

-    inc(chunkIndex);

-  end;

-  result := i;

-end;

-

-function TMidifile.ReadString(l: integer): string;

-var

-  s: PChar;

-  i: integer;

-begin

-  GetMem(s, l + 1); ;

-  s[l] := chr(0);

-  for i := 0 to l - 1 do

-  begin

-    s[i] := Chr(chunkIndex^);

-    inc(chunkIndex);

-  end;

-  result := string(s);

-end;

-

-procedure TMidifile.ReadFile;

-var

-  i: integer;

-begin

-  for i := 0 to Tracks.Count - 1 do

-    TMidiTrack(Tracks.Items[i]).Free;

-  Tracks.Clear;

-  chunkType := illegal;

-

-  AssignFile(midiFile, FFilename);

-  FileMode := 0;

-  Reset(midiFile);

-  while not eof(midiFile) do

-    ReadChunk;

-  CloseFile(midiFile);

-  numberTracks := Tracks.Count;

-end;

-

-function KeyToStr(key: integer): string;

-var

-  n: integer;

-  str: string;

-begin

-  n := key mod 12;

-  case n of

-    0: str := 'C';

-    1: str := 'C#';

-    2: str := 'D';

-    3: str := 'D#';

-    4: str := 'E';

-    5: str := 'F';

-    6: str := 'F#';

-    7: str := 'G';

-    8: str := 'G#';

-    9: str := 'A';

-    10: str := 'A#';

-    11: str := 'B';

-  end;

-  Result := str + IntToStr(key div 12);

-end;

-

-function IntToLenStr(val: integer; len: integer): string;

-var

-  str: string;

-begin

-  str := IntToStr(val);

-  while Length(str) < len do

-    str := '0' + str;

-  Result := str;

-end;

-

-function MyTimeToStr(val: integer): string;

- var

-  hour: integer;

-  min: integer;

-  sec: integer;

-  msec: integer;

-begin

-  msec := val mod 1000;

-  sec := val div 1000;

-  min := sec div 60;

-  sec := sec mod 60;

-  hour := min div 60;

-  min := min mod 60;

-  Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);

-end;

-

-function TMidiFIle.GetFusPerTick : Double;

-begin

-  Result := FusPerTick;

-end;

-

-function  TMidiFIle.GetTrackLength:integer;

-var i,length : integer;

-    time : extended;

-begin

-  length := 0;

-  for i := 0 to Tracks.Count - 1 do

-    if TMidiTrack(Tracks.Items[i]).getTrackLength > length then

-      length := TMidiTrack(Tracks.Items[i]).getTrackLength;

-  time := length * FusPerTick;

-  time := time / 1000.0;

-  result := round(time);

-end;

-

-function  TMidiFIle.Ready: boolean;

-var i : integer;

-begin

-  result := true;

-  for i := 0 to Tracks.Count - 1 do

-    if not TMidiTrack(Tracks.Items[i]).isready then

-      result := false;

-end;

-

-procedure TMidiFile.OnTrackReady;

-begin

-  if ready then

-    if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);

-end;

-

-procedure TMidiFile.WndProc(var Msg : TMessage);

-begin

-  with MSG do

-  begin

-    case Msg of

-      WM_MULTIMEDIA_TIMER:

-      begin

-        //try

-          MidiTimer(self);

-        //except

-        // Note: HandleException() is called by default if exception is not handled

-        //  Application.HandleException(Self);

-        //end;

-      end;

-    else

-      begin

-        Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);

-      end;

-    end;

-  end;

-end;

-

-procedure Register;

-begin

-  RegisterComponents('Synth', [TMidiFile]);

-end;

-

-end.

-

+{
+  Load a midifile and get access to tracks and events
+  I did build this component to convert midifiles to wave files
+  or play the files on a software synthesizer which I'm currenly
+  building.
+
+  version 1.0 first release
+
+  version 1.1
+    added some function
+    function KeyToStr(key : integer) : string;
+    function MyTimeToStr(val : integer) : string;
+    Bpm can be set to change speed
+
+  version 1.2
+    added some functions
+    function  GetTrackLength:integer;
+    function  Ready: boolean;
+
+  version 1.3
+    update by Chulwoong,
+    He knows how to use the MM timer, the timing is much better now, thank you
+
+  for comments/bugs
+  F.Bouwmans
+  fbouwmans@spiditel.nl
+
+  if you think this component is nice and you use it, sent me a short email.
+  I've seen that other of my components have been downloaded a lot, but I've
+  got no clue wether they are actually used.
+  Don't worry because you are free to use these components
+
+  Timing has improved, however because the messages are handled by the normal
+  windows message loop (of the main window) it is still influenced by actions
+  done on the window (minimize/maximize ..).
+  Use of a second thread with higher priority which only handles the
+  timer message should increase performance. If somebody knows such a component
+  which is freeware please let me know.
+
+  interface description:
+
+  procedure ReadFile:
+    actually read the file which is set in Filename
+
+  function GetTrack(index: integer) : TMidiTrack;
+
+  property Filename
+    set/read filename of midifile
+
+  property NumberOfTracks
+    read number of tracks in current file
+
+  property TicksPerQuarter: integer
+    ticks per quarter, tells how to interpret the time value in midi events
+
+  property FileFormat: TFileFormat
+    tells the format of the current midifile
+
+  property Bpm:integer
+    tells Beats per minut
+
+  property OnMidiEvent:TOnMidiEvent
+    called while playing for each midi event
+
+  procedure StartPlaying;
+    start playing the current loaded midifile from the beginning
+
+  procedure StopPlaying;
+    stop playing the current midifile
+
+  procedure PlayToTime(time : integer);
+    if playing yourself then events from last time to this time are produced
+
+
+  function KeyToStr(key : integer) : string;
+      give note string on key value:  e.g. C4
+
+  function MyTimeToStr(val : integer) : string;
+      give time string from msec time
+
+  function  GetTrackLength:integer;
+      gives the track lenght in msec (assuming the bpm at the start oof the file)
+
+  function  Ready: boolean;
+      now you can check wether the playback is finished
+
+}
+
+unit MidiFile;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Windows,
+  //Forms,
+  Messages,
+  SysUtils,
+  UCommon,
+  Classes;
+
+type
+  TChunkType = (illegal, header, track);
+  TFileFormat = (single, multi_synch, multi_asynch);
+  PByte = ^byte;
+
+  TMidiEvent = record
+    event: byte;
+    data1: byte;
+    data2: byte;
+    str: string;
+    dticks: integer;
+    time: integer;
+    mtime: integer;
+    len: integer;
+  end;
+  PMidiEvent = ^TMidiEvent;
+
+  TOnMidiEvent = procedure(event: PMidiEvent) of object;
+  TEvent = procedure of object;
+
+  TMidiTrack = class(TObject)
+  protected
+    events: TList;
+      name: string;
+    instrument: string;
+    currentTime: integer;
+    currentPos: integer;
+    ready: boolean;
+    trackLenght: integer;
+    procedure checkReady;
+  public
+    OnMidiEvent: TOnMidiEvent;
+    OnTrackReady: TEvent;
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Rewind(pos: integer);
+    procedure PlayUntil(pos: integer);
+    procedure GoUntil(pos: integer);
+
+    procedure putEvent(event: PMidiEvent);
+    function getEvent(index: integer): PMidiEvent;
+    function getName: string;
+    function getInstrument: string;
+    function getEventCount: integer;
+    function getCurrentTime: integer;
+    function getTrackLength: integer;
+    function isReady:boolean;
+  end;
+
+  TMidiFile = class(TComponent)
+  private
+    { Private declarations }
+    procedure MidiTimer(sender : TObject);
+    procedure WndProc(var Msg : TMessage);
+  protected
+    { Protected declarations }
+    midiFile: file of byte;
+    chunkType: TChunkType;
+    chunkLength: integer;
+    chunkData: PByte;
+    chunkIndex: PByte;
+    chunkEnd: PByte;
+    FPriority: DWORD;
+
+    // midi file attributes
+    FFileFormat: TFileFormat;
+    numberTracks: integer;
+    deltaTicks: integer;
+    FBpm: integer;
+    FBeatsPerMeasure: integer;
+    FusPerTick: double;
+    FFilename: string;
+
+    Tracks: TList;
+    currentTrack: TMidiTrack;
+    FOnMidiEvent: TOnMidiEvent;
+    FOnUpdateEvent: TNotifyEvent;
+
+    // playing attributes
+    playing: boolean;
+    PlayStartTime: integer;
+    currentTime: integer; // Current playtime in msec
+    currentPos: Double; // Current Position in ticks
+
+    procedure OnTrackReady;
+    procedure setFilename(val: string);
+    procedure ReadChunkHeader;
+    procedure ReadChunkContent;
+    procedure ReadChunk;
+    procedure ProcessHeaderChunk;
+    procedure ProcessTrackChunk;
+    function ReadVarLength: integer;
+    function ReadString(l: integer): string;
+    procedure SetOnMidiEvent(handler: TOnMidiEvent);
+    procedure SetBpm(val: integer);
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure ReadFile;
+    function GetTrack(index: integer): TMidiTrack;
+
+    procedure StartPlaying;
+    procedure StopPlaying;
+    procedure ContinuePlaying;
+
+    procedure PlayToTime(time: integer);
+    procedure GoToTime(time: integer);
+    function GetCurrentTime: integer;
+    function GetFusPerTick : Double;
+    function  GetTrackLength:integer;
+    function  Ready: boolean;
+  published
+    { Published declarations }
+    property Filename: string read FFilename write setFilename;
+    property NumberOfTracks: integer read numberTracks;
+    property TicksPerQuarter: integer read deltaTicks;
+    property FileFormat: TFileFormat read FFileFormat;
+    property Bpm: integer read FBpm write SetBpm;
+    property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent;
+    property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent;
+  end;
+
+function KeyToStr(key: integer): string;
+function MyTimeToStr(val: integer): string;
+procedure Register;
+
+implementation
+
+uses mmsystem;
+
+type
+{$IFDEF FPC}
+  TTimerProc = TTIMECALLBACK;
+  TTimeCaps = TIMECAPS;
+{$ELSE}
+  TTimerProc = TFNTimeCallBack;
+{$ENDIF}
+
+const TIMER_RESOLUTION=10;
+const WM_MULTIMEDIA_TIMER=WM_USER+127;
+
+var MIDIFileHandle : HWND;
+    TimerProc      : TTimerProc;
+    MIDITimerID    : Integer;
+    TimerPeriod     : Integer;
+
+procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall;
+begin
+     PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);
+end;
+
+procedure SetMIDITimer;
+  var TimeCaps    : TTimeCaps;
+begin
+  timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));
+  if TIMER_RESOLUTION < TimeCaps.wPeriodMin then
+    TimerPeriod:=TimeCaps.wPeriodMin
+  else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then
+    TimerPeriod:=TimeCaps.wPeriodMax
+  else
+    TimerPeriod:=TIMER_RESOLUTION;
+
+  timeBeginPeriod(TimerPeriod);
+  MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc,
+                            DWORD(MIDIFileHandle),TIME_PERIODIC);
+  if MIDITimerID=0 then
+    timeEndPeriod(TimerPeriod);
+end;
+
+procedure KillMIDITimer;
+begin
+  timeKillEvent(MIDITimerID);
+  timeEndPeriod(TimerPeriod);
+end;
+
+constructor TMidiTrack.Create;
+begin
+  inherited Create;
+  events := TList.Create;
+  currentTime := 0;
+  currentPos := 0;
+end;
+
+destructor TMidiTrack.Destroy;
+var
+  i: integer;
+begin
+  for i := 0 to events.count - 1 do
+    Dispose(PMidiEvent(events.items[i]));
+  events.Free;
+  inherited Destroy;
+end;
+
+procedure TMidiTRack.putEvent(event: PMidiEvent);
+var
+  command: integer;
+  i: integer;
+  pevent: PMidiEvent;
+begin
+  if (event.event = $FF) then
+  begin
+    if (event.data1 = 3) then
+      name := event.str;
+    if (event.data1 = 4) then
+      instrument := event.str;
+  end;
+  currentTime := currentTime + event.dticks;
+  event.time := currentTime; // for the moment just add dticks
+  event.len := 0;
+  events.add(TObject(event));
+  command := event.event and $F0;
+
+  if ((command = $80) // note off
+    or ((command = $90) and (event.data2 = 0))) //note on with speed 0
+  then
+  begin
+    // this is a note off, try to find the accompanion note on
+    command := event.event or $90;
+    i := events.count - 2;
+    while i >= 0 do
+    begin
+      pevent := PMidiEvent(events[i]);
+      if (pevent.event = command) and
+        (pevent.data1 = event.data1)
+        then
+      begin
+        pevent.len := currentTIme - pevent.time;
+        i := 0;
+        event.len := -1;
+      end;
+      dec(i);
+    end;
+  end;
+end;
+
+function TMidiTrack.getName: string;
+begin
+  result := name;
+end;
+
+function TMidiTrack.getInstrument: string;
+begin
+  result := instrument;
+end;
+
+function TMiditrack.getEventCount: integer;
+begin
+  result := events.count;
+end;
+
+function TMiditrack.getEvent(index: integer): PMidiEvent;
+begin
+  if ((index < events.count) and (index >= 0)) then
+    result := events[index]
+  else
+    result := nil;
+end;
+
+function TMiditrack.getCurrentTime: integer;
+begin
+  result := currentTime;
+end;
+
+procedure TMiditrack.Rewind(pos: integer);
+begin
+  if currentPos = events.count then
+    dec(currentPos);
+  while ((currentPos > 0) and
+    (PMidiEvent(events[currentPos]).time > pos))
+    do
+  begin
+    dec(currentPos);
+  end;
+  checkReady;
+end;
+
+procedure TMiditrack.PlayUntil(pos: integer);
+begin
+  if assigned(OnMidiEvent) then
+  begin
+    while ((currentPos < events.count) and
+      (PMidiEvent(events[currentPos]).time < pos)) do
+    begin
+      OnMidiEvent(PMidiEvent(events[currentPos]));
+      inc(currentPos);
+    end;
+  end;
+  checkReady;
+end;
+
+procedure TMidiTrack.GoUntil(pos: integer);
+begin
+  while ((currentPos < events.count) and
+    (PMidiEvent(events[currentPos]).time < pos)) do
+  begin
+    inc(currentPos);
+  end;
+  checkReady;
+end;
+
+procedure TMidiTrack.checkReady;
+begin
+  if currentPos >= events.count then
+  begin
+    ready := true;
+    if assigned(OnTrackReady) then
+      OnTrackReady;
+  end
+  else
+    ready := false;
+end;
+
+function TMidiTrack.getTrackLength: integer;
+begin
+  result := PMidiEvent(events[events.count-1]).time
+end;
+
+function TMidiTrack.isReady: boolean;
+begin
+  result := ready;
+end;
+
+constructor TMidifile.Create(AOwner: TComponent);
+begin
+  inherited Create(AOWner);
+  MIDIFileHandle:=AllocateHWnd(WndProc);
+  chunkData := nil;
+  chunkType := illegal;
+  Tracks := TList.Create;
+  TimerProc:=@TimerCallBackProc;
+  FPriority:=GetPriorityClass(MIDIFileHandle);
+end;
+
+destructor TMidifile.Destroy;
+var
+  i: integer;
+begin
+  if not (chunkData = nil) then FreeMem(chunkData);
+  for i := 0 to Tracks.Count - 1 do
+    TMidiTrack(Tracks.Items[i]).Free;
+  Tracks.Free;
+  SetPriorityClass(MIDIFileHandle,FPriority);
+
+  if MIDITimerID<>0 then KillMIDITimer;
+
+  DeallocateHWnd(MIDIFileHandle);
+
+  inherited Destroy;
+end;
+
+function TMidiFile.GetTrack(index: integer): TMidiTrack;
+begin
+  result := Tracks.Items[index];
+end;
+
+procedure TMidifile.setFilename(val: string);
+begin
+  FFilename := val;
+//  ReadFile;
+end;
+
+procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent);
+var
+  i: integer;
+begin
+//  if not (FOnMidiEvent = handler) then
+//  begin
+  FOnMidiEvent := handler;
+  for i := 0 to tracks.count - 1 do
+    TMidiTrack(tracks.items[i]).OnMidiEvent := handler;
+//  end;
+end;
+
+procedure TMidifile.MidiTimer(Sender: TObject);
+begin
+  if playing then
+  begin
+    PlayToTime(GetTickCount - PlayStartTime);
+    if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
+  end;
+end;
+
+procedure TMidifile.StartPlaying;
+var
+  i: integer;
+begin
+  for i := 0 to tracks.count - 1 do
+    TMidiTrack(tracks[i]).Rewind(0);
+  playStartTime := getTickCount;
+  playing := true;
+
+  SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+
+  SetMIDITimer;
+  currentPos := 0.0;
+  currentTime := 0;
+end;
+
+procedure TMidifile.ContinuePlaying;
+begin
+  PlayStartTime := GetTickCount - currentTime;
+  playing := true;
+
+  SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+
+  SetMIDITimer;
+end;
+
+procedure TMidifile.StopPlaying;
+begin
+  playing := false;
+  KillMIDITimer;
+  SetPriorityClass(MIDIFileHandle,FPriority);
+end;
+
+function TMidiFile.GetCurrentTime: integer;
+begin
+  Result := currentTime;
+end;
+
+procedure TMidifile.PlayToTime(time: integer);
+var
+  i: integer;
+  track: TMidiTrack;
+  pos: integer;
+  deltaTime: integer;
+begin
+  // calculate the pos in the file.
+  // pos is actually tick
+  // Current FusPerTick is uses to determine the actual pos
+
+  deltaTime := time - currentTime;
+  currentPos := currentPos + (deltaTime * 1000) / FusPerTick;
+  pos := round(currentPos);
+
+  for i := 0 to tracks.count - 1 do
+  begin
+    TMidiTrack(tracks.items[i]).PlayUntil(pos);
+  end;
+  currentTime := time;
+end;
+
+procedure TMidifile.GoToTime(time: integer);
+var
+  i: integer;
+  track: TMidiTrack;
+  pos: integer;
+begin
+  // this function should be changed because FusPerTick might not be constant
+  pos := round((time * 1000) / FusPerTick);
+  for i := 0 to tracks.count - 1 do
+  begin
+    TMidiTrack(tracks.items[i]).Rewind(0);
+    TMidiTrack(tracks.items[i]).GoUntil(pos);
+  end;
+end;
+
+procedure TMidifile.SetBpm(val: integer);
+var
+  us_per_quarter: integer;
+begin
+  if not (val = FBpm) then
+  begin
+    us_per_quarter := 60000000 div val;
+
+    FBpm := 60000000 div us_per_quarter;
+    FusPerTick := us_per_quarter / deltaTicks;
+  end;
+end;
+
+procedure TMidifile.ReadChunkHeader;
+var
+  theByte: array[0..7] of byte;
+begin
+  BlockRead(midiFile, theByte, 8);
+  if (theByte[0] = $4D) and (theByte[1] = $54) then
+  begin
+    if (theByte[2] = $68) and (theByte[3] = $64) then
+      chunkType := header
+    else if (theByte[2] = $72) and (theByte[3] = $6B) then
+      chunkType := track
+    else
+      chunkType := illegal;
+  end
+  else
+  begin
+    chunkType := illegal;
+  end;
+  chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;
+end;
+
+procedure TMidifile.ReadChunkContent;
+begin
+  if not (chunkData = nil) then
+    FreeMem(chunkData);
+  GetMem(chunkData, chunkLength + 10);
+  BlockRead(midiFile, chunkData^, chunkLength);
+  chunkIndex := chunkData;
+  chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);
+end;
+
+procedure TMidifile.ReadChunk;
+begin
+  ReadChunkHeader;
+  ReadChunkContent;
+  case chunkType of
+    header:
+      ProcessHeaderChunk;
+    track:
+      ProcessTrackCHunk;
+  end;
+end;
+
+procedure TMidifile.ProcessHeaderChunk;
+begin
+  chunkIndex := chunkData;
+  inc(chunkIndex);
+  if chunkType = header then
+  begin
+    case chunkIndex^ of
+      0: FfileFormat := single;
+      1: FfileFormat := multi_synch;
+      2: FfileFormat := multi_asynch;
+    end;
+    inc(chunkIndex);
+    numberTracks := chunkIndex^ * $100;
+    inc(chunkIndex);
+    numberTracks := numberTracks + chunkIndex^;
+    inc(chunkIndex);
+    deltaTicks := chunkIndex^ * $100;
+    inc(chunkIndex);
+    deltaTicks := deltaTicks + chunkIndex^;
+  end;
+end;
+
+procedure TMidifile.ProcessTrackChunk;
+var
+  dTime: integer;
+  event: integer;
+  len: integer;
+  str: string;
+  midiEvent: PMidiEvent;
+  i: integer;
+  us_per_quarter: integer;
+begin
+  chunkIndex := chunkData;
+//  inc(chunkIndex);
+  event := 0;
+  if chunkType = track then
+  begin
+    currentTrack := TMidiTrack.Create;
+    currentTrack.OnMidiEvent := FOnMidiEvent;
+    Tracks.add(currentTrack);
+    while integer(chunkIndex) < integer(chunkEnd) do
+    begin
+      // each event starts with var length delta time
+      dTime := ReadVarLength;
+      if chunkIndex^ >= $80 then
+      begin
+        event := chunkIndex^;
+        inc(chunkIndex);
+      end;
+      // else it is a running status event (just the same event as before)
+
+      if event = $FF then
+      begin
+{        case chunkIndex^ of
+        $00: // sequence number, not implemented jet
+            begin
+              inc(chunkIndex); // $02
+              inc(chunkIndex);
+            end;
+        $01 .. $0f: // text events  FF ty len text
+            begin
+              New(midiEvent);
+              midiEvent.event := $FF;
+              midiEvent.data1 := chunkIndex^;     // type is stored in data1
+              midiEvent.dticks := dtime;
+
+              inc(chunkIndex);
+              len := ReadVarLength;
+              midiEvent.str    := ReadString(len);
+
+              currentTrack.putEvent(midiEvent);
+            end;
+        $20: // Midi channel prefix  FF 20 01 cc
+             begin
+               inc(chunkIndex); // $01
+               inc(chunkIndex); // channel
+               inc(chunkIndex);
+             end;
+        $2F: // End of track FF 2F 00
+             begin
+               inc(chunkIndex); // $00
+               inc(chunkIndex);
+             end;
+        $51: // Set Tempo  FF 51 03 tttttt
+             begin
+               inc(chunkIndex); // $03
+               inc(chunkIndex); // tt
+               inc(chunkIndex); // tt
+               inc(chunkIndex); // tt
+               inc(chunkIndex);
+             end;
+        $54: // SMPTE offset  FF 54 05 hr mn se fr ff
+             begin
+               inc(chunkIndex); // $05
+               inc(chunkIndex); // hr
+               inc(chunkIndex); // mn
+               inc(chunkIndex); // se
+               inc(chunkIndex); // fr
+               inc(chunkIndex); // ff
+               inc(chunkIndex);
+             end;
+        $58: // Time signature FF 58 04 nn dd cc bb
+             begin
+               inc(chunkIndex); // $04
+               inc(chunkIndex); // nn
+               inc(chunkIndex); // dd
+               inc(chunkIndex); // cc
+               inc(chunkIndex); // bb
+               inc(chunkIndex);
+             end;
+        $59: // Key signature FF 59 02 df mi
+             begin
+               inc(chunkIndex); // $02
+               inc(chunkIndex); // df
+               inc(chunkIndex); // mi
+               inc(chunkIndex);
+             end;
+        $7F: // Sequence specific Meta-event
+            begin
+              inc(chunkIndex);
+              len := ReadVarLength;
+              str := ReadString(len);
+            end;
+        else // unknown meta event
+        }
+        begin
+          New(midiEvent);
+          midiEvent.event := $FF;
+          midiEvent.data1 := chunkIndex^; // type is stored in data1
+          midiEvent.dticks := dtime;
+
+          inc(chunkIndex);
+          len := ReadVarLength;
+          midiEvent.str := ReadString(len);
+          currentTrack.putEvent(midiEvent);
+
+          case midiEvent.data1 of
+            $51:
+              begin
+                us_per_quarter :=
+                  (integer(byte(midiEvent.str[1])) shl 16 +
+                  integer(byte(midiEvent.str[2])) shl 8 +
+                  integer(byte(midiEvent.str[3])));
+                FBpm := 60000000 div us_per_quarter;
+                FusPerTick := us_per_quarter / deltaTicks;
+              end;
+          end;
+        end;
+//        end;
+      end
+      else
+      begin
+      // these are all midi events
+        New(midiEvent);
+        midiEvent.event := event;
+        midiEvent.dticks := dtime;
+//         inc(chunkIndex);
+        case event of
+          $80..$8F, // note off
+          $90..$9F, // note on
+          $A0..$AF, // key aftertouch
+          $B0..$BF, // control change
+          $E0..$EF: // pitch wheel change
+            begin
+              midiEvent.data1 := chunkIndex^; inc(chunkIndex);
+              midiEvent.data2 := chunkIndex^; inc(chunkIndex);
+            end;
+          $C0..$CF, // program change
+          $D0..$DF: // channel aftertouch
+            begin
+              midiEvent.data1 := chunkIndex^; inc(chunkIndex);
+            end;
+        else
+           // error
+        end;
+        currentTrack.putEvent(midiEvent);
+      end;
+    end;
+  end;
+end;
+
+
+function TMidifile.ReadVarLength: integer;
+var
+  i: integer;
+  b: byte;
+begin
+  b := 128;
+  i := 0;
+  while b > 127 do
+  begin
+    i := i shl 7;
+    b := chunkIndex^;
+    i := i + b and $7F;
+    inc(chunkIndex);
+  end;
+  result := i;
+end;
+
+function TMidifile.ReadString(l: integer): string;
+var
+  s: PChar;
+  i: integer;
+begin
+  GetMem(s, l + 1); ;
+  s[l] := chr(0);
+  for i := 0 to l - 1 do
+  begin
+    s[i] := Chr(chunkIndex^);
+    inc(chunkIndex);
+  end;
+  result := string(s);
+end;
+
+procedure TMidifile.ReadFile;
+var
+  i: integer;
+begin
+  for i := 0 to Tracks.Count - 1 do
+    TMidiTrack(Tracks.Items[i]).Free;
+  Tracks.Clear;
+  chunkType := illegal;
+
+  AssignFile(midiFile, FFilename);
+  FileMode := 0;
+  Reset(midiFile);
+  while not eof(midiFile) do
+    ReadChunk;
+  CloseFile(midiFile);
+  numberTracks := Tracks.Count;
+end;
+
+function KeyToStr(key: integer): string;
+var
+  n: integer;
+  str: string;
+begin
+  n := key mod 12;
+  case n of
+    0: str := 'C';
+    1: str := 'C#';
+    2: str := 'D';
+    3: str := 'D#';
+    4: str := 'E';
+    5: str := 'F';
+    6: str := 'F#';
+    7: str := 'G';
+    8: str := 'G#';
+    9: str := 'A';
+    10: str := 'A#';
+    11: str := 'B';
+  end;
+  Result := str + IntToStr(key div 12);
+end;
+
+function IntToLenStr(val: integer; len: integer): string;
+var
+  str: string;
+begin
+  str := IntToStr(val);
+  while Length(str) < len do
+    str := '0' + str;
+  Result := str;
+end;
+
+function MyTimeToStr(val: integer): string;
+ var
+  hour: integer;
+  min: integer;
+  sec: integer;
+  msec: integer;
+begin
+  msec := val mod 1000;
+  sec := val div 1000;
+  min := sec div 60;
+  sec := sec mod 60;
+  hour := min div 60;
+  min := min mod 60;
+  Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);
+end;
+
+function TMidiFIle.GetFusPerTick : Double;
+begin
+  Result := FusPerTick;
+end;
+
+function  TMidiFIle.GetTrackLength:integer;
+var i,length : integer;
+    time : extended;
+begin
+  length := 0;
+  for i := 0 to Tracks.Count - 1 do
+    if TMidiTrack(Tracks.Items[i]).getTrackLength > length then
+      length := TMidiTrack(Tracks.Items[i]).getTrackLength;
+  time := length * FusPerTick;
+  time := time / 1000.0;
+  result := round(time);
+end;
+
+function  TMidiFIle.Ready: boolean;
+var i : integer;
+begin
+  result := true;
+  for i := 0 to Tracks.Count - 1 do
+    if not TMidiTrack(Tracks.Items[i]).isready then
+      result := false;
+end;
+
+procedure TMidiFile.OnTrackReady;
+begin
+  if ready then
+    if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
+end;
+
+procedure TMidiFile.WndProc(var Msg : TMessage);
+begin
+  with MSG do
+  begin
+    case Msg of
+      WM_MULTIMEDIA_TIMER:
+      begin
+        //try
+          MidiTimer(self);
+        //except
+        // Note: HandleException() is called by default if exception is not handled
+        //  Application.HandleException(Self);
+        //end;
+      end;
+    else
+      begin
+        Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);
+      end;
+    end;
+  end;
+end;
+
+procedure Register;
+begin
+  RegisterComponents('Synth', [TMidiFile]);
+end;
+
+end.
+
diff --git a/Game/Code/lib/midi/MidiScope.pas b/Game/Code/lib/midi/MidiScope.pas
index 43efc4e8..42fc65fc 100644
--- a/Game/Code/lib/midi/MidiScope.pas
+++ b/Game/Code/lib/midi/MidiScope.pas
@@ -1,198 +1,198 @@
-{

-  Shows a large black area where midi note/controller events are shown

-  just to monitor midi activity (for the MidiPlayer)

-

-  version 1.0 first release

-

-  for comments/bugs

-  F.Bouwmans

-  fbouwmans@spiditel.nl

-

-  if you think this component is nice and you use it, sent me a short email.

-  I've seen that other of my components have been downloaded a lot, but I've

-  got no clue wether they are actually used.

-  Don't worry because you are free to use these components

-}

-

-unit MidiScope;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

-

-type

-  TMidiScope = class(TGraphicControl)

-  private

-    { Private declarations }

-  protected

-    { Protected declarations }

-    notes       : array[0..15,0..127] of integer;

-    controllers : array[0..15,0..17]  of integer;

-    aftertouch  : array[0..15,0..127] of integer;

-

-    selectedChannel : integer;

-

-    procedure PaintSlide(ch,pos,val: integer);

-

-    procedure NoteOn(channel, note, speed : integer);

-    procedure Controller(channel,number,value : integer);

-    procedure AfterTch(channel, note, value : integer);

-

-  public

-    { Public declarations }

-    constructor Create(AOwner: TComponent); override;

-    procedure MidiEvent(event,data1,data2 : integer);

-    procedure Paint; override;

-  published

-    { Published declarations }

-  end;

-

-

-procedure Register;

-

-const

-  BarHeight = 16;

-  BarHeightInc  = BarHeight+2;

-  BarWidth      = 3;

-  BarWidthInc   = BarWidth+1;

-  HeightDiv     = 128 div BarHeight;

-

-implementation

-

-uses Midicons;

-

-procedure Register;

-begin

-  RegisterComponents('Synth', [TMidiScope]);

-end;

-

-constructor TMidiScope.Create(AOwner: TComponent);

-var

- i,j : integer;

-begin

-  inherited Create(AOwner);

-  Height := BarHeightinc * 16 + 4;

-  Width :=  147*BarWidthInc + 4 + 20;  // for channel number

-  for i := 0 to 15 do

-  begin

-    for j := 0 to 127 do

-    begin

-      notes[i,j] := 0;

-      aftertouch[i,j] := 0;

-    end;

-  end;

-  for i := 0 to 17 do

-  begin

-    for j := 0 to 15 do

-      controllers[i,j] := 0;

-  end;

-end;

-

-procedure TMidiScope.PaintSlide(ch,pos,val: integer);

-var x,y:integer;

-begin

-  Canvas.Brush.Color := clBlack;

-  Canvas.Pen.color := clBlack;

-  x := pos * BarWidthInc + 2;

-  y := 2 + ch * BarHeightInc;

-  Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc);

-  Canvas.Brush.Color := clGreen;

-  Canvas.Pen.Color := clGreen;

-  Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight)

-end;

-

-procedure TMidiScope.Paint;

-var i,j : integer;

-x : integer;

-begin

-  Canvas.Brush.color := clBlack;

-  Canvas.Rectangle(0,0,Width,Height);

-  Canvas.Pen.Color := clGreen;

-  x := 128*BarWidthInc+2;

-  Canvas.MoveTo(x,0);

-  Canvas.LineTo(x,Height);

-  x :=  148*BarWIdthInc+2;

-  canvas.Font.Color := clGreen;

-  for i := 0 to 15 do

-    Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1));

-  canvas.Pen.color := clBlack;

-  begin

-    for j := 0 to 127 do

-    begin

-      PaintSlide(i,j,notes[i,j]);

-    end;

-    for j := 0 to 17 do

-    begin

-      PaintSlide(i,j+129,controllers[i,j]);

-    end;

-  end;

-end;

-procedure TMidiScope.NoteOn(channel, note, speed : integer);

-begin

-  notes[channel,note] := speed;

-  PaintSlide(channel,note,notes[channel,note]);

-end;

-procedure TMidiScope.AfterTch(channel, note, value : integer);

-begin

-  aftertouch[channel,note] := value;

-end;

-

-procedure TMidiScope.Controller(channel,number,value : integer);

-var i : integer;

-begin

-  if number < 18 then

-  begin

-  controllers[channel,number] := value;

-  PaintSlide(channel,number+129,value);

-  end

-  else if number >= $7B then

-  begin

-    // all notes of for channel

-    for i := 0 to 127 do

-    begin

-      if notes[channel,i] > 0 then

-      begin

-        notes[channel,i] := 0;

-        PaintSlide(channel,i,0);

-      end;

-    end;

-  end;

-end;

-

-procedure TMidiScope.MidiEvent(event,data1,data2 : integer);

-begin

-  case (event AND $F0) of

-  MIDI_NOTEON :

-  begin

-    NoteOn((event AND $F),data1,data2);

-  end;

-  MIDI_NOTEOFF:

-  begin

-    NoteOn((event AND $F),data1,0);

-  end;

-  MIDI_CONTROLCHANGE :

-  begin

-    Controller((event AND $F),data1,data2);

-  end;

-  MIDI_CHANAFTERTOUCH:

-  begin

-    Controller((Event AND $F),16,Data1);

-  end;

-  MIDI_PITCHBEND:

-  begin

-  begin

-    Controller((Event AND $F),17,data2);

-  end;

-  end;

-  MIDI_KEYAFTERTOUCH:

-  begin

-  end;

-  end;

-end;

-end.

+{
+  Shows a large black area where midi note/controller events are shown
+  just to monitor midi activity (for the MidiPlayer)
+
+  version 1.0 first release
+
+  for comments/bugs
+  F.Bouwmans
+  fbouwmans@spiditel.nl
+
+  if you think this component is nice and you use it, sent me a short email.
+  I've seen that other of my components have been downloaded a lot, but I've
+  got no clue wether they are actually used.
+  Don't worry because you are free to use these components
+}
+
+unit MidiScope;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
+
+type
+  TMidiScope = class(TGraphicControl)
+  private
+    { Private declarations }
+  protected
+    { Protected declarations }
+    notes       : array[0..15,0..127] of integer;
+    controllers : array[0..15,0..17]  of integer;
+    aftertouch  : array[0..15,0..127] of integer;
+
+    selectedChannel : integer;
+
+    procedure PaintSlide(ch,pos,val: integer);
+
+    procedure NoteOn(channel, note, speed : integer);
+    procedure Controller(channel,number,value : integer);
+    procedure AfterTch(channel, note, value : integer);
+
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    procedure MidiEvent(event,data1,data2 : integer);
+    procedure Paint; override;
+  published
+    { Published declarations }
+  end;
+
+
+procedure Register;
+
+const
+  BarHeight = 16;
+  BarHeightInc  = BarHeight+2;
+  BarWidth      = 3;
+  BarWidthInc   = BarWidth+1;
+  HeightDiv     = 128 div BarHeight;
+
+implementation
+
+uses Midicons;
+
+procedure Register;
+begin
+  RegisterComponents('Synth', [TMidiScope]);
+end;
+
+constructor TMidiScope.Create(AOwner: TComponent);
+var
+ i,j : integer;
+begin
+  inherited Create(AOwner);
+  Height := BarHeightinc * 16 + 4;
+  Width :=  147*BarWidthInc + 4 + 20;  // for channel number
+  for i := 0 to 15 do
+  begin
+    for j := 0 to 127 do
+    begin
+      notes[i,j] := 0;
+      aftertouch[i,j] := 0;
+    end;
+  end;
+  for i := 0 to 17 do
+  begin
+    for j := 0 to 15 do
+      controllers[i,j] := 0;
+  end;
+end;
+
+procedure TMidiScope.PaintSlide(ch,pos,val: integer);
+var x,y:integer;
+begin
+  Canvas.Brush.Color := clBlack;
+  Canvas.Pen.color := clBlack;
+  x := pos * BarWidthInc + 2;
+  y := 2 + ch * BarHeightInc;
+  Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc);
+  Canvas.Brush.Color := clGreen;
+  Canvas.Pen.Color := clGreen;
+  Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight)
+end;
+
+procedure TMidiScope.Paint;
+var i,j : integer;
+x : integer;
+begin
+  Canvas.Brush.color := clBlack;
+  Canvas.Rectangle(0,0,Width,Height);
+  Canvas.Pen.Color := clGreen;
+  x := 128*BarWidthInc+2;
+  Canvas.MoveTo(x,0);
+  Canvas.LineTo(x,Height);
+  x :=  148*BarWIdthInc+2;
+  canvas.Font.Color := clGreen;
+  for i := 0 to 15 do
+    Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1));
+  canvas.Pen.color := clBlack;
+  begin
+    for j := 0 to 127 do
+    begin
+      PaintSlide(i,j,notes[i,j]);
+    end;
+    for j := 0 to 17 do
+    begin
+      PaintSlide(i,j+129,controllers[i,j]);
+    end;
+  end;
+end;
+procedure TMidiScope.NoteOn(channel, note, speed : integer);
+begin
+  notes[channel,note] := speed;
+  PaintSlide(channel,note,notes[channel,note]);
+end;
+procedure TMidiScope.AfterTch(channel, note, value : integer);
+begin
+  aftertouch[channel,note] := value;
+end;
+
+procedure TMidiScope.Controller(channel,number,value : integer);
+var i : integer;
+begin
+  if number < 18 then
+  begin
+  controllers[channel,number] := value;
+  PaintSlide(channel,number+129,value);
+  end
+  else if number >= $7B then
+  begin
+    // all notes of for channel
+    for i := 0 to 127 do
+    begin
+      if notes[channel,i] > 0 then
+      begin
+        notes[channel,i] := 0;
+        PaintSlide(channel,i,0);
+      end;
+    end;
+  end;
+end;
+
+procedure TMidiScope.MidiEvent(event,data1,data2 : integer);
+begin
+  case (event AND $F0) of
+  MIDI_NOTEON :
+  begin
+    NoteOn((event AND $F),data1,data2);
+  end;
+  MIDI_NOTEOFF:
+  begin
+    NoteOn((event AND $F),data1,0);
+  end;
+  MIDI_CONTROLCHANGE :
+  begin
+    Controller((event AND $F),data1,data2);
+  end;
+  MIDI_CHANAFTERTOUCH:
+  begin
+    Controller((Event AND $F),16,Data1);
+  end;
+  MIDI_PITCHBEND:
+  begin
+  begin
+    Controller((Event AND $F),17,data2);
+  end;
+  end;
+  MIDI_KEYAFTERTOUCH:
+  begin
+  end;
+  end;
+end;
+end.
diff --git a/Game/Code/lib/midi/Midicons.pas b/Game/Code/lib/midi/Midicons.pas
index 45bae463..35dbb5f3 100644
--- a/Game/Code/lib/midi/Midicons.pas
+++ b/Game/Code/lib/midi/Midicons.pas
@@ -1,47 +1,47 @@
-{ $Header: /MidiComp/MIDICONS.PAS 2     10/06/97 7:33 Davec $ }

-

-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,

-  released to the public domain. }

-

-

-{ MIDI Constants }

-unit Midicons;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses Messages;

-

-const

-	MIDI_ALLNOTESOFF     = $7B;

-	MIDI_NOTEON          = $90;

-	MIDI_NOTEOFF         = $80;

-	MIDI_KEYAFTERTOUCH   = $a0;

-	MIDI_CONTROLCHANGE   = $b0;

-	MIDI_PROGRAMCHANGE   = $c0;

-	MIDI_CHANAFTERTOUCH  = $d0;

-	MIDI_PITCHBEND       = $e0;

-	MIDI_SYSTEMMESSAGE   = $f0;

-	MIDI_BEGINSYSEX      = $f0;

-	MIDI_MTCQUARTERFRAME = $f1;

-	MIDI_SONGPOSPTR      = $f2;

-	MIDI_SONGSELECT      = $f3;

-	MIDI_ENDSYSEX        = $F7;

-	MIDI_TIMINGCLOCK     = $F8;

-	MIDI_START           = $FA;

-	MIDI_CONTINUE        = $FB;

-	MIDI_STOP            = $FC;

-	MIDI_ACTIVESENSING   = $FE;

-	MIDI_SYSTEMRESET     = $FF;

-

-	MIM_OVERFLOW         = WM_USER;	{ Input buffer overflow }

-	MOM_PLAYBACK_DONE    = WM_USER+1; { Timed playback complete }

-

-

-implementation

-

-end.

+{ $Header: /MidiComp/MIDICONS.PAS 2     10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+  released to the public domain. }
+
+
+{ MIDI Constants }
+unit Midicons;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses Messages;
+
+const
+	MIDI_ALLNOTESOFF     = $7B;
+	MIDI_NOTEON          = $90;
+	MIDI_NOTEOFF         = $80;
+	MIDI_KEYAFTERTOUCH   = $a0;
+	MIDI_CONTROLCHANGE   = $b0;
+	MIDI_PROGRAMCHANGE   = $c0;
+	MIDI_CHANAFTERTOUCH  = $d0;
+	MIDI_PITCHBEND       = $e0;
+	MIDI_SYSTEMMESSAGE   = $f0;
+	MIDI_BEGINSYSEX      = $f0;
+	MIDI_MTCQUARTERFRAME = $f1;
+	MIDI_SONGPOSPTR      = $f2;
+	MIDI_SONGSELECT      = $f3;
+	MIDI_ENDSYSEX        = $F7;
+	MIDI_TIMINGCLOCK     = $F8;
+	MIDI_START           = $FA;
+	MIDI_CONTINUE        = $FB;
+	MIDI_STOP            = $FC;
+	MIDI_ACTIVESENSING   = $FE;
+	MIDI_SYSTEMRESET     = $FF;
+
+	MIM_OVERFLOW         = WM_USER;	{ Input buffer overflow }
+	MOM_PLAYBACK_DONE    = WM_USER+1; { Timed playback complete }
+
+
+implementation
+
+end.
diff --git a/Game/Code/lib/midi/Midiin.pas b/Game/Code/lib/midi/Midiin.pas
index a122bcb0..3688d5c9 100644
--- a/Game/Code/lib/midi/Midiin.pas
+++ b/Game/Code/lib/midi/Midiin.pas
@@ -1,725 +1,725 @@
-{ $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

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  Classes,

-  SysUtils,

-  Messages,

-  Windows,

-  MMSystem,

-  UCommon,

-  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: MMVERSION;

-    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: MMVERSION 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,

-     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.

-

+{ $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
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  Classes,
+  SysUtils,
+  Messages,
+  Windows,
+  MMSystem,
+  UCommon,
+  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: MMVERSION;
+    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: MMVERSION 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,
+     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.
+
diff --git a/Game/Code/lib/midi/Midiout.pas b/Game/Code/lib/midi/Midiout.pas
index 81b00e9f..2463ae8a 100644
--- a/Game/Code/lib/midi/Midiout.pas
+++ b/Game/Code/lib/midi/Midiout.pas
@@ -1,617 +1,617 @@
-{ $Header: /MidiComp/MidiOut.pas 2     10/06/97 7:33 Davec $ }

-

-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,

-  released to the public domain. }

-

-{ Thanks very much to Fred Kohler for the Technology code. }

-

-unit MidiOut;

-

-{

-  MIDI Output component.

-

-  Properties:

-   DeviceID: 	Windows numeric device ID for the MIDI output device.

- Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1).

-    Special value MIDI_MAPPER specifies output to the Windows MIDI mapper

- Read-only while device is open, exception if changed while open

-

- MIDIHandle:	The output handle to the MIDI device.

- 0 when device is not open

- Read-only, runtime-only

-

- ProductName: Name of the output device product that corresponds to the

- DeviceID property (e.g. 'MPU 401 out').

- You can write to this while the device is closed to select a particular

- output device by name (the DeviceID property will change to match).

- Exception if this property is changed while the device is open.

-

- Numdevs: Number of MIDI output devices installed on the system. This

- is the value returned by midiOutGetNumDevs. It's included for

- completeness.

-

-    Technology: Type of technology used by the MIDI device. You can set this

-    property to one of the values listed for OutportTech (below) and the component

-    will find an appropriate MIDI device. For example:

-     MidiOutput.Technology := opt_FMSynth;

-    will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one

-    is installed. If no such device is available an exception is raised,

-    see MidiOutput.SetTechnology.

-

- See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the

- following properties:

-  DriverVersion

-  Voices

-  Notes

-  ChannelMask

-  Support

-

- Error: The error code for the last MMSYSTEM error. See the MMSYSERR_

- entries in MMSYSTEM.INT for possible values.

-

-  Methods:

- Open: Open MIDI device specified by DeviceID property for output

-

- Close: Close device

-

- PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the

- device. This method takes a TMyMidiEvent object and transmits it.

- Notes:

-   1. If the object contains a sysex event the OnMidiOutput event will

-    be triggered when the sysex transmission is complete.

-   2. You can queue up multiple blocks of system exclusive data for

-    transmission by chucking them at this method; they will be

-   transmitted as quickly as the device can manage.

-   3. This method will not free the TMyMidiEvent object, the caller

-    must do that. Any sysex data in the TMyMidiEvent is copied before

-   transmission so you can free the TMyMidiEvent immediately after

-   calling PutMidiEvent, even if output has not yet finished.

-

- PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short

- MIDI message. Handy when you can't be bothered to build a TMyMidiEvent.

- If the message you're sending doesn't use Data1 or Data2, set them to 0.

-

- PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data.

-  SysexPointer: Pointer to sysex data to send

-  msgLength: Length of sysex data.

- This is handy when you don't have a TMyMidiEvent.

-

- SetVolume(Left: Word, Right: Word): Set the volume of the

- left and right channels on the output device (only on internal devices?).

- 0xFFFF is maximum volume. If the device doesn't support separate

- left/right volume control, the value of the Left parameter will be used.

- Check the Support property to see whether the device supports volume

- control. See also other notes on volume control under midiOutSetVolume()

- in MMSYSTEM.HLP.

-

-  Events:

- OnMidiOutput: Procedure called when output of a system exclusive block

- is completed.

-

-  Notes:

-   I haven't implemented any methods for midiOutCachePatches and

-  midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing

-  them. Does anyone really use these?

-}

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-  {$H+} // use AnsiString

-{$ENDIF}

-

-uses

-  SysUtils,

-  Windows,

-  Messages,

-  Classes,

-  MMSystem,

-  UCommon,

-  Circbuf,

-  MidiType,

-  MidiDefs,

-  Delphmcb;

-

-{$IFDEF FPC}

-type TmidioutCaps = MIDIOUTCAPS;

-{$ENDIF}

-

-type

-  midioutputState = (mosOpen, mosClosed);

-  EmidioutputError = class(Exception);

-

- { These are the equivalent of constants prefixed with mod_

-   as defined in MMSystem. See SetTechnology }

-  OutPortTech = (

-    opt_None, { none }

-    opt_MidiPort, { output port }

-    opt_Synth, { generic internal synth }

-    opt_SQSynth, { square wave internal synth }

-    opt_FMSynth, { FM internal synth }

-    opt_Mapper); { MIDI mapper }

-  TechNameMap = array[OutPortTech] of string[18];

-

-

-const

-  TechName: TechNameMap = (

-    'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth',

-    'FM Synth', 'MIDI Mapper');

-

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

-type

-  TMidiOutput = class(TComponent)

-  protected

-    Handle: THandle; { Window handle used for callback notification }

-    FDeviceID: Cardinal; { MIDI device ID }

-    FMIDIHandle: Hmidiout; { Handle to output device }

-    FState: midioutputState; { Current device state }

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

-

-    PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open }

-

-    FError: Word; { Last MMSYSTEM error }

-

- { Stuff from midioutCAPS }

-    FDriverVersion: MMVERSION; { Driver version from midioutGetDevCaps }

-    FProductName: string; { product name }

-    FTechnology: OutPortTech; { Type of MIDI output device }

-    FVoices: Word; { Number of voices (internal synth) }

-    FNotes: Word; { Number of notes (internal synth) }

-    FChannelMask: Word; { Bit set for each MIDI channels that the

-          device responds to (internal synth) }

-    FSupport: DWORD; { Technology supported (volume control,

-          patch caching etc. }

-    FNumdevs: Word; { Number of MIDI output devices on system }

-

-

-    FOnMIDIOutput: TNotifyEvent; { Sysex output finished }

-

-    procedure MidiOutput(var Message: TMessage);

-    procedure SetDeviceID(DeviceID: Cardinal);

-    procedure SetProductName(NewProductName: string);

-    procedure SetTechnology(NewTechnology: OutPortTech);

-    function midioutErrorString(WError: Word): string;

-

-  public

- { Properties }

-    property MIDIHandle: Hmidiout read FMIDIHandle;

-    property DriverVersion: MMVERSION { Driver version from midioutGetDevCaps }

-    read FDriverVersion;

-    property Technology: OutPortTech { Type of MIDI output device }

-    read FTechnology

-      write SetTechnology

-      default opt_Synth;

-    property Voices: Word { Number of voices (internal synth) }

-    read FVoices;

-    property Notes: Word { Number of notes (internal synth) }

-    read FNotes;

-    property ChannelMask: Word { Bit set for each MIDI channels that the }

-    read FChannelMask; { device responds to (internal synth) }

-    property Support: DWORD { Technology supported (volume control, }

-    read FSupport; { patch caching etc. }

-    property Error: Word read FError;

-    property Numdevs: Word read FNumdevs;

-

- { Methods }

-    function Open: Boolean; virtual;

-    function Close: Boolean; virtual;

-    procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual;

-    procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual;

-    procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual;

-    procedure SetVolume(Left: Word; Right: Word);

-    constructor Create(AOwner: TComponent); override;

-    destructor Destroy; override;

-

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

-

-  published

- { TODO: Property editor with dropdown list of product names }

-    property ProductName: string read FProductName write SetProductName;

-

-    property DeviceID: Cardinal read FDeviceID write SetDeviceID default 0;

- { TODO: midiOutGetVolume? Or two properties for Left and Right volume?

-   Is it worth it??

-     midiOutMessage?? Does anyone use this? }

-

- { Events }

-    property Onmidioutput: TNotifyEvent

-      read FOnmidioutput

-      write FOnmidioutput;

-  end;

-

-procedure Register;

-

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

-implementation

-

-(* Not used in Delphi 3

-

-{ This is the callback procedure in the external DLL.

-  It's used when midioutOpen is called by the Open method.

-  There are special requirements and restrictions for this callback

-  procedure (see midioutOpen 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}

-function midiHandler(

-    hMidiIn: HMidiIn;

-    wMsg: Word;

-    dwInstance: DWORD;

-    dwParam1: DWORD;

-    dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL';

-{$ENDIF}

-*)

-

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

-

-constructor Tmidioutput.Create(AOwner: TComponent);

-begin

-  inherited Create(AOwner);

-  FState := mosClosed;

-  FNumdevs := midiOutGetNumDevs;

-

- { Create the window for callback notification }

-  if not (csDesigning in ComponentState) then

-  begin

-    Handle := AllocateHwnd(MidiOutput);

-  end;

-

-end;

-

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

-

-destructor Tmidioutput.Destroy;

-begin

-  if FState = mosOpen then

-    Close;

-  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 midioutGetErrorText. TODO: These errors aren't very helpful

-  (e.g. "an invalid parameter was passed to a system function") so

-  some proper error strings would be nice. }

-

-

-function Tmidioutput.midioutErrorString(WError: Word): string;

-var

-  errorDesc: PChar;

-begin

-  errorDesc := nil;

-  try

-    errorDesc := StrAlloc(MAXERRORLENGTH);

-    if midioutGetErrorText(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 output device ID and change the other properties to match }

-

-procedure Tmidioutput.SetDeviceID(DeviceID: Cardinal);

-var

-  midioutCaps: TmidioutCaps;

-begin

-  if FState = mosOpen then

-    raise EmidioutputError.Create('Change to DeviceID while device was open')

-  else

-    if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then

-      raise EmidioutputError.Create('Invalid device ID')

-    else

-    begin

-      FDeviceID := DeviceID;

-

-   { Set the name and other midioutCAPS properties to match the ID }

-      FError :=

-        midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps));

-      if Ferror > 0 then

-        raise EmidioutputError.Create(midioutErrorString(FError));

-

-      with midiOutCaps do

-      begin

-        FProductName := StrPas(szPname);

-        FDriverVersion := vDriverVersion;

-        FTechnology := OutPortTech(wTechnology);

-        FVoices := wVoices;

-        FNotes := wNotes;

-        FChannelMask := wChannelMask;

-        FSupport := dwSupport;

-      end;

-

-    end;

-end;

-

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

-{ Set the product name property and put the matching output device number

-  in FDeviceID.

-  This is handy if you want to save a configured output/output device

-  by device name instead of device number, because device numbers may

-  change if users install or remove MIDI devices.

-  Exception if output device with matching name not found,

-  or if output device is open }

-

-procedure Tmidioutput.SetProductName(NewProductName: string);

-var

-  midioutCaps: TmidioutCaps;

-  testDeviceID: Integer;

-  testProductName: string;

-begin

-  if FState = mosOpen then

-    raise EmidioutputError.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

-    { Loop uses -1 to test for MIDI_MAPPER as well }

-      for testDeviceID := -1 to (midioutGetNumDevs - 1) do

-      begin

-        FError :=

-          midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps));

-        if Ferror > 0 then

-          raise EmidioutputError.Create(midioutErrorString(FError));

-        testProductName := StrPas(midioutCaps.szPname);

-        if testProductName = NewProductName then

-        begin

-          FProductName := NewProductName;

-          Break;

-        end;

-      end;

-      if FProductName <> NewProductName then

-        raise EmidioutputError.Create('MIDI output Device ' +

-          NewProductName + ' not installed')

-      else

-        SetDeviceID(testDeviceID);

-    end;

-end;

-

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

-{ Set the output technology property and put the matching output device

- number in FDeviceID.

-  This is handy, for example, if you want to be able to switch between a

-  sound card and a MIDI port }

-

-procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);

-var

-  midiOutCaps: TMidiOutCaps;

-  testDeviceID: Integer;

-  testTechnology: OutPortTech;

-begin

-  if FState = mosOpen then

-    raise EMidiOutputError.Create(

-      'Change to Product Technology while device was open')

-  else

-  begin

-       { Loop uses -1 to test for MIDI_MAPPER as well }

-    for testDeviceID := -1 to (midiOutGetNumDevs - 1) do

-    begin

-      FError :=

-        midiOutGetDevCaps(testDeviceID,

-        @midiOutCaps, sizeof(TMidiOutCaps));

-      if Ferror > 0 then

-        raise EMidiOutputError.Create(MidiOutErrorString(FError));

-      testTechnology := OutPortTech(midiOutCaps.wTechnology);

-      if testTechnology = NewTechnology then

-      begin

-        FTechnology := NewTechnology;

-        Break;

-      end;

-    end;

-    if FTechnology <> NewTechnology then

-      raise EMidiOutputError.Create('MIDI output technology ' +

-        TechName[NewTechnology] + ' not installed')

-    else

-      SetDeviceID(testDeviceID);

-  end;

-end;

-

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

-

-function Tmidioutput.Open: Boolean;

-var

-  hMem: THandle;

-begin

-  Result := False;

-  try

-  { Create the control info for the DLL }

-    if (PCtlInfo = nil) then

-    begin

-      PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);

-      PctlInfo^.hMem := hMem;

-    end;

-

-    Pctlinfo^.hWindow := Handle; { Control's window handle }

-

-    FError := midioutOpen(@FMidiHandle, FDeviceId,

-      DWORD(@midiHandler),

-      DWORD(PCtlInfo),

-      CALLBACK_FUNCTION);

-{                FError := midioutOpen(@FMidiHandle, FDeviceId,

-      Handle,

-      DWORD(PCtlInfo),

-      CALLBACK_WINDOW); }

-    if (FError <> 0) then

-   { TODO: use CreateFmtHelp to add MIDI device name/ID to message }

-      raise EmidioutputError.Create(midioutErrorString(FError))

-    else

-    begin

-      Result := True;

-      FState := mosOpen;

-    end;

-

-  except

-    if PCtlInfo <> nil then

-    begin

-      GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);

-      PCtlInfo := nil;

-    end;

-  end;

-

-end;

-

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

-

-procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);

-var

-  thisMsg: DWORD;

-begin

-  thisMsg := DWORD(MidiMessage) or

-    (DWORD(Data1) shl 8) or

-    (DWORD(Data2) shl 16);

-

-  FError := midiOutShortMsg(FMidiHandle, thisMsg);

-  if Ferror > 0 then

-    raise EmidioutputError.Create(midioutErrorString(FError));

-end;

-

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

-

-procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);

-{ Notes: This works asynchronously; you send your sysex output by

-calling this function, which returns immediately. When the MIDI device

-driver has finished sending the data the MidiOutPut function in this

-component is called, which will in turn call the OnMidiOutput method

-if the component user has defined one. }

-{ TODO: Combine common functions with PutTimedLong into subroutine }

-

-var

-  MyMidiHdr: TMyMidiHdr;

-begin

- { Initialize the header and allocate buffer memory }

-  MyMidiHdr := TMyMidiHdr.Create(msgLength);

-

- { Copy the data over to the MidiHdr buffer

-   We can't just use the caller's PChar because the buffer memory

-   has to be global, shareable, and locked. }

-  StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength);

-

- { Store the MyMidiHdr address in the header so we can find it again quickly

-      (see the MidiOutput proc) }

-  MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);

-

- { Get MMSYSTEM's blessing for this header }

-  FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,

-    sizeof(TMIDIHDR));

-  if Ferror > 0 then

-    raise EMidiOutputError.Create(MidiOutErrorString(FError));

-

- { Send it }

-  FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer,

-    sizeof(TMIDIHDR));

-  if Ferror > 0 then

-    raise EMidiOutputError.Create(MidiOutErrorString(FError));

-

-end;

-

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

-

-procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent);

-begin

-  if FState <> mosOpen then

-    raise EMidiOutputError.Create('MIDI Output device not open');

-

-  with theEvent do

-  begin

-    if Sysex = nil then

-    begin

-      PutShort(MidiMessage, Data1, Data2)

-    end

-    else

-      PutLong(Sysex, SysexLength);

-  end;

-end;

-

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

-

-function Tmidioutput.Close: Boolean;

-begin

-  Result := False;

-  if FState = mosOpen then

-  begin

-

-        { Note this sends a lot of fast control change messages which some synths can't handle.

-          TODO: Make this optional. }

-{		FError := midioutReset(FMidiHandle);

-  if Ferror <> 0 then

-   raise EMidiOutputError.Create(MidiOutErrorString(FError)); }

-

-    FError := midioutClose(FMidiHandle);

-    if Ferror <> 0 then

-      raise EMidiOutputError.Create(MidiOutErrorString(FError))

-    else

-      Result := True;

-  end;

-

-  FMidiHandle := 0;

-  FState := mosClosed;

-

-end;

-

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

-

-procedure TMidiOutput.SetVolume(Left: Word; Right: Word);

-var

-  dwVolume: DWORD;

-begin

-  dwVolume := (DWORD(Left) shl 16) or Right;

-  FError := midiOutSetVolume(DeviceID, dwVolume);

-  if Ferror <> 0 then

-    raise EMidiOutputError.Create(MidiOutErrorString(FError));

-end;

-

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

-

-procedure Tmidioutput.midioutput(var Message: TMessage);

-{ Triggered when sysex output from PutLong is complete }

-var

-  MyMidiHdr: TMyMidiHdr;

-  thisHdr: PMidiHdr;

-begin

-  if Message.Msg = Mom_Done then

-  begin

-  { Find the MIDIHDR we used for the output. Message.lParam is its address }

-    thisHdr := PMidiHdr(Message.lParam);

-

-  { Remove it from the output device }

-    midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR));

-

-  { Get the address of the MyMidiHdr object containing this MIDIHDR structure.

-   We stored this address in the PutLong procedure }

-    MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser);

-

-  { Header and copy of sysex data no longer required since output is complete }

-    MyMidiHdr.Free;

-

-  { Call the user's event handler if any }

-    if Assigned(FOnmidioutput) then

-      FOnmidioutput(Self);

-  end;

- { TODO: Case for MOM_PLAYBACK_DONE }

-end;

-

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

-

-procedure Register;

-begin

-  RegisterComponents('Synth', [Tmidioutput]);

-end;

-

-end.

-

+{ $Header: /MidiComp/MidiOut.pas 2     10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+  released to the public domain. }
+
+{ Thanks very much to Fred Kohler for the Technology code. }
+
+unit MidiOut;
+
+{
+  MIDI Output component.
+
+  Properties:
+   DeviceID: 	Windows numeric device ID for the MIDI output device.
+ Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1).
+    Special value MIDI_MAPPER specifies output to the Windows MIDI mapper
+ Read-only while device is open, exception if changed while open
+
+ MIDIHandle:	The output handle to the MIDI device.
+ 0 when device is not open
+ Read-only, runtime-only
+
+ ProductName: Name of the output device product that corresponds to the
+ DeviceID property (e.g. 'MPU 401 out').
+ You can write to this while the device is closed to select a particular
+ output device by name (the DeviceID property will change to match).
+ Exception if this property is changed while the device is open.
+
+ Numdevs: Number of MIDI output devices installed on the system. This
+ is the value returned by midiOutGetNumDevs. It's included for
+ completeness.
+
+    Technology: Type of technology used by the MIDI device. You can set this
+    property to one of the values listed for OutportTech (below) and the component
+    will find an appropriate MIDI device. For example:
+     MidiOutput.Technology := opt_FMSynth;
+    will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one
+    is installed. If no such device is available an exception is raised,
+    see MidiOutput.SetTechnology.
+
+ See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the
+ following properties:
+  DriverVersion
+  Voices
+  Notes
+  ChannelMask
+  Support
+
+ Error: The error code for the last MMSYSTEM error. See the MMSYSERR_
+ entries in MMSYSTEM.INT for possible values.
+
+  Methods:
+ Open: Open MIDI device specified by DeviceID property for output
+
+ Close: Close device
+
+ PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the
+ device. This method takes a TMyMidiEvent object and transmits it.
+ Notes:
+   1. If the object contains a sysex event the OnMidiOutput event will
+    be triggered when the sysex transmission is complete.
+   2. You can queue up multiple blocks of system exclusive data for
+    transmission by chucking them at this method; they will be
+   transmitted as quickly as the device can manage.
+   3. This method will not free the TMyMidiEvent object, the caller
+    must do that. Any sysex data in the TMyMidiEvent is copied before
+   transmission so you can free the TMyMidiEvent immediately after
+   calling PutMidiEvent, even if output has not yet finished.
+
+ PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short
+ MIDI message. Handy when you can't be bothered to build a TMyMidiEvent.
+ If the message you're sending doesn't use Data1 or Data2, set them to 0.
+
+ PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data.
+  SysexPointer: Pointer to sysex data to send
+  msgLength: Length of sysex data.
+ This is handy when you don't have a TMyMidiEvent.
+
+ SetVolume(Left: Word, Right: Word): Set the volume of the
+ left and right channels on the output device (only on internal devices?).
+ 0xFFFF is maximum volume. If the device doesn't support separate
+ left/right volume control, the value of the Left parameter will be used.
+ Check the Support property to see whether the device supports volume
+ control. See also other notes on volume control under midiOutSetVolume()
+ in MMSYSTEM.HLP.
+
+  Events:
+ OnMidiOutput: Procedure called when output of a system exclusive block
+ is completed.
+
+  Notes:
+   I haven't implemented any methods for midiOutCachePatches and
+  midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing
+  them. Does anyone really use these?
+}
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+  SysUtils,
+  Windows,
+  Messages,
+  Classes,
+  MMSystem,
+  UCommon,
+  Circbuf,
+  MidiType,
+  MidiDefs,
+  Delphmcb;
+
+{$IFDEF FPC}
+type TmidioutCaps = MIDIOUTCAPS;
+{$ENDIF}
+
+type
+  midioutputState = (mosOpen, mosClosed);
+  EmidioutputError = class(Exception);
+
+ { These are the equivalent of constants prefixed with mod_
+   as defined in MMSystem. See SetTechnology }
+  OutPortTech = (
+    opt_None, { none }
+    opt_MidiPort, { output port }
+    opt_Synth, { generic internal synth }
+    opt_SQSynth, { square wave internal synth }
+    opt_FMSynth, { FM internal synth }
+    opt_Mapper); { MIDI mapper }
+  TechNameMap = array[OutPortTech] of string[18];
+
+
+const
+  TechName: TechNameMap = (
+    'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth',
+    'FM Synth', 'MIDI Mapper');
+
+{-------------------------------------------------------------------}
+type
+  TMidiOutput = class(TComponent)
+  protected
+    Handle: THandle; { Window handle used for callback notification }
+    FDeviceID: Cardinal; { MIDI device ID }
+    FMIDIHandle: Hmidiout; { Handle to output device }
+    FState: midioutputState; { Current device state }
+    PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
+
+    PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open }
+
+    FError: Word; { Last MMSYSTEM error }
+
+ { Stuff from midioutCAPS }
+    FDriverVersion: MMVERSION; { Driver version from midioutGetDevCaps }
+    FProductName: string; { product name }
+    FTechnology: OutPortTech; { Type of MIDI output device }
+    FVoices: Word; { Number of voices (internal synth) }
+    FNotes: Word; { Number of notes (internal synth) }
+    FChannelMask: Word; { Bit set for each MIDI channels that the
+          device responds to (internal synth) }
+    FSupport: DWORD; { Technology supported (volume control,
+          patch caching etc. }
+    FNumdevs: Word; { Number of MIDI output devices on system }
+
+
+    FOnMIDIOutput: TNotifyEvent; { Sysex output finished }
+
+    procedure MidiOutput(var Message: TMessage);
+    procedure SetDeviceID(DeviceID: Cardinal);
+    procedure SetProductName(NewProductName: string);
+    procedure SetTechnology(NewTechnology: OutPortTech);
+    function midioutErrorString(WError: Word): string;
+
+  public
+ { Properties }
+    property MIDIHandle: Hmidiout read FMIDIHandle;
+    property DriverVersion: MMVERSION { Driver version from midioutGetDevCaps }
+    read FDriverVersion;
+    property Technology: OutPortTech { Type of MIDI output device }
+    read FTechnology
+      write SetTechnology
+      default opt_Synth;
+    property Voices: Word { Number of voices (internal synth) }
+    read FVoices;
+    property Notes: Word { Number of notes (internal synth) }
+    read FNotes;
+    property ChannelMask: Word { Bit set for each MIDI channels that the }
+    read FChannelMask; { device responds to (internal synth) }
+    property Support: DWORD { Technology supported (volume control, }
+    read FSupport; { patch caching etc. }
+    property Error: Word read FError;
+    property Numdevs: Word read FNumdevs;
+
+ { Methods }
+    function Open: Boolean; virtual;
+    function Close: Boolean; virtual;
+    procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual;
+    procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual;
+    procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual;
+    procedure SetVolume(Left: Word; Right: Word);
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+   { Some functions to decode and classify incoming messages would be nice }
+
+  published
+ { TODO: Property editor with dropdown list of product names }
+    property ProductName: string read FProductName write SetProductName;
+
+    property DeviceID: Cardinal read FDeviceID write SetDeviceID default 0;
+ { TODO: midiOutGetVolume? Or two properties for Left and Right volume?
+   Is it worth it??
+     midiOutMessage?? Does anyone use this? }
+
+ { Events }
+    property Onmidioutput: TNotifyEvent
+      read FOnmidioutput
+      write FOnmidioutput;
+  end;
+
+procedure Register;
+
+{-------------------------------------------------------------------}
+implementation
+
+(* Not used in Delphi 3
+
+{ This is the callback procedure in the external DLL.
+  It's used when midioutOpen is called by the Open method.
+  There are special requirements and restrictions for this callback
+  procedure (see midioutOpen 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}
+function midiHandler(
+    hMidiIn: HMidiIn;
+    wMsg: Word;
+    dwInstance: DWORD;
+    dwParam1: DWORD;
+    dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL';
+{$ENDIF}
+*)
+
+{-------------------------------------------------------------------}
+
+constructor Tmidioutput.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FState := mosClosed;
+  FNumdevs := midiOutGetNumDevs;
+
+ { Create the window for callback notification }
+  if not (csDesigning in ComponentState) then
+  begin
+    Handle := AllocateHwnd(MidiOutput);
+  end;
+
+end;
+
+{-------------------------------------------------------------------}
+
+destructor Tmidioutput.Destroy;
+begin
+  if FState = mosOpen then
+    Close;
+  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 midioutGetErrorText. TODO: These errors aren't very helpful
+  (e.g. "an invalid parameter was passed to a system function") so
+  some proper error strings would be nice. }
+
+
+function Tmidioutput.midioutErrorString(WError: Word): string;
+var
+  errorDesc: PChar;
+begin
+  errorDesc := nil;
+  try
+    errorDesc := StrAlloc(MAXERRORLENGTH);
+    if midioutGetErrorText(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 output device ID and change the other properties to match }
+
+procedure Tmidioutput.SetDeviceID(DeviceID: Cardinal);
+var
+  midioutCaps: TmidioutCaps;
+begin
+  if FState = mosOpen then
+    raise EmidioutputError.Create('Change to DeviceID while device was open')
+  else
+    if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then
+      raise EmidioutputError.Create('Invalid device ID')
+    else
+    begin
+      FDeviceID := DeviceID;
+
+   { Set the name and other midioutCAPS properties to match the ID }
+      FError :=
+        midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps));
+      if Ferror > 0 then
+        raise EmidioutputError.Create(midioutErrorString(FError));
+
+      with midiOutCaps do
+      begin
+        FProductName := StrPas(szPname);
+        FDriverVersion := vDriverVersion;
+        FTechnology := OutPortTech(wTechnology);
+        FVoices := wVoices;
+        FNotes := wNotes;
+        FChannelMask := wChannelMask;
+        FSupport := dwSupport;
+      end;
+
+    end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the product name property and put the matching output device number
+  in FDeviceID.
+  This is handy if you want to save a configured output/output device
+  by device name instead of device number, because device numbers may
+  change if users install or remove MIDI devices.
+  Exception if output device with matching name not found,
+  or if output device is open }
+
+procedure Tmidioutput.SetProductName(NewProductName: string);
+var
+  midioutCaps: TmidioutCaps;
+  testDeviceID: Integer;
+  testProductName: string;
+begin
+  if FState = mosOpen then
+    raise EmidioutputError.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
+    { Loop uses -1 to test for MIDI_MAPPER as well }
+      for testDeviceID := -1 to (midioutGetNumDevs - 1) do
+      begin
+        FError :=
+          midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps));
+        if Ferror > 0 then
+          raise EmidioutputError.Create(midioutErrorString(FError));
+        testProductName := StrPas(midioutCaps.szPname);
+        if testProductName = NewProductName then
+        begin
+          FProductName := NewProductName;
+          Break;
+        end;
+      end;
+      if FProductName <> NewProductName then
+        raise EmidioutputError.Create('MIDI output Device ' +
+          NewProductName + ' not installed')
+      else
+        SetDeviceID(testDeviceID);
+    end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the output technology property and put the matching output device
+ number in FDeviceID.
+  This is handy, for example, if you want to be able to switch between a
+  sound card and a MIDI port }
+
+procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);
+var
+  midiOutCaps: TMidiOutCaps;
+  testDeviceID: Integer;
+  testTechnology: OutPortTech;
+begin
+  if FState = mosOpen then
+    raise EMidiOutputError.Create(
+      'Change to Product Technology while device was open')
+  else
+  begin
+       { Loop uses -1 to test for MIDI_MAPPER as well }
+    for testDeviceID := -1 to (midiOutGetNumDevs - 1) do
+    begin
+      FError :=
+        midiOutGetDevCaps(testDeviceID,
+        @midiOutCaps, sizeof(TMidiOutCaps));
+      if Ferror > 0 then
+        raise EMidiOutputError.Create(MidiOutErrorString(FError));
+      testTechnology := OutPortTech(midiOutCaps.wTechnology);
+      if testTechnology = NewTechnology then
+      begin
+        FTechnology := NewTechnology;
+        Break;
+      end;
+    end;
+    if FTechnology <> NewTechnology then
+      raise EMidiOutputError.Create('MIDI output technology ' +
+        TechName[NewTechnology] + ' not installed')
+    else
+      SetDeviceID(testDeviceID);
+  end;
+end;
+
+{-------------------------------------------------------------------}
+
+function Tmidioutput.Open: Boolean;
+var
+  hMem: THandle;
+begin
+  Result := False;
+  try
+  { Create the control info for the DLL }
+    if (PCtlInfo = nil) then
+    begin
+      PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
+      PctlInfo^.hMem := hMem;
+    end;
+
+    Pctlinfo^.hWindow := Handle; { Control's window handle }
+
+    FError := midioutOpen(@FMidiHandle, FDeviceId,
+      DWORD(@midiHandler),
+      DWORD(PCtlInfo),
+      CALLBACK_FUNCTION);
+{                FError := midioutOpen(@FMidiHandle, FDeviceId,
+      Handle,
+      DWORD(PCtlInfo),
+      CALLBACK_WINDOW); }
+    if (FError <> 0) then
+   { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
+      raise EmidioutputError.Create(midioutErrorString(FError))
+    else
+    begin
+      Result := True;
+      FState := mosOpen;
+    end;
+
+  except
+    if PCtlInfo <> nil then
+    begin
+      GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
+      PCtlInfo := nil;
+    end;
+  end;
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);
+var
+  thisMsg: DWORD;
+begin
+  thisMsg := DWORD(MidiMessage) or
+    (DWORD(Data1) shl 8) or
+    (DWORD(Data2) shl 16);
+
+  FError := midiOutShortMsg(FMidiHandle, thisMsg);
+  if Ferror > 0 then
+    raise EmidioutputError.Create(midioutErrorString(FError));
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);
+{ Notes: This works asynchronously; you send your sysex output by
+calling this function, which returns immediately. When the MIDI device
+driver has finished sending the data the MidiOutPut function in this
+component is called, which will in turn call the OnMidiOutput method
+if the component user has defined one. }
+{ TODO: Combine common functions with PutTimedLong into subroutine }
+
+var
+  MyMidiHdr: TMyMidiHdr;
+begin
+ { Initialize the header and allocate buffer memory }
+  MyMidiHdr := TMyMidiHdr.Create(msgLength);
+
+ { Copy the data over to the MidiHdr buffer
+   We can't just use the caller's PChar because the buffer memory
+   has to be global, shareable, and locked. }
+  StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength);
+
+ { Store the MyMidiHdr address in the header so we can find it again quickly
+      (see the MidiOutput proc) }
+  MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
+
+ { Get MMSYSTEM's blessing for this header }
+  FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
+    sizeof(TMIDIHDR));
+  if Ferror > 0 then
+    raise EMidiOutputError.Create(MidiOutErrorString(FError));
+
+ { Send it }
+  FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer,
+    sizeof(TMIDIHDR));
+  if Ferror > 0 then
+    raise EMidiOutputError.Create(MidiOutErrorString(FError));
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent);
+begin
+  if FState <> mosOpen then
+    raise EMidiOutputError.Create('MIDI Output device not open');
+
+  with theEvent do
+  begin
+    if Sysex = nil then
+    begin
+      PutShort(MidiMessage, Data1, Data2)
+    end
+    else
+      PutLong(Sysex, SysexLength);
+  end;
+end;
+
+{-------------------------------------------------------------------}
+
+function Tmidioutput.Close: Boolean;
+begin
+  Result := False;
+  if FState = mosOpen then
+  begin
+
+        { Note this sends a lot of fast control change messages which some synths can't handle.
+          TODO: Make this optional. }
+{		FError := midioutReset(FMidiHandle);
+  if Ferror <> 0 then
+   raise EMidiOutputError.Create(MidiOutErrorString(FError)); }
+
+    FError := midioutClose(FMidiHandle);
+    if Ferror <> 0 then
+      raise EMidiOutputError.Create(MidiOutErrorString(FError))
+    else
+      Result := True;
+  end;
+
+  FMidiHandle := 0;
+  FState := mosClosed;
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.SetVolume(Left: Word; Right: Word);
+var
+  dwVolume: DWORD;
+begin
+  dwVolume := (DWORD(Left) shl 16) or Right;
+  FError := midiOutSetVolume(DeviceID, dwVolume);
+  if Ferror <> 0 then
+    raise EMidiOutputError.Create(MidiOutErrorString(FError));
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Tmidioutput.midioutput(var Message: TMessage);
+{ Triggered when sysex output from PutLong is complete }
+var
+  MyMidiHdr: TMyMidiHdr;
+  thisHdr: PMidiHdr;
+begin
+  if Message.Msg = Mom_Done then
+  begin
+  { Find the MIDIHDR we used for the output. Message.lParam is its address }
+    thisHdr := PMidiHdr(Message.lParam);
+
+  { Remove it from the output device }
+    midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR));
+
+  { Get the address of the MyMidiHdr object containing this MIDIHDR structure.
+   We stored this address in the PutLong procedure }
+    MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser);
+
+  { Header and copy of sysex data no longer required since output is complete }
+    MyMidiHdr.Free;
+
+  { Call the user's event handler if any }
+    if Assigned(FOnmidioutput) then
+      FOnmidioutput(Self);
+  end;
+ { TODO: Case for MOM_PLAYBACK_DONE }
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Register;
+begin
+  RegisterComponents('Synth', [Tmidioutput]);
+end;
+
+end.
+
diff --git a/Game/Code/lib/midi/demo/MidiTest.pas b/Game/Code/lib/midi/demo/MidiTest.pas
index 0cf3e302..793db730 100644
--- a/Game/Code/lib/midi/demo/MidiTest.pas
+++ b/Game/Code/lib/midi/demo/MidiTest.pas
@@ -1,249 +1,249 @@
-// Test application for TMidiFile

-

-unit MidiTest;

-

-interface

-

-uses

-  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

-  StdCtrls, MidiFile,  ExtCtrls, MidiOut, MidiType, MidiScope, Grids;

-type

-  TMidiPlayer = class(TForm)

-    OpenDialog1: TOpenDialog;

-    Button1: TButton;

-    Button3: TButton;

-    Button4: TButton;

-    MidiOutput1: TMidiOutput;

-    cmbInput: TComboBox;

-    MidiFile1: TMidiFile;

-    MidiScope1: TMidiScope;

-    Label3: TLabel;

-    edtBpm: TEdit;

-    Memo2: TMemo;

-    edtTime: TEdit;

-    Button2: TButton;

-    TrackGrid: TStringGrid;

-    TracksGrid: TStringGrid;

-    edtLength: TEdit;

-    procedure Button1Click(Sender: TObject);

-    procedure MidiFile1MidiEvent(event: PMidiEvent);

-    procedure Button3Click(Sender: TObject);

-    procedure Button4Click(Sender: TObject);

-    procedure FormCreate(Sender: TObject);

-    procedure cmbInputChange(Sender: TObject);

-    procedure MidiFile1UpdateEvent(Sender: TObject);

-    procedure Button2Click(Sender: TObject);

-    procedure edtBpmKeyPress(Sender: TObject; var Key: Char);

-    procedure TracksGridSelectCell(Sender: TObject; Col, Row: Integer;

-      var CanSelect: Boolean);

-    procedure FormShow(Sender: TObject);

-  private

-    { Private declarations }

-    MidiOpened : boolean;

-    procedure SentAllNotesOff;

-

-    procedure MidiOpen;

-    procedure MidiClose;

-

-  public

-    { Public declarations }

-  end;

-

-var

-  MidiPlayer: TMidiPlayer;

-

-implementation

-

-{$R *.DFM}

-

-procedure TMidiPlayer.Button1Click(Sender: TObject);

-var

-  i,j: integer;

-  track : TMidiTrack;

-  event : PMidiEvent;

-begin

-  if opendialog1.execute then

-  begin

-    midifile1.filename := opendialog1.filename;

-    midifile1.readfile;

-//    label1.caption := IntToStr(midifile1.NumberOfTracks);

-    edtBpm.text := IntToStr(midifile1.Bpm);

-//    TracksGrid.cells.clear;

-    for i := 0 to midifile1.NumberOfTracks-1 do

-    begin

-      track := midifile1.getTrack(i);

-      TracksGrid.cells[0,i] := 'Tr: '+ track.getName + ' '+ track.getInstrument ;

-    end;

-    edtLength.Text := MyTimeToStr(MidiFile1.GetTrackLength);

-  end;

-end;

-

-procedure TMidiPlayer.MidiFile1MidiEvent(event: PMidiEvent);

-var mEvent : TMyMidiEvent;

-begin

-  mEvent := TMyMidiEvent.Create;

-  if not (event.event = $FF) then

-  begin

-    mEvent.MidiMessage := event.event;

-    mEvent.data1 := event.data1;

-    mEvent.data2 := event.data2;

-    midioutput1.PutMidiEvent(mEvent);

-  end

-  else

-  begin

-    if (event.data1 >= 1) and (event.data1 < 15) then

-    begin

-      memo2.Lines.add(IntToStr(event.data1) + ' '+ event.str);

-    end

-  end;

-  midiScope1.MidiEvent(event.event,event.data1,event.data2);

-  mEvent.Destroy;

-end;

-

-procedure TMidiPlayer.SentAllNotesOff;

-var mEvent : TMyMidiEvent;

-channel : integer;

-begin

-  mEvent := TMyMidiEvent.Create;

-  for channel:= 0 to 15 do

-  begin

-    mEvent.MidiMessage := $B0 + channel;

-    mEvent.data1 := $78;

-    mEvent.data2 := 0;

-    if MidiOpened then

-      midioutput1.PutMidiEvent(mEvent);

-    midiScope1.MidiEvent(mEvent.MidiMessage,mEvent.data1,mEvent.data2);

-  end;

-  mEvent.Destroy;

-end;

-

-procedure TMidiPlayer.Button3Click(Sender: TObject);

-begin

-  midifile1.StartPlaying;

-end;

-

-procedure TMidiPlayer.Button4Click(Sender: TObject);

-begin

-  midifile1.StopPlaying;

-  SentAllNotesOff;

-end;

-

-procedure TMidiPlayer.MidiOpen;

-begin

-  if not (cmbInput.Text = '') then

-  begin

-    MidiOutput1.ProductName := cmbInput.Text;

-    MidiOutput1.OPEN;

-    MidiOpened := true;

-  end;

-end;

-

-procedure TMidiPlayer.MidiClose;

-begin

-  if MidiOpened then

-  begin

-    MidiOutput1.Close;

-    MidiOpened := false;

-  end;

-end;

-

-

-procedure TMidiPlayer.FormCreate(Sender: TObject);

-var thisDevice : integer;

-begin

-  for thisDevice := 0 to MidiOutput1.NumDevs - 1 do

-  begin

-    MidiOutput1.DeviceID := thisDevice;

-    cmbInput.Items.Add(MidiOutput1.ProductName);

-  end;

-  cmbInput.ItemIndex := 0;

-  MidiOpened := false;

-  MidiOpen;

-end;

-

-procedure TMidiPlayer.cmbInputChange(Sender: TObject);

-begin

-  MidiClose;

-  MidiOPen;

-end;

-

-procedure TMidiPlayer.MidiFile1UpdateEvent(Sender: TObject);

-begin

-  edtTime.Text := MyTimeToStr(MidiFile1.GetCurrentTime);

-  edtTime.update;

-  if MidiFile1.ready then

-  begin

-    midifile1.StopPlaying;

-    SentAllNotesOff;

-  end;

-end;

-

-procedure TMidiPlayer.Button2Click(Sender: TObject);

-begin

-  MidiFile1.ContinuePlaying;

-end;

-

-procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: Char);

-begin

- if Key = char(13) then

- begin

-   MidiFile1.Bpm := StrToInt(edtBpm.Text);

-   edtBpm.text := IntToStr(midifile1.Bpm);

-   abort;

- end;

-

-end;

-

-procedure TMidiPlayer.TracksGridSelectCell(Sender: TObject; Col,

-  Row: Integer; var CanSelect: Boolean);

-var

-  MidiTrack : TMidiTrack;

-  i         : integer;

-  j         : integer;

-  event     : PMidiEvent;

-begin

-  CanSelect := false;

-  if Row < MidiFile1.NumberOfTracks then

-  begin

-    CanSelect := true;

-    MidiTrack := MidiFile1.GetTrack(Row);

-    TrackGrid.RowCount := 2;

-    TrackGrid.RowCount := MidiTrack.getEventCount;

-    j := 1;

-    for i := 0 to MidiTrack.GetEventCount-1 do

-    begin

-      event := MidiTrack.getEvent(i);

-      if not (event.len = -1) then

-      begin // do not print when

-        TrackGrid.cells[0,j] := IntToStr(i);

-        TrackGrid.cells[1,j] := MyTimeToStr(event.time);

-        TrackGrid.cells[2,j] := IntToHex(event.event,2);

-        if not (event.event = $FF) then

-        begin

-          TrackGrid.cells[3,j] := IntToStr(event.len);

-          TrackGrid.cells[4,j] := KeyToStr(event.data1);

-          TrackGrid.cells[5,j] := IntToStr(event.data2);

-        end

-        else

-        begin

-          TrackGrid.cells[3,j] := IntToStr(event.data1);

-          TrackGrid.cells[4,j] := '';

-          TrackGrid.cells[5,j] := event.str;

-        end;

-        inc(j);

-      end;

-    end;

-    TrackGrid.RowCount := j;

-  end;

-end;

-

-procedure TMidiPlayer.FormShow(Sender: TObject);

-begin

-  TrackGrid.ColWidths[0] := 30;

-  TrackGrid.ColWidths[2] := 30;

-  TrackGrid.ColWidths[3] := 30;

-  TrackGrid.ColWidths[4] := 30;

-  TrackGrid.ColWidths[5] := 100;

-end;

-

-end.

+// Test application for TMidiFile
+
+unit MidiTest;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, MidiFile,  ExtCtrls, MidiOut, MidiType, MidiScope, Grids;
+type
+  TMidiPlayer = class(TForm)
+    OpenDialog1: TOpenDialog;
+    Button1: TButton;
+    Button3: TButton;
+    Button4: TButton;
+    MidiOutput1: TMidiOutput;
+    cmbInput: TComboBox;
+    MidiFile1: TMidiFile;
+    MidiScope1: TMidiScope;
+    Label3: TLabel;
+    edtBpm: TEdit;
+    Memo2: TMemo;
+    edtTime: TEdit;
+    Button2: TButton;
+    TrackGrid: TStringGrid;
+    TracksGrid: TStringGrid;
+    edtLength: TEdit;
+    procedure Button1Click(Sender: TObject);
+    procedure MidiFile1MidiEvent(event: PMidiEvent);
+    procedure Button3Click(Sender: TObject);
+    procedure Button4Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure cmbInputChange(Sender: TObject);
+    procedure MidiFile1UpdateEvent(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+    procedure edtBpmKeyPress(Sender: TObject; var Key: Char);
+    procedure TracksGridSelectCell(Sender: TObject; Col, Row: Integer;
+      var CanSelect: Boolean);
+    procedure FormShow(Sender: TObject);
+  private
+    { Private declarations }
+    MidiOpened : boolean;
+    procedure SentAllNotesOff;
+
+    procedure MidiOpen;
+    procedure MidiClose;
+
+  public
+    { Public declarations }
+  end;
+
+var
+  MidiPlayer: TMidiPlayer;
+
+implementation
+
+{$R *.DFM}
+
+procedure TMidiPlayer.Button1Click(Sender: TObject);
+var
+  i,j: integer;
+  track : TMidiTrack;
+  event : PMidiEvent;
+begin
+  if opendialog1.execute then
+  begin
+    midifile1.filename := opendialog1.filename;
+    midifile1.readfile;
+//    label1.caption := IntToStr(midifile1.NumberOfTracks);
+    edtBpm.text := IntToStr(midifile1.Bpm);
+//    TracksGrid.cells.clear;
+    for i := 0 to midifile1.NumberOfTracks-1 do
+    begin
+      track := midifile1.getTrack(i);
+      TracksGrid.cells[0,i] := 'Tr: '+ track.getName + ' '+ track.getInstrument ;
+    end;
+    edtLength.Text := MyTimeToStr(MidiFile1.GetTrackLength);
+  end;
+end;
+
+procedure TMidiPlayer.MidiFile1MidiEvent(event: PMidiEvent);
+var mEvent : TMyMidiEvent;
+begin
+  mEvent := TMyMidiEvent.Create;
+  if not (event.event = $FF) then
+  begin
+    mEvent.MidiMessage := event.event;
+    mEvent.data1 := event.data1;
+    mEvent.data2 := event.data2;
+    midioutput1.PutMidiEvent(mEvent);
+  end
+  else
+  begin
+    if (event.data1 >= 1) and (event.data1 < 15) then
+    begin
+      memo2.Lines.add(IntToStr(event.data1) + ' '+ event.str);
+    end
+  end;
+  midiScope1.MidiEvent(event.event,event.data1,event.data2);
+  mEvent.Destroy;
+end;
+
+procedure TMidiPlayer.SentAllNotesOff;
+var mEvent : TMyMidiEvent;
+channel : integer;
+begin
+  mEvent := TMyMidiEvent.Create;
+  for channel:= 0 to 15 do
+  begin
+    mEvent.MidiMessage := $B0 + channel;
+    mEvent.data1 := $78;
+    mEvent.data2 := 0;
+    if MidiOpened then
+      midioutput1.PutMidiEvent(mEvent);
+    midiScope1.MidiEvent(mEvent.MidiMessage,mEvent.data1,mEvent.data2);
+  end;
+  mEvent.Destroy;
+end;
+
+procedure TMidiPlayer.Button3Click(Sender: TObject);
+begin
+  midifile1.StartPlaying;
+end;
+
+procedure TMidiPlayer.Button4Click(Sender: TObject);
+begin
+  midifile1.StopPlaying;
+  SentAllNotesOff;
+end;
+
+procedure TMidiPlayer.MidiOpen;
+begin
+  if not (cmbInput.Text = '') then
+  begin
+    MidiOutput1.ProductName := cmbInput.Text;
+    MidiOutput1.OPEN;
+    MidiOpened := true;
+  end;
+end;
+
+procedure TMidiPlayer.MidiClose;
+begin
+  if MidiOpened then
+  begin
+    MidiOutput1.Close;
+    MidiOpened := false;
+  end;
+end;
+
+
+procedure TMidiPlayer.FormCreate(Sender: TObject);
+var thisDevice : integer;
+begin
+  for thisDevice := 0 to MidiOutput1.NumDevs - 1 do
+  begin
+    MidiOutput1.DeviceID := thisDevice;
+    cmbInput.Items.Add(MidiOutput1.ProductName);
+  end;
+  cmbInput.ItemIndex := 0;
+  MidiOpened := false;
+  MidiOpen;
+end;
+
+procedure TMidiPlayer.cmbInputChange(Sender: TObject);
+begin
+  MidiClose;
+  MidiOPen;
+end;
+
+procedure TMidiPlayer.MidiFile1UpdateEvent(Sender: TObject);
+begin
+  edtTime.Text := MyTimeToStr(MidiFile1.GetCurrentTime);
+  edtTime.update;
+  if MidiFile1.ready then
+  begin
+    midifile1.StopPlaying;
+    SentAllNotesOff;
+  end;
+end;
+
+procedure TMidiPlayer.Button2Click(Sender: TObject);
+begin
+  MidiFile1.ContinuePlaying;
+end;
+
+procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = char(13) then
+ begin
+   MidiFile1.Bpm := StrToInt(edtBpm.Text);
+   edtBpm.text := IntToStr(midifile1.Bpm);
+   abort;
+ end;
+
+end;
+
+procedure TMidiPlayer.TracksGridSelectCell(Sender: TObject; Col,
+  Row: Integer; var CanSelect: Boolean);
+var
+  MidiTrack : TMidiTrack;
+  i         : integer;
+  j         : integer;
+  event     : PMidiEvent;
+begin
+  CanSelect := false;
+  if Row < MidiFile1.NumberOfTracks then
+  begin
+    CanSelect := true;
+    MidiTrack := MidiFile1.GetTrack(Row);
+    TrackGrid.RowCount := 2;
+    TrackGrid.RowCount := MidiTrack.getEventCount;
+    j := 1;
+    for i := 0 to MidiTrack.GetEventCount-1 do
+    begin
+      event := MidiTrack.getEvent(i);
+      if not (event.len = -1) then
+      begin // do not print when
+        TrackGrid.cells[0,j] := IntToStr(i);
+        TrackGrid.cells[1,j] := MyTimeToStr(event.time);
+        TrackGrid.cells[2,j] := IntToHex(event.event,2);
+        if not (event.event = $FF) then
+        begin
+          TrackGrid.cells[3,j] := IntToStr(event.len);
+          TrackGrid.cells[4,j] := KeyToStr(event.data1);
+          TrackGrid.cells[5,j] := IntToStr(event.data2);
+        end
+        else
+        begin
+          TrackGrid.cells[3,j] := IntToStr(event.data1);
+          TrackGrid.cells[4,j] := '';
+          TrackGrid.cells[5,j] := event.str;
+        end;
+        inc(j);
+      end;
+    end;
+    TrackGrid.RowCount := j;
+  end;
+end;
+
+procedure TMidiPlayer.FormShow(Sender: TObject);
+begin
+  TrackGrid.ColWidths[0] := 30;
+  TrackGrid.ColWidths[2] := 30;
+  TrackGrid.ColWidths[3] := 30;
+  TrackGrid.ColWidths[4] := 30;
+  TrackGrid.ColWidths[5] := 100;
+end;
+
+end.
diff --git a/Game/Code/lib/midi/demo/Project1.dpr b/Game/Code/lib/midi/demo/Project1.dpr
index 4237e983..7aa4e512 100644
--- a/Game/Code/lib/midi/demo/Project1.dpr
+++ b/Game/Code/lib/midi/demo/Project1.dpr
@@ -1,13 +1,13 @@
-program Project1;

-

-uses

-  Forms,

-  MidiTest in 'MidiTest.pas' {MidiPlayer};

-

-{$R *.RES}

-

-begin

-  Application.Initialize;

-  Application.CreateForm(TMidiPlayer, MidiPlayer);

-  Application.Run;

-end.

+program Project1;
+
+uses
+  Forms,
+  MidiTest in 'MidiTest.pas' {MidiPlayer};
+
+{$R *.RES}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TMidiPlayer, MidiPlayer);
+  Application.Run;
+end.
diff --git a/Game/Code/lib/midi/midiComp.cfg b/Game/Code/lib/midi/midiComp.cfg
index 2ee4ea3a..8b774c81 100644
--- a/Game/Code/lib/midi/midiComp.cfg
+++ b/Game/Code/lib/midi/midiComp.cfg
@@ -1,35 +1,35 @@
--$A+

--$B-

--$C+

--$D+

--$E-

--$F-

--$G+

--$H+

--$I+

--$J+

--$K-

--$L+

--$M-

--$N+

--$O+

--$P+

--$Q-

--$R-

--$S-

--$T-

--$U-

--$V+

--$W-

--$X+

--$Y-

--$Z1

--cg

--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

--H+

--W+

--M

--$M16384,1048576

--K$00400000

--LE"d:\program files\borland\delphi5\Projects\Bpl"

--LN"d:\program files\borland\delphi5\Projects\Bpl"

+-$A+
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J+
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$Y-
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-LE"d:\program files\borland\delphi5\Projects\Bpl"
+-LN"d:\program files\borland\delphi5\Projects\Bpl"
diff --git a/Game/Code/lib/midi/readme.txt b/Game/Code/lib/midi/readme.txt
index 5e4207f6..7112aecf 100644
--- a/Game/Code/lib/midi/readme.txt
+++ b/Game/Code/lib/midi/readme.txt
@@ -1,60 +1,60 @@
-

-Midi components

-  TMidiFile, TMidiScope

-  TMidiIn and TMidiOut of david Churcher are included because they are used in 

-  the demo application

-

-Freeware.

-

-100% source code,  demo application.

-

-Included Components/Classes

-

-TMidiFile, read a midifile and have the contents available in memory 

-  list of Tracks, track is list of events

-

-

-TMidiScope, show all activity on a midi device

-

-TMidiIn and TMidiOut of David Churcher are included because they are used 

-in the demo application

-

-Midiplayer is a demo application which plays a midifile on a midi output

- it is build fairly simple with the included components. The timer is used

- to time the midievents. The timing is therefor as good as the windows timer.

-

-

-  The header of midifile,midiscope contains help information on the properties/functions

-  The example Midiplayer gives a good idea how to use the components

-

-Installation

-	open midiComp.dpk with file/open

-	compile and install the package

-	make sure that the directory where the files are located is in the library path 	

-        (tools/environment options/library)

-

-to run the demo

-	open project1.dpr in the demo directory and press run.

-

-

-

-history

-1.0  18-1-1999 first release

-

-1.1  5-3-1999 update

-  added some functions for display purposes

-  improved demo to include event viewer

-  bpm can be changed

-

-1.2  24-2-2000 update

-  added some functions to see the length of a song and ready function to know when playback is ready

-

-for comments/bugs in these components:

-

-Frans Bouwmans

-fbouwmans@spiditel.nl

-

-I'm busy building a software music synthesizer, which will be available in source 

-to the public. If you are interrested in helping me with certain soundmodules 

-(effects, filters, sound generators) just sent me an email.

-

+
+Midi components
+  TMidiFile, TMidiScope
+  TMidiIn and TMidiOut of david Churcher are included because they are used in 
+  the demo application
+
+Freeware.
+
+100% source code,  demo application.
+
+Included Components/Classes
+
+TMidiFile, read a midifile and have the contents available in memory 
+  list of Tracks, track is list of events
+
+
+TMidiScope, show all activity on a midi device
+
+TMidiIn and TMidiOut of David Churcher are included because they are used 
+in the demo application
+
+Midiplayer is a demo application which plays a midifile on a midi output
+ it is build fairly simple with the included components. The timer is used
+ to time the midievents. The timing is therefor as good as the windows timer.
+
+
+  The header of midifile,midiscope contains help information on the properties/functions
+  The example Midiplayer gives a good idea how to use the components
+
+Installation
+	open midiComp.dpk with file/open
+	compile and install the package
+	make sure that the directory where the files are located is in the library path 	
+        (tools/environment options/library)
+
+to run the demo
+	open project1.dpr in the demo directory and press run.
+
+
+
+history
+1.0  18-1-1999 first release
+
+1.1  5-3-1999 update
+  added some functions for display purposes
+  improved demo to include event viewer
+  bpm can be changed
+
+1.2  24-2-2000 update
+  added some functions to see the length of a song and ready function to know when playback is ready
+
+for comments/bugs in these components:
+
+Frans Bouwmans
+fbouwmans@spiditel.nl
+
+I'm busy building a software music synthesizer, which will be available in source 
+to the public. If you are interrested in helping me with certain soundmodules 
+(effects, filters, sound generators) just sent me an email.
+