要如何由音效卡發出特定頻率的聲音 |
|
尚未結案
|
|
clijoe
一般會員   發表：1 回覆：2 積分：0 註冊：2003-05-07 發送簡訊給我 |
|
|
wnhoo
高階會員   發表：75 回覆：443 積分：198 註冊：2003-04-22 發送簡訊給我 |
//利用PC自己的音效卡发生
implementation
var
StopSound:boolean; {$R *.dfm}
procedure sound(freq:word);
begin
asm
in al,61h
or al,3
out 61h,al
mov al,0b6h
out 43h,al
mov bx,freq
mov al,bl
out 42h,al
mov al,bh
out 42h,al
end;
end;
// windows 98жr
procedure nosound;
begin
asm
in al,61h
and al,0fch
out 61h,al
end;
end; procedure tone(t:string);
var f,w:integer;
begin
f:=2400;
t:=uppercase(t);
if (win32platform=VER_PLATFORM_WIN32_NT) then // NTжr
begin
if pos('7',t)>0 then f:=1976;
if pos('6',t)>0 then f:=1760;
if pos('5',t)>0 then f:=1568;
if pos('4',t)>0 then f:=1397;
if pos('3',t)>0 then f:=1319;
if pos('2',t)>0 then f:=1175;
if pos('1',t)>0 then f:=1047;
f:=(f *57) div 100;
if pos('.',t)>0 then f:=f * 2;
if pos(',',t)>0 then f:=f div 2;
end
else // Win98жr
begin
if pos('1',t)>0 then f:=1976;
if pos('2',t)>0 then f:=1760;
if pos('3',t)>0 then f:=1568;
if pos('4',t)>0 then f:=1480;
if pos('5',t)>0 then f:=1319;
if pos('6',t)>0 then f:=1175;
if pos('7',t)>0 then f:=1047;
if pos('.',t)>0 then f:=f div 2;
if pos(',',t)>0 then f:=f * 2;
end; w:=2;
if pos('--',t)>0 then w:=8
else if pos('-',t)>0 then w:=4
else if pos('=',t)>0 then w:=1;
if (win32platform=VER_PLATFORM_WIN32_NT) then // NT
begin
windows.beep(f,w*50);
end
else // win98
begin
sound(f);
sleep(w*50);
nosound();
end;
sleep(50);
end; procedure music(song:string);
var c:char;
i:integer;
t:string;
begin
t:='';
for i:=1 to length(song) do
if not StopSound then
begin
Application.ProcessMessages;
c:=song[i];
if (C>='0') and (C<='9')then
begin
if t='' then t:=t+c
else
begin
tone(t);
t:=c;
end;
end
else t:=t+c;
end
else break;
if t<>'' then tone(t);
StopSound:=False;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
music('01234567-7654310');
end; end. 风花雪月 e梦情缘
------
风花雪月 e梦情缘 |
|
clijoe
一般會員 發表：1 回覆：2 積分：0 註冊：2003-05-07 發送簡訊給我 |
|
|
wnhoo
高階會員 發表：75 回覆：443 積分：198 註冊：2003-04-22 發送簡訊給我 |
|
|
clijoe
一般會員 發表：1 回覆：2 積分：0 註冊：2003-05-07 發送簡訊給我 |
發表時間：2003-05-07 08:08:49
IP:211.23.xxx.xxx 未訂閱
系統時間：2024-04-25 17:53:50
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |