在delphi中如何让PC机的喇叭发声（非声卡）？在线等待......

szztao 2003-02-10 03:56:57
Beep()和MessageBeep()；均通过声卡发声，如何让PC自带的喇叭发声？
...全文
86 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
szztao 2003-02-10
  • 打赏
  • 举报
 回复
多谢各位参与，祝大家新年快乐！！
经验证：
在Delphi中直接调用Beep()时不行，使用Windows.Beep()使用Api函数
就可以了。
楼上lanxingw(Qao Kei)的方法最适合(win2000系统下),因此得分。
谢谢
「已注销」 2003-02-10
  • 打赏
  • 举报
 回复
没有声卡的话beep,messagebeep就可以了，这个beep是delphi封装的
有声卡的话只能用windows.beep了，这个beep是API
jackie168 2003-02-10
  • 打赏
  • 举报
 回复
Beep()應該可以.....
wjlsmail 2003-02-10
  • 打赏
  • 举报
 回复
同意楼上:) ,猜着是但不敢说， 不方便拔声卡:)


谢谢楼上
LKJ99 2003-02-10
  • 打赏
  • 举报
 回复
Beep()应该就是你要找的。
我的电脑没声卡更无音箱之类，
但Beep()一下，挺响的！
「已注销」 2003-02-10
  • 打赏
  • 举报
 回复
有那么复杂吗？
给你一个

const
MHZ:Array[8] of Integer=(523,587,659,698,784,880,988,1047);
var
I:Integer;

for I:=Low(MHZ) to High(MHZ) do
windows.beep(MHZ[I],500);
esu 2003-02-10
  • 打赏
  • 举报
 回复
procedure sound(mhz : integer);
{mhz = the frequency of the pc speaker}
var
count : word;
oldport,
newport : byte;

begin
count := 1193280 div mhz;
asm
mov al,$b6
out $43,al
mov ax,count
out $42,al
mov al,ah
out $42,al
mov al,3
out $61,al
end;
end;

procedure nosound;
{turn off the pc speaker}
begin
asm
mov al,0
out $61,al
end;
end;


拷的，试试
Billy_Chen28 2003-02-10
  • 打赏
  • 举报
 回复

function TPCSpeaker.GetPort(address: Word): Word;
var
bValue: Byte;
begin
asm
mov DX, address
in AL, DX
mov bValue, AL
end;
result := bValue;
end;
procedure Tpcspeaker.Button1Click(Sender: TObject);
begin
play(1800,100);//由这两个参数控制音调
end;

procedure Tpcspeaker.Button2Click(Sender: TObject);
begin
NoSound;
end;

end.

来自：whb_li 时间：00-10-26 0:17:21 ID:376428
to terry_lzs: 打扰，我用你的代码调试了一下，发现
asm
mov DX, address
in AL, DX /////这一行出错
mov bValue, AL
end;
--------------------------------------------------------------------------------
来自：terry_lzs 时间：00-10-26 8:27:07 ID:376539
to whb_li:我在我的电脑上用delphi 4和delphi 5都试过了，没有问题。
如果你是把网页上的直接拷贝到unit上请注意删除一些不可见的字符。
我以前有遇到这种问题的。

--------------------------------------------------------------------------------
来自：pino 时间：00-11-21 9:49:23 ID:399668
在nt下不能直接对端口操作，可以用api messagebeep
而在win9x下就不能用api，可以在代码里面根据系统选择实现方式
来自：xjktthq 时间：00-11-21 9:57:09 ID:399678
for i:=9 to 20 do
windows.beep(i*130,20);

--------------------------------------------------------------------------------
来自：cat.yy 时间：01-1-31 23:25:07 ID:445935
呀呀 鞋都跑丢了 不知能否帮上忙
(用API 如果有声卡 好像有点麻烦)
*------------------------------- DLL 的 dpr 代码 --------------
library SpeakSound;

//uses
// SysUtils,
// Classes,

