aboutsummaryrefslogtreecommitdiffstats
path: root/src/lib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lib/midi/CircBuf.pas248
-rw-r--r--src/lib/midi/DelphiMcb.pas210
-rw-r--r--src/lib/midi/MidiComp.dpk16
-rw-r--r--src/lib/midi/MidiCons.pas52
-rw-r--r--src/lib/midi/MidiDefs.pas53
-rw-r--r--src/lib/midi/MidiFile.pas174
-rw-r--r--src/lib/midi/MidiIn.pas129
-rw-r--r--src/lib/midi/MidiOut.pas143
-rw-r--r--src/lib/midi/MidiScope.pas142
-rw-r--r--src/lib/midi/MidiType.pas87
-rw-r--r--src/lib/midi/demo/MidiTest.pas56
-rw-r--r--src/lib/midi/readme.txt12
12 files changed, 651 insertions, 671 deletions
diff --git a/src/lib/midi/CircBuf.pas b/src/lib/midi/CircBuf.pas
index 571d1ee4..995b82ac 100644
--- a/src/lib/midi/CircBuf.pas
+++ b/src/lib/midi/CircBuf.pas
@@ -5,19 +5,19 @@
{ A First-In First-Out circular buffer.
- Port of circbuf.c from Microsoft's Windows MIDI monitor example.
+ 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
+ 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;
+unit CircBuf;
interface
@@ -26,158 +26,158 @@ interface
{$H+} // use long strings
{$ENDIF}
-Uses
+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;
+ { 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;
+function GlobalSharedLockedAlloc(Capacity: word; var hMem: HGLOBAL): pointer;
var
- ptr: Pointer;
+ 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;
+ { 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 );
+procedure GlobalSharedLockedFree(hMem: HGLOBAL; ptr: pointer);
begin
- if (hMem <> 0) then
- begin
- GlobalUnlock(hMem);
- GlobalFree(hMem);
- end;
+ if hMem <> 0 then
+ begin
+ GlobalUnlock(hMem);
+ GlobalFree(hMem);
+ end;
end;
-function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+function CircbufAlloc(Capacity: word): PCircularBuffer;
var
- NewCircularBuffer: PCircularBuffer;
- NewMIDIBuffer: PMidiBufferItem;
- hMem: HGLOBAL;
+ 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;
+ { 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 );
+procedure CircbufFree(pBuffer: PCircularBuffer);
begin
- if (pBuffer <> Nil) then
- begin
- GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
- GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
- end;
+ 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;
+function CircbufReadEvent(PBuffer: PCircularBuffer; PEvent: PMidiBufferItem): boolean;
var
- PCurrentEvent: PMidiBufferItem;
+ 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;
+ 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;
+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;
+ 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/src/lib/midi/DelphiMcb.pas b/src/lib/midi/DelphiMcb.pas
index 39b1c61f..5686e227 100644
--- a/src/lib/midi/DelphiMcb.pas
+++ b/src/lib/midi/DelphiMcb.pas
@@ -1,10 +1,10 @@
{ $Header: /MidiComp/DelphiMcb.pas 2 10/06/97 7:33 Davec $ }
-{MIDI callback for Delphi, was DLL for Delphi 1}
+{Midi callback for Delphi, was DLL for Delphi 1}
unit DelphiMcb;
-{ These segment options required for the MIDI callback functions }
+{ These segment options required for the Midi callback functions }
{$IFNDEF FPC}
{$C PRELOAD FIXED PERMANENT}
{$ENDIF}
@@ -23,118 +23,118 @@ uses
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;
+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;
+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;
+ 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
+{ 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;
+procedure MidiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: dword;
+ 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 }
+ 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/src/lib/midi/MidiComp.dpk b/src/lib/midi/MidiComp.dpk
index 7c403eae..cf99a3ea 100644
--- a/src/lib/midi/MidiComp.dpk
+++ b/src/lib/midi/MidiComp.dpk
@@ -1,9 +1,9 @@
-package midiComp;
+package MidiComp;
{$R *.RES}
{$R 'MidiFile.dcr'}
-{$R 'Midiin.dcr'}
-{$R 'Midiout.dcr'}
+{$R 'MidiIn.dcr'}
+{$R 'MidiOut.dcr'}
{$R 'MidiScope.dcr'}
{$ALIGN ON}
{$ASSERTIONS ON}
@@ -34,12 +34,12 @@ requires
vcl50;
contains
- Miditype in 'Miditype.pas',
- Mididefs in 'Mididefs.pas',
+ MidiType in 'MidiType.pas',
+ MidiDefs in 'MidiDefs.pas',
MidiFile in 'MidiFile.pas',
- Midiin in 'Midiin.pas',
- Midiout in 'Midiout.pas',
+ MidiIn in 'MidiIn.pas',
+ MidiOut in 'MidiOut.pas',
MidiScope in 'MidiScope.pas',
- Midicons in 'Midicons.pas';
+ MidiCons in 'MidiCons.pas';
end.
diff --git a/src/lib/midi/MidiCons.pas b/src/lib/midi/MidiCons.pas
index dbd3c5b7..aa8462c3 100644
--- a/src/lib/midi/MidiCons.pas
+++ b/src/lib/midi/MidiCons.pas
@@ -4,7 +4,7 @@
released to the public domain. }
-{ MIDI Constants }
+{ Midi Constants }
unit MidiCons;
interface
@@ -14,33 +14,33 @@ interface
{$H+} // use long strings
{$ENDIF}
-uses Messages;
+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 }
-
+ 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
diff --git a/src/lib/midi/MidiDefs.pas b/src/lib/midi/MidiDefs.pas
index f14b5e77..8ec7626e 100644
--- a/src/lib/midi/MidiDefs.pas
+++ b/src/lib/midi/MidiDefs.pas
@@ -4,7 +4,7 @@
released to the public domain. }
-{ Common definitions used by DELPHMID.DPR and the MIDI components.
+{ 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;
@@ -23,33 +23,32 @@ uses
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;
+ {-------------------------------------------------------------------}
+ { 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/src/lib/midi/MidiFile.pas b/src/lib/midi/MidiFile.pas
index acf44c04..c0271521 100644
--- a/src/lib/midi/MidiFile.pas
+++ b/src/lib/midi/MidiFile.pas
@@ -128,7 +128,7 @@ type
TMidiTrack = class(TObject)
protected
events: TList;
- name: string;
+ name: string;
instrument: string;
currentTime: integer;
currentPos: integer;
@@ -162,13 +162,13 @@ type
procedure WndProc(var Msg : TMessage);
protected
{ Protected declarations }
- midiFile: TBinaryFileStream;
+ MidiFile: TBinaryFileStream;
chunkType: TChunkType;
chunkLength: integer;
chunkData: PByte;
chunkIndex: PByte;
chunkEnd: PByte;
- FPriority: DWORD;
+ FPriority: dword;
// midi file attributes
FFileFormat: TFileFormat;
@@ -236,7 +236,8 @@ procedure Register;
implementation
-uses mmsystem;
+uses
+ mmsystem;
type
{$IFDEF FPC}
@@ -246,40 +247,43 @@ type
TTimerProc = TFNTimeCallBack;
{$ENDIF}
-const TIMER_RESOLUTION=10;
-const WM_MULTIMEDIA_TIMER=WM_USER+127;
+const
+ TIMER_RESOLUTION = 10;
+ WM_MULTIMEDIA_TIMER = WM_USER + 127;
-var MIDIFileHandle : HWND;
- TimerProc : TTimerProc;
- MIDITimerID : Integer;
- TimerPeriod : Integer;
+var
+ MidiFileHandle: HWND;
+ TimerProc: TTimerProc;
+ MidiTimerID: integer;
+ TimerPeriod: integer;
-procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall;
+procedure TimerCallBackProc(uTimerID, uMsg: Cardinal; dwUser, dwParam1, dwParam2:dword);stdcall;
begin
- PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);
+ PostMessage(HWND(dwUser), WM_MULTIMEDIA_TIMER, 0, 0);
end;
-procedure SetMIDITimer;
- var TimeCaps : TTimeCaps;
+procedure SetMidiTimer;
+var
+ TimeCaps: TTimeCaps;
begin
- timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));
+ timeGetDevCaps(@TimeCaps, SizeOf(TimeCaps));
if TIMER_RESOLUTION < TimeCaps.wPeriodMin then
- TimerPeriod:=TimeCaps.wPeriodMin
+ TimerPeriod := TimeCaps.wPeriodMin
else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then
- TimerPeriod:=TimeCaps.wPeriodMax
+ TimerPeriod := TimeCaps.wPeriodMax
else
- TimerPeriod:=TIMER_RESOLUTION;
+ TimerPeriod := TIMER_RESOLUTION;
timeBeginPeriod(TimerPeriod);
- MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc,
- DWORD(MIDIFileHandle),TIME_PERIODIC);
- if MIDITimerID=0 then
+ MidiTimerID := timeSetEvent(TimerPeriod, TimerPeriod, TimerProc,
+ dword(MidiFileHandle), TIME_PERIODIC);
+ if MidiTimerID=0 then
timeEndPeriod(TimerPeriod);
end;
-procedure KillMIDITimer;
+procedure KillMidiTimer;
begin
- timeKillEvent(MIDITimerID);
+ timeKillEvent(MidiTimerID);
timeEndPeriod(TimerPeriod);
end;
@@ -307,11 +311,11 @@ var
i: integer;
pevent: PMidiEvent;
begin
- if (event.event = $FF) then
+ if event.event = $FF then
begin
- if (event.data1 = 3) then
+ if event.data1 = 3 then
name := event.str;
- if (event.data1 = 4) then
+ if event.data1 = 4 then
instrument := event.str;
end;
currentTime := currentTime + event.dticks;
@@ -320,8 +324,8 @@ begin
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
+ 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
@@ -331,8 +335,7 @@ begin
begin
pevent := PMidiEvent(events[i]);
if (pevent.event = command) and
- (pevent.data1 = event.data1)
- then
+ (pevent.data1 = event.data1) then
begin
pevent.len := currentTIme - pevent.time;
i := 0;
@@ -360,7 +363,7 @@ end;
function TMiditrack.getEvent(index: integer): PMidiEvent;
begin
- if ((index < events.count) and (index >= 0)) then
+ if (index < events.count) and (index >= 0) then
result := events[index]
else
result := nil;
@@ -375,36 +378,29 @@ procedure TMiditrack.Rewind(pos: integer);
begin
if currentPos = events.count then
dec(currentPos);
- while ((currentPos > 0) and
- (PMidiEvent(events[currentPos]).time > pos))
- do
- begin
+ while (currentPos > 0) and
+ (PMidiEvent(events[currentPos]).time > pos) do
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
+ while (currentPos < events.count) and
+ (PMidiEvent(events[currentPos]).time < pos) do
inc(currentPos);
- end;
checkReady;
end;
@@ -433,27 +429,29 @@ end;
constructor TMidifile.Create(AOwner: TComponent);
begin
inherited Create(AOWner);
- MIDIFileHandle:=AllocateHWnd(WndProc);
+ MidiFileHandle := AllocateHWnd(WndProc);
chunkData := nil;
chunkType := illegal;
Tracks := TList.Create;
- TimerProc:=@TimerCallBackProc;
- FPriority:=GetPriorityClass(MIDIFileHandle);
+ TimerProc := @TimerCallBackProc;
+ FPriority := GetPriorityClass(MidiFileHandle);
end;
destructor TMidifile.Destroy;
var
i: integer;
begin
- if not (chunkData = nil) then FreeMem(chunkData);
+ 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);
+ SetPriorityClass(MidiFileHandle, FPriority);
- if MIDITimerID<>0 then KillMIDITimer;
+ if MidiTimerID <> 0 then
+ KillMidiTimer;
- DeallocateHWnd(MIDIFileHandle);
+ DeallocateHWnd(MidiFileHandle);
inherited Destroy;
end;
@@ -501,9 +499,9 @@ begin
playStartTime := getTickCount;
playing := true;
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+ SetPriorityClass(MidiFileHandle, REALTIME_PRIORITY_CLASS);
- SetMIDITimer;
+ SetMidiTimer;
currentPos := 0.0;
currentTime := 0;
end;
@@ -514,17 +512,17 @@ begin
PlayStartTime := GetTickCount - currentTime;
playing := true;
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+ SetPriorityClass(MidiFileHandle, REALTIME_PRIORITY_CLASS);
- SetMIDITimer;
+ SetMidiTimer;
end;
{$WARNINGS ON}
procedure TMidifile.StopPlaying;
begin
playing := false;
- KillMIDITimer;
- SetPriorityClass(MIDIFileHandle,FPriority);
+ KillMidiTimer;
+ SetPriorityClass(MidiFileHandle, FPriority);
end;
function TMidiFile.GetCurrentTime: integer;
@@ -586,7 +584,7 @@ procedure TMidifile.ReadChunkHeader;
var
theByte: array[0..7] of byte;
begin
- midiFile.Read(theByte[0], 8);
+ MidiFile.Read(theByte[0], 8);
if (theByte[0] = $4D) and (theByte[1] = $54) then
begin
if (theByte[2] = $68) and (theByte[3] = $64) then
@@ -597,9 +595,7 @@ begin
chunkType := illegal;
end
else
- begin
chunkType := illegal;
- end;
chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;
end;
@@ -608,7 +604,7 @@ begin
if not (chunkData = nil) then
FreeMem(chunkData);
GetMem(chunkData, chunkLength + 10);
- midiFile.Read(chunkData^, chunkLength);
+ MidiFile.Read(chunkData^, chunkLength);
chunkIndex := chunkData;
chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);
end;
@@ -693,7 +689,7 @@ begin
inc(chunkIndex);
len := ReadVarLength;
- midiEvent.str := ReadString(len);
+ midiEvent.str := ReadString(len);
currentTrack.putEvent(midiEvent);
end;
@@ -826,7 +822,7 @@ end;
function TMidifile.ReadString(l: integer): string;
var
- s: PChar;
+ s: Pchar;
i: integer;
begin
GetMem(s, l + 1); ;
@@ -848,10 +844,10 @@ begin
Tracks.Clear;
chunkType := illegal;
- midiFile := TBinaryFileStream.Create(FFilename, fmOpenRead);
- while (midiFile.Position < midiFile.Size) do
+ MidiFile := TBinaryFileStream.Create(FFilename, fmOpenRead);
+ while (MidiFile.Position < MidiFile.Size) do
ReadChunk;
- FreeAndNil(midiFile);
+ FreeAndNil(MidiFile);
numberTracks := Tracks.Count;
end;
@@ -862,16 +858,16 @@ var
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';
+ 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;
@@ -889,18 +885,18 @@ begin
end;
function MyTimeToStr(val: integer): string;
- var
+var
hour: integer;
- min: integer;
- sec: integer;
+ min: integer;
+ sec: integer;
msec: integer;
begin
msec := val mod 1000;
- sec := val div 1000;
- min := sec div 60;
- sec := sec mod 60;
+ sec := val div 1000;
+ min := sec div 60;
+ sec := sec mod 60;
hour := min div 60;
- min := min mod 60;
+ min := min mod 60;
Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);
end;
@@ -910,8 +906,9 @@ begin
end;
function TMidiFIle.GetTrackLength:integer;
-var i,length : integer;
- time : extended;
+var
+ i, length: integer;
+ time: extended;
begin
length := 0;
for i := 0 to Tracks.Count - 1 do
@@ -923,7 +920,8 @@ begin
end;
function TMidiFIle.Ready: boolean;
-var i : integer;
+var
+ i : integer;
begin
result := true;
for i := 0 to Tracks.Count - 1 do
@@ -934,12 +932,13 @@ end;
procedure TMidiFile.OnTrackReady;
begin
if ready then
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
+ if assigned(FOnUpdateEvent) then
+ FOnUpdateEvent(self);
end;
procedure TMidiFile.WndProc(var Msg : TMessage);
begin
- with MSG do
+ with Msg do
begin
case Msg of
WM_MULTIMEDIA_TIMER:
@@ -953,7 +952,7 @@ begin
end;
else
begin
- Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);
+ Result := DefWindowProc(MidiFileHandle, Msg, wParam, lParam);
end;
end;
end;
@@ -965,4 +964,3 @@ begin
end;
end.
-
diff --git a/src/lib/midi/MidiIn.pas b/src/lib/midi/MidiIn.pas
index 5ff17ae8..7587a3eb 100644
--- a/src/lib/midi/MidiIn.pas
+++ b/src/lib/midi/MidiIn.pas
@@ -7,26 +7,26 @@ unit MidiIn;
{
Properties:
- DeviceID: Windows numeric device ID for the MIDI input device.
+ 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.
+ 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
+ MessageCount: Number of input messages waiting in input buffer
- Capacity: Number of messages input buffer can hold
+ 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
+ SysexBufferSize: Size in bytes of each sysex buffer
Defaults to 10K
Minimum 0K (no buffers), Maximum 64K-1
- SysexBufferCount: Number of sysex buffers
+ SysexBufferCount: Number of sysex buffers
Defaults to 16
Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize)
Check where these buffers are allocated?
@@ -83,7 +83,7 @@ unit MidiIn;
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
+ 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.
@@ -129,23 +129,23 @@ type
TMidiInput = class(TComponent)
private
Handle: THandle; { Window handle used for callback notification }
- FDeviceID: Word; { MIDI device ID }
+ FDeviceID: word; { MIDI device ID }
FMIDIHandle: HMIDIIn; { Handle to input device }
FState: MidiInputState; { Current device state }
- FError: Word;
- FSysexOnly: Boolean;
+ FError: word;
+ FSysexOnly: boolean;
{ Stuff from MIDIINCAPS }
FDriverVersion: MMVERSION;
FProductName: string;
- FMID: Word; { Manufacturer ID }
- FPID: Word; { Product ID }
+ FMID: word; { Manufacturer ID }
+ FPID: word; { Product ID }
{ Queue }
- FCapacity: Word; { Buffer capacity }
+ FCapacity: word; { Buffer capacity }
PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method }
- FNumdevs: Word; { Number of input devices on system }
+ FNumdevs: word; { Number of input devices on system }
{ Events }
FOnMIDIInput: TNotifyEvent; { MIDI Input arrived }
@@ -153,8 +153,8 @@ type
{ TODO: Some sort of error handling event for MIM_ERROR }
{ Sysex }
- FSysexBufferSize: Word;
- FSysexBufferCount: Word;
+ FSysexBufferSize: word;
+ FSysexBufferCount: word;
MidiHdrs: Tlist;
PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
@@ -163,13 +163,13 @@ type
procedure Prepareheaders;
procedure UnprepareHeaders;
procedure AddBuffers;
- procedure SetDeviceID(DeviceID: Word);
+ 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;
+ 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;
@@ -178,12 +178,12 @@ type
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 MID: word read FMID; { Manufacturer ID }
+ property PID: word read FPID; { Product ID }
- property Numdevs: Word read FNumdevs;
+ property Numdevs: word read FNumdevs;
- property MessageCount: Word read GetEventCount;
+ property MessageCount: word read GetEventCount;
{ TODO: property to select which incoming messages get filtered out }
procedure Open;
@@ -201,21 +201,21 @@ type
{ 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
+ 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
+ property SysexBufferCount: word
read FSysexBufferCount
write SetSysexBufferCount
default 16;
- property SysexOnly: Boolean
+ property SysexOnly: boolean
read FSysexOnly
write SetSysexOnly
- default False;
+ default false;
{ Events }
property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput;
@@ -228,8 +228,9 @@ procedure Register;
{====================================================================}
implementation
-uses Controls,
- Graphics;
+uses
+ Controls,
+ Graphics;
(* Not used in Delphi 3
{ This is the callback procedure in the external DLL.
@@ -241,9 +242,9 @@ uses Controls,
function midiHandler(
hMidiIn: HMidiIn;
wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
+ dwInstance: dword;
+ dwParam1: dword;
+ dwParam2: dword): boolean; stdcall; external 'DELMID32.DLL';
{$ENDIF}
*)
{-------------------------------------------------------------------}
@@ -253,7 +254,7 @@ begin
inherited Create(AOwner);
FState := misCreating;
- FSysexOnly := False;
+ FSysexOnly := false;
FNumDevs := midiInGetNumDevs;
MidiHdrs := nil;
@@ -279,13 +280,13 @@ end;
destructor TMidiInput.Destroy;
begin
- if (FMidiHandle <> 0) then
+ if FMidiHandle <> 0 then
begin
Close;
FMidiHandle := 0;
end;
- if (PCtlInfo <> nil) then
+ if PCtlInfo <> nil then
GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
DeallocateHwnd(Handle);
@@ -298,9 +299,9 @@ end;
(e.g. "an invalid parameter was passed to a system function") so
sort out some proper error strings. }
-function TMidiInput.MidiInErrorString(WError: Word): string;
+function TMidiInput.MidiInErrorString(WError: word): string;
var
- errorDesc: PChar;
+ errorDesc: Pchar;
begin
errorDesc := nil;
try
@@ -317,7 +318,7 @@ end;
{-------------------------------------------------------------------}
{ Set the sysex buffer size, fail if device is already open }
-procedure TMidiInput.SetSysexBufferSize(BufferSize: Word);
+procedure TMidiInput.SetSysexBufferSize(BufferSize: word);
begin
if FState = misOpen then
raise EMidiInputError.Create('Change to SysexBufferSize while device was open')
@@ -329,7 +330,7 @@ end;
{-------------------------------------------------------------------}
{ Set the sysex buffer count, fail if device is already open }
-procedure TMidiInput.SetSysexBuffercount(Buffercount: Word);
+procedure TMidiInput.SetSysexBuffercount(Buffercount: word);
begin
if FState = misOpen then
raise EMidiInputError.Create('Change to SysexBuffercount while device was open')
@@ -341,7 +342,7 @@ end;
{-------------------------------------------------------------------}
{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages }
-procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean);
+procedure TMidiInput.SetSysexOnly(bSysexOnly: boolean);
begin
FSysexOnly := bSysexOnly;
{ Update the interrupt handler's copy of this property }
@@ -353,14 +354,14 @@ 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);
+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
+ if DeviceID >= midiInGetNumDevs then
raise EMidiInputError.Create('Invalid device ID')
else
begin
@@ -391,7 +392,7 @@ end;
procedure TMidiInput.SetProductName(NewProductName: string);
var
MidiInCaps: TMidiInCaps;
- testDeviceID: Word;
+ testDeviceID: word;
testProductName: string;
begin
if FState = misOpen then
@@ -414,7 +415,7 @@ begin
if testProductName = NewProductName then
begin
FProductName := NewProductName;
- Break;
+ break;
end;
end;
if FProductName <> NewProductName then
@@ -432,7 +433,7 @@ end;
procedure TMidiInput.PrepareHeaders;
var
- ctr: Word;
+ ctr: word;
MyMidiHdr: TMyMidiHdr;
begin
if (FSysexBufferCount > 0) and (FSysexBufferSize > 0)
@@ -448,7 +449,7 @@ begin
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);
+ MyMidiHdr.hdrPointer^.dwUser := dword(MyMidiHdr);
{ Get MMSYSTEM's blessing for this header }
FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
@@ -468,9 +469,9 @@ end;
procedure TMidiInput.UnprepareHeaders;
var
- ctr: Word;
+ ctr: word;
begin
- if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers }
+ if MidiHdrs <> nil then { will be nil if 0 sysex buffers }
begin
for ctr := 0 to MidiHdrs.Count - 1 do
begin
@@ -491,9 +492,9 @@ end;
procedure TMidiInput.AddBuffers;
var
- ctr: Word;
+ ctr: word;
begin
- if MidiHdrs <> nil then { will be Nil if 0 sysex buffers }
+ if MidiHdrs <> nil then { will be nil if 0 sysex buffers }
begin
if MidiHdrs.Count > 0 then
begin
@@ -517,11 +518,11 @@ var
begin
try
{ Create the buffer for the MIDI input messages }
- if (PBuffer = nil) then
+ if PBuffer = nil then
PBuffer := CircBufAlloc(FCapacity);
{ Create the control info for the DLL }
- if (PCtlInfo = nil) then
+ if PCtlInfo = nil then
begin
PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
PctlInfo^.hMem := hMem;
@@ -530,11 +531,11 @@ begin
Pctlinfo^.hWindow := Handle; { Control's window handle }
PCtlInfo^.SysexOnly := FSysexOnly;
FError := midiInOpen(@FMidiHandle, FDeviceId,
- DWORD(@midiHandler),
- DWORD(PCtlInfo),
+ dword(@midiHandler),
+ dword(PCtlInfo),
CALLBACK_FUNCTION);
- if (FError <> MMSYSERR_NOERROR) then
+ if FError <> MMSYSERR_NOERROR then
{ TODO: use CreateFmtHelp to add MIDI device name/ID to message }
raise EMidiInputError.Create(MidiInErrorString(FError));
@@ -576,7 +577,7 @@ begin
with thisItem do
begin
Result.Time := Timestamp;
- if (Sysex = nil) then
+ if Sysex = nil then
begin
{ Short message }
Result.MidiMessage := LoByte(LoWord(Data));
@@ -618,7 +619,7 @@ end;
{-------------------------------------------------------------------}
-function TMidiInput.GetEventCount: Word;
+function TMidiInput.GetEventCount: word;
begin
if FState = misOpen then
Result := PBuffer^.EventCount
@@ -654,7 +655,7 @@ begin
FMidiHandle := 0;
- if (PBuffer <> nil) then
+ if PBuffer <> nil then
begin
CircBufFree(PBuffer);
PBuffer := nil;
diff --git a/src/lib/midi/MidiOut.pas b/src/lib/midi/MidiOut.pas
index 60538a08..6d675013 100644
--- a/src/lib/midi/MidiOut.pas
+++ b/src/lib/midi/MidiOut.pas
@@ -11,12 +11,12 @@ unit MidiOut;
MIDI Output component.
Properties:
- DeviceID: Windows numeric device ID for the MIDI output device.
+ 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.
+ MIDIHandle: The output handle to the MIDI device.
0 when device is not open
Read-only, runtime-only
@@ -67,16 +67,16 @@ unit MidiOut;
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
+ 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.
+ 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
+ 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.
@@ -126,12 +126,12 @@ type
{ These are the equivalent of constants prefixed with mod_
as defined in MMSystem. See SetTechnology }
OutPortTech = (
- opt_None, { none }
+ 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 }
+ 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];
@@ -145,35 +145,35 @@ type
TMidiOutput = class(TComponent)
protected
Handle: THandle; { Window handle used for callback notification }
- FDeviceID: Cardinal; { MIDI device ID }
- FMIDIHandle: Hmidiout; { Handle to output device }
+ 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 }
+ 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
+ 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,
+ FSupport: dword; { Technology supported (volume control,
patch caching etc. }
- FNumdevs: Word; { Number of MIDI output devices on system }
+ FNumdevs: word; { Number of MIDI output devices on system }
FOnMIDIOutput: TNotifyEvent; { Sysex output finished }
procedure MidiOutput(var Message: TMessage);
- procedure SetDeviceID(DeviceID: Cardinal);
+ procedure SetDeviceID(DeviceID: cardinal);
procedure SetProductName(NewProductName: string);
procedure SetTechnology(NewTechnology: OutPortTech);
- function midioutErrorString(WError: Word): string;
+ function midioutErrorString(WError: word): string;
public
{ Properties }
@@ -184,24 +184,24 @@ type
read FTechnology
write SetTechnology
default opt_Synth;
- property Voices: Word { Number of voices (internal synth) }
+ property Voices: word { Number of voices (internal synth) }
read FVoices;
- property Notes: Word { Number of notes (internal synth) }
+ property Notes: word { Number of notes (internal synth) }
read FNotes;
- property ChannelMask: Word { Bit set for each MIDI channels that the }
+ 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, }
+ property Support: dword { Technology supported (volume control, }
read FSupport; { patch caching etc. }
- property Error: Word read FError;
- property Numdevs: Word read FNumdevs;
+ property Error: word read FError;
+ property Numdevs: word read FNumdevs;
{ Methods }
- function Open: Boolean; virtual;
- function Close: Boolean; virtual;
+ 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);
+ 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;
@@ -211,7 +211,7 @@ type
{ 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;
+ 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? }
@@ -238,9 +238,9 @@ implementation
function midiHandler(
hMidiIn: HMidiIn;
wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
+ dwInstance: dword;
+ dwParam1: dword;
+ dwParam2: dword): boolean; stdcall; external 'DELMID32.DLL';
{$ENDIF}
*)
@@ -254,9 +254,7 @@ begin
{ Create the window for callback notification }
if not (csDesigning in ComponentState) then
- begin
Handle := AllocateHwnd(MidiOutput);
- end;
end;
@@ -266,7 +264,7 @@ destructor Tmidioutput.Destroy;
begin
if FState = mosOpen then
Close;
- if (PCtlInfo <> nil) then
+ if PCtlInfo <> nil then
GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
DeallocateHwnd(Handle);
inherited Destroy;
@@ -279,9 +277,9 @@ end;
some proper error strings would be nice. }
-function Tmidioutput.midioutErrorString(WError: Word): string;
+function Tmidioutput.midioutErrorString(WError: word): string;
var
- errorDesc: PChar;
+ errorDesc: Pchar;
begin
errorDesc := nil;
try
@@ -291,14 +289,15 @@ begin
else
result := 'Specified error number is out of range';
finally
- if errorDesc <> nil then StrDispose(errorDesc);
+ 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);
+procedure Tmidioutput.SetDeviceID(DeviceID: cardinal);
var
midioutCaps: TmidioutCaps;
begin
@@ -343,7 +342,7 @@ end;
procedure Tmidioutput.SetProductName(NewProductName: string);
var
midioutCaps: TmidioutCaps;
- testDeviceID: Integer;
+ testDeviceID: integer;
testProductName: string;
begin
if FState = mosOpen then
@@ -366,7 +365,7 @@ begin
if testProductName = NewProductName then
begin
FProductName := NewProductName;
- Break;
+ break;
end;
end;
if FProductName <> NewProductName then
@@ -386,7 +385,7 @@ end;
procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);
var
midiOutCaps: TMidiOutCaps;
- testDeviceID: Integer;
+ testDeviceID: integer;
testTechnology: OutPortTech;
begin
if FState = mosOpen then
@@ -406,7 +405,7 @@ begin
if testTechnology = NewTechnology then
begin
FTechnology := NewTechnology;
- Break;
+ break;
end;
end;
if FTechnology <> NewTechnology then
@@ -419,14 +418,14 @@ end;
{-------------------------------------------------------------------}
-function Tmidioutput.Open: Boolean;
+function Tmidioutput.Open: boolean;
var
hMem: THandle;
begin
- Result := False;
+ Result := false;
try
{ Create the control info for the DLL }
- if (PCtlInfo = nil) then
+ if PCtlInfo = nil then
begin
PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
PctlInfo^.hMem := hMem;
@@ -435,19 +434,19 @@ begin
Pctlinfo^.hWindow := Handle; { Control's window handle }
FError := midioutOpen(@FMidiHandle, FDeviceId,
- DWORD(@midiHandler),
- DWORD(PCtlInfo),
+ dword(@midiHandler),
+ dword(PCtlInfo),
CALLBACK_FUNCTION);
-{ FError := midioutOpen(@FMidiHandle, FDeviceId,
+{ FError := midioutOpen(@FMidiHandle, FDeviceId,
Handle,
- DWORD(PCtlInfo),
+ dword(PCtlInfo),
CALLBACK_WINDOW); }
- if (FError <> 0) then
+ if FError <> 0 then
{ TODO: use CreateFmtHelp to add MIDI device name/ID to message }
raise EmidioutputError.Create(midioutErrorString(FError))
else
begin
- Result := True;
+ Result := true;
FState := mosOpen;
end;
@@ -463,13 +462,13 @@ end;
{-------------------------------------------------------------------}
-procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);
+procedure TMidiOutput.PutShort(MidiMessage: byte; Data1: byte; Data2: byte);
var
- thisMsg: DWORD;
+ thisMsg: dword;
begin
- thisMsg := DWORD(MidiMessage) or
- (DWORD(Data1) shl 8) or
- (DWORD(Data2) shl 16);
+ thisMsg := dword(MidiMessage) or
+ (dword(Data1) shl 8) or
+ (dword(Data2) shl 16);
FError := midiOutShortMsg(FMidiHandle, thisMsg);
if Ferror > 0 then
@@ -478,7 +477,7 @@ end;
{-------------------------------------------------------------------}
-procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);
+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
@@ -493,13 +492,13 @@ begin
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
+ 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);
+ MyMidiHdr.hdrPointer^.dwUser := dword(MyMidiHdr);
{ Get MMSYSTEM's blessing for this header }
FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
@@ -525,9 +524,7 @@ begin
with theEvent do
begin
if Sysex = nil then
- begin
PutShort(MidiMessage, Data1, Data2)
- end
else
PutLong(Sysex, SysexLength);
end;
@@ -535,15 +532,15 @@ end;
{-------------------------------------------------------------------}
-function Tmidioutput.Close: Boolean;
+function Tmidioutput.Close: boolean;
begin
- Result := False;
+ Result := false;
if FState = mosOpen then
begin
- { Note this sends a lot of fast control change messages which some synths can't handle.
+{ Note this sends a lot of fast control change messages which some synths can't handle.
TODO: Make this optional. }
-{ FError := midioutReset(FMidiHandle);
+{ FError := midioutReset(FMidiHandle);
if Ferror <> 0 then
raise EMidiOutputError.Create(MidiOutErrorString(FError)); }
@@ -551,7 +548,7 @@ begin
if Ferror <> 0 then
raise EMidiOutputError.Create(MidiOutErrorString(FError))
else
- Result := True;
+ Result := true;
end;
FMidiHandle := 0;
@@ -561,11 +558,11 @@ end;
{-------------------------------------------------------------------}
-procedure TMidiOutput.SetVolume(Left: Word; Right: Word);
+procedure TMidiOutput.SetVolume(Left: word; Right: word);
var
- dwVolume: DWORD;
+ dwVolume: dword;
begin
- dwVolume := (DWORD(Left) shl 16) or Right;
+ dwVolume := (dword(Left) shl 16) or Right;
FError := midiOutSetVolume(DeviceID, dwVolume);
if Ferror <> 0 then
raise EMidiOutputError.Create(MidiOutErrorString(FError));
diff --git a/src/lib/midi/MidiScope.pas b/src/lib/midi/MidiScope.pas
index afc20b0f..3eb51054 100644
--- a/src/lib/midi/MidiScope.pas
+++ b/src/lib/midi/MidiScope.pas
@@ -24,7 +24,14 @@ interface
{$ENDIF}
uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
+ Windows,
+ Messages,
+ SysUtils,
+ Classes,
+ Graphics,
+ Controls,
+ Forms,
+ Dialogs;
type
TMidiScope = class(TGraphicControl)
@@ -32,40 +39,40 @@ type
{ 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;
+ 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;
+ selectedChannel: integer;
- procedure PaintSlide(ch,pos,val: 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);
+ 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 MidiEvent(event, data1, data2: integer);
procedure Paint; override;
published
{ Published declarations }
end;
-
procedure Register;
const
- BarHeight = 16;
- BarHeightInc = BarHeight+2;
+ BarHeight = 16;
+ BarHeightInc = BarHeight + 2;
BarWidth = 3;
- BarWidthInc = BarWidth+1;
+ BarWidthInc = BarWidth + 1;
HeightDiv = 128 div BarHeight;
implementation
-uses Midicons;
+uses
+ MidiCons;
procedure Register;
begin
@@ -74,125 +81,100 @@ end;
constructor TMidiScope.Create(AOwner: TComponent);
var
- i,j : integer;
+ i, j: integer;
begin
inherited Create(AOwner);
Height := BarHeightinc * 16 + 4;
- Width := 147*BarWidthInc + 4 + 20; // for channel number
+ 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;
+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.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)
+ Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv)), x + BarWidth, y + BarHeight)
end;
procedure TMidiScope.Paint;
-var i,j : integer;
-x : integer;
+var
+ i, j: integer;
+ x: integer;
begin
Canvas.Brush.color := clBlack;
- Canvas.Rectangle(0,0,Width,Height);
+ 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;
+ 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.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;
+ for j := 0 to 127 do
+ PaintSlide(i, j, notes[i,j]);
+ for j := 0 to 17 do
+ PaintSlide(i, j + 129, controllers[i,j]);
end;
-procedure TMidiScope.NoteOn(channel, note, speed : integer);
+
+procedure TMidiScope.NoteOn(channel, note, speed: integer);
begin
notes[channel,note] := speed;
- PaintSlide(channel,note,notes[channel,note]);
+ PaintSlide(channel, note, notes[channel,note]);
end;
-procedure TMidiScope.AfterTch(channel, note, value : integer);
+
+procedure TMidiScope.AfterTch(channel, note, value: integer);
begin
aftertouch[channel,note] := value;
end;
-procedure TMidiScope.Controller(channel,number,value : integer);
-var i : integer;
+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);
+ 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);
+ PaintSlide(channel, i, 0);
end;
- end;
end;
end;
-procedure TMidiScope.MidiEvent(event,data1,data2 : integer);
+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;
+ case (event and $F0) of
+ MIDI_NOTEON : NoteOn ((event and $F), data1, data2);
+ MIDI_NOTEOFF: NoteOn ((event and $F), data1, 0 );
+ MIDI_CONTROLCHANGE: Controller((event and $F), data1, data2);
+ MIDI_CHANAFTERTOUCH: Controller((Event and $F), 16, data1);
+ MIDI_PITCHBEND: Controller((Event and $F), 17, data2);
+ MIDI_KEYAFTERTOUCH: ;
end;
end;
+
end.
diff --git a/src/lib/midi/MidiType.pas b/src/lib/midi/MidiType.pas
index 14157dbe..30e043ab 100644
--- a/src/lib/midi/MidiType.pas
+++ b/src/lib/midi/MidiType.pas
@@ -1,9 +1,8 @@
-{ $Header: /MidiComp/MidiType.pas 2 10/06/97 7:33 Davec $ }
+{ $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
@@ -22,32 +21,32 @@ uses
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;
+ {-------------------------------------------------------------------}
+ { 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
@@ -55,36 +54,34 @@ implementation
{ Free any sysex buffer associated with the event }
destructor TMyMidiEvent.Destroy;
begin
- if (Sysex <> Nil) then
- Freemem(Sysex, SysexLength);
+ if (Sysex <> nil) then
+ Freemem(Sysex, SysexLength);
- inherited Destroy;
+ inherited Destroy;
end;
{-------------------------------------------------------------------}
{ Allocate memory for the sysex header and buffer }
-constructor TMyMidiHdr.Create(BufferSize:Word);
+constructor TMyMidiHdr.Create(BufferSize: word);
begin
- inherited Create;
+ inherited Create;
- if BufferSize > 0 then
- begin
- hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);
- sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);
+ if BufferSize > 0 then
+ begin
+ hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);
+ sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);
- hdrPointer^.lpData := sysexPointer;
- hdrPointer^.dwBufferLength := BufferSize;
- end;
+ hdrPointer^.lpData := sysexPointer;
+ hdrPointer^.dwBufferLength := BufferSize;
+ end;
end;
{-------------------------------------------------------------------}
destructor TMyMidiHdr.Destroy;
begin
- GlobalSharedLockedFree( hdrHandle, hdrPointer );
- GlobalSharedLockedFree( sysexHandle, sysexPointer );
- inherited Destroy;
+ GlobalSharedLockedFree(hdrHandle, hdrPointer);
+ GlobalSharedLockedFree(sysexHandle, sysexPointer);
+ inherited Destroy;
end;
-
-
end.
diff --git a/src/lib/midi/demo/MidiTest.pas b/src/lib/midi/demo/MidiTest.pas
index 793db730..4ded35fd 100644
--- a/src/lib/midi/demo/MidiTest.pas
+++ b/src/lib/midi/demo/MidiTest.pas
@@ -5,8 +5,22 @@ unit MidiTest;
interface
uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, MidiFile, ExtCtrls, MidiOut, MidiType, MidiScope, Grids;
+ Windows,
+ Messages,
+ SysUtils,
+ Classes,
+ Graphics,
+ Controls,
+ Forms,
+ Dialogs,
+ StdCtrls,
+ ExtCtrls,
+ Grids,
+ MidiFile,
+ MidiOut,
+ MidiType,
+ MidiScope;
+
type
TMidiPlayer = class(TForm)
OpenDialog1: TOpenDialog;
@@ -33,9 +47,9 @@ type
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 edtBpmKeyPress(Sender: TObject; var Key: char);
+ procedure TracksGridSelectCell(Sender: TObject; Col, Row: integer;
+ var CanSelect: boolean);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
@@ -58,9 +72,9 @@ implementation
procedure TMidiPlayer.Button1Click(Sender: TObject);
var
- i,j: integer;
- track : TMidiTrack;
- event : PMidiEvent;
+ i, j: integer;
+ track: TMidiTrack;
+ event: PMidiEvent;
begin
if opendialog1.execute then
begin
@@ -79,7 +93,8 @@ begin
end;
procedure TMidiPlayer.MidiFile1MidiEvent(event: PMidiEvent);
-var mEvent : TMyMidiEvent;
+var
+ mEvent: TMyMidiEvent;
begin
mEvent := TMyMidiEvent.Create;
if not (event.event = $FF) then
@@ -90,19 +105,16 @@ begin
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;
+var
+ mEvent: TMyMidiEvent;
+ channel: integer;
begin
mEvent := TMyMidiEvent.Create;
for channel:= 0 to 15 do
@@ -149,7 +161,8 @@ end;
procedure TMidiPlayer.FormCreate(Sender: TObject);
-var thisDevice : integer;
+var
+ thisDevice: integer;
begin
for thisDevice := 0 to MidiOutput1.NumDevs - 1 do
begin
@@ -183,7 +196,7 @@ begin
MidiFile1.ContinuePlaying;
end;
-procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: Char);
+procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: char);
begin
if Key = char(13) then
begin
@@ -195,12 +208,11 @@ begin
end;
procedure TMidiPlayer.TracksGridSelectCell(Sender: TObject; Col,
- Row: Integer; var CanSelect: Boolean);
+ Row: integer; var CanSelect: boolean);
var
- MidiTrack : TMidiTrack;
- i : integer;
- j : integer;
- event : PMidiEvent;
+ MidiTrack: TMidiTrack;
+ i, j: integer;
+ event: PMidiEvent;
begin
CanSelect := false;
if Row < MidiFile1.NumberOfTracks then
diff --git a/src/lib/midi/readme.txt b/src/lib/midi/readme.txt
index 7112aecf..e412c23e 100644
--- a/src/lib/midi/readme.txt
+++ b/src/lib/midi/readme.txt
@@ -1,7 +1,6 @@
-
Midi components
TMidiFile, TMidiScope
- TMidiIn and TMidiOut of david Churcher are included because they are used in
+ TMidiIn and TMidiOut of David Churcher are included because they are used in
the demo application
Freeware.
@@ -16,15 +15,12 @@ TMidiFile, read a midifile and have the contents available in memory
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 header of midifile, midiscope contains help information on the properties/functions
The example Midiplayer gives a good idea how to use the components
Installation
@@ -36,8 +32,6 @@ Installation
to run the demo
open project1.dpr in the demo directory and press run.
-
-
history
1.0 18-1-1999 first release
@@ -55,6 +49,6 @@ 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
+to the public. If you are interested in helping me with certain soundmodules
(effects, filters, sound generators) just sent me an email.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-30 15:24:20 +0000