X
xingzhe_xr
Unregistered / Unconfirmed
GUEST, unregistred user!
小弟正在研究用机箱内的喇叭播放音乐（MEDI OR WAV）的问题……受阻……
特来请教各位高人！
我曾经找到一控件，他提供了一种发声方式（控件代码见后文）
PLAY（XXX，XXX）；
OR
DOBLEEP（XXX，XXX）；
但如果用这个去拼首歌就太…………
而且根本不知道XXX是哪个音……
所以想请教各位有无其他解决方法，谢谢！
如果可以提供一分
DOBLEEP（XXX，XXX）===（某个音）
的列表也行！
以下为控件代码
[
!]
Unit BleepInt;
{ Version 4.2 }
{ Andy Preston - Apollo Developments, Swindon U.K. andy@apollod.freeserve.co.uk
HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE!
How to make your Delphi programs bleep like FRACTINT! See Demo1.pas/Demo1.dfm or Bleepint.htm for details
}
Interface
Type
TBleepType = (bOK, bInterrupt, bError);
Procedure ShutUp;
{ Added to help counter the effects ofdo
Bleep (Freq, -1).
If you are producing a tone, &
you want to stop withoutdo
ing another Bleep, call this procedure }
Proceduredo
Bleep (Freq : Word;
MSecs : Integer);
{ Duration of -1 means bleep until the next bleep sent, or ShutUp is called }
Procedure Bleep (BleepType : TBleepType);
Implementation
Uses
{$IFDEF WIN32} Windows, {$else
} WinProcs, {$ENDIF}
{$IFNDEF CONSOLE} Forms;
{$ENDIF} { Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }
Procedure AsmShutUp;
{$IFDEF WIN32} Pascal;
{$ENDIF}
begin
Asm
In AL, $61 { Stop Bleeping }
And AL, $FC
Out $61, AL
end;
end;
Procedure AsmBeep (Freq : Word);
{$IFDEF WIN32} Pascal;
{$ENDIF}
Label
Skip;
begin
Asm
Push BX
In AL, $61
Mov BL, AL
And AL, 3
Jne Skip
Mov AL, BL
Or AL, 3
Out $61, AL
Mov AL, $B6
Out $43, AL
Skip: Mov AX, Freq
Out $42, AL
Mov AL, AH
Out $42, AL
Pop BX
end;
end;
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Low Level Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }
Procedure HardBleep (Freq : Word;
MSecs : Integer);
Var
{ Changed FirstTickCount from LongInt to DWord to counter P.Satyanarayana's Delphi 4 Warning - see below }
FirstTickCount : {$IFDEF WIN32} DWord {$else
} LongInt {$ENDIF};
begin
{ Michl Ladislav pointed out that having a delay when the bleep freq is out of range is a waste of 'stuff' so I've added
another begin
END }
If (Freq>=20) And (Freq<=5000) then
begin
AsmBeep (Word (1193181 Div LongInt(Freq)));
If MSecs>=0 then
begin
{ P.Satyanarayana Get's a warning under Delphi 4 here 'Comparing signed and unsigned types - widened both operands'
This should be cleared up by the fact that FirstTickCount is now a DWord under Win32 }
FirstTickCount:=GetTickCount;
{ Michl Ladislav suggested changing the old WHILEdo
to a REPEAT UNTIL so as to fit his modifications in easyer }
Repeat
{ Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{$IFNDEF CONSOLE} If MSecs>1000 then
Application.ProcessMessages;
{$ENDIF}
Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
AsmShutUp;
end;
end;
end;
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- Procedures for you to use -- --- -- --- -- --- -- --- -- --- -- --- }
Procedure Bleep (BleepType : TBleepType);
begin
Case BleepType of
bOK: begin
do
Bleep (1047,100);
do
Bleep (1109,100);
do
Bleep (1175,100);
end;
bInterrupt: begin
do
Bleep (2093,100);
do
Bleep (1976,100);
do
Bleep (1857,100);
end;
bError:do
Bleep (40,500);
end;
end;
{$IFDEF WIN32} Var SysWinNT : Boolean;
{$ENDIF}
Proceduredo
Bleep (Freq : Word;
MSecs : Integer);
begin
{$IFDEF WIN32} If SysWinNT then
Windows.Beep (Freq, MSecs) else
{$ENDIF}
HardBleep (Freq, MSecs);
end;
Procedure ShutUp;
begin
{$IFDEF WIN32} If SysWinNT then
Windows.Beep (1, 0) else
{$ENDIF}
AsmShutUp;
end;
{$IFDEF WIN32}
Procedure InitSysType;
Var
VersionInfo : TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize:=SizeOf (VersionInfo);
GetVersionEx (VersionInfo);
SysWinNt:=VersionInfo.dwPlatformID=VER_PLATFORM_WIN32_NT;
end;
Initialization
InitSysType;
{$ENDIF}
end.
特来请教各位高人！
我曾经找到一控件，他提供了一种发声方式（控件代码见后文）
PLAY（XXX，XXX）；
OR
DOBLEEP（XXX，XXX）；
但如果用这个去拼首歌就太…………
而且根本不知道XXX是哪个音……
所以想请教各位有无其他解决方法，谢谢！
如果可以提供一分
DOBLEEP（XXX，XXX）===（某个音）
的列表也行！
以下为控件代码
代码:
Unit BleepInt;
{ Version 4.2 }
{ Andy Preston - Apollo Developments, Swindon U.K. andy@apollod.freeserve.co.uk
HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE! HACKERS OF THE WORLD UNITE!
How to make your Delphi programs bleep like FRACTINT! See Demo1.pas/Demo1.dfm or Bleepint.htm for details
}
Interface
Type
TBleepType = (bOK, bInterrupt, bError);
Procedure ShutUp;
{ Added to help counter the effects ofdo
Bleep (Freq, -1).
If you are producing a tone, &
you want to stop withoutdo
ing another Bleep, call this procedure }
Proceduredo
Bleep (Freq : Word;
MSecs : Integer);
{ Duration of -1 means bleep until the next bleep sent, or ShutUp is called }
Procedure Bleep (BleepType : TBleepType);
Implementation
Uses
{$IFDEF WIN32} Windows, {$else
} WinProcs, {$ENDIF}
{$IFNDEF CONSOLE} Forms;
{$ENDIF} { Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }
Procedure AsmShutUp;
{$IFDEF WIN32} Pascal;
{$ENDIF}
begin
Asm
In AL, $61 { Stop Bleeping }
And AL, $FC
Out $61, AL
end;
end;
Procedure AsmBeep (Freq : Word);
{$IFDEF WIN32} Pascal;
{$ENDIF}
Label
Skip;
begin
Asm
Push BX
In AL, $61
Mov BL, AL
And AL, 3
Jne Skip
Mov AL, BL
Or AL, 3
Out $61, AL
Mov AL, $B6
Out $43, AL
Skip: Mov AX, Freq
Out $42, AL
Mov AL, AH
Out $42, AL
Pop BX
end;
end;
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Low Level Bits for Wind 3.x And '95 -- --- -- --- -- --- -- --- -- --- }
Procedure HardBleep (Freq : Word;
MSecs : Integer);
Var
{ Changed FirstTickCount from LongInt to DWord to counter P.Satyanarayana's Delphi 4 Warning - see below }
FirstTickCount : {$IFDEF WIN32} DWord {$else
} LongInt {$ENDIF};
begin
{ Michl Ladislav pointed out that having a delay when the bleep freq is out of range is a waste of 'stuff' so I've added
another begin
END }
If (Freq>=20) And (Freq<=5000) then
begin
AsmBeep (Word (1193181 Div LongInt(Freq)));
If MSecs>=0 then
begin
{ P.Satyanarayana Get's a warning under Delphi 4 here 'Comparing signed and unsigned types - widened both operands'
This should be cleared up by the fact that FirstTickCount is now a DWord under Win32 }
FirstTickCount:=GetTickCount;
{ Michl Ladislav suggested changing the old WHILEdo
to a REPEAT UNTIL so as to fit his modifications in easyer }
Repeat
{ Michl Ladislav suggested removing the Forms unit from 32-bit Console Apps, saving 130K }
{$IFNDEF CONSOLE} If MSecs>1000 then
Application.ProcessMessages;
{$ENDIF}
Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
AsmShutUp;
end;
end;
end;
{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- Procedures for you to use -- --- -- --- -- --- -- --- -- --- -- --- }
Procedure Bleep (BleepType : TBleepType);
begin
Case BleepType of
bOK: begin
do
Bleep (1047,100);
do
Bleep (1109,100);
do
Bleep (1175,100);
end;
bInterrupt: begin
do
Bleep (2093,100);
do
Bleep (1976,100);
do
Bleep (1857,100);
end;
bError:do
Bleep (40,500);
end;
end;
{$IFDEF WIN32} Var SysWinNT : Boolean;
{$ENDIF}
Proceduredo
Bleep (Freq : Word;
MSecs : Integer);
begin
{$IFDEF WIN32} If SysWinNT then
Windows.Beep (Freq, MSecs) else
{$ENDIF}
HardBleep (Freq, MSecs);
end;
Procedure ShutUp;
begin
{$IFDEF WIN32} If SysWinNT then
Windows.Beep (1, 0) else
{$ENDIF}
AsmShutUp;
end;
{$IFDEF WIN32}
Procedure InitSysType;
Var
VersionInfo : TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize:=SizeOf (VersionInfo);
GetVersionEx (VersionInfo);
SysWinNt:=VersionInfo.dwPlatformID=VER_PLATFORM_WIN32_NT;
end;
Initialization
InitSysType;
{$ENDIF}
end.