procedure pcSound(dFreq:Double;wLong:Word);export;
var
wFreq:word;
begin
wFreq := round(1192576/dFreq);
asm
push ax
push bx
push cx
push dx
push di
mov al,0B6H
out 43H,al
mov dx,12H
mov ax,wFreq
out 42H,al
mov al,ah
out 42H,al
in al,61H
mov ah,al
or al,3
out 61H,al
@wait1:
mov cx,wLong
@delay:
dec cx
jnz @delay
dec bx
jnz @wait1
mov al,0B6H
out 43H,al
mov al,ah
out 61H,al
pop di
pop dx
pop cx
pop bx
pop ax
end;
end;

exports
pcSound;

begin
end.
* ------------------------------ 调用的例子 ------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
DLLName:string;
Buffer:array[0..127] of Char;
LIB:THandle;
pcSound:procedure(dFreq:Double;wLong:Word);
begin
DLLName := 'SpeakSound.dll';
StrPCopy(Buffer,DLLName);
Lib := LoadLibrary(Buffer);
if not(Lib=0) then
try
pcSound := GetProcAddress(Lib,'pcSound');
pcsound(440.0,1000);
Finally
FreeLibrary(Lib);
end
else
Showmessage('failed');
end;

end.
{
261.7 c
293.7 d
329.6 e
349.2 f
392.0 g
440.0 a
493.9 b
}
--------------------------------------------------------------------------------
来自：悲酥清风 时间：01-2-6 16:23:18 ID:450522
AHM2000 Freeware 中有个PcSpeaker控件，带源码的，源码在AHM2000的主叶上有！
来自：Iknow 时间：01-2-6 17:36:31 ID:450601
^_^ 连cdefgab都出来了. 音乐功底不错嘛.

c=1, d=2, ... ^_^

其实如果是在Windows下, 为什么不尝试用系统中的声卡设备(如果有的话)?

DOS下如果用Borland Pascal的话, 可以用sound(frequency);delay(duration);nosound;
组合来发声, 效果还可以的.
Billy_Chen28 2003-02-10
  • 打赏
  • 举报
 回复
大富翁上的：
：sunstone 时间：00-9-3 7:51:42 ID:325632
送你一个控件

unit PCSpk;

{* Program : PCSpk.Pas
Purpose : TPCSpeaker Component

Author Version Last Changed Comments
------ ------- ------------ --------
Song Weng Sam 1.01 Aug. 28, 96 Initial Release (Version set to 1.01
to match the 16bit version which is
currently 1.01 too.)
*}

interface

uses
Classes, WinProcs, Forms;

type
TPCSpeaker = class(TComponent)
private
{ Private declarations }
procedure NoSound;
procedure Sound(Freq: Word);
procedure SetPort(address, value: Word);
function GetPort(address: Word): Word;
protected
{ Protected declarations }
public
{ Public declarations }
procedure Delay(MSecs: Integer);
procedure Play(Freq: Word; MSecs: Integer);
procedure Stop;
published
{ Published declarations }
end;

procedure Register;

implementation

procedure TPCSpeaker.NoSound;
var
wValue: Word;
begin
wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;

procedure TPCSpeaker.Sound(Freq: Word);
var
B: Word;
begin
if Freq > 18 then begin
Freq := Word(1193181 div LongInt(Freq));

B := GetPort($61);

if (B and 3) = 0 then begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;

SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;

