4programmers.net 4p Forum Delphi i Pascal Delphi12 community - sekwencer Midi, problem z przeliczeniem czasu (taktów)

Delphi12 community - sekwencer Midi, problem z przeliczeniem czasu (taktów)

Delphi12 community - sekwencer Midi, problem z przeliczeniem czasu (taktów)
zebmcs
zebmcs
  • Rejestracja: dni
  • Ostatnio: dni
0

Witam mam problem z którym nie mogę sobie poradzić. Próbowałem nwet z AI coś wykombinować ale to dopiero był dramat... :) , otóż uparłem się zrobić sekwencer midi (coś w rodzaju cakewalk 9) problem polega na tym, że nie mogę sobie poradzić z "przeliczeniem" odpowiedniego czasu przesuwu "czerwonej linii i odliczania taktów w czasie odtwarzania pliku midi. Normalnie mijają podczas odtwarzania załóżmy 4 takty, a u mnie przesunięcie zegara taktowego i tej linii odbywa się w "żółwim tempie" , gdzie cał utwór zmieści się w moich 2-może 3 taktach... jak sobie z tym poradzić, dodam, że 1 takt podzieliłem na 1920 "punktów, nutowych" gdzie można będzie zapisać dźwięki czyli przy metrum 4/4 każda ćwiartka to 480 takich punktów. może wrzucę mój unit "główny" to ktoś coś może doradzi.... może na coś wpadnie jak to zrobić... Dodam, że próbowałem użyć komponentu midi Simplified 1.6 ale coś nie idzie mi z nim i wróciłem do standartowego zegata TTimer z delphi. Z góry dzięki za pomoc,

