cmpmidigrid.pas

Delphi的另一款钢琴软件

unit cmpMidiGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, cmpMidiData, cmpMidiIterator;

type
  TMidiGrid = class(TCustomGrid)
  private
    fMidiData : TMidiData;
    fTrack : Integer;
    fIterator : TMidiPosition;

    procedure SetMidiData (value : TMidiData);
    procedure SetTrack (value : Integer);
  protected
    procedure DrawCell (Col, Row: Longint; Rect: TRect; State: TGridDrawState); override;
  public
    constructor Create (AnOwner : TComponent); override;
    property ColWidths;
    property ColCount;
  published
    property MidiData : TMidiData read fMidiData write SetMidiData;
    property Track : Integer read fTrack write SetTrack;
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DefaultColWidth;
    property DefaultRowHeight;
    property Font;
    property GridLineWidth;
    property Options;
    property ParentColor;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property Row;
    property RowCount;
    property ShowHint;
    property TabOrder;
    property TopRow;
    property VisibleRowCount;

    property onMouseUp;
    property onMouseDown;
    property onClick;
    property OnDblClick;
  end;

implementation

uses StdCtrls, unitMidiGlobals;

constructor TMidiGrid.Create (AnOwner : TComponent);
begin
  inherited Create (AnOwner);
  FixedCols := 0;
  FixedRows := 0;
  ScrollBars := ssVertical;
  ColCount := 6;
  RowCount := 100;
  fIterator := TMidiPosition.Create (self);
end;

procedure TMidiGrid.SetMidiData (value : TMidiData);
begin
  if value <> fMidiData then
  begin
    fMidiData := value;
    fIterator.MidiData := value;
    Track := 0;
  end
end;

procedure TMidiGrid.SetTrack (value : Integer);
begin
  fTrack := value;
  if Assigned (fMidiData) then
    if (value < fMidiData.NoTracks) and Assigned (fMidiData.Tracks [value]) then
      RowCount := fMidiData.Tracks [value].EventCount
    else RowCount := 100
  else RowCount := 100;
  TopRow := 0;
  Refresh
end;

procedure TMidiGrid.DrawCell(Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);

var
  st : string;
  pc : pchar;
  EventPtr : PMidiEventData;
  LowerDiv : Integer;
  Key : ShortInt;
  tempo, h, m, s, cs : Integer;
begin
  if (Assigned (MidiData)) and (MidiData.Active) and Assigned (MidiData.Tracks [fTrack]) then
    with MidiData.Tracks [fTrack] do
      if Row < EventCount then
      try
        EventPtr := Event [Row];
        with EventPtr^ do
        begin
          fIterator.Position := pos;
          case col of
            0 : with fIterator do st := Format ('%d-%02.2d-%03.3d', [bar + 1, Beat + 1, Tick]);
            1 : with fIterator do
                begin
                  s := Time div 1000;
                  cs := Time mod 1000 div 10;
                  m := s div 60;
                  s := s mod 60;
                  h := m div 60;
                  m := m mod 60;
                  st := Format ('%02d:%02.2d:%02.2d.%02.2d', [h, m, s, cs]);
                end;
            2: if data.status < $f0 then
                  st := IntToStr (data.status and $0f + 1)
                else
                  st := IntToStr (pos) + ',' + IntToStr (fIterator.Position);
            3 : case data.status and $f0 of
                  midiNoteOff           : st := 'Note Off';
                  midiNoteOn            : if data.b3 = 0 then st := 'Note Off' else st := 'Note On';
                  midiKeyAftertouch     : st := 'Key Aftertouch';
                  midiController 	      : st := 'Controller';
                  midiProgramChange     : st := 'Program change';
                  midiChannelAftertouch : st := 'Channel Aftertouch';
                  midiPitchBend         : st := 'Pitch bend';
                  midiSysex : case data.status of
                                midiSysex     : st := 'Sysex';
                                midiSysexCont : st := 'Sysex continuation';
                                midiMeta	    : st := 'Meta event'
                                else st := 'Unknown sysex type';
                              end
                  else st := '???';
                end;
            4 : if data.status = midiMeta then
                  case Byte (data.sysex [0]) of
                    metaSeqNo 		 : st := 'Sequence number';
                    metaText  	     : st := 'Text event';
                    metaCopyright 	 : st := 'Copyright notice';
                    metaTrackName 	 : st := 'Track name';
                    metaInstrumentName : st := 'Instrument name';
                    metaLyric 		 : st := 'Lyric';
                    metaMarker	     : st := 'Marker';
                    metaCuePoint       : st := 'Cue point';
                    metaMiscText0..
                    metaMiscText7      : st := 'Misc text';
                    metaTrackStart     : st := 'Start of track';
                    metaTrackEnd       : st := 'End of track';
                    metaTempoChange    : st := 'Tempo change';
                    metaSMPTE			 : st := 'SMPTE';
                    metaTimeSig		 : st := 'Time signature';
                    metaKeySig		 : st := 'Key signature';
                    metaSequencer      : st := 'Sequencer specific'
                    else st := IntToHex (byte (data.sysex [0]), 2) + ' Unknown'
                  end
                else
                  case data.status and $f0 of
                    midiController : st := ControllerNames [data.b2];
                    midiNoteOn, midiNoteOff : st := GetNoteName (data.b2);
                    else st := IntToStr (data.b2)
                  end;
            5 : case data.status  of
                  midiMeta : case Byte (data.sysex [0])of
                          metaText..
                          metaMiscText7 :
                            begin
                              pc := data.sysex + 1;
                              st := pc
                            end;
                          metaTempoChange :
                          begin
                            tempo :=  (LongInt (data.sysex [3]) + 256 * LongInt (data.sysex [2]) + 65536 * LongInt (data.sysex [1])) div 1000;
                            st := Format ('%d', [GetBPM (tempo, fIterator.BeatDiv)])
                          end;
                          metaTimeSig :
                          begin
                            lowerDiv := 4;
                            if Integer (data.sysex [2]) < 2 then
                              lowerDiv := lowerDiv shr (2 - Integer (data.sysex [2]))
                            else
                              if Integer (data.sysex [2]) > 2 then
                                lowerDiv := lowerDiv shl (Integer (data.sysex [2]) - 2);
                            st := Format ('%d/%d', [Integer (data.sysex [1]), LowerDiv])
                          end;
                          metaKeySig :
                          begin
                            key := ShortInt (data.sysex [1]);
                            if key < 0 then
                              st := Char (Ord ('A') + (7 + (key + 1)) mod 7) + ' Min'
                            else
                              st := Char (Ord ('A') + key ) + ' Maj'
                          end;

                          else st := IntToHex (Integer (data.sysex [0]), 2);
                        end;
                  else st := IntToStr (data.b3)
                end;

            else st := '---';     // Else of case
          end
        end
      except
      end;
  Dec (rect.Right);
  Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 1, st);
end;

end.