１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"Beep音で音階を鳴らす(Win95) for MIDIな人"
{
日印(M_Kid)(KYB02503)さんの nifty:FDELPHI/MES/16/#00594
Beep音で音階を鳴らす(Win95)
Mata さんの nifty:FDELPHI/MES/16/#00190
PC98, DOS/V 機種判定
を参考にMIDIな人が使いやすいように改良しました。
日印(M_Kid)さんありがとうございます。
UNITにしてあるのでそのまま使えると思います。
ＡＴ互換機でしか動作しません。（ＰＣ９８はだめ。）
ＮＴでも駄目です。
＃ ＮＴチェックも組み入れたいけどわからなかったです。
＃ 開いたスピーカーは閉じないでいいのでしょうか？
}
unit SysBeep;
interface
uses Windows, Dialogs;
var TimeBase : integer;
Tempo : integer;
procedure DemoSong;
function SpeakerOpen : boolean;
function MidiOn(MidiOnkai : byte) :LongInt;
function MidiOff :LongInt;
function MidiOnOff(MidiOnkai : byte; Delta, Dur : Integer) : boolean;
implementation
var LastDur : integer;
{// }
{// 【各音階ごとの周波数データ】音階の下位バイトの値 }
{// }
function MidiOnkai2TickLo(MidiOnkai : byte): Byte;
begin
case MidiOnkai of
045: Result:= 95; // 110.00hz A3 ra2_lo
046: Result:= 254; // 116.54hz A#3 ra2_loshp
047: Result:= 191; // 123.47hz B3 si2_lo
048: Result:= 161; // 130.81hz C3 do3_lo
049: Result:= 161; // 138.59hz C#3 do3_loshp
050: Result:= 190; // 146.83hz D3 re3_lo
051: Result:= 14; // 155.06hz D#3 re3_loshp
052: Result:= 71; // 164.81hz E3 mi3_lo
053: Result:= 177; // 174.61hz F3 fa3_lo
054: Result:= 49; // 185.00hz F#3 fa3_loshp
055: Result:= 199; // 196.00hz G3 so3_lo
056: Result:= 114; // 207.65hz G#3 so3_loshp
057: Result:= 47; // 220.00hz A3 ra3_lo
058: Result:= 255; // 233.08hz A#3 ra3_loshp
059: Result:= 223; // 246.94hz B3 si3_lo
060: Result:= 208; // 261.63hz C4 do_lo
061: Result:= 208; // 277.18hz C#4 do_loshp
062: Result:= 223; // 293.66hz D4 re_lo
063: Result:= 250; // 311.13hz D#4 re_loshp
064: Result:= 35; // 329.63hz E4 mi_lo
065: Result:= 88; // 349.23hz F4 fa_lo
066: Result:= 152; // 369.99hz F#4 fa_loshp
067: Result:= 227; // 392.00hz G4 so_lo
068: Result:= 57; // 415.30hz G#4 so_loshp
069: Result:= 151; // 440.00hz A4 ra_lo
070: Result:= 255; // 466.16hz A#4 ra_loshp
071: Result:= 111; // 493.88hz B4 si_lo
072: Result:= 232; // 523.25hz C5 do5_lo
073: Result:= 104; // 554.37hz C#5 do5_loshp
074: Result:= 239; // 587.33hz D5 re5_lo
075: Result:= 125; // 622.25hz D#5 re5_loshp
076: Result:= 17; // 659.26hz E5 mi5_lo
077: Result:= 172; // 698.46hz F5 fa5_lo
078: Result:= 76; // 739.99hz F#5 fa5_loshp
079: Result:= 241; // 783.99hz G5 so5_lo
080: Result:= 156; // 830.61hz G#5 so5_loshp
081: Result:= 65; // 880.00hz A5 ra5_lo
082: Result:= 255; // 932.33hz A#5 ra5_loshp
083: Result:= 183; // 987.77hz B5 si5_lo
084: Result:= 116; // 1046.50hz C6 do6_lo
085: Result:= 52; // 1108.73hz C#6 do6_loshp
086: Result:= 247; // 1174.66hz D6 re6_lo
087: Result:= 200; // 1244.51hz D#6 re6_loshp
088: Result:= 130; // 1328.51hz E6 mi6_lo
089: Result:= 86; // 1396.91hz F6 fa6_lo
else Result:= 208;
end;
end;
{// }
{// 【各音階ごとの周波数データ】音階の上位バイトの値 }
{// }
function MidiOnkai2TickHi(MidiOnkai : byte): Byte;
begin
case MidiOnkai of
045: Result:= 42; // ra2_hi
046: Result:= 39; // ra2_hishp
047: Result:= 37; // si2_hi
048: Result:= 35; // do3_hi
049: Result:= 33; // do3_hishp
050: Result:= 31; // re3_hi
051: Result:= 30; // re3_hishp
052: Result:= 28; // mi3_hi
053: Result:= 26; // fa3_hi
054: Result:= 25; // fa3_hishp
055: Result:= 23; // so3_hi
056: Result:= 22; // so3_hishp
057: Result:= 21; // ra3_hi
058: Result:= 19; // ra3_hishp
059: Result:= 18; // si3_hi
060: Result:= 17; // do_hi
061: Result:= 16; // do_hishp
062: Result:= 15; // re_hi
063: Result:= 14; // re_hishp
064: Result:= 14; // mi_hi
065: Result:= 13; // fa_hi
066: Result:= 12; // fa_hishp
067: Result:= 11; // so_hi
068: Result:= 11; // so_hishp
069: Result:= 10; // ra_hi
070: Result:= 9; // ra_hishp
071: Result:= 9; // si_hi
072: Result:= 8; // do5_hi
073: Result:= 8; // do5_hishp
074: Result:= 7; // re5_hi
075: Result:= 7; // re5_hishp
076: Result:= 7; // mi5_hi
077: Result:= 6; // fa5_hi
078: Result:= 6; // fa5_hishp
079: Result:= 5; // so5_hi
080: Result:= 5; // so5_hishp
081: Result:= 5; // ra5_hi
082: Result:= 4; // ra5_hishp
083: Result:= 4; // si5_hi
084: Result:= 4; // do6_hi
085: Result:= 4; // do6_hishp
086: Result:= 3; // re6_hi
087: Result:= 3; // re6_hishp
088: Result:= 3; // mi6_hi
089: Result:= 3; // fa6_hi
else Result:= 17;
end;
end;
{// }
{// スピーカー初期化 }
{// }
function SpeakerOpen : boolean;
var r : integer;
begin
r := GetKeyboardType(1);// API
if ($000<=r)and(r<=$004) then begin
asm
{speaker_redy}
mov ax,0b6h
mov dx,43h {ﾎﾟｰﾄ 43h}
out dx,ax {ﾀｲﾏ ｦ ﾚﾃﾞｲ ﾆ ｽﾙ}
end;
Result := true;
end else begin
Result := false;
ShowMessage('ＡＴ互換機でないとうごかないです。');
end;
end;
{// }
{// 音を出す }
{// }
function MidiOn(MidiOnkai : byte) :LongInt;
var
TickLo, TickHi: Byte;
begin
Result:= 0;
TickLo:= MidiOnkai2TickLo(MidiOnkai);
TickHi:= MidiOnkai2TickHi(MidiOnkai);
asm
{タイマーチックをポートに出力}
xor ah,ah {AHﾚｼﾞｽﾀはｸﾘｱしておく}
mov al,TickLo {音階の下位バイト}
mov dx,42h {ﾎﾟｰﾄ 42h}
out dx,ax {AX --> ﾎﾟｰﾄ ﾍ ﾛｰﾄﾞ}
mov al,TickHi {音階の上位バイト}
mov dx,42h {ﾎﾟｰﾄ 42h}
out dx,ax {AX --> ﾎﾟｰﾄ ﾍ ﾛｰﾄﾞ}
{スピーカを鳴らす}
mov dx,61h {スピーカー ＯＮ}
in ax,dx {(1.ﾎﾟｰﾄ 61h ｦ ﾖﾑ)}
or ax,03h {(2.ﾋﾞﾂﾄ 0 ﾄ 1 ｦ ﾐﾙ)}
mov dx,61h
out dx,ax
end;
end;
{// }
{// 音を消す }
{// }
function MidiOff :LongInt;
begin
asm
{スピーカを止める}
mov dx,61h {スピーカー ＯＦＦ}
in ax,dx {(1.ﾎﾟｰﾄ 61h ｦ ﾖﾑ)}
and ax,0fch {(2.ﾋﾞﾂﾄ 0 ﾄ 1 ｦ ｹｽ)}
mov dx,61h
out dx,ax
end;
Result:= 0;
end;
{// }
{// 音を出して消す }
{// }
function MidiOnOff(MidiOnkai : byte; Delta, Dur : Integer) : boolean;
procedure WaitTick(t : integer);
var ms : integer;
Start_MiriTime, End_MiriTime: integer;
begin
ms := round(60000*(1/TimeBase)*(1/Tempo)*t);
if (ms<0)or(5000<ms)or(Not Result) then begin
{５秒以上ならエラーを返す}
Result := false;
if 5000<ms then ms := 5000
else ms := 0;
end else begin
Result := true;
end;
if 0<ms then begin
Start_MiriTime:= GetTickCount; {Windows起動後のミリ秒}
End_MiriTime := Start_MiriTime;
while End_MiriTime < Start_MiriTime +ms do begin
{指定時間ループさせる}
End_MiriTime:= GetTickCount;
end;
end;
end;
begin
Result := true;
WaitTick(Delta-LastDur);
MidiOn(MidiOnkai); // 音を出す
WaitTick(Dur);
MidiOff; //音を消す
LastDur := Dur;
end;
procedure DemoSong;{聞いてみてのお楽しみ}
begin
if SpeakerOpen then begin
TimeBase := 120;
Tempo := 152;
LastDur := 0;
MidiOnOff( 71, 0, 119); MidiOnOff( 73,180, 59); MidiOnOff( 71, 60, 179);
MidiOnOff( 68,180, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59);
MidiOnOff( 73, 60, 59); MidiOnOff( 73, 60, 59); MidiOnOff( 71, 60, 59);
MidiOnOff( 71, 60, 59); MidiOnOff( 68, 60, 59); MidiOnOff( 68, 60, 59);
MidiOnOff( 71, 60, 179); MidiOnOff( 73,180, 59); MidiOnOff( 71, 60, 239);
MidiOnOff( 68,360, 59); MidiOnOff( 68, 60, 59); MidiOnOff( 73, 60, 59);
MidiOnOff( 73, 60, 59); MidiOnOff( 75, 60, 59); MidiOnOff( 75, 60, 59);
MidiOnOff( 76, 60, 239); MidiOnOff( 73,240, 119); MidiOnOff( 71,240, 59);
MidiOnOff( 71, 60, 59); MidiOnOff( 73, 60, 59); MidiOnOff( 73, 60, 59);
MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 68, 60, 59);
MidiOnOff( 68, 60, 59); MidiOnOff( 71, 60, 599); MidiOnOff( 71,960, 179);
MidiOnOff( 73,180, 59); MidiOnOff( 71, 60, 179); MidiOnOff( 68,180, 59);
MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 73, 60, 59);
MidiOnOff( 73, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59);
MidiOnOff( 68, 60, 59); MidiOnOff( 68, 60, 59); MidiOnOff( 71, 60, 179);
MidiOnOff( 73,180, 59); MidiOnOff( 71, 60, 179); MidiOnOff( 68,180, 59);
MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 73, 60, 59);
MidiOnOff( 73, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 71, 60, 59);
MidiOnOff( 68, 60, 59); MidiOnOff( 68, 60, 59); MidiOnOff( 70,180, 119);
MidiOnOff( 70,120, 59); MidiOnOff( 70, 60, 119); MidiOnOff( 69,120, 119);
MidiOnOff( 69,120, 59); MidiOnOff( 69, 60, 59); MidiOnOff( 69, 60, 59);
MidiOnOff( 69, 60, 59); MidiOnOff( 71, 60, 59); MidiOnOff( 69, 60, 59);
MidiOnOff( 69, 60, 59); MidiOnOff( 68, 60, 479); MidiOnOff( 68,720, 119);
MidiOnOff( 68,120, 119); MidiOnOff( 66,120, 59); MidiOnOff( 64, 60, 119);
MidiOnOff( 64,120, 299);
end;
end;
initialization
TimeBase := 120;
Tempo := 120;
end.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Ts TSEQ Ver2.3a JAF10202@nifty.ne.jp
http://hp.vector.co.jp/authors/VA009927/
Original document by Ts 氏 ID:(JAF10202)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。