Kopiuj
unit SekwencerMidi;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Native.Devices.StdCtrls,
  Native.Devices.Classes, Native.Midi.Classes, Native.Midi.Devices,
  Vcl.ComCtrls, Vcl.ToolWin, Vcl.Menus, Vcl.ExtCtrls, Vcl.Grids,
  Native.SysCtrls.Timers, Native.Midi.Sequencers,
  Native.Midi.Files, Vcl.MPlayer, Vcl.ButtonGroup, Vcl.Buttons;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Plik1: TMenuItem;
    Edycja1: TMenuItem;
    EfektyMidi1: TMenuItem;
    About1: TMenuItem;
    Nowy1: TMenuItem;
    Wczytaj1: TMenuItem;
    Zapisz1: TMenuItem;
    Zakocz1: TMenuItem;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    DrawGrid1: TDrawGrid;
    Splitter1: TSplitter;
    DrawGrid2: TDrawGrid;
    MIDIOutDevices1: TMIDIOutDevices;
    DeviceListBox1: TDeviceListBox;
    SMFSequencer1: TSMFSequencer;
    SMFFile1: TSMFFile;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label2: TLabel;
    Button6: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Label3: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Edit3: TEdit;
    Label1: TLabel;
    Edit1: TEdit;
    N3: TMenuItem;
    N4: TMenuItem;
    View1: TMenuItem;
    View2: TMenuItem;
    Nuty1: TMenuItem;
    Edit4: TEdit;
    Edit5: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    MediaPlayer1: TMediaPlayer;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure DrawGrid2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure SMFSequencer1Event(Sender: TObject; const ASequence, APosition: Cardinal);
    procedure SysTimer1Timer(Sender: TObject);
    procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
    procedure DrawGrid2SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
    procedure DrawGrid1TopLeftChanged(Sender: TObject);
    procedure DrawGrid2TopLeftChanged(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Wczytaj1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Zapisz1Click(Sender: TObject);
    procedure Zakocz1Click(Sender: TObject);
    procedure Markery1Click(Sender: TObject);
    procedure Metrum1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Kwantyzacja1Click(Sender: TObject);
    procedure ranspozycja1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure View1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure View2Click(Sender: TObject);
    procedure Nuty1Click(Sender: TObject);
    procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure DrawGrid2DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    FCurrentPos: Cardinal;
    FIsSyncing: Boolean;
    FGridData: array[0..8, 1..16] of string; // Od 1 do 16 dla tracków
    FMaxPos: Cardinal; // Tu zapiszemy ostatni tick
  public
    FPPQ: Integer;
    FNumerator: Integer;
    FDenominator: Integer;
    FTicksPerMeasure: Integer;
    FTicksPerBeat: Integer;
    FBeatsPerMeasure: Integer;

    procedure UpdateGridWidth;
    procedure RecalculateTimeStructure;
    function GetMidiTimeStr(APosition: Cardinal): string;
  end;

var
  Form1: TForm1;
  SequenceData: array[0..15, 0..500, 0..127] of Boolean;
implementation

{$R *.dfm}

uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit10, Unit8, Unit9;

procedure TForm1.SysTimer1Timer(Sender: TObject);
var
  LBPM: Double;
  TotalSec, H, M, S: Integer;
begin
  if (MediaPlayer1.Mode = mpPlaying) or (MediaPlayer1.Mode = mpPaused) then
  begin
    LBPM := StrToFloatDef(Edit1.Text, 120.0);

    if FPPQ > 0 then
      FCurrentPos := Round((MediaPlayer1.Position * LBPM * FPPQ) / 60000);

    // Czas zegarowy do Edit4 (0:00:00)
    TotalSec := MediaPlayer1.Position div 1000;
    H := TotalSec div 3600;
    M := (TotalSec mod 3600) div 60;
    S := TotalSec mod 60;
    Edit4.Text := Format('%d:%.2d:%.2d', [H, M, S]);

    // Pozycja taktowa do Edit5 (1.01.000)
    Edit5.Text := StringReplace(GetMidiTimeStr(FCurrentPos), ':', '.', [rfReplaceAll]);

    DrawGrid2.Invalidate;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  LBPM: Double;
  TotalMS, H, M, S: Integer;
begin
  if (MediaPlayer1.Mode <> mpStopped) then
  begin
    TotalMS := MediaPlayer1.Position; // Pobieramy MS
    LBPM := StrToFloatDef(Edit1.Text, 120.0);

    // KLUCZOWA POPRAWKA: Przeliczenie MS na Ticki MIDI
    // Wzór: Ticks = (Milisekundy * BPM * PPQ) / 60000
    if (FPPQ > 0) and (LBPM > 0) then
      FCurrentPos := Round((Int64(TotalMS) * LBPM * FPPQ) / 60000);

    // ZEGAR GODZINOWY (Edit4) - musi działać!
    S := (TotalMS div 1000) mod 60;
    M := (TotalMS div 60000) mod 60;
    H := (TotalMS div 3600000);
    Edit4.Text := Format('%d:%.2d:%.2d', [H, M, S]);

    // ZEGAR TAKTOWY (Edit5)
    Edit5.Text := StringReplace(GetMidiTimeStr(FCurrentPos), ':', '.', [rfReplaceAll]);

    DrawGrid2.Invalidate; // Odświeżanie siatki
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MediaPlayer1.TimeFormat := tfMilliseconds; // przeliczenie taktów
  FIsSyncing := False;
  FCurrentPos := 0;
  FPPQ := 480;

  // Wartości domyślne dla 2025
  Edit2.Text := '4';
  Edit3.Text := '4';

  // --- PRZYWRÓCONA KONFIGURACJA DRAWGRID1 ---
  DrawGrid1.ColCount := 7;
  DrawGrid1.RowCount := 17;
  DrawGrid1.FixedCols := 1;
  DrawGrid1.FixedRows := 1;
  DrawGrid1.Options := DrawGrid1.Options + [goRowSelect, goDrawFocusSelected];

  DrawGrid1.ColWidths[0] := 35; // Track
  DrawGrid1.ColWidths[1] := 25; // M
  DrawGrid1.ColWidths[2] := 50; // Chanel
  DrawGrid1.ColWidths[3] := 90; // Bank
  DrawGrid1.ColWidths[4] := 90; // Patch
  DrawGrid1.ColWidths[5] := 40; // Vol
  DrawGrid1.ColWidths[6] := 40; // Pan

  // --- KONFIGURACJA DRAWGRID2 ---
  DrawGrid2.FixedRows := 1;
  DrawGrid2.RowCount := 17;
  DrawGrid2.ColCount := 400;
  DrawGrid2.DefaultColWidth := 60; // Szerokość miary (ćwierćnuty/ósemki)
  DrawGrid2.Options := DrawGrid2.Options + [goRowSelect, goDrawFocusSelected];

  DrawGrid1.Align := alLeft;
  Splitter1.Align := alLeft;
  DrawGrid2.Align := alClient;

  RecalculateTimeStructure;
  UpdateGridWidth;
end;

procedure TForm1.RecalculateTimeStructure;
begin
  // Pobieranie wartości z pól edycyjnych z zabezpieczeniem (default 4/4)
  FNumerator := StrToIntDef(Edit2.Text, 4);
  FDenominator := StrToIntDef(Edit3.Text, 4);

  // Walidacja danych wejściowych
  if FDenominator <= 0 then FDenominator := 4;
  if FNumerator <= 0 then FNumerator := 1;

  // LOGIKA OBSŁUGI METRUM
  if (FDenominator = 8) and (FNumerator mod 3 = 0) and (FNumerator > 3) then
  begin
    FTicksPerBeat := Trunc(FPPQ * (4.0 / 8.0) * 3);
    FBeatsPerMeasure := FNumerator div 3;
  end
  else
  begin
    FTicksPerBeat := Trunc(FPPQ * (4.0 / FDenominator));
    FBeatsPerMeasure := FNumerator;
  end;

  FTicksPerMeasure := Trunc(FPPQ * (4.0 / FDenominator)) * FNumerator;

  DrawGrid2.Invalidate;
end;

function TForm1.GetMidiTimeStr(APosition: Cardinal): string;
var Bar, Beat, Tick: Integer;
begin
  if (FTicksPerMeasure <= 0) or (FTicksPerBeat <= 0) then Exit('1:01:000');
  Bar := (Integer(APosition) div FTicksPerMeasure) + 1;
  Beat := ((Integer(APosition) mod FTicksPerMeasure) div FTicksPerBeat) + 1;
  Tick := (Integer(APosition) mod FTicksPerBeat);
  Result := Format('%d:%.2d:%.3d', [Bar, Beat, Tick]);
end;

procedure TForm1.Kwantyzacja1Click(Sender: TObject);
begin
  Form4.Show;
end;

procedure TForm1.Markery1Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.Metrum1Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  Form7.Show;
end;

procedure TForm1.Nuty1Click(Sender: TObject);
begin
  Form10.Show;
end;

procedure TForm1.ranspozycja1Click(Sender: TObject);
begin
     Form5.Show;
end;

procedure TForm1.DrawGrid2DblClick(Sender: TObject);
begin
  if DrawGrid2.Row > 0 then
  begin
    Form7.SelectedTrackID := DrawGrid2.Row;
    Form7.Caption := Format('Piano Roll - Track %d [Metrum: %s/%s]',
                     [DrawGrid2.Row, Edit2.Text, Edit3.Text]);
    Form7.Show;
  end;
end;

procedure TForm1.DrawGrid2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  CursorCol: Integer;
  i: Integer;
  PosX: Integer;
begin
  // 1. TŁO
  if gdSelected in State then
  begin
    DrawGrid2.Canvas.Brush.Color := clHighlight;
    DrawGrid2.Canvas.Font.Color := clHighlightText;
  end
  else if ARow = 0 then
    DrawGrid2.Canvas.Brush.Color := clBtnFace
  else
    DrawGrid2.Canvas.Brush.Color := clWhite;

  DrawGrid2.Canvas.FillRect(Rect);

  // 2. GRAFIKA WIDOKU OGÓLNEGO (Cakewalk Style)
  if (ARow > 0) and (ARow <= 16) then
  begin
     // Skanujemy nuty w SequenceData dla tej komórki czasu
     for i := 0 to 127 do
       if (ACol < 501) and SequenceData[ARow-1, ACol, i] then
       begin
         DrawGrid2.Canvas.Brush.Color := clBlue;
         DrawGrid2.Canvas.FillRect(Bounds(Rect.Left + 2, Rect.Top + 4, 4, Rect.Height - 8));
         Break;
       end;
  end;

  // 3. NAGŁÓWEK TAKTU
  if (ARow = 0) and (FNumerator > 0) then
  begin
    if (ACol mod FNumerator) = 0 then
    begin
      DrawGrid2.Canvas.Font.Style := [fsBold];
      DrawGrid2.Canvas.Font.Color := clBlack;
      DrawGrid2.Canvas.TextOut(Rect.Left + 4, Rect.Top + 2, IntToStr((ACol div FNumerator) + 1));
    end;
  end;

  // 4. RYSOWANIE LINII SIATKI
  DrawGrid2.Canvas.Brush.Style := bsClear;
  DrawGrid2.Canvas.Pen.Color := clSilver;
  DrawGrid2.Canvas.Pen.Width := 1;

  if (FNumerator > 0) and (ACol mod FNumerator = 0) then
  begin
    DrawGrid2.Canvas.Pen.Color := clGray;
    DrawGrid2.Canvas.Pen.Width := 2;
    DrawGrid2.Canvas.MoveTo(Rect.Left, Rect.Top);
    DrawGrid2.Canvas.LineTo(Rect.Left, Rect.Bottom);
  end;

  DrawGrid2.Canvas.Pen.Width := 1;
  DrawGrid2.Canvas.Pen.Color := clSilver;
  DrawGrid2.Canvas.Rectangle(Rect);

  // 5. RYSOWANIE CZERWONEJ LINII POSTĘPU
  if FTicksPerBeat > 0 then
  begin
    if ACol = (Integer(FCurrentPos) div FTicksPerBeat) then
    begin
      DrawGrid2.Canvas.Pen.Color := clRed;
      DrawGrid2.Canvas.Pen.Width := 2;
      // Obliczanie płynnego przesunięcia wewnątrz komórki
      PosX := Rect.Left + Round(((FCurrentPos mod Cardinal(FTicksPerBeat)) / FTicksPerBeat) * Rect.Width);
      DrawGrid2.Canvas.MoveTo(PosX, Rect.Top);
      DrawGrid2.Canvas.LineTo(PosX, Rect.Bottom);
    end;
  end;
end;




procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  S: string;
begin
  if gdSelected in State then
  begin
    DrawGrid1.Canvas.Brush.Color := clHighlight;
    DrawGrid1.Canvas.Font.Color := clHighlightText;
  end
  else if (ARow = 0) or (ACol = 0) then
  begin
    DrawGrid1.Canvas.Brush.Color := clBtnFace;
    DrawGrid1.Canvas.Font.Color := clWindowText;
  end
  else
  begin
    DrawGrid1.Canvas.Brush.Color := clWindow;
    DrawGrid1.Canvas.Font.Color := clWindowText;
  end;

  DrawGrid1.Canvas.FillRect(Rect);

  S := '';
  if ARow = 0 then
  begin
    case ACol of
      0: S := 'Track';
      1: S := 'M';
      2: S := 'Chan';
      3: S := 'Bank';
      4: S := 'Patch';
      5: S := 'Vol';
      6: S := 'Pan';
    end;
  end
  else if ACol = 0 then
    S := IntToStr(ARow);

  if S <> '' then
  begin
    DrawGrid1.Canvas.Brush.Style := bsClear;
    DrawText(DrawGrid1.Canvas.Handle, PChar(S), Length(S), Rect,
             DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
  end;

  DrawGrid1.Canvas.Pen.Color := clSilver;
  DrawGrid1.Canvas.Brush.Style := bsClear;
  DrawGrid1.Canvas.Rectangle(Rect);
end;

procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  if FIsSyncing then Exit;
  FIsSyncing := True;
  try DrawGrid2.Row := ARow; finally FIsSyncing := False; end;
end;

procedure TForm1.DrawGrid2SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
  if FIsSyncing then Exit;
  FIsSyncing := True;
  try DrawGrid1.Row := ARow; finally FIsSyncing := False; end;
end;

procedure TForm1.DrawGrid1TopLeftChanged(Sender: TObject);
begin
  if FIsSyncing then Exit;
  FIsSyncing := True;
  try DrawGrid2.TopRow := DrawGrid1.TopRow; finally FIsSyncing := False; end;
end;

procedure TForm1.DrawGrid2TopLeftChanged(Sender: TObject);
begin
  if FIsSyncing then Exit;
  FIsSyncing := True;
  try DrawGrid1.TopRow := DrawGrid2.TopRow; finally FIsSyncing := False; end;
end;

procedure TForm1.Edit2Change(Sender: TObject); begin RecalculateTimeStructure; end;
procedure TForm1.Edit3Change(Sender: TObject); begin RecalculateTimeStructure; end;
procedure TForm1.SMFSequencer1Event(Sender: TObject; const ASequence, APosition: Cardinal); begin FCurrentPos := APosition; end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if (MediaPlayer1.FileName <> '') then
  begin
    MediaPlayer1.Position := 0;
    FCurrentPos := 0;
    Edit4.Text := '0:00:00';
    Edit5.Text := '1.01.000';
    DrawGrid2.Repaint;
  end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if (MediaPlayer1.FileName <> '') then MediaPlayer1.Play;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if (MediaPlayer1.FileName <> '') then MediaPlayer1.Pause;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
 if (MediaPlayer1.FileName <> '') then MediaPlayer1.Pause;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
  BPM: Integer;
begin
  if (MediaPlayer1.FileName <> '') then
  begin
    MediaPlayer1.Position := MediaPlayer1.Length;
    BPM := StrToIntDef(Edit1.Text, 120);
    FCurrentPos := Round((Int64(MediaPlayer1.Length) * BPM * FPPQ) / 60000);
    Edit5.Text := StringReplace(GetMidiTimeStr(FCurrentPos), ':', '.', [rfReplaceAll]);
    DrawGrid2.Repaint;
  end;
end;

procedure TForm1.Splitter1CanResize(Sender: TObject; var NewSize: Integer;
  var Accept: Boolean);
begin
  NewSize := 257;
  Accept := False;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  Form6.Show;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FS: TFileStream;
  MHeader: array[0..13] of Byte;
  B: Byte;
  TempoVal: Integer;
begin
  if OpenDialog1.Execute then
  begin
    FS := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyNone);
    try
      FS.ReadBuffer(MHeader, 14);
      // RĘCZNE WYDOBYCIE PPQ (Bajt 12 i 13)
      FPPQ := (MHeader[12] shl 8) or MHeader[13];

      // Skanowanie bajtów w poszukiwaniu Tempa (FF 51 03)
      FS.Position := 14;
      while FS.Position < FS.Size - 5 do
      begin
        FS.Read(B, 1);
        if B = $FF then
        begin
          FS.Read(B, 1);
          if B = $51 then // Tempo
          begin
            FS.Position := FS.Position + 1; // pomiń len
            TempoVal := 0;
            FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
            FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
            FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
            Edit1.Text := IntToStr(Round(60000000 / TempoVal));
            Break;
          end;
        end;
      end;
    finally
      FS.Free;
    end;

    if FPPQ <= 0 then FPPQ := 480;

    MediaPlayer1.Close;
    MediaPlayer1.FileName := OpenDialog1.FileName;
    MediaPlayer1.Open;

    RecalculateTimeStructure;

    // Skalowanie ilości kolumn w siatce (jedna kolumna = jeden Beat)
    FMaxPos := Round((Int64(MediaPlayer1.Length) * StrToFloatDef(Edit1.Text, 120) * FPPQ) / 60000);
    if FTicksPerBeat > 0 then
      DrawGrid2.ColCount := (Integer(FMaxPos) div FTicksPerBeat) + 20;

    FCurrentPos := 0;
    Timer1.Enabled := True;
    DrawGrid2.Invalidate;
    Form1.StatusBar1.Panels[0].Text := 'Wczytano: ' + opendialog1.filename;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Form4.Show;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     Form5.Show;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
form3.Show;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin Form2.Show;
end;

procedure TForm1.UpdateGridWidth;
var I, TotalWidth: Integer;
begin
  TotalWidth := 0;
  for I := 0 to DrawGrid1.ColCount - 1 do TotalWidth := TotalWidth + DrawGrid1.ColWidths[I] + 1;
  DrawGrid1.Width := TotalWidth + 4;
end;

procedure TForm1.View1Click(Sender: TObject);
begin
  if DrawGrid2.Row > 0 then
  begin
    if not Assigned(Form8) then Form8 := TForm8.Create(Application);
    Form8.LoadEventsFromTrack(DrawGrid2.Row);
    Form8.Show;
  end;
end;

procedure TForm1.View2Click(Sender: TObject);
begin
  Form9.show;
end;

procedure TForm1.Wczytaj1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

procedure TForm1.Zakocz1Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.Zapisz1Click(Sender: TObject);
begin
  savedialog1.Execute;
end;

end.
Udostępnij
Komentuj
Marius.Maximus
Marius.Maximus
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 2202
0

@zebmcs: opis mglisty to i Najmądrzejszy chat nie da rady.

Jak wczytasz midi to pewnie wiesz ile "nutek" w nim jest wiec znasz jego czas
Jak odtwarzasz to musisz znać pozycje gdzie jesteś
Z tych dwóch iinformacji wyliczasz jaki jest postęp operacji i gdzie ma być czerwona linia.

Wiec pytanie:

  • czy problem jest po stronie blednych obliczen
  • czy tez blednego rysowania ?
Udostępnij
Komentuj
MCS_Zbigniew
MCS_Zbigniew
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 2
0

witam , sorki że z drugiego konta, problemy z logowaniem (...), a więc tak. rysowanie jest zintegrowane z czasem ,więc raczej nie jest to wina rysowania lecz obliczeń i stąd ten problem, najprawdopodobniej brakuje mi jakiegoś niestandardowego wzoru aby prawidłowo zliczyć czas i wstawić/narysować go w drawgrid (obecnie próbuję w stringrid), przy wczytywaniu zczytuję z pliku midi tempo , metrum i liczbę ticków,, nie mam pojęcia co robię źle.

Udostępnij
Komentuj
MCS_Zbigniew
MCS_Zbigniew
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 2
0

dobra udało mi się ogarnąć temat, problem rozwiązany, zmieniłem strukturę wczytywania na w pełni dynamiczną - czyli pełny odczyt z midi i dostosowane , dynamiczne rysowanie tabel (tym razemi) w StringGrid, porzuciłem całkowicie media player, nie można z nim przeprowadzić odpowiedniej synchronizacji, wrzucę działający kod głównego Unit'a może kiedyś komuś się przyda coś z tego (...)

unit SekwencerMidi;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Vcl.ComCtrls, Vcl.ToolWin, Vcl.Menus, Vcl.ExtCtrls, Vcl.Grids,
Vcl.MPlayer, Vcl.ButtonGroup, Vcl.Buttons, Math, Winapi.MMSystem;

type
TNoteData = record
HasNote: Boolean;
MinPitch, MaxPitch: Byte;
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Plik1: TMenuItem;
Edycja1: TMenuItem;
EfektyMidi1: TMenuItem;
About1: TMenuItem;
Nowy1: TMenuItem;
Wczytaj1: TMenuItem;
Zapisz1: TMenuItem;
Zakocz1: TMenuItem;
StatusBar1: TStatusBar;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Splitter1: TSplitter;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button6: TButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
Edit3: TEdit;
Label1: TLabel;
Edit1: TEdit;
N3: TMenuItem;
N4: TMenuItem;
View1: TMenuItem;
View2: TMenuItem;
Nuty1: TMenuItem;
Edit4: TEdit;
Edit5: TEdit;
Label5: TLabel;
Label6: TLabel;
Timer1: TTimer;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Edit6: TEdit;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
procedure StringGrid2SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
procedure StringGrid1TopLeftChanged(Sender: TObject);
procedure StringGrid2TopLeftChanged(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure Wczytaj1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Zapisz1Click(Sender: TObject);
procedure Zakocz1Click(Sender: TObject);
procedure Markery1Click(Sender: TObject);
procedure Metrum1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Kwantyzacja1Click(Sender: TObject);
procedure ranspozycja1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure View1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure View2Click(Sender: TObject);
procedure Nuty1Click(Sender: TObject);
procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
procedure StringGrid2DblClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PlayMidiEvents(FromTick, ToTick: Cardinal);

private
FCurrentPos: Cardinal;
FIsSyncing: Boolean;
FMaxPos: Cardinal;
function TicksPerGridCol: Integer;
function ColsPerMeasure: Integer;

public
FLastPos: Cardinal;
FMidiOut:HMIDIOUT;
FMidiOutName: string;
FStartQPC: Int64;
FQPCFreq: Int64;
FPPQ: Integer;
FNumerator: Integer;
FDenominator: Integer;
FTicksPerMeasure: Integer;
FTicksPerBeat: Integer;
FBeatsPerMeasure: Integer;
FNoteMinMax: array[1..16, 0..5000] of TNoteData;
function BeToN32(v: Cardinal): Cardinal;
procedure UpdateGridWidth;
procedure RecalculateTimeStructure;
function GetMidiTimeStr(APosition: Int64): string;
procedure PlayGridColumn(ACol: Integer);
end;

var
Form1: TForm1;
SequenceData: array[0..15, 0..500, 0..127] of Boolean;

type
TMidiNoteEvent = record
StartTick: Cardinal;
Duration: Cardinal;
Note: Byte;
Velocity: Byte;
Channel: Byte;
Active: Boolean;
end;

var
MidiNotes: array[0..20000] of TMidiNoteEvent;
MidiNoteCount: Integer;

implementation

{$R *.dfm}

uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit10, Unit8, Unit9;

function GetMidiOutName(DeviceID: UINT): string;
var
Caps: MIDIOUTCAPS;
begin
Result := '';
if midiOutGetDevCaps(DeviceID, @Caps, SizeOf(Caps)) = MMSYSERR_NOERROR then
Result := Caps.szPname;
end;

function OpenMicrosoftGS(out Midi: HMIDIOUT): Boolean;
var
i: Integer;
Caps: TMidiOutCaps;
begin
Result := False;
Midi := 0;
for i := 0 to midiOutGetNumDevs - 1 do
begin
if midiOutGetDevCaps(i, @Caps, SizeOf(Caps)) = MMSYSERR_NOERROR then
begin
if (Pos('Microsoft GS', Caps.szPname) > 0) or (Pos('Wavetable', Caps.szPname) > 0) then
begin
if midiOutOpen(@Midi, i, 0, 0, 0) = MMSYSERR_NOERROR then
begin
Result := True;
Exit;
end;
end;
end;
end;
end;

procedure TForm1.PlayMidiEvents(FromTick, ToTick: Cardinal);
var
i: Integer;
Msg: DWORD;
OffTick: Cardinal;
begin
if FMidiOut = 0 then Exit;
if ToTick <= FromTick then Exit;

for i := 0 to MidiNoteCount - 1 do
begin
if (not MidiNotes[i].Active) and
(MidiNotes[i].StartTick >= FromTick) and
(MidiNotes[i].StartTick < ToTick) then
begin
Msg := $90 or (MidiNotes[i].Channel and $0F) or
(MidiNotes[i].Note shl 8) or
(MidiNotes[i].Velocity shl 16);
midiOutShortMsg(FMidiOut, Msg);
MidiNotes[i].Active := True;
end;

OffTick := MidiNotes[i].StartTick + MidiNotes[i].Duration;
if MidiNotes[i].Active and
   (OffTick > FromTick) and
   (OffTick <= ToTick) then
begin
  // Dodano trzeci bajt (0) dla Note Off dla lepszej kompatybilności
  Msg := $80 or (MidiNotes[i].Channel and $0F) or (MidiNotes[i].Note shl 8) or (0 shl 16);
  midiOutShortMsg(FMidiOut, Msg);
  MidiNotes[i].Active := False;
end;

end;
end;

procedure TForm1.PlayGridColumn(ACol: Integer);
var
Track: Integer;
Note, Channel: Byte;
begin
for Track := 1 to 16 do
begin
// ZAMIANA FHasNote na FNoteMinMax
if (ACol <= 5000) and FNoteMinMax[Track, ACol].HasNote then
begin
Channel := Track - 1;
Note := FNoteMinMax[Track, ACol].MinPitch; // Używamy zapisanej wysokości nuty

  midiOutShortMsg(FMidiOut, $90 or Channel or (Note shl 8) or ($64 shl 16));
end;

end;
end;

function TForm1.TicksPerGridCol: Integer;
begin
if FPPQ < 4 then Result := 1 else Result := FPPQ div 4;
end;

function TForm1.ColsPerMeasure: Integer;
begin
if TicksPerGridCol = 0 then Result := 16 else Result := FTicksPerMeasure div TicksPerGridCol;
end;

function TForm1.BeToN32(v: Cardinal): Cardinal;
begin
Result := ((v shl 24) and $FF000000) or ((v shl 8) and $00FF0000) or
((v shr 8) and $0000FF00) or ((v shr 24) and $000000FF);
end;

procedure TForm1.RecalculateTimeStructure;
begin
FNumerator := StrToIntDef(Edit2.Text, 4);
FDenominator := StrToIntDef(Edit3.Text, 4);
if FNumerator <= 0 then FNumerator := 4;
if FDenominator <= 0 then FDenominator := 4;
FTicksPerBeat := (FPPQ * 4) div FDenominator;
FBeatsPerMeasure := FNumerator;
FTicksPerMeasure := FTicksPerBeat * FBeatsPerMeasure;
StringGrid2.Invalidate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
NowQPC: Int64;
ElapsedSec: Double;
BPM: Double;
NewPos: Cardinal;
CursorCol: Integer;
PianoCursorCol: Integer;
begin
QueryPerformanceCounter(NowQPC);
ElapsedSec := (NowQPC - FStartQPC) / FQPCFreq;
BPM := StrToFloatDef(Edit1.Text, 120);

NewPos := Round(ElapsedSec * (BPM / 60.0) * FPPQ);
PlayMidiEvents(FLastPos, NewPos);

FLastPos := NewPos;
FCurrentPos := NewPos;

if FPPQ >= 4 then
begin
CursorCol := FCurrentPos div (FPPQ div 4);

// --- POPRAWKA 2: AUTO-SCROLLING (Przesuwanie widoku za kursorem) ---
if CursorCol > StringGrid2.LeftCol + StringGrid2.VisibleColCount - 2 then
  StringGrid2.LeftCol := CursorCol - 5; // Przesuń widok, by kursor był widoczny

StringGrid2.Invalidate;

end;

if Form7.Visible then
begin
// Przelicza aktualną pozycję na kolumny Piano Roll
PianoCursorCol := FCurrentPos div FTicksPerBeat;

// AUTO-SCROLLING w Piano Roll (nie ucieka za ekran)
if PianoCursorCol > Form7.DrawGrid2.LeftCol + Form7.DrawGrid2.VisibleColCount - 2 then
  Form7.DrawGrid2.LeftCol := PianoCursorCol - 5;

if PianoCursorCol < Form7.DrawGrid2.LeftCol then
  Form7.DrawGrid2.LeftCol := PianoCursorCol;

Form7.DrawGrid2.Invalidate; // Odśwież widok Piano Roll

end;

if Assigned(Form8) and Form8.Visible then
begin
// wymusza odświeżenie rysowania
Form8.StringGrid1.Invalidate;
end;

Edit4.Text := FormatDateTime('h:nn:ss', ElapsedSec / SecsPerDay);
Edit5.Text := StringReplace(GetMidiTimeStr(FCurrentPos), ':', '.', [rfReplaceAll]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FMidiOut := 0;
// Próba otwarcia konkretnego syntezatora
if not OpenMicrosoftGS(FMidiOut) then
midiOutOpen(@FMidiOut, 0, 0, 0, 0);

FMidiOutName := GetMidiOutName(0);
Edit6.Text := 'MIDI: ' + FMidiOutName;

Timer1.Enabled := False;
FIsSyncing := False;
FCurrentPos := 0;
FLastPos := 0;
FPPQ := 120;
Edit1.Text := '120';
Edit2.Text := '4';
Edit3.Text := '4';

StringGrid1.ColCount := 7;
StringGrid1.RowCount := 17;
StringGrid1.FixedCols := 1;
StringGrid1.FixedRows := 1;
StringGrid1.Options := StringGrid1.Options + [goRowSelect, goDrawFocusSelected];
StringGrid1.ColWidths[0] := 50; StringGrid1.ColWidths[1] := 25;
StringGrid1.ColWidths[2] := 40; StringGrid1.ColWidths[3] := 60;
StringGrid1.ColWidths[4] := 70; StringGrid1.ColWidths[5] := 40;
StringGrid1.ColWidths[6] := 40;
StringGrid1.Cells[0, 0] := 'Track'; StringGrid1.Cells[1, 0] := 'M';
StringGrid1.Cells[2, 0] := 'Kan'; StringGrid1.Cells[3, 0] := 'Bank';
StringGrid1.Cells[4, 0] := 'Patch'; StringGrid1.Cells[5, 0] := 'Vol';
StringGrid1.Cells[6, 0] := 'Pan';
for var i := 1 to 16 do StringGrid1.Cells[0, i] := IntToStr(i);

StringGrid2.FixedRows := 1;
StringGrid2.RowCount := 17;
StringGrid2.ColCount := 2000;
StringGrid2.DefaultColWidth := 14;
StringGrid2.Options := StringGrid2.Options + [goRowSelect, goDrawFocusSelected];
StringGrid1.Align := alLeft;
Splitter1.Align := alLeft;
StringGrid2.Align := alClient;

RecalculateTimeStructure;
UpdateGridWidth;
end;

function TForm1.GetMidiTimeStr(APosition: Int64): string;
var
Bar, Beat, Tick: Int64;
begin
if FTicksPerMeasure <= 0 then Exit('1:01:000');
Bar := (APosition div FTicksPerMeasure) + 1;
Beat := ((APosition mod FTicksPerMeasure) div FTicksPerBeat) + 1;
Tick := (APosition mod FTicksPerBeat);
Result := Format('%d:%.2d:%.3d', [Bar, Beat, Tick]);
end;

procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
CursorCol: Integer;
S: string;
R: TRect;
NoteY, NoteH: Integer;
begin
// --- 1. NAGŁÓWEK (Pasek czasu) ---
if ARow = 0 then
begin
StringGrid2.Canvas.Brush.Color := $E0E0E0; // Jasny szary dla nagłówka
StringGrid2.Canvas.FillRect(Rect);
if (ACol mod 16 = 0) then
begin
StringGrid2.Canvas.Font.Color := clBlack;
StringGrid2.Canvas.Font.Style := [fsBold];
S := IntToStr((ACol div 16) + 1);
R := Rect; R.Left := R.Left + 2; R.Right := R.Left + 100;
DrawText(StringGrid2.Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_TOP or DT_NOCLIP);
end;
if ACol mod 16 = 0 then
begin
StringGrid2.Canvas.Pen.Width := 1;
StringGrid2.Canvas.Pen.Color := clGray;
StringGrid2.Canvas.MoveTo(Rect.Left, Rect.Top);
StringGrid2.Canvas.LineTo(Rect.Left, Rect.Bottom);
end;
Exit;
end;

// --- 2. TŁO (SYNCHRONIZACJA ZAZNACZENIA) ---
if ARow = StringGrid2.Row then
StringGrid2.Canvas.Brush.Color := $FFFAF0 // Ten sam jasny błękit co w Grid1
else
StringGrid2.Canvas.Brush.Color := clWhite; // Standardowe białe tło

StringGrid2.Canvas.FillRect(Rect);

// Linie pionowe siatki
if (ACol mod 16 = 0) then
StringGrid2.Canvas.Pen.Color := clSilver // Linia taktu
else
StringGrid2.Canvas.Pen.Color := $F0F0F0; // Subtelna linia uderzenia

StringGrid2.Canvas.MoveTo(Rect.Left, Rect.Top);
StringGrid2.Canvas.LineTo(Rect.Left, Rect.Bottom);

// Pozioma linia oddzielająca tracki
StringGrid2.Canvas.Pen.Color := $EEEEEE;
StringGrid2.Canvas.MoveTo(Rect.Left, Rect.Bottom - 1);
StringGrid2.Canvas.LineTo(Rect.Right, Rect.Bottom - 1);

// --- 3. RYSOWANIE NUT (GHOST NOTES - STYL CAKEWALK) ---
if (ARow >= 1) and (ARow <= 16) and (ACol >= 0) and (ACol <= 5000) then
begin
if FNoteMinMax[ARow, ACol].HasNote then
begin
// Dobór kolorów (wyraźne na błękitnym/białym tle)
if ARow = 10 then
begin
StringGrid2.Canvas.Brush.Color := $5555FF; // Perkusja
StringGrid2.Canvas.Pen.Color := clMaroon;
end else begin
StringGrid2.Canvas.Brush.Color := clBlue; // Instrumenty
StringGrid2.Canvas.Pen.Color := $000044; // Ciemniejsza obwódka dla kontrastu
end;

  // Obliczanie pozycji pionowej nuty
  NoteY := Rect.Top + 2 + Round(((127 - FNoteMinMax[ARow, ACol].MaxPitch) mod 24 / 24) * (Rect.Height - 8));
  NoteH := 4;

  // Rysowanie zaokrąglonej kreski nuty
  StringGrid2.Canvas.RoundRect(Rect.Left + 1, NoteY, Rect.Right - 1, NoteY + NoteH, 2, 2);
end;

end;

// --- 4. KURSOR (CZERWONA LINIA) ---
if FPPQ >= 4 then CursorCol := FCurrentPos div (FPPQ div 4) else CursorCol := -1;
if Integer(ACol) = CursorCol then
begin
StringGrid2.Canvas.Pen.Color := clRed;
StringGrid2.Canvas.Pen.Width := 2;
StringGrid2.Canvas.MoveTo(Rect.Left, Rect.Top);
StringGrid2.Canvas.LineTo(Rect.Left, Rect.Bottom);
StringGrid2.Canvas.Pen.Width := 1;
end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
S: string;
begin
S := StringGrid1.Cells[ACol, ARow];

// 1. USTALANIE KOLORU TŁA (Logika spójna ze StringGrid2)
if ARow = 0 then
begin
// Nagłówek (Track, M, Kan, Patch...)
StringGrid1.Canvas.Brush.Color := clBtnFace;
StringGrid1.Canvas.Font.Color := clWindowText;
end
else if ARow = StringGrid1.Row then
begin
// ZAZNACZONY WIERSZ (Jasny błękit nieba - identyczny w obu Gridach)
// $FFFAF0 to kolor jasny i czytelny (Sky Blue / Alice Blue)
StringGrid1.Canvas.Brush.Color := $FFFAF0;
StringGrid1.Canvas.Font.Color := clBlack; // Czarny tekst lepiej wygląda na jasnym tle
end
else if ACol = 0 then
begin
// Pierwsza kolumna (Numery tracków)
StringGrid1.Canvas.Brush.Color := clBtnFace;
StringGrid1.Canvas.Font.Color := clWindowText;
end
else
begin
// Pozostałe, niezaznaczone komórki
StringGrid1.Canvas.Brush.Color := clWindow;
StringGrid1.Canvas.Font.Color := clWindowText;
end;

// 2. WYPEŁNIENIE TŁA
StringGrid1.Canvas.FillRect(Rect);

// 3. RYSOWANIE TEKSTU
if S <> '' then
begin
StringGrid1.Canvas.Brush.Style := bsClear;
// DT_NOPREFIX chroni przed zamianą znaku "&" na podkreślenie
DrawText(StringGrid1.Canvas.Handle, PChar(S), Length(S), Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX);
end;

// 4. RYSOWANIE RAMKI KOMÓRKI
StringGrid1.Canvas.Pen.Color := clSilver;
StringGrid1.Canvas.Brush.Style := bsClear;
StringGrid1.Canvas.Rectangle(Rect);
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
if FIsSyncing then Exit;
FIsSyncing := True;
try
StringGrid2.Row := ARow;
StringGrid2.Invalidate; // Wymusza odświeżenie podświetlenia w gridzie 2
finally
FIsSyncing := False;
end;
end;

procedure TForm1.StringGrid2SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
if FIsSyncing then Exit;
FIsSyncing := True;
try
StringGrid1.Row := ARow;
StringGrid1.Invalidate; // Wymusza odświeżenie podświetlenia w gridzie 2
finally
FIsSyncing := False;
end;
end;

procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
begin
if FIsSyncing then Exit;
FIsSyncing := True;
try
StringGrid2.TopRow := StringGrid1.TopRow;
finally
FIsSyncing := False;
end;
end;

procedure TForm1.StringGrid2TopLeftChanged(Sender: TObject);
begin
if FIsSyncing then Exit;
FIsSyncing := True;
try
StringGrid1.TopRow := StringGrid2.TopRow;
finally
FIsSyncing := False;
end;
end;

procedure TForm1.Edit2Change(Sender: TObject); begin RecalculateTimeStructure; end;
procedure TForm1.Edit3Change(Sender: TObject); begin RecalculateTimeStructure; end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var i: Integer;
begin
for i := 0 to MidiNoteCount - 1 do MidiNotes[i].Active := False;
FLastPos := 0; FCurrentPos := 0;
QueryPerformanceFrequency(FQPCFreq);
QueryPerformanceCounter(FStartQPC);
Timer1.Enabled := True;
StatusBar1.Panels[0].Text := 'Odtwarzanie';
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Timer1.Enabled := False;
for var i := 0 to 15 do midiOutShortMsg(FMidiOut, $B0 or i or ($7B shl 8));
FCurrentPos := 0; FLastPos := 0;
StringGrid2.Invalidate;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
FCurrentPos := FMaxPos;
QueryPerformanceCounter(FStartQPC);
Edit5.Text := StringReplace(GetMidiTimeStr(FCurrentPos), ':', '.', [rfReplaceAll]);
StringGrid2.Repaint;
StatusBar1.Panels[0].Text := 'Koniec utworu';
end;

procedure TForm1.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
begin NewSize := 257; Accept := False; end;

procedure TForm1.Button1Click(Sender: TObject);
var
FS: TFileStream;
MHeader: array[0..13] of Byte;
B, Status, Note, Velo, PatchNum: Byte;
TempoVal: Integer;
i, j: Integer;
ID: array[0..3] of AnsiChar;
TSize, TSizeMeta: Cardinal;
NumTracks: Word;
Delta: Cardinal;
AbsTick: Int64;
CurrentGridCol: Integer;
NoteStart: array[0..15, 0..127] of Int64;
RunningStatus: Byte;

function ReadVarLen: Cardinal;
var B: Byte;
begin
Result := 0;
repeat
FS.Read(B, 1);
Result := (Result shl 7) or (B and $7F);
until (B and $80) = 0;
end;

begin
FillChar(FNoteMinMax, SizeOf(FNoteMinMax), 0);
if not OpenDialog1.Execute then Exit;

MidiNoteCount := 0;
FillChar(NoteStart, SizeOf(NoteStart), $FF);
FLastPos := 0; FMaxPos := 0; FCurrentPos := 0;

FS := TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyNone);
try
FS.ReadBuffer(MHeader, 14);
NumTracks := (MHeader[10] shl 8) or MHeader[11];
FPPQ := (MHeader[12] shl 8) or MHeader[13];

for i := 1 to NumTracks do
begin
  if i > 16 then Break;
  FS.Read(ID, 4);
  FS.ReadBuffer(TSize, 4);
  TSize := BeToN32(TSize);
  j := FS.Position;
  AbsTick := 0;
  RunningStatus := 0;

  while (FS.Position < j + TSize) and (FS.Position < FS.Size) do
  begin
    Delta := ReadVarLen;
    AbsTick := AbsTick + Delta;
    FS.Read(Status, 1);

    if Status < $80 then begin
      FS.Position := FS.Position - 1;
      Status := RunningStatus;
    end else if Status < $F0 then begin
      RunningStatus := Status;
    end;

    var CurrentChannel := Status and $0F;
    var GridRow := CurrentChannel + 1;

    if FPPQ >= 4 then CurrentGridCol := AbsTick div (FPPQ div 4) else CurrentGridCol := 0;

    // --- LOGIKA NOTE ON ($90) ---
    if (Status and $F0 = $90) then
    begin
      FS.Read(Note, 1); FS.Read(Velo, 1);
      if Velo > 0 then
      begin
        NoteStart[CurrentChannel, Note] := AbsTick;
        if (CurrentGridCol >= 0) and (CurrentGridCol <= 5000) and (GridRow >= 1) and (GridRow <= 16) then
        begin
          if not FNoteMinMax[GridRow, CurrentGridCol].HasNote then
          begin
            FNoteMinMax[GridRow, CurrentGridCol].HasNote := True;
            FNoteMinMax[GridRow, CurrentGridCol].MinPitch := Note;
            FNoteMinMax[GridRow, CurrentGridCol].MaxPitch := Note;
          end else begin
            if Note < FNoteMinMax[GridRow, CurrentGridCol].MinPitch then FNoteMinMax[GridRow, CurrentGridCol].MinPitch := Note;
            if Note > FNoteMinMax[GridRow, CurrentGridCol].MaxPitch then FNoteMinMax[GridRow, CurrentGridCol].MaxPitch := Note;
          end;
        end;
      end else begin
        // Note On z Velo=0 to Note Off
        if (MidiNoteCount < 20000) and (NoteStart[CurrentChannel, Note] >= 0) then begin
          MidiNotes[MidiNoteCount].StartTick := NoteStart[CurrentChannel, Note];
          MidiNotes[MidiNoteCount].Duration := AbsTick - NoteStart[CurrentChannel, Note];
          MidiNotes[MidiNoteCount].Note := Note;
          MidiNotes[MidiNoteCount].Velocity := 100;
          MidiNotes[MidiNoteCount].Channel := CurrentChannel;
          MidiNotes[MidiNoteCount].Active := False;
          Inc(MidiNoteCount);
          NoteStart[CurrentChannel, Note] := -1;
        end;
      end;
    end
    // --- LOGIKA NOTE OFF ($80) ---
    else if (Status and $F0 = $80) then
    begin
      FS.Read(Note, 1); FS.Read(Velo, 1);
      if (MidiNoteCount < 20000) and (NoteStart[CurrentChannel, Note] >= 0) then begin
        MidiNotes[MidiNoteCount].StartTick := NoteStart[CurrentChannel, Note];
        MidiNotes[MidiNoteCount].Duration := AbsTick - NoteStart[CurrentChannel, Note];
        MidiNotes[MidiNoteCount].Note := Note;
        MidiNotes[MidiNoteCount].Velocity := 100;
        MidiNotes[MidiNoteCount].Channel := CurrentChannel;
        MidiNotes[MidiNoteCount].Active := False;
        Inc(MidiNoteCount);
        NoteStart[CurrentChannel, Note] := -1;
      end;
    end
    // --- LOGIKA CONTROL CHANGE ($B0) ---
    else if (Status and $F0 = $B0) then
    begin
      var CC_Num, CC_Val: Byte;
      FS.Read(CC_Num, 1); FS.Read(CC_Val, 1);
      if (GridRow >= 1) and (GridRow <= 16) then begin
        if (CC_Num = 0) or (CC_Num = 32) then begin
          StringGrid1.Cells[3, GridRow] := IntToStr(CC_Val);
          midiOutShortMsg(FMidiOut, Status or (CC_Num shl 8) or (CC_Val shl 16));
        end;
        if (CC_Num = 7) then StringGrid1.Cells[5, GridRow] := IntToStr(CC_Val);
        if (CC_Num = 10) then StringGrid1.Cells[6, GridRow] := IntToStr(CC_Val);
      end;
    end
    // --- LOGIKA PROGRAM CHANGE ($C0) ---
    else if (Status and $F0 = $C0) then
    begin
      FS.Read(PatchNum, 1);
      if (GridRow >= 1) and (GridRow <= 16) then begin
        StringGrid1.Cells[4, GridRow] := IntToStr(PatchNum);
        StringGrid1.Cells[2, GridRow] := IntToStr(CurrentChannel);
        midiOutShortMsg(FMidiOut, Status or (PatchNum shl 8));
      end;
    end
    // --- LOGIKA META EVENTS ($FF) ---
    else if (Status = $FF) then
    begin
      FS.Read(B, 1);
      TSizeMeta := ReadVarLen;
      if B = $51 then begin
         TempoVal := 0;
         FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
         FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
         FS.Read(B, 1); TempoVal := (TempoVal shl 8) or B;
         Edit1.Text := IntToStr(Round(60000000 / TempoVal));
      end else FS.Position := FS.Position + TSizeMeta;
    end
    else begin
      // Inne zdarzenia
      case (Status and $F0) of
        $D0: FS.Read(B, 1);
        $A0, $E0: begin FS.Read(B, 1); FS.Read(B, 1); end;
      end;
    end;

    if AbsTick > FMaxPos then FMaxPos := AbsTick;
  end; // end while
  FS.Position := j + TSize;
end; // end for

RecalculateTimeStructure;
StatusBar1.Panels[0].Text := 'Wczytano: ' + ExtractFileName(OpenDialog1.FileName);

finally
FS.Free;
StringGrid2.Invalidate;
end;
end;

procedure TForm1.Button3Click(Sender: TObject); begin Form4.Show; end;
procedure TForm1.Button4Click(Sender: TObject); begin Form5.Show; end;
procedure TForm1.Button5Click(Sender: TObject); begin Form3.Show; end;
procedure TForm1.Button6Click(Sender: TObject); begin Form2.Show; end;

procedure TForm1.UpdateGridWidth;
var I, TotalWidth: Integer;
begin
TotalWidth := 0;
for I := 0 to StringGrid1.ColCount - 1 do TotalWidth := TotalWidth + StringGrid1.ColWidths[I] + 1;
StringGrid1.Width := TotalWidth + 4;
end;

procedure TForm1.Wczytaj1Click(Sender: TObject); begin Button1Click(nil); end;
procedure TForm1.Zakocz1Click(Sender: TObject); begin Close; end;
procedure TForm1.Zapisz1Click(Sender: TObject); begin SaveDialog1.Execute; end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if FMidiOut <> 0 then begin
midiOutReset(FMidiOut);
midiOutClose(FMidiOut);
FMidiOut := 0;
end;
end;

procedure TForm1.StringGrid2DblClick(Sender: TObject);
begin
if StringGrid2.Row > 0 then begin
Form7.SelectedTrackID := StringGrid2.Row;
Form7.Caption := Format('Piano Roll - Track %d', [StringGrid2.Row]);
Form7.Show;
end;
end;

procedure TForm1.About1Click(Sender: TObject); begin Form6.Show; end;
procedure TForm1.Markery1Click(Sender: TObject); begin Form2.Show; end;
procedure TForm1.Metrum1Click(Sender: TObject); begin Form3.Show; end;
procedure TForm1.Kwantyzacja1Click(Sender: TObject); begin Form4.Show; end;
procedure TForm1.ranspozycja1Click(Sender: TObject); begin Form5.Show; end;
procedure TForm1.N4Click(Sender: TObject);
begin
Form7.Show;
end;
procedure TForm1.View2Click(Sender: TObject); begin Form9.Show; end;
procedure TForm1.Nuty1Click(Sender: TObject); begin Form10.Show; end;

procedure TForm1.View1Click(Sender: TObject);
begin
if StringGrid2.Row > 0 then begin
if not Assigned(Form8) then Form8 := TForm8.Create(Application);
Form8.LoadEventsFromTrack(StringGrid2.Row);
Form8.Show;
end;
end;

end.

Udostępnij
Komentuj

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.

Utwórz konto