< -->
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{=================}UNIT MusicSHU;{=======================}
{||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{$M 65520, 0, 655360}
{$G+,D-}
INTERFACE
type
Nm = String[2];
type
TNota = record
NPos : ShortInt; { Позиция }
Name : Nm; { Имя }
sharp : Boolean; { диез }
freq : Word; { Частота }
end;
type
TMusicNota = record
freq : Word;
ling : LongInt;
end;
const
Nnotes = 9000;
type
TMusicPhrase = record
Leng : Word;
MusicNotes : array[1 .. Nnotes] of TMusicNota;
end;
const
filesign:String[11] = '@ShyarMusic';
filesigntable:String[18] = '@ShyarMusic|TABLE|';
NN = 89;
ROGnots : array[1..NN] of TNota = (
(NPos:28 ; Name:'A0'; sharp: false ; freq:28),
(NPos:28 ; Name:'A0'; sharp: true ; freq:29),
(NPos:27 ; Name:'B0'; sharp: false ; freq:31),
(NPos:26 ; Name:'C1'; sharp: false ; freq:33),
(NPos:26 ; Name:'C1'; sharp: true ; freq:35),
(NPos:25 ; Name:'D1'; sharp: false ; freq:37),
(NPos:25 ; Name:'D1'; sharp: true ; freq:39),
(NPos:24 ; Name:'E1'; sharp: false ; freq:41),
(NPos:23 ; Name:'F1'; sharp: false ; freq:44),
(NPos:23 ; Name:'F1'; sharp: true ; freq:46),
(NPos:22 ; Name:'G1'; sharp: false ; freq:49),
(NPos:22 ; Name:'G1'; sharp: true ; freq:52),
(NPos:21 ; Name:'A1'; sharp: false ; freq:55),
(NPos:21 ; Name:'A1'; sharp: true ; freq:58),
(NPos:20 ; Name:'B1'; sharp: false ; freq:62),
(NPos:19 ; Name:'C2'; sharp: false ; freq:65),
(NPos:19 ; Name:'C2'; sharp: true ; freq:69),
(NPos:18 ; Name:'D2'; sharp: false ; freq:73),
(NPos:18 ; Name:'D2'; sharp: true ; freq:78),
(NPos:17 ; Name:'E2'; sharp: false ; freq:82),
(NPos:16 ; Name:'F2'; sharp: false ; freq:87),
(NPos:16 ; Name:'F2'; sharp: true ; freq:92),{93}
(NPos:15 ; Name:'G2'; sharp: false ; freq:98),
(NPos:15 ; Name:'G2'; sharp: true ; freq:104),
(NPos:14 ; Name:'A2'; sharp: false ; freq:110),
(NPos:14 ; Name:'A2'; sharp: true ; freq:117),
(NPos:13 ; Name:'B2'; sharp: false ; freq:123),
(NPos:12 ; Name:'C3'; sharp: false ; freq:131),
(NPos:12 ; Name:'C3'; sharp: true ; freq:139),
(NPos:11 ; Name:'D3'; sharp: false ; freq:147),
(NPos:11 ; Name:'D3'; sharp: true ; freq:156),
(NPos:10 ; Name:'E3'; sharp: false ; freq:165),
(NPos:9 ; Name:'F3'; sharp: false ; freq:175),
(NPos:9 ; Name:'F3'; sharp: true ; freq:185),
(NPos:8 ; Name:'G3'; sharp: false ; freq:196),
(NPos:8 ; Name:'G3'; sharp: true ; freq:208),
(NPos:7 ; Name:'A3'; sharp: false ; freq:220),
(NPos:7 ; Name:'A3'; sharp: true ; freq:233),
(NPos:6 ; Name:'B3'; sharp: false ; freq:247),
(NPos:5 ; Name:'C4'; sharp: false ; freq:262),
(NPos:5 ; Name:'C4'; sharp: true ; freq:277),
(NPos:4 ; Name:'D4'; sharp: false ; freq:294),
(NPos:4 ; Name:'D4'; sharp: true ; freq:311),
(NPos:3 ; Name:'E4'; sharp: false ; freq:330),
(NPos:2 ; Name:'F4'; sharp: false ; freq:349),
(NPos:2 ; Name:'F4'; sharp: true ; freq:370),
(NPos:1 ; Name:'G4'; sharp: false ; freq:392),
(NPos:1 ; Name:'G4'; sharp: true ; freq:415),
(NPos:0 ; Name:'A4'; sharp: false ; freq:440),
(NPos:0 ; Name:'A4'; sharp: true ; freq:466),
(NPos:-1 ; Name:'B4'; sharp: false ; freq:494),
(NPos:-2 ; Name:'C5'; sharp: false ; freq:523),
(NPos:-2 ; Name:'C5'; sharp: true ; freq:554),
(NPos:-3 ; Name:'D5'; sharp: false ; freq:587),
(NPos:-3 ; Name:'D5'; sharp: true ; freq:622),
(NPos:-4 ; Name:'E5'; sharp: false ; freq:659),
(NPos:-5 ; Name:'F5'; sharp: false ; freq:698),
(NPos:-5 ; Name:'F5'; sharp: true ; freq:740),
(NPos:-6 ; Name:'G5'; sharp: false ; freq:784),
(NPos:-6 ; Name:'G5'; sharp: true ; freq:831),
(NPos:-7 ; Name:'A5'; sharp: false ; freq:880),
(NPos:-7 ; Name:'A5'; sharp: true ; freq:932),
(NPos:-8 ; Name:'B5'; sharp: false ; freq:988),
(NPos:-9 ; Name:'C6'; sharp: false ; freq:1047),
(NPos:-9 ; Name:'C6'; sharp: true ; freq:1109),
(NPos:-10; Name:'D6'; sharp: false ; freq:1175),
(NPos:-10; Name:'D6'; sharp: true ; freq:1246),
(NPos:-11; Name:'E6'; sharp: false ; freq:1319),
(NPos:-12; Name:'F6'; sharp: false ; freq:1397),
(NPos:-12; Name:'F6'; sharp: true ; freq:1480),
(NPos:-13; Name:'G6'; sharp: false ; freq:1568),
(NPos:-13; Name:'G6'; sharp: true ; freq:1661),
(NPos:-14; Name:'A6'; sharp: false ; freq:1760),
(NPos:-14; Name:'A6'; sharp: true ; freq:1865),
(NPos:-15; Name:'B6'; sharp: false ; freq:1976),
(NPos:-16; Name:'C7'; sharp: false ; freq:2093),
(NPos:-16; Name:'C7'; sharp: true ; freq:2217),
(NPos:-17; Name:'D7'; sharp: false ; freq:2349),
(NPos:-17; Name:'D7'; sharp: true ; freq:2489),
(NPos:-18; Name:'E7'; sharp: false ; freq:2637),
(NPos:-19; Name:'F7'; sharp: false ; freq:2794),
(NPos:-19; Name:'F7'; sharp: true ; freq:2960),
(NPos:-20; Name:'G7'; sharp: false ; freq:3136),
(NPos:-20; Name:'G7'; sharp: true ; freq:3322),
(NPos:-21; Name:'A7'; sharp: false ; freq:3520),
(NPos:-21; Name:'A7'; sharp: true ; freq:3729),
(NPos:-22; Name:'B7'; sharp: false ; freq:3951),
(NPos:-23; Name:'C8'; sharp: false ; freq:4186),
(NPos:-23; Name:'C8'; sharp: true ; freq:4435));
const
MaxFrq : Word = 4435;
MinFrq : Word = 28;
var
MusicPhrase : TMusicPhrase;
LingNota : LongInt;
MusicName : String[80];
TableInfo : String[80];
Function KeyPressed : Boolean;
Function ReadKey : Char;
Procedure PlayMusic(MPh : TMusicPhrase);
Function FrqNotaName(NName : Nm; Shrp : Boolean):Word;
Function FrqNotaPos(Nposit : ShortInt; Shrp : Boolean):Word;
Procedure SetNewMusTable(frq, ootw : Real);
Procedure SetStdMusTable;
Procedure MusStr2Nota(MS_ : String; var MPh : TMusicPhrase; numb : Word);
Function LoadCodeMusicPhrase(var MPh : TMusicPhrase; filename : String):Boolean;
Procedure MusicCode2StrFile(MPh : TMusicPhrase;filename:String);
Function SaveMusicPhrase(MPh : TMusicPhrase; filename : String):Boolean;
Function LoadMusicPhrase(var MPh : TMusicPhrase; filename : String):Boolean;
Function SaveMusicTable(filename : String):Boolean;
Function LoadMusicTable(filename : String):Boolean;
Procedure SetMusicName(S : String);
Procedure SetTableInfo(S : String);
IMPLEMENTATION
Uses ProgFace;
var
Error, ifErr, Erq : Boolean;
{------------------}
Function ReadKey : Char; Assembler;
asm
mov ah, 10h
int 16h
end;
{----------------}
Procedure ResetTimer;Assembler;
asm
mov cx, 0
mov dx, 1
mov ah, $86
int $15
jnc @1
mov ah, 83h
mov al, 1
int 15h
@1:
end;
{------------------------}
Function KeyPressed : Boolean;Assembler;
asm
mov ah, $0B
int $21
end;
{------------------------}
Procedure Delay(V, W : Word);
begin
asm
@1:
mov cx, Word Ptr V
mov dx, Word Ptr W
mov ah, $86
int $15
jc @1
end;
end;
{----------------}
Procedure Sound(Freq : Word);Assembler;
asm
mov bx, sp
mov bx, ss:[bx+4]
mov ax, 34DDh
mov dx, 12h
cmp dx, bx
jnb @1
div bx
mov bx, ax
in al, 61h
test al, 3
jnz @2
or al, 3
out 61h, al
mov al, 0B6h
out 43h, al
@2:
mov al, bl
out 42h, al
mov al, bh
out 42h, al
@1:
end;
{------------------------}
Procedure NoSound;Assembler;
asm
in al, 61h
and al, 0FCh
out 61h, al
end;
{------------------------}
Function FrqNotaName(NName : Nm; Shrp : Boolean):Word;
var
i : Integer;
FNN : Word;
begin
FNN := 0;
for i := 1 to NN do with ROGnots[i] do
begin
if (NName = Name) and (Shrp = Sharp) then
FNN := freq;
end;
FrqNotaName := FNN;
end;
Function FrqNotaPos(Nposit : ShortInt; Shrp : Boolean):Word;
var
i : Integer;
FNN : Word;
begin
FNN := 0;
for i := 1 to NN do with ROGnots[i] do
begin
if (Nposit = Npos) and (Shrp = Sharp) then
FNN := freq;
end;
FrqNotaPos := FNN;
end;
Procedure SetNewMusTable(frq, ootw : Real);
var
i : Word;
begin
for i := 1 to NN do
begin
ROGnots[i].freq := Round(frq);
frq:=frq*ootw;
end;
end;
Procedure SetStdMusTable;
begin
SetNewMusTable(27.50, exp(ln(2)/12));
end;
Function SharpName(flatname : Nm) : Nm;
var
Sn : Nm;
begin
case FlatName[1] of
'B'..'G' : begin
Sn[1] := Pred(flatname[1]);
case flatname[1] of
'C' : Sn[2] := Pred(flatname[2]);
else Sn[2] := flatname[2];
end;
end;
'A' : begin
Sn[1] := 'G';
Sn[2] := flatName[2];
end;
else Sn:='A0';
end;
SharpName := Sn;
end;
const
AvailChar : Set of Char = [' ', '!', '#', '@', '0'..'9', '^', '/', '|'];
Procedure MusStr2Nota(MS_ : String; var MPh : TMusicPhrase; numb : Word);
var
St, MS : String;
Sx : Nm;
i, k, kk : Word;
z : Real;
Sh : Boolean;
SNErr : String;
j : ShortInt;
begin
ifErr := False;
MS := MS_;
kk := MPh.Leng + 1;
with MPh do
begin
k := Leng + 1;
Repeat
if Pos('/', MS) = 0 then Break;
if MS[1] = '/' then
begin
Delete(MS, 1, 1);
if not (MS[1] in AvailChar) then
Delete(MS, 1, Pos('/', MS));
Continue;
end;
if MS[1] = ' ' then
begin
Delete(MS, 1, 1);
Continue;
end;
if (MS[1] = '|') then Break;
if (MS = '/') then Break;
if Pos('/', MS) > 1 then
begin
St := MS;
Delete(MS, 1, Pos('/', MS));
end;
if St[1]='#' then
begin
Delete(St, 1, 1);
Sh := True;
end
else Sh := False;
if St[1] = '^' then
if St[2] = '!' then
begin
Delete(St, 1, 1);
Sh := False;
Sx[0] := #2;
Sx[1] := St[2];
Sx[2] := St[3];
Sx := SharpName(Sx);
St[3] := Sx[1];
St[4] := Sx[2];
end;
if St[1] = '!' then
case St[2] of
'A'..'G':
begin
MusicNotes[k].freq := FrqNotaName(St[2]+St[3], Sh);
Delete(St, 1, Pos(':', St));
Error := False;
end;
end {case}
else
if St[1] = '@' then
begin
Delete(St, 1, Pos(':', St));
MusicNotes[k].freq := 0;
end
else
begin
Sx := Copy(St, 1, Pos(':', St)-1);
val(Copy(St, 1, Pos(':', St)-1), j, i);
MusicNotes[k].freq := FrqNotaPos(j, Sh);
Error := (i<>0);
ifErr := ifErr or Error;
Delete(St, 1, Pos(':', St));
end;
val(Copy(St, 1, Pos('/', St)-1), z, i);
if z <> 0 then
MusicNotes[k].ling := Round(LingNota / z)
else MusicNotes[k].ling := 0;
Error := (i<>0) or Error;
ifErr := ifErr or Error;
if Error then
begin
Str(k, SNErr);
WriteLine('MUSIC : ошибка: нота ~'+SNErr, WinAttr);
Str(numb, SNErr);
WriteLine(', строка '+SNErr, WinAttr);
Str(k-kk+1, SNErr);
WriteLine(', позиция в строке: '+SNErr, WinAttr);
NewLine;
end;
inc(k);
if (k > Nnotes) and (Length(MS)<>0) then
begin
Str(Nnotes, SNErr);
WriteLine('MUSIC: количество нот превышает '+SNErr, WinAttr);
Leng := Nnotes;
ReadKey;
While KeyPressed do ReadKey;
Exit;
end;
until Length(MS) = 0;
Leng := k-1;
end;
end;
Procedure SetTxPoint(X,Y,ColorTx,BkColorTx:Byte;C:Char);Assembler;
asm
push ds
mov ax, $B800
mov ds, ax
mov ah, 0
mov bh, 0
mov bl, byte ptr x
cmp bx, 80
ja @1
mov al, byte ptr y
cmp ax, 25
ja @1
dec ax
mov cl, 80
mul cl
dec bx
add bx, ax
mov cl, byte ptr ColorTx
and cl, $8F
mov dl, BkColorTx
mov al, dl
and dl, $7
shl dl, 4
and al, $80
or dl, al
or dl, cl
mov al, byte ptr C
mov ah, dl
shl bx, 1
mov ds:[bx], ax
@1:
pop ds
end;
Procedure ScrollByOneLineUp(y, Cnt : Word); Assembler;
asm
push ds
push es
mov ax, 0B800h
mov ds, ax
mov es, ax
cld
mov di, y
mov si, di
add si, 2*80
mov cx, Cnt
rep movsw
pop es
pop ds
end;
Procedure PlayMusic(MPh : TMusicPhrase);
var
i : Word;
j, Nbl : Byte;
dN, incr, dFrq : Real;
Mq : Word;
PrevPosX, PosX : Byte;
begin
with MPh do
begin
Mq := 1;
for i := 2 to Leng do
if MusicNotes[Mq].freqMusicNotes[i].freq then
if MusicNotes[i].freq <> 0 then Mq := i;
MinFrq := MusicNotes[Mq].freq;
dFrq := Ln(MaxFrq) - Ln(MinFrq);
if dFrq = 0 then dFrq := 1;
if MusicNotes[1].freq <> 0 then
PosX := 2 + Round(77.0*(Ln(MusicNotes[1].freq)-Ln(MinFrq))/dFrq)
else
if MusicNotes[1].freq <> 0 then
PosX := 2 + Round(77.0*(Ln(MusicNotes[2].freq)-Ln(MinFrq))/dFrq)
else
PosX := 2 + Round(77.0*(Ln(MusicNotes[3].freq)-Ln(MinFrq))/dFrq);
PrevPosX := PosX;
end;
SaveBar(1, 23, 80, 25);
SaveBar(1, 12, 80, 22);
SaveBar(1, 9, 80, 11);
SetWindChar(' ');
SetAttr(Yellow, Black,WinAttr);
SetAttr(LightCyan, DarkGray,WinHAttr);
SetAttr(Green, DarkGray,WBorderAttr);
SetWindow(1, 23, 80, 25, 2, '', False);
SetAttr(Red, DarkGray,WBorderAttr);
SetWindow(1, 12, 80, 22, 2, '', True);
SetAttr(Cyan, DarkGray,WBorderAttr);
SetWindow(1, 9, 80, 11, 1, '<[ Прогресс... ]>', False);
ZZCursor;
incr := 0.0;
if MPh.Leng <> 0 then dN := (79.0/MPh.Leng);
with MPh do
for i := 1 to Leng do
begin
Sound(MusicNotes[i].freq);
ScrollByOneLineUp(2*12*80, 8*80);
if PosX < PrevPosX then
for j := PosX to PrevPosX do
SetTxPoint(j, 21, Black, Black, ' ') else
for j := PrevPosX to PosX do
SetTxPoint(j, 21, Black, Black, ' ');
incr := incr + dN;
if incr >= 1.0 then
begin
Nbl := Trunc(incr);
incr := incr-Int(incr);
for j := 1 to Nbl do
WriteLine('±', WinAttr);{°±І}
end;
{ SetTxPoint(PosX, 24, Black, Black, ' ');}
if PosX < PrevPosX then
for j := PosX to PrevPosX do
SetTxPoint(j, 24, Black, Black, ' ') else
for j := PrevPosX to PosX do
SetTxPoint(j, 24, Black, Black, ' ');
SetTxPoint(PosX, 22, Red, Black, #205);
PrevPosX := PosX;
if MusicNotes[i].freq <> 0 then
PosX := 2 + Round(77.0*(Ln(MusicNotes[i].freq)-Ln(MinFrq))/dFrq);
if PosX < PrevPosX then
for j := PosX to PrevPosX do
SetTxPoint(j, 24, LightGray, Black, '°'); {}
if PosX > PrevPosX then
for j := PrevPosX to PosX do
SetTxPoint(j, 24, LightGray, Black, '°');
if MusicNotes[i].freq <> 0 then
begin
if PosX < PrevPosX then
for j := PosX to PrevPosX do
SetTxPoint(j, 21, LightGray, Black, '<') else
if PosX > PrevPosX then
for j := PrevPosX to PosX do
SetTxPoint(j, 21, LightGray, Black, '>') else
if PosX = PrevPosX then
for j := PrevPosX to PosX do
SetTxPoint(j, 21, LightGray, Black, '|');
SetTxPoint(PosX, 22, i and 7 + LightGray, Black, ' ');
SetTxPoint(PosX, 24, i and 7 + LightGray, Blue, 'ю');
end;
Delay(Hi(MusicNotes[i].ling), Lo(MusicNotes[i].ling));
NoSound;
Delay(0, 10);
if KeyPressed then
begin
While KeyPressed do ReadKey;
Break;
end;
end;
NoSound;
UndoMenu;
UndoMenu;
UndoMenu;
end;
Procedure MusicCode2StrFile(MPh : TMusicPhrase;filename:String);
var
ft : Text;
i, j, ii, jj, Mq : Word;
begFreq, mulFreq : Real;
TableName : String;
Procedure WriteFileMPh(Flag : Boolean);
var
i, j : Word;
begin
if Flag then
Assign(ft, Copy(filename, 1, Pos('.', filename)-3)+'_@.MZC')
else
Assign(ft, Copy(filename, 1, Pos('.', filename)-3)+'_$.MZC');
{$I-}
Rewrite(ft);
{$I+}
if IOresult <> 0 then Exit;
WriteLn(ft, '[ShyarDinamicoMusic]');
WriteLn(ft, ';' + MusicName);
WriteLn(ft, 'LingNota = #', LingNota);
if Flag then
WriteLn(ft, 'MusTable = &', TableName)
else
begin
WriteLn(ft, 'begFreq = #', begFreq);
WriteLn(ft, 'mulFreq = #', mulFreq);
end;
if MPh.Leng mod 7 <> 0 then
WriteLn(ft, '[Phrases]:', MPh.Leng div 7 + 1)
else
WriteLn(ft, '[Phrases]:', MPh.Leng div 7);
for i := 1 to MPh.Leng do
begin
for j := 1 to NN do
if MPh.MusicNotes[i].freq = ROGnots[j].freq then
begin
if ROGnots[j].sharp then Write(ft, '#');
Write(ft, ROGnots[j].NPos, ':');
Break;
end;
if MPh.MusicNotes[i].freq = 0 then
Write(ft, '@:');
if MPh.MusicNotes[i].ling <> 0 then
Write(ft, (LingNota/MPh.MusicNotes[i].ling):1:5, '/')
else
Write(ft, '0/');
if i mod 7 = 0 then WriteLn(ft);
end;
WriteLn(ft);
if Flag then
for i := 1 to jj do
begin
Write(ft, ROGnots[i].freq:8);
if i mod 8 = 0 Then WriteLn(ft);
end;
Close(ft);
end;
begin
with MPh do
begin
Mq := 1;
for i := 2 to Leng do
if MusicNotes[Mq].freqMusicNotes[i].freq then
if MusicNotes[i].freq <> 0 then Mq := i;
MinFrq := MusicNotes[Mq].freq;
Mq := 1;
for i := 2 to Leng do
if MusicNotes[Mq].ling 0 then Mq := i;
LingNota := MusicNotes[Mq].ling;
end;
ii := 0;
jj := 0;
MulFreq := Ln(MaxFrq/MinFrq);
for i := 1 to MPh.Leng do
for j := 1 to MPh.Leng do
begin
if MPh.MusicNotes[i].freq <> MPh.MusicNotes[j].freq then
if MPh.MusicNotes[j].freq <> 0 then
if Abs(MPh.MusicNotes[i].freq/MPh.MusicNotes[j].freq-exp(ln(2)/12))MaxFrq then
inc(jj) else Break;
ROGnots[jj].freq := MaxFrq ;
for j := 1 to MPh.Leng do
if (MPh.MusicNotes[j].freq>ROGnots[jj-1].freq) and
(MPh.MusicNotes[j].freq 0 then
begin
SaveMusicTable := False;
Exit;
end;
BlockWrite(f, filesigntable, SizeOf(filesigntable));
BlockWrite(f, TableInfo, SizeOf(TableInfo));
BlockWrite(f, ROGnots, SizeOf(ROGnots));
Close(f);
SaveMusicTable := True;
end;
Function LoadMusicTable(filename : String):Boolean;
var
f : file;
St : String;
Lg : Word;
begin
Assign(f, filename);
{$I-}
Reset(f, 1);
{$I+}
if IOresult <> 0 then
begin
LoadMusicTable:=False;
Exit;
end;
BlockRead(f, St, SizeOf(filesigntable));
if St <> filesigntable then
begin
LoadMusicTable:=False;
Close(f);
Exit;
end;
BlockRead(f, TableInfo, SizeOf(TableInfo));
BlockRead(f, ROGnots, SizeOf(ROGnots));
Close(f);
LoadMusicTable:=True;
end;
Function SaveMusicPhrase(MPh : TMusicPhrase; filename : String):Boolean;
var
f : file;
Lg : Word;
begin
Assign(f, filename);
{$I-}
ReWrite(f, 1);
{$I+}
if IOresult <> 0 then
begin
SaveMusicPhrase := False;
Exit;
end;
Lg := MPh.Leng;
BlockWrite(f, filesign, SizeOf(filesign));
BlockWrite(f, musicname, SizeOf(musicname));
BlockWrite(f, MPh.Leng, SizeOf(Word));
BlockWrite(f, MPh, SizeOf(Word)+Lg*SizeOf(TMusicNota));
Close(f);
SaveMusicPhrase := True;
end;
Function LoadMusicPhrase(var MPh : TMusicPhrase; filename : String):Boolean;
var
f : file;
St : String;
Lg : Word;
begin
Assign(f, filename);
{$I-}
Reset(f, 1);
{$I+}
if IOresult <> 0 then
begin
LoadMusicPhrase:=False;
Exit;
end;
Seek(f, 0);
BlockRead(f, St, SizeOf(filesign));
if St <> filesign then
begin
LoadMusicPhrase:=False;
Close(f);
Exit;
end;
BlockRead(f, musicname, SizeOf(musicname));
BlockRead(f, Lg, SizeOf(Word));
BlockRead(f, MPh, SizeOf(Word)+Lg*SizeOf(TMusicNota));
Close(f);
LoadMusicPhrase:=True;
end;
Function LoadCodeMusicPhrase(var MPh : TMusicPhrase; filename : String):Boolean;
var
ft : Text;
i, NSt: Longint;
Code : Integer;
St : String;
begFreq, mulFreq : Real;
begin
Assign(ft, filename);
{$I-}
Reset(ft);
{$I+}
if IOresult <> 0 then
begin
LoadCodeMusicPhrase:=False;
Exit;
end;
ReadLn(ft, St);
if St <> '[ShyarDinamicoMusic]' then
begin
LoadCodeMusicPhrase:=False;
Close(ft);
Exit;
end;
Read(ft, MusicName[1]);
ReadLn(ft, MusicName);
ReadLn(ft, St);
Delete(St, 1, Pos('#', St));
val(St, LingNota, Code);
ReadLn(ft, St);
if Pos('&', St)<>0 then
begin
Delete(St, 1, Pos('&', St));
LoadMusicTable(St);
end
else
begin
Delete(St, 1, Pos('#', St));
val(St, begFreq, Code);
ReadLn(ft, St);
Delete(St, 1, Pos('#', St));
val(St, mulFreq, Code);
SetNewMusTable(begFreq, mulFreq);
end;
ReadLn(ft, St);
Delete(St, 1, Pos(':', St));
val(St, NSt, Code);
MPh.Leng := 0;
SaveBar(1, 12, 80, 25);
SetWindChar(' ');
SetAttr(Yellow,Magenta,WinAttr);
SetAttr(Green,Black,WBorderAttr);
SetAttr(LightRed+Blink,Cyan,WinHAttr);
SetWindow(1, 12, 80, 25, 2, '---=== Компиляция музыки: ===---', False);
ZZCursor;
Erq := False;
for i := 1 to NSt do
begin
ReadLn(ft, St);
MusStr2Nota(St, MPh, i);
Erq := Erq or ifErr;
end;
if Erq then
begin
ReadKey;
While KeyPressed do ReadKey;
end;
UndoMenu;
Close(ft);
LoadCodeMusicPhrase:=True;
end;
Procedure SetTableInfo(S : String);
var
i : Byte;
begin
for i := 1 to 80 do
TableInfo[i] := ' ';
TableInfo := S;
end;
Procedure SetMusicName(S : String);
var
i : Byte;
begin
for i := 1 to 80 do
MusicName[i] := ' ';
MusicName := S;
end;
begin
ResetTimer;
LingNota := $2000;
SetTableInfo('General Table Type');
SetMusicName('');
end.
Назад