如何使PC喇叭发音?给段 代码!!(100分)

  • 主题发起人 主题发起人 OnlyU
  • 开始时间 开始时间
O

OnlyU

Unregistered / Unconfirmed
GUEST, unregistred user!
如何使PC喇叭发音?给段 代码!!
 
用MessageBeep,应该用Beep,而且不是Delphi的Beep(SysUtils),是
Windows的Beep
Windows.Beep
下面是MSDN的说明:

BOOL Beep(
DWORD dwFreq, // sound frequency, in hertz
DWORD dwDuration // sound duration, in milliseconds
);

Parameters
dwFreq
Windows NT: Specifies the frequency, in hertz, of the sound. This parameter must be in the range 37 through 32,767 (0x25 through 0x7FFF).
dwDuration
Windows NT: Specifies the duration, in milliseconds, of the sound.
 
用pc喇叭发声
{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;
 
http://delphibase.6to23.com有程序下载,源代码如下:
unit main2;

interface

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

type
TForm1 = class(TForm)
btn_beep: TButton;
btn_stop: TButton;
DateTimePicker1: TDateTimePicker;
Timer1: TTimer;
btn_exit: TButton;
btn_start: TButton;
Edit1: TEdit;
procedure btn_beepClick(Sender: TObject);
procedure btn_stopClick(Sender: TObject);
procedure btn_exitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btn_startClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function _getport(address:word):word;
procedure _setport(address,value:word);
procedure startbeep(freq:word);
procedure stopbeep;
end;

var
Form1: TForm1;
const
low_freq=40;
high_freq=5000;
implementation

{$R *.DFM}

procedure TForm1.btn_beepClick(Sender: TObject);
var
tone:word;
nowtime:tdatetime;

begin
{ with form1 do
begin
left:=left+1;
top:=top+1;
if left>=378 then left:=303;
if top>=152 then top:=120;

end;}
tone:=1000;
nowtime:=time;
edit1.text:=timetostr(nowtime);
// showmessage(timetostr(nowtime));
//startbeep(tone);
// starttime:=gettickcount;
// while ((gettickcount-starttime)<longint(msees)) do
if timetostr(nowtime)>=timetostr(datetimepicker1.Time) then
begin
startbeep(tone);
application.ProcessMessages ;
end;
// stopbeep;
end;
{---------------------------------_GetPort-------------------
-------------------}
function Tform1._GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
Result := bValue;
end; { _GetPort }
{----------------------------------_SetPort------------------
--------------------}
procedure Tform1._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; { _SetPort }


{----------------------------------StartBeep-----------------
---------------------}
procedure Tform1.StartBeep(Freq : Word);
var
B: Byte;
begin
if (Freq >= LOW_FREQ) and (Freq <= HIGH_FREQ)
then
begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(_GetPort($61));
if (B and 3) = 0
then
begin
_SetPort($61, Word(B or 3));
_SetPort($43, $B6);
end;
_SetPort($42, Freq);
_SetPort($42, Freq shr 8);
end;
end; { StartBeep }



{------------------------------StopBeep----------------------
------------------}
procedure Tform1.StopBeep;
var
Value: Word;
begin
Value := _GetPort($61) and $FC;
_SetPort($61, Value);
end; { StopBeep }


procedure TForm1.btn_stopClick(Sender: TObject);
begin
btn_start.Enabled :=true;
btn_stop.Enabled :=false;
timer1.Enabled :=false;
stopbeep;
end;

procedure TForm1.btn_exitClick(Sender: TObject);
begin
stopbeep;
timer1.Enabled :=false;
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{ with form1 do
begin
left:=303;
top:=120;

end; }
// timer1.Enabled :=false;
end;

procedure TForm1.btn_startClick(Sender: TObject);
begin
timer1.Enabled :=true;
btn_start.Enabled :=false;
btn_stop.Enabled :=true;
end;

end.
 
接受答案了.
 
后退
顶部