procedure TPCSpeaker.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages; {allowing access to other controls, etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;

procedure TPCSpeaker.Play(Freq: Word; MSecs: Integer);
begin
Sound(Freq);
Delay(MSecs);
NoSound;
end;

procedure TPCSpeaker.Stop;
begin
NoSound;
end;

procedure TPCSpeaker.SetPort(address, value: Word);
var
bValue: Byte;
begin
bValue := trunc(value and 255);
asm
mov DX, address
mov AL, bValue
out DX, AL
end;
end;

function TPCSpeaker.GetPort(address: Word): Word;
var
bValue: Byte;
begin
asm
mov DX, address
in AL, DX
mov bValue, AL
end;
result := bValue;
end;

procedure Register;
begin
RegisterComponents('Sun', [TPCSpeaker]);
end;

end.


--------------------------------------------------------------------------------
来自：浦欣 时间：00-9-4 1:29:47 ID:326342
sunstone的这个控件实际上和原来提问中的那段程序一样，但我还想要得是一些声音例子，就象
“电子日记本”的“备忘录”中，有一些做好的声音可选！
或者给出每个调所对应的频率

来自：terry_lzs 时间：00-10-24 10:48:33 ID:374463
用汇编吧
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
Tpcspeaker = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure NoSound;
procedure Sound(Freq: Word);
procedure SetPort(address, value: Word);
function GetPort(address: Word): Word;
{ Private declarations }
public
procedure Delay(MSecs: Integer);
procedure Play(Freq: Word; MSecs: Integer);
{ Public declarations }
end;

var
pcspeaker: Tpcspeaker;

implementation

{$R *.DFM}
procedure TPCSpeaker.NoSound;
var
wValue: Word;
begin
wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;

procedure TPCSpeaker.Sound(Freq: Word);
var
B: Word;
begin
if Freq > 18 then begin
Freq := Word(1193181 div LongInt(Freq));

B := GetPort($61);
B := GetPort($61);

if (B and 3) = 0 then begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;

SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;

procedure TPCSpeaker.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages; {allowing access to other controls,
etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;


procedure TPCSpeaker.Play(Freq: Word; MSecs: Integer);
begin
Sound(Freq);
Delay(MSecs);
//NoSound;
end;

procedure TPCSpeaker.SetPort(address, value: Word);
var
bValue: Byte;
begin
bValue := trunc(value and 255);
asm
mov DX, address
mov AL, bValue
out DX, AL
end;
end;
Billy_Chen28 2003-02-10
  • 打赏
  • 举报
 回复
procedure Sound(Freq:Integer)；
var
p:Integer;
begin
P:=1190000 div Freq;
asm
mov al,10110110B
out 43h,al
mov ax,P
out 42h,al
mov al,ah
out 42,al
in al,61h
mov ah,al
or al,03h
out 61h,al
end;
end;
wjlsmail 2003-02-10
  • 打赏
  • 举报
 回复
Beep() 是通过声卡么 ? 倒没有注意...


Study
szztao 2003-02-10
  • 打赏
  • 举报
 回复
up
《实战Delphi6/Kylix2/SOAP/Web Service程序设计篇》(
《实战Delphi6/Kylix2/SOAP/Web Service程序设计篇》(李维著)
最强悍的 VC VB反编译工具 Hex-Rays
最强悍的反编译工具 Hex-Rays。 可以反编译 VB VC BCB Delphi 等等一切 x86/x64 代码为 C 代码。密码参见内附说明文件。 我写了个简单的介绍 http://blog.caozhongyan.com/article.asp?id=19
DelphiXE10零基础实战快速入门
通过课堂上一个一个的实战例子，演示DelphiXE10的用法，最后通过一个完整的通讯录程序，让学员初步掌握软件开发的全部流程让零基础学员快速入门Delphi编程，快速掌握Delphi的使用方法，并能够制作出自己的软件来。为同学们下一步的提高打下坚实的基础。
Delphi精简版Embarcadero.Delphi.10.1.Berlin.Update2.v24.0.25048.9432.Lite.v13.2
Embarcadero.Delphi.10.1.Berlin.Update1.v24.0.25048.9432.Lite.v13.2 -------------------------------------------------------------------------------- 基本信息： 作者：lsuper 联系方式：... -------------------
Delphi 多声卡开发
    最近想写一个程序，用于在一台电脑上控制多块声卡，分别放不同的音乐文件。一般的播放控件都没有在哪块声卡进行播放的选择功能。网上倒是见过OCX方式的多声卡SDK（开发包），但不注册的话只能控制两块，而且播放还不稳定，注册的话，费用要2K！倒，我是穷人也，欺负我么。    只好自己动手了。    查找多方面资料，知道用DirectX开发的话是可以实现的，但要用Delphi直接使用Dire
Delphi

5,388

社区成员

262,731

社区内容

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章