Re: Help on Midi port access source.
[ Follow Ups ] [ The MIDIWORLD Forum ]
Posted by Oreste on August 19, 2003 at 14:34:27:
In Reply to: Help on Midi port access source. posted by BuiHongPhuc on December 25, 2002 at 22:54:17:
Hi Bui,
I am programming a Karaoke prog in Delphi Pascal 6.0, the work is still ongoing. I send u what I've done up to now. Any comment will be highly appreciated.
Bye
Oreste
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MPlayer, StdCtrls, ComCtrls, StrUtils;
type
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
Button1: TButton;
OpenDialog1: TOpenDialog;
Button2: TButton;
Label1: TLabel;
Memo1: TMemo;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
End;
MDIHeaderRec = Record
ID:Array[0..3] of Char;
Length:LongInt;
Format:Word;
NumTracks:Word;
Division:Word;
End;
MDITrackRec = Record
ID:Array[0..3] Of Char;
Length:LongInt;
End;
var
Form1: TForm1;
MDI:File;
MDIHeader:MDIHeaderRec;
MDITrack:MDITrackRec;
EndOfTrack:Boolean;
MidiFileName:string;
Next:Byte;
NewTempo:Real;
Tempo:LongInt;
Time:Word;
Channel:Byte;
Command:Byte;
Note:Byte;
Volume:Byte;
VolumeArray:Array[0..15] of Byte;
Pitch:Word;
iLetti:Integer;
sBuf:String;
bBuf:Byte;
wBuf:Word;
iMessaggi:Integer = 0;
Const sAcapo:String = #13 + #10;
Procedure ReadMDI(MDIFile:string);
Function IntelToMotorolaWord(Num:Word):String;
Function IntelToMotorolaInteger(Num:Integer):String;
Procedure Range01To07(b0107:Byte);
Procedure ReadTracks();
Procedure Messaggio(s:ShortString);
Procedure Evento(bEvento:Byte);
Procedure SeqNum();
Procedure MidiChan();
Procedure MidiPort();
Procedure Tempi();
Procedure SMTPEoffset();
Procedure TimeSign();
Procedure KeySign();
Procedure EndTrack();
Procedure ReadTrackHeader();
Procedure Proprietary();
implementation
{$R *.dfm}
//--------------------------------------------------------
Procedure Proprietary();
var
sProp:String;
Begin
sProp := '';
Repeat
BlockRead(MDI,bBuf,1,iLetti);
sProp := sProp + IntToHex(bBuf,2);
Until bBuf = $FF;
Messaggio('Proprietary = ' + sProp);
End;
//--------------------------------------------------------
Procedure SeqNum();
Var
ss1:Byte;
ss2:Byte;
Begin
BlockRead(MDI,bBuf,1,iLetti);
If bBuf = 2 Then
Begin
BlockRead(MDI,ss1,1,iLetti);
BlockRead(MDI,ss2,1,iLetti);
Messaggio('Sequence from ' +
IntToHex(ss1,2) +
' and ' +
IntToHex(ss2,2));
End
Else
Messaggio('False sequence');
End;
//--------------------------------------------------------
Procedure MidiChan();
Var
cc:Byte;
Begin
BlockRead(MDI,cc,1,iLetti);
BlockRead(MDI,cc,1,iLetti);
Messaggio('Midi channel n. ' + IntToHex(cc,2));
End;
//--------------------------------------------------------
Procedure MidiPort();
Var
pp:Byte;
Begin
BlockRead(MDI,pp,1,iLetti);
BlockRead(MDI,pp,1,iLetti);
Messaggio('Midi port n. ' + IntToHex(pp,2));
End;
//--------------------------------------------------------
Procedure Tempi();
Var
bTemp:Byte;
btt1:Byte;
btt2:Byte;
btt3:Byte;
sHexTempo:String;
iTempo:Integer;
iTempoSec:Integer;
Begin
BlockRead(MDI,bTemp,1,iLetti);
BlockRead(MDI,btt1,1,iLetti);
BlockRead(MDI,btt2,1,iLetti);
BlockRead(MDI,btt3,1,iLetti);
sHexTempo := '$' +
IntToHex(btt1,2) +
IntToHex(btt2,2) +
IntToHex(btt3,2);
iTempo := StrToInt(sHexTempo);
iTempoSec := (iTempo div 1000) ;
Messaggio('Tempo = ' + IntToStr(iTempoSec) + ' ms');
End;
//--------------------------------------------------------
Procedure SMTPEoffset();
Var
bTemp:Byte;
bhr:Byte;
bmn:Byte;
bse:Byte;
bfr:Byte;
bff:Byte;
sSmpte:String;
Begin
BlockRead(MDI,bTemp,1,iLetti);
BlockRead(MDI,bhr,1,iLetti);
BlockRead(MDI,bmn,1,iLetti);
BlockRead(MDI,bse,1,iLetti);
BlockRead(MDI,bfr,1,iLetti);
BlockRead(MDI,bff,1,iLetti);
sSmpte := 'hours ' + IntToHex(bhr,2) +
' min ' + IntToHex(bmn,2) +
' sec ' + IntToHex(bse,2) +
' frames ' + IntToHex(bfr,2) +
' subfr ' + IntToHex(bff,2);
Messaggio('SMPTE = ' + sSmpte);
End;
//--------------------------------------------------------
Procedure TimeSign();
Var
bTemp:Byte;
bnn:Byte;
bdd:Byte;
bcc:Byte;
bbb:Byte;
sSignature:String;
Begin
BlockRead(MDI,bTemp,1,iLetti);
BlockRead(MDI,bnn,1,iLetti);
BlockRead(MDI,bdd,1,iLetti);
BlockRead(MDI,bcc,1,iLetti);
BlockRead(MDI,bbb,1,iLetti);
sSignature := 'numerator = ' + IntToHex(bnn,2) +
' denominator = ' + IntToHex(bdd,2) +
' clocks = ' + IntToHex(bcc,2) +
' 32nds in a quarter = ' + IntToHex(bbb,2);
Messaggio('Signature = ' + sSignature);
End;
//--------------------------------------------------------
Procedure KeySign();
Var
bTemp:Byte;
bsf:Byte;
bmi:Byte;
sKey:String;
Begin
BlockRead(MDI,bTemp,1,iLetti);
BlockRead(MDI,bsf,1,iLetti);
BlockRead(MDI,bmi,1,iLetti);
sKey := 'sf ' + IntToHex(bsf,2) +
' mi ' + IntToHex(bmi,2);
Messaggio('Key = ' + sKey);
End;
//--------------------------------------------------------
Procedure EndTrack();
Begin
Messaggio('End of track');
BlockRead(MDI,bBuf,1,iLetti);
if eof(MDI) Then
Exit;
ReadTrackHeader();
End;
//--------------------------------------------------------
Procedure Evento(bEvento:Byte);
Begin
Case bEvento of
$00: SeqNum(); //'Sequence Number';
$01: Range01To07(bEvento); //'Text = ';
$02: Range01To07(bEvento); //'CopyRight = ';
$03: Range01To07(bEvento); //'Sequence/Track name = ';
$04: Range01To07(bEvento); //'Instrument = ';
$05: Range01To07(bEvento); //'Lyric = ';
$06: Range01To07(bEvento); //'Marker = ';
$07: Range01To07(bEvento); //'Cue Point = ';
$20: MidiChan(); //'Midi channel';
$21: MidiPort(); //'Midi port';
$2F: EndTrack(); //'End of track';
$51: Tempi(); //'Tempo';
$54: SMTPEoffset(); //'SMTPE offset';
$58: TimeSign(); //'Time signature';
$59: KeySign(); //'Key signature';
$7F: Proprietary(); //'Proprietary';
else
End;
End;
//--------------------------------------------------------
Procedure Range01To07(b0107:Byte);
var
bCount:Byte;
bLen:Byte;
sTextRange:String;
Begin
sTextRange := '';
BlockRead(MDI,bLen,1,iLetti);
For bCount := 1 to bLen do
Begin
BlockRead(MDI,bBuf,1,iLetti);
sTextRange := sTextRange + Chr(bBuf);
End;
Case b0107 of
$01: Messaggio('Text = ' + sTextRange);
$02: Messaggio('CopyRight = ' + sTextRange);
$03: Messaggio('Sequence/Track name = ' + sTextRange);
$04: Messaggio('Instrument = ' + sTextRange);
$05: Messaggio('Lyric = ' + sTextRange);
$06: Messaggio('Marker = ' + sTextRange);
$07: Messaggio('Cue Point = ' + sTextRange);
else
End;
End;
//--------------------------------------------------------
Procedure Messaggio(s:ShortString);
Begin
Form1.Memo1.Text := Form1.Memo1.Text +
IntToHex(FilePos(MDI),8) +
':' +
IntToStr(iMessaggi) +
': ' +
s +
sAcapo;
inc(iMessaggi);
End;
//--------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.terminate
end;
//--------------------------------------------------------
Procedure TForm1.Button2Click(Sender: TObject);
Begin
OpenDialog1.DefaultExt := 'mid';
OpenDialog1.Filename := '*.mid';
OpenDialog1.InitialDir := 'c:\karaoke\Brasiliani';
if OpenDialog1.Execute then
Begin
With MediaPlayer1 do begin
MidiFileName := OpenDialog1.Filename;
Label1.Caption := MidiFileName;
DeviceType := dtAutoSelect;
Filename := MidiFileName;
Open;
end;
end;
end;
//--------------------------------------------------------
Function IntelToMotorolaWord(Num:Word):String;
Var
sMotoHex:String;
iMotoNum:Integer;
sMotoNum:String;
Begin
sMotoHex := '$' +
RightStr(IntToHex(Num,4),2) +
LeftStr(IntToHex(Num,4),2);
iMotoNum := StrToInt(sMotoHex);
sMotoNum := IntToStr(iMotoNum);
Result := sMotoHex + ' = ' + sMotoNum ;
End;
//--------------------------------------------------------
Function IntelToMotorolaInteger(Num:Integer):String;
Var
sMotoHex:String;
iMotoNum:Integer;
sMotoNum:String;
Begin
sMotoHex := '$' +
RightStr(IntToHex(Num,8),2) +
MidStr(IntToHex(Num,8), 3, 2) +
MidStr(IntToHex(Num,8), 5, 2) +
LeftStr(IntToHex(Num,8),2);
iMotoNum := StrToInt(sMotoHex);
sMotoNum := IntToStr(iMotoNum);
Result := sMotoHex + ' = ' + sMotoNum ;
End;
//--------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
begin
OpenDialog1.DefaultExt := 'mid';
OpenDialog1.Filename := '*.mid';
OpenDialog1.InitialDir := 'c:\karaoke\Brasiliani';
if OpenDialog1.Execute then
Begin
MidiFileName := OpenDialog1.Filename;
Label1.Caption := MidiFileName;
Form1.Memo1.Text := MidiFileName + sAcapo;
if MidiFileName = '' Then
Else
ReadMDI(MidiFileName);
end;
CloseFile(MDI);
end;
//--------------------------------------------------------
procedure TForm1.Button4Click(Sender: TObject);
begin
MediaPlayer1.Close ;
Label1.Caption := '';
end;
//--------------------------------------------------------
Procedure ReadTracks();
Begin
While not eof(MDI) do
Begin
Repeat
BlockRead(MDI,bBuf,1,iLetti);
if eof(MDI) Then Exit;
if bBuf $FF Then Messaggio(IntToHex(bBuf,2));
Until bBuf = $FF;
BlockRead(MDI,bBuf,1,iLetti);
Evento(bBuf);
End; // loop while not eof
End;
//--------------------------------------------------------
Procedure ReadTrackHeader();
Begin
messaggio('-----------------------------------------------');
messaggio('Inizio Procedure ReadTrackHeader');
messaggio('-----------------------------------------------');
BlockRead(MDI,MDITrack,SizeOf(MDITrack),iLetti);
if iLetti SizeOf(MDITrack) Then
Messaggio('iLetti SizeOf(MDITrack)');
With MDITrack do
Begin
Messaggio('ID Track = ' + ID);
Messaggio('length = ' + IntelToMotorolaInteger(length));
End;
End;
//--------------------------------------------------------
Procedure ReadMDI(MDIFile:String);
Begin
Assignfile(MDI,MDIFile);
Reset(MDI,1);
BlockRead(MDI,MDIHeader,SizeOf(MDIHeader),iLetti);
if iLetti SizeOf(MDIHeader) Then
Messaggio('iLetti SizeOf(MDIHeader)');
With MDIHeader do
Begin
Messaggio('ID Header = ' + ID);
Messaggio('length = ' + IntelToMotorolaInteger(length));
Messaggio('Format = ' + IntelToMotorolaWord(Format));
Messaggio('NumTracks = ' + IntelToMotorolaWord(NumTracks));
Messaggio('Division = ' + IntelToMotorolaWord(Division));
End;
Seek(MDI, iLetti - 2);
ReadTrackHeader(); // valido solo per il primo MTrk
ReadTracks();
End;
//--------------------------------------------------------
end.