From 1ba91d5a0e1df7419a561f6dcf16a0839509a5e7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 27 Aug 2008 13:28:57 +0000 Subject: Reordering of the directories[1]: moving Game/Code to src git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1302 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/lib/midi/MidiScope.pas | 198 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 198 insertions(+) create mode 100644 src/lib/midi/MidiScope.pas (limited to 'src/lib/midi/MidiScope.pas') diff --git a/src/lib/midi/MidiScope.pas b/src/lib/midi/MidiScope.pas new file mode 100644 index 00000000..42fc65fc --- /dev/null +++ b/src/lib/midi/MidiScope.pas @@ -0,0 +1,198 @@ +{ + Shows a large black area where midi note/controller events are shown + just to monitor midi activity (for the MidiPlayer) + + version 1.0 first release + + for comments/bugs + F.Bouwmans + fbouwmans@spiditel.nl + + if you think this component is nice and you use it, sent me a short email. + I've seen that other of my components have been downloaded a lot, but I've + got no clue wether they are actually used. + Don't worry because you are free to use these components +} + +unit MidiScope; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; + +type + TMidiScope = class(TGraphicControl) + private + { Private declarations } + protected + { Protected declarations } + notes : array[0..15,0..127] of integer; + controllers : array[0..15,0..17] of integer; + aftertouch : array[0..15,0..127] of integer; + + selectedChannel : integer; + + procedure PaintSlide(ch,pos,val: integer); + + procedure NoteOn(channel, note, speed : integer); + procedure Controller(channel,number,value : integer); + procedure AfterTch(channel, note, value : integer); + + public + { Public declarations } + constructor Create(AOwner: TComponent); override; + procedure MidiEvent(event,data1,data2 : integer); + procedure Paint; override; + published + { Published declarations } + end; + + +procedure Register; + +const + BarHeight = 16; + BarHeightInc = BarHeight+2; + BarWidth = 3; + BarWidthInc = BarWidth+1; + HeightDiv = 128 div BarHeight; + +implementation + +uses Midicons; + +procedure Register; +begin + RegisterComponents('Synth', [TMidiScope]); +end; + +constructor TMidiScope.Create(AOwner: TComponent); +var + i,j : integer; +begin + inherited Create(AOwner); + Height := BarHeightinc * 16 + 4; + Width := 147*BarWidthInc + 4 + 20; // for channel number + for i := 0 to 15 do + begin + for j := 0 to 127 do + begin + notes[i,j] := 0; + aftertouch[i,j] := 0; + end; + end; + for i := 0 to 17 do + begin + for j := 0 to 15 do + controllers[i,j] := 0; + end; +end; + +procedure TMidiScope.PaintSlide(ch,pos,val: integer); +var x,y:integer; +begin + Canvas.Brush.Color := clBlack; + Canvas.Pen.color := clBlack; + x := pos * BarWidthInc + 2; + y := 2 + ch * BarHeightInc; + Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc); + Canvas.Brush.Color := clGreen; + Canvas.Pen.Color := clGreen; + Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight) +end; + +procedure TMidiScope.Paint; +var i,j : integer; +x : integer; +begin + Canvas.Brush.color := clBlack; + Canvas.Rectangle(0,0,Width,Height); + Canvas.Pen.Color := clGreen; + x := 128*BarWidthInc+2; + Canvas.MoveTo(x,0); + Canvas.LineTo(x,Height); + x := 148*BarWIdthInc+2; + canvas.Font.Color := clGreen; + for i := 0 to 15 do + Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1)); + canvas.Pen.color := clBlack; + begin + for j := 0 to 127 do + begin + PaintSlide(i,j,notes[i,j]); + end; + for j := 0 to 17 do + begin + PaintSlide(i,j+129,controllers[i,j]); + end; + end; +end; +procedure TMidiScope.NoteOn(channel, note, speed : integer); +begin + notes[channel,note] := speed; + PaintSlide(channel,note,notes[channel,note]); +end; +procedure TMidiScope.AfterTch(channel, note, value : integer); +begin + aftertouch[channel,note] := value; +end; + +procedure TMidiScope.Controller(channel,number,value : integer); +var i : integer; +begin + if number < 18 then + begin + controllers[channel,number] := value; + PaintSlide(channel,number+129,value); + end + else if number >= $7B then + begin + // all notes of for channel + for i := 0 to 127 do + begin + if notes[channel,i] > 0 then + begin + notes[channel,i] := 0; + PaintSlide(channel,i,0); + end; + end; + end; +end; + +procedure TMidiScope.MidiEvent(event,data1,data2 : integer); +begin + case (event AND $F0) of + MIDI_NOTEON : + begin + NoteOn((event AND $F),data1,data2); + end; + MIDI_NOTEOFF: + begin + NoteOn((event AND $F),data1,0); + end; + MIDI_CONTROLCHANGE : + begin + Controller((event AND $F),data1,data2); + end; + MIDI_CHANAFTERTOUCH: + begin + Controller((Event AND $F),16,Data1); + end; + MIDI_PITCHBEND: + begin + begin + Controller((Event AND $F),17,data2); + end; + end; + MIDI_KEYAFTERTOUCH: + begin + end; + end; +end; +end. -- cgit v1.2.3 From 917901e8e33438c425aef50a0a7417f32d77b760 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 9 Nov 2009 00:27:55 +0000 Subject: merged unicode branch (r1931) into trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1939 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/lib/midi/MidiScope.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/lib/midi/MidiScope.pas') diff --git a/src/lib/midi/MidiScope.pas b/src/lib/midi/MidiScope.pas index 42fc65fc..afc20b0f 100644 --- a/src/lib/midi/MidiScope.pas +++ b/src/lib/midi/MidiScope.pas @@ -20,7 +20,7 @@ interface {$IFDEF FPC} {$MODE Delphi} - {$H+} // use AnsiString + {$H+} // use long strings {$ENDIF} uses -- cgit v1.2.3