From 9cd462b34d5d839f8addfdf6a9f4469c99a8e653 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 1 Dec 2013 00:31:54 +0000 Subject: formating and beautifying. no actual code change, but needs checks. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@3011 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/lib/midi/CircBuf.pas | 248 ++++++++++++++++++++--------------------- src/lib/midi/DelphiMcb.pas | 210 +++++++++++++++++----------------- src/lib/midi/MidiComp.dpk | 16 +-- src/lib/midi/MidiCons.pas | 52 ++++----- src/lib/midi/MidiDefs.pas | 53 +++++---- src/lib/midi/MidiFile.pas | 174 ++++++++++++++--------------- src/lib/midi/MidiIn.pas | 129 ++++++++++----------- src/lib/midi/MidiOut.pas | 143 ++++++++++++------------ src/lib/midi/MidiScope.pas | 142 +++++++++++------------ src/lib/midi/MidiType.pas | 87 +++++++-------- src/lib/midi/demo/MidiTest.pas | 56 ++++++---- src/lib/midi/readme.txt | 12 +- 12 files changed, 651 insertions(+), 671 deletions(-) (limited to 'src') 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 , 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. -- cgit v1.2.3