aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/lib/midi/MidiFile.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Code/lib/midi/MidiFile.pas')
-rw-r--r--Game/Code/lib/midi/MidiFile.pas970
1 files changed, 0 insertions, 970 deletions
diff --git a/Game/Code/lib/midi/MidiFile.pas b/Game/Code/lib/midi/MidiFile.pas
deleted file mode 100644
index 11b1ca0b..00000000
--- a/Game/Code/lib/midi/MidiFile.pas
+++ /dev/null
@@ -1,970 +0,0 @@
-{
- Load a midifile and get access to tracks and events
- I did build this component to convert midifiles to wave files
- or play the files on a software synthesizer which I'm currenly
- building.
-
- version 1.0 first release
-
- version 1.1
- added some function
- function KeyToStr(key : integer) : string;
- function MyTimeToStr(val : integer) : string;
- Bpm can be set to change speed
-
- version 1.2
- added some functions
- function GetTrackLength:integer;
- function Ready: boolean;
-
- version 1.3
- update by Chulwoong,
- He knows how to use the MM timer, the timing is much better now, thank you
-
- 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
-
- Timing has improved, however because the messages are handled by the normal
- windows message loop (of the main window) it is still influenced by actions
- done on the window (minimize/maximize ..).
- Use of a second thread with higher priority which only handles the
- timer message should increase performance. If somebody knows such a component
- which is freeware please let me know.
-
- interface description:
-
- procedure ReadFile:
- actually read the file which is set in Filename
-
- function GetTrack(index: integer) : TMidiTrack;
-
- property Filename
- set/read filename of midifile
-
- property NumberOfTracks
- read number of tracks in current file
-
- property TicksPerQuarter: integer
- ticks per quarter, tells how to interpret the time value in midi events
-
- property FileFormat: TFileFormat
- tells the format of the current midifile
-
- property Bpm:integer
- tells Beats per minut
-
- property OnMidiEvent:TOnMidiEvent
- called while playing for each midi event
-
- procedure StartPlaying;
- start playing the current loaded midifile from the beginning
-
- procedure StopPlaying;
- stop playing the current midifile
-
- procedure PlayToTime(time : integer);
- if playing yourself then events from last time to this time are produced
-
-
- function KeyToStr(key : integer) : string;
- give note string on key value: e.g. C4
-
- function MyTimeToStr(val : integer) : string;
- give time string from msec time
-
- function GetTrackLength:integer;
- gives the track lenght in msec (assuming the bpm at the start oof the file)
-
- function Ready: boolean;
- now you can check wether the playback is finished
-
-}
-
-unit MidiFile;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows,
- //Forms,
- Messages,
- Classes,
- {$IFDEF FPC}
- WinAllocation,
- {$ENDIF}
- SysUtils;
-
-type
- TChunkType = (illegal, header, track);
- TFileFormat = (single, multi_synch, multi_asynch);
- PByte = ^byte;
-
- TMidiEvent = record
- event: byte;
- data1: byte;
- data2: byte;
- str: string;
- dticks: integer;
- time: integer;
- mtime: integer;
- len: integer;
- end;
- PMidiEvent = ^TMidiEvent;
-
- TOnMidiEvent = procedure(event: PMidiEvent) of object;
- TEvent = procedure of object;
-
- TMidiTrack = class(TObject)
- protected
- events: TList;
- name: string;
- instrument: string;
- currentTime: integer;
- currentPos: integer;
- ready: boolean;
- trackLenght: integer;
- procedure checkReady;
- public
- OnMidiEvent: TOnMidiEvent;
- OnTrackReady: TEvent;
- constructor Create;
- destructor Destroy; override;
-
- procedure Rewind(pos: integer);
- procedure PlayUntil(pos: integer);
- procedure GoUntil(pos: integer);
-
- procedure putEvent(event: PMidiEvent);
- function getEvent(index: integer): PMidiEvent;
- function getName: string;
- function getInstrument: string;
- function getEventCount: integer;
- function getCurrentTime: integer;
- function getTrackLength: integer;
- function isReady:boolean;
- end;
-
- TMidiFile = class(TComponent)
- private
- { Private declarations }
- procedure MidiTimer(sender : TObject);
- procedure WndProc(var Msg : TMessage);
- protected
- { Protected declarations }
- midiFile: file of byte;
- chunkType: TChunkType;
- chunkLength: integer;
- chunkData: PByte;
- chunkIndex: PByte;
- chunkEnd: PByte;
- FPriority: DWORD;
-
- // midi file attributes
- FFileFormat: TFileFormat;
- numberTracks: integer;
- deltaTicks: integer;
- FBpm: integer;
- FBeatsPerMeasure: integer;
- FusPerTick: double;
- FFilename: string;
-
- Tracks: TList;
- currentTrack: TMidiTrack;
- FOnMidiEvent: TOnMidiEvent;
- FOnUpdateEvent: TNotifyEvent;
-
- // playing attributes
- playing: boolean;
- PlayStartTime: integer;
- currentTime: integer; // Current playtime in msec
- currentPos: Double; // Current Position in ticks
-
- procedure OnTrackReady;
- procedure setFilename(val: string);
- procedure ReadChunkHeader;
- procedure ReadChunkContent;
- procedure ReadChunk;
- procedure ProcessHeaderChunk;
- procedure ProcessTrackChunk;
- function ReadVarLength: integer;
- function ReadString(l: integer): string;
- procedure SetOnMidiEvent(handler: TOnMidiEvent);
- procedure SetBpm(val: integer);
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure ReadFile;
- function GetTrack(index: integer): TMidiTrack;
-
- procedure StartPlaying;
- procedure StopPlaying;
- procedure ContinuePlaying;
-
- procedure PlayToTime(time: integer);
- procedure GoToTime(time: integer);
- function GetCurrentTime: integer;
- function GetFusPerTick : Double;
- function GetTrackLength:integer;
- function Ready: boolean;
- published
- { Published declarations }
- property Filename: string read FFilename write setFilename;
- property NumberOfTracks: integer read numberTracks;
- property TicksPerQuarter: integer read deltaTicks;
- property FileFormat: TFileFormat read FFileFormat;
- property Bpm: integer read FBpm write SetBpm;
- property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent;
- property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent;
- end;
-
-function KeyToStr(key: integer): string;
-function MyTimeToStr(val: integer): string;
-procedure Register;
-
-implementation
-
-uses mmsystem;
-
-type
-{$IFDEF FPC}
- TTimerProc = TTIMECALLBACK;
- TTimeCaps = TIMECAPS;
-{$ELSE}
- TTimerProc = TFNTimeCallBack;
-{$ENDIF}
-
-const TIMER_RESOLUTION=10;
-const WM_MULTIMEDIA_TIMER=WM_USER+127;
-
-var MIDIFileHandle : HWND;
- TimerProc : TTimerProc;
- MIDITimerID : Integer;
- TimerPeriod : Integer;
-
-procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall;
-begin
- PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);
-end;
-
-procedure SetMIDITimer;
- var TimeCaps : TTimeCaps;
-begin
- timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));
- if TIMER_RESOLUTION < TimeCaps.wPeriodMin then
- TimerPeriod:=TimeCaps.wPeriodMin
- else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then
- TimerPeriod:=TimeCaps.wPeriodMax
- else
- TimerPeriod:=TIMER_RESOLUTION;
-
- timeBeginPeriod(TimerPeriod);
- MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc,
- DWORD(MIDIFileHandle),TIME_PERIODIC);
- if MIDITimerID=0 then
- timeEndPeriod(TimerPeriod);
-end;
-
-procedure KillMIDITimer;
-begin
- timeKillEvent(MIDITimerID);
- timeEndPeriod(TimerPeriod);
-end;
-
-constructor TMidiTrack.Create;
-begin
- inherited Create;
- events := TList.Create;
- currentTime := 0;
- currentPos := 0;
-end;
-
-destructor TMidiTrack.Destroy;
-var
- i: integer;
-begin
- for i := 0 to events.count - 1 do
- Dispose(PMidiEvent(events.items[i]));
- events.Free;
- inherited Destroy;
-end;
-
-procedure TMidiTRack.putEvent(event: PMidiEvent);
-var
- command: integer;
- i: integer;
- pevent: PMidiEvent;
-begin
- if (event.event = $FF) then
- begin
- if (event.data1 = 3) then
- name := event.str;
- if (event.data1 = 4) then
- instrument := event.str;
- end;
- currentTime := currentTime + event.dticks;
- event.time := currentTime; // for the moment just add dticks
- event.len := 0;
- events.add(TObject(event));
- command := event.event and $F0;
-
- if ((command = $80) // note off
- or ((command = $90) and (event.data2 = 0))) //note on with speed 0
- then
- begin
- // this is a note off, try to find the accompanion note on
- command := event.event or $90;
- i := events.count - 2;
- while i >= 0 do
- begin
- pevent := PMidiEvent(events[i]);
- if (pevent.event = command) and
- (pevent.data1 = event.data1)
- then
- begin
- pevent.len := currentTIme - pevent.time;
- i := 0;
- event.len := -1;
- end;
- dec(i);
- end;
- end;
-end;
-
-function TMidiTrack.getName: string;
-begin
- result := name;
-end;
-
-function TMidiTrack.getInstrument: string;
-begin
- result := instrument;
-end;
-
-function TMiditrack.getEventCount: integer;
-begin
- result := events.count;
-end;
-
-function TMiditrack.getEvent(index: integer): PMidiEvent;
-begin
- if ((index < events.count) and (index >= 0)) then
- result := events[index]
- else
- result := nil;
-end;
-
-function TMiditrack.getCurrentTime: integer;
-begin
- result := currentTime;
-end;
-
-procedure TMiditrack.Rewind(pos: integer);
-begin
- if currentPos = events.count then
- dec(currentPos);
- while ((currentPos > 0) and
- (PMidiEvent(events[currentPos]).time > pos))
- do
- begin
- dec(currentPos);
- end;
- checkReady;
-end;
-
-procedure TMiditrack.PlayUntil(pos: integer);
-begin
- if assigned(OnMidiEvent) then
- begin
- while ((currentPos < events.count) and
- (PMidiEvent(events[currentPos]).time < pos)) do
- begin
- OnMidiEvent(PMidiEvent(events[currentPos]));
- inc(currentPos);
- end;
- end;
- checkReady;
-end;
-
-procedure TMidiTrack.GoUntil(pos: integer);
-begin
- while ((currentPos < events.count) and
- (PMidiEvent(events[currentPos]).time < pos)) do
- begin
- inc(currentPos);
- end;
- checkReady;
-end;
-
-procedure TMidiTrack.checkReady;
-begin
- if currentPos >= events.count then
- begin
- ready := true;
- if assigned(OnTrackReady) then
- OnTrackReady;
- end
- else
- ready := false;
-end;
-
-function TMidiTrack.getTrackLength: integer;
-begin
- result := PMidiEvent(events[events.count-1]).time
-end;
-
-function TMidiTrack.isReady: boolean;
-begin
- result := ready;
-end;
-
-constructor TMidifile.Create(AOwner: TComponent);
-begin
- inherited Create(AOWner);
- MIDIFileHandle:=AllocateHWnd(WndProc);
- chunkData := nil;
- chunkType := illegal;
- Tracks := TList.Create;
- TimerProc:=@TimerCallBackProc;
- FPriority:=GetPriorityClass(MIDIFileHandle);
-end;
-
-destructor TMidifile.Destroy;
-var
- i: integer;
-begin
- if not (chunkData = nil) then FreeMem(chunkData);
- for i := 0 to Tracks.Count - 1 do
- TMidiTrack(Tracks.Items[i]).Free;
- Tracks.Free;
- SetPriorityClass(MIDIFileHandle,FPriority);
-
- if MIDITimerID<>0 then KillMIDITimer;
-
- DeallocateHWnd(MIDIFileHandle);
-
- inherited Destroy;
-end;
-
-function TMidiFile.GetTrack(index: integer): TMidiTrack;
-begin
- result := Tracks.Items[index];
-end;
-
-procedure TMidifile.setFilename(val: string);
-begin
- FFilename := val;
-// ReadFile;
-end;
-
-procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent);
-var
- i: integer;
-begin
-// if not (FOnMidiEvent = handler) then
-// begin
- FOnMidiEvent := handler;
- for i := 0 to tracks.count - 1 do
- TMidiTrack(tracks.items[i]).OnMidiEvent := handler;
-// end;
-end;
-
-{$WARNINGS OFF}
-procedure TMidifile.MidiTimer(Sender: TObject);
-begin
- if playing then
- begin
- PlayToTime(GetTickCount - PlayStartTime);
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
- end;
-end;
-{$WARNINGS ON}
-
-procedure TMidifile.StartPlaying;
-var
- i: integer;
-begin
- for i := 0 to tracks.count - 1 do
- TMidiTrack(tracks[i]).Rewind(0);
- playStartTime := getTickCount;
- playing := true;
-
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
-
- SetMIDITimer;
- currentPos := 0.0;
- currentTime := 0;
-end;
-
-{$WARNINGS OFF}
-procedure TMidifile.ContinuePlaying;
-begin
- PlayStartTime := GetTickCount - currentTime;
- playing := true;
-
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
-
- SetMIDITimer;
-end;
-{$WARNINGS ON}
-
-procedure TMidifile.StopPlaying;
-begin
- playing := false;
- KillMIDITimer;
- SetPriorityClass(MIDIFileHandle,FPriority);
-end;
-
-function TMidiFile.GetCurrentTime: integer;
-begin
- Result := currentTime;
-end;
-
-procedure TMidifile.PlayToTime(time: integer);
-var
- i: integer;
- track: TMidiTrack;
- pos: integer;
- deltaTime: integer;
-begin
- // calculate the pos in the file.
- // pos is actually tick
- // Current FusPerTick is uses to determine the actual pos
-
- deltaTime := time - currentTime;
- currentPos := currentPos + (deltaTime * 1000) / FusPerTick;
- pos := round(currentPos);
-
- for i := 0 to tracks.count - 1 do
- begin
- TMidiTrack(tracks.items[i]).PlayUntil(pos);
- end;
- currentTime := time;
-end;
-
-procedure TMidifile.GoToTime(time: integer);
-var
- i: integer;
- track: TMidiTrack;
- pos: integer;
-begin
- // this function should be changed because FusPerTick might not be constant
- pos := round((time * 1000) / FusPerTick);
- for i := 0 to tracks.count - 1 do
- begin
- TMidiTrack(tracks.items[i]).Rewind(0);
- TMidiTrack(tracks.items[i]).GoUntil(pos);
- end;
-end;
-
-procedure TMidifile.SetBpm(val: integer);
-var
- us_per_quarter: integer;
-begin
- if not (val = FBpm) then
- begin
- us_per_quarter := 60000000 div val;
-
- FBpm := 60000000 div us_per_quarter;
- FusPerTick := us_per_quarter / deltaTicks;
- end;
-end;
-
-procedure TMidifile.ReadChunkHeader;
-var
- theByte: array[0..7] of byte;
-begin
- BlockRead(midiFile, theByte, 8);
- if (theByte[0] = $4D) and (theByte[1] = $54) then
- begin
- if (theByte[2] = $68) and (theByte[3] = $64) then
- chunkType := header
- else if (theByte[2] = $72) and (theByte[3] = $6B) then
- chunkType := track
- else
- chunkType := illegal;
- end
- else
- begin
- chunkType := illegal;
- end;
- chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;
-end;
-
-procedure TMidifile.ReadChunkContent;
-begin
- if not (chunkData = nil) then
- FreeMem(chunkData);
- GetMem(chunkData, chunkLength + 10);
- BlockRead(midiFile, chunkData^, chunkLength);
- chunkIndex := chunkData;
- chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);
-end;
-
-procedure TMidifile.ReadChunk;
-begin
- ReadChunkHeader;
- ReadChunkContent;
- case chunkType of
- header:
- ProcessHeaderChunk;
- track:
- ProcessTrackCHunk;
- end;
-end;
-
-procedure TMidifile.ProcessHeaderChunk;
-begin
- chunkIndex := chunkData;
- inc(chunkIndex);
- if chunkType = header then
- begin
- case chunkIndex^ of
- 0: FfileFormat := single;
- 1: FfileFormat := multi_synch;
- 2: FfileFormat := multi_asynch;
- end;
- inc(chunkIndex);
- numberTracks := chunkIndex^ * $100;
- inc(chunkIndex);
- numberTracks := numberTracks + chunkIndex^;
- inc(chunkIndex);
- deltaTicks := chunkIndex^ * $100;
- inc(chunkIndex);
- deltaTicks := deltaTicks + chunkIndex^;
- end;
-end;
-
-procedure TMidifile.ProcessTrackChunk;
-var
- dTime: integer;
- event: integer;
- len: integer;
- str: string;
- midiEvent: PMidiEvent;
- i: integer;
- us_per_quarter: integer;
-begin
- chunkIndex := chunkData;
-// inc(chunkIndex);
- event := 0;
- if chunkType = track then
- begin
- currentTrack := TMidiTrack.Create;
- currentTrack.OnMidiEvent := FOnMidiEvent;
- Tracks.add(currentTrack);
- while integer(chunkIndex) < integer(chunkEnd) do
- begin
- // each event starts with var length delta time
- dTime := ReadVarLength;
- if chunkIndex^ >= $80 then
- begin
- event := chunkIndex^;
- inc(chunkIndex);
- end;
- // else it is a running status event (just the same event as before)
-
- if event = $FF then
- begin
-{ case chunkIndex^ of
- $00: // sequence number, not implemented jet
- begin
- inc(chunkIndex); // $02
- inc(chunkIndex);
- end;
- $01 .. $0f: // text events FF ty len text
- begin
- New(midiEvent);
- midiEvent.event := $FF;
- midiEvent.data1 := chunkIndex^; // type is stored in data1
- midiEvent.dticks := dtime;
-
- inc(chunkIndex);
- len := ReadVarLength;
- midiEvent.str := ReadString(len);
-
- currentTrack.putEvent(midiEvent);
- end;
- $20: // Midi channel prefix FF 20 01 cc
- begin
- inc(chunkIndex); // $01
- inc(chunkIndex); // channel
- inc(chunkIndex);
- end;
- $2F: // End of track FF 2F 00
- begin
- inc(chunkIndex); // $00
- inc(chunkIndex);
- end;
- $51: // Set Tempo FF 51 03 tttttt
- begin
- inc(chunkIndex); // $03
- inc(chunkIndex); // tt
- inc(chunkIndex); // tt
- inc(chunkIndex); // tt
- inc(chunkIndex);
- end;
- $54: // SMPTE offset FF 54 05 hr mn se fr ff
- begin
- inc(chunkIndex); // $05
- inc(chunkIndex); // hr
- inc(chunkIndex); // mn
- inc(chunkIndex); // se
- inc(chunkIndex); // fr
- inc(chunkIndex); // ff
- inc(chunkIndex);
- end;
- $58: // Time signature FF 58 04 nn dd cc bb
- begin
- inc(chunkIndex); // $04
- inc(chunkIndex); // nn
- inc(chunkIndex); // dd
- inc(chunkIndex); // cc
- inc(chunkIndex); // bb
- inc(chunkIndex);
- end;
- $59: // Key signature FF 59 02 df mi
- begin
- inc(chunkIndex); // $02
- inc(chunkIndex); // df
- inc(chunkIndex); // mi
- inc(chunkIndex);
- end;
- $7F: // Sequence specific Meta-event
- begin
- inc(chunkIndex);
- len := ReadVarLength;
- str := ReadString(len);
- end;
- else // unknown meta event
- }
- begin
- New(midiEvent);
- midiEvent.event := $FF;
- midiEvent.data1 := chunkIndex^; // type is stored in data1
- midiEvent.dticks := dtime;
-
- inc(chunkIndex);
- len := ReadVarLength;
- midiEvent.str := ReadString(len);
- currentTrack.putEvent(midiEvent);
-
- case midiEvent.data1 of
- $51:
- begin
- us_per_quarter :=
- (integer(byte(midiEvent.str[1])) shl 16 +
- integer(byte(midiEvent.str[2])) shl 8 +
- integer(byte(midiEvent.str[3])));
- FBpm := 60000000 div us_per_quarter;
- FusPerTick := us_per_quarter / deltaTicks;
- end;
- end;
- end;
-// end;
- end
- else
- begin
- // these are all midi events
- New(midiEvent);
- midiEvent.event := event;
- midiEvent.dticks := dtime;
-// inc(chunkIndex);
- case event of
- $80..$8F, // note off
- $90..$9F, // note on
- $A0..$AF, // key aftertouch
- $B0..$BF, // control change
- $E0..$EF: // pitch wheel change
- begin
- midiEvent.data1 := chunkIndex^; inc(chunkIndex);
- midiEvent.data2 := chunkIndex^; inc(chunkIndex);
- end;
- $C0..$CF, // program change
- $D0..$DF: // channel aftertouch
- begin
- midiEvent.data1 := chunkIndex^; inc(chunkIndex);
- end;
- else
- // error
- end;
- currentTrack.putEvent(midiEvent);
- end;
- end;
- end;
-end;
-
-
-function TMidifile.ReadVarLength: integer;
-var
- i: integer;
- b: byte;
-begin
- b := 128;
- i := 0;
- while b > 127 do
- begin
- i := i shl 7;
- b := chunkIndex^;
- i := i + b and $7F;
- inc(chunkIndex);
- end;
- result := i;
-end;
-
-function TMidifile.ReadString(l: integer): string;
-var
- s: PChar;
- i: integer;
-begin
- GetMem(s, l + 1); ;
- s[l] := chr(0);
- for i := 0 to l - 1 do
- begin
- s[i] := Chr(chunkIndex^);
- inc(chunkIndex);
- end;
- result := string(s);
-end;
-
-procedure TMidifile.ReadFile;
-var
- i: integer;
-begin
- for i := 0 to Tracks.Count - 1 do
- TMidiTrack(Tracks.Items[i]).Free;
- Tracks.Clear;
- chunkType := illegal;
-
- AssignFile(midiFile, FFilename);
- FileMode := 0;
- Reset(midiFile);
- while not eof(midiFile) do
- ReadChunk;
- CloseFile(midiFile);
- numberTracks := Tracks.Count;
-end;
-
-function KeyToStr(key: integer): string;
-var
- n: integer;
- str: string;
-begin
- n := key mod 12;
- case n of
- 0: str := 'C';
- 1: str := 'C#';
- 2: str := 'D';
- 3: str := 'D#';
- 4: str := 'E';
- 5: str := 'F';
- 6: str := 'F#';
- 7: str := 'G';
- 8: str := 'G#';
- 9: str := 'A';
- 10: str := 'A#';
- 11: str := 'B';
- end;
- Result := str + IntToStr(key div 12);
-end;
-
-function IntToLenStr(val: integer; len: integer): string;
-var
- str: string;
-begin
- str := IntToStr(val);
- while Length(str) < len do
- str := '0' + str;
- Result := str;
-end;
-
-function MyTimeToStr(val: integer): string;
- var
- hour: integer;
- min: integer;
- sec: integer;
- msec: integer;
-begin
- msec := val mod 1000;
- sec := val div 1000;
- min := sec div 60;
- sec := sec mod 60;
- hour := min div 60;
- min := min mod 60;
- Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);
-end;
-
-function TMidiFIle.GetFusPerTick : Double;
-begin
- Result := FusPerTick;
-end;
-
-function TMidiFIle.GetTrackLength:integer;
-var i,length : integer;
- time : extended;
-begin
- length := 0;
- for i := 0 to Tracks.Count - 1 do
- if TMidiTrack(Tracks.Items[i]).getTrackLength > length then
- length := TMidiTrack(Tracks.Items[i]).getTrackLength;
- time := length * FusPerTick;
- time := time / 1000.0;
- result := round(time);
-end;
-
-function TMidiFIle.Ready: boolean;
-var i : integer;
-begin
- result := true;
- for i := 0 to Tracks.Count - 1 do
- if not TMidiTrack(Tracks.Items[i]).isready then
- result := false;
-end;
-
-procedure TMidiFile.OnTrackReady;
-begin
- if ready then
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
-end;
-
-procedure TMidiFile.WndProc(var Msg : TMessage);
-begin
- with MSG do
- begin
- case Msg of
- WM_MULTIMEDIA_TIMER:
- begin
- //try
- MidiTimer(self);
- //except
- // Note: HandleException() is called by default if exception is not handled
- // Application.HandleException(Self);
- //end;
- end;
- else
- begin
- Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);
- end;
- end;
- end;
-end;
-
-procedure Register;
-begin
- RegisterComponents('Synth', [TMidiFile]);
-end;
-
-end.
-
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 03:17:16 +0000