www.pudn.com > MIDIFile2v094.zip > MIDITest.pas, change:2012-05-28,size:3425b


{' UNIT MIDITest.pas 
'--------------------------------- MIDITest ----------------------------- 
' Test program for MIDIReader 
' 
' Copyright 2011 Silhwan Hyun, All Rights Reserved 
' This unit is free. It may be used both in commercial and non-commercial software either in 
'  original or in modified form. 
' This unit can be freely distributed in any way and by any means provided this copyright 
'  notice is preserved. 
 
' Author : Silhwan Hyun   (e-mail addr : hyunsh@hanafos.com) 
' 
' Author's comment : Please let me know if you have any idea to improve or to debug this unit. 
' 
' 
' Revision History 
' 
'  Ver 0.9.0    Jun 4 2011 
'    Initial release 
'----------------------------------------------------------------------------} 
 
unit MIDITest; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, FileCtrl, 
  Dialogs, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    btnOpen: TButton; 
    OpenDialog1: TOpenDialog; 
    btnClose: TButton; 
    edTracks: TEdit; 
    Label1: TLabel; 
    Label2: TLabel; 
    edFormat: TEdit; 
    edLength: TEdit; 
    Label4: TLabel; 
    edFile: TEdit; 
    Label7: TLabel; 
    edCopyright: TEdit; 
    Label9: TLabel; 
    TrackList: TListBox; 
    Label3: TLabel; 
    Label5: TLabel; 
    procedure btnOpenClick(Sender: TObject); 
    procedure btnCloseClick(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private declarations } 
    FCanvas: TCanvas; 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses MIDIFile2; 
 
var 
  FileInfo: TMidiFile2; 
 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  FileInfo := TMidiFile2.Create(Self); 
  FCanvas := TControlCanvas.Create; 
  TControlCanvas(FCanvas).Control := edFile; 
  FCanvas.Font := edFile.Font; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FCanvas.Free; 
  FileInfo.Free; 
end; 
 
procedure TForm1.btnOpenClick(Sender: TObject); 
var 
  I: integer; 
  MidiTrack: TMidiTrack; 
begin 
  if not OpenDialog1.Execute then 
    exit; 
 
  if not FileInfo.ReadFromFile(OpenDialog1.FileName) then 
  begin 
    MessageBox(Self.Handle, 'Not a valid MIDI file.', 'Confirm', MB_OK); 
    exit; 
  end; 
 
  edFile.Text := MinimizeName(OpenDialog1.FileName, FCanvas, edFile.Width); 
  case FileInfo.Format of 
    0: edFormat.Text := 'single-track, '; 
    1: edFormat.Text := 'multiple tracks, synchronous, '; 
    2: edFormat.Text := 'multiple tracks, asynchronous, '; 
  end; 
  case FileInfo.TickUnit of 
    0: edFormat.Text := edFormat.Text + intToStr(FileInfo.TicksPerQuarter) + ' Ticks per quarter note'; 
    1: edFormat.Text := edFormat.Text + intToStr(FileInfo.TicksPerQuarter) + ' Ticks per second'; 
  end; 
 
  MidiTrack := TMidiTrack(FileInfo.GetTrack(0)); 
  edCopyright.Text := MidiTrack.Copyright; 
  edLength.Text := FormatFloat('#,##0', FileInfo.PlayTicks) + ' Ticks     ' + FormatFloat('#,##0', FileInfo.Duration) + ' ms'; 
 
  edTracks.Text := intToStr(FileInfo.TrackCount); 
  TrackList.Clear; 
  for I := 0 to (FileInfo.TrackCount - 1) do 
  begin 
    MidiTrack := TMidiTrack(FileInfo.GetTrack(I)); 
    TrackList.Items.Add('Track ' + intToStr(I) + ' : ' + MidiTrack.TrackName); 
  end; 
end; 
 
procedure TForm1.btnCloseClick(Sender: TObject); 
begin 
   Close; 
end; 
 
 
end.