登录社区:用户名: 密码: 忘记密码 网页功能:加入收藏 设为首页 网站搜索  

文档

下载

图书

论坛

安全

源码

硬件

游戏
首页 信息 空间 VB VC Delphi Java Flash 补丁 控件 安全 黑客 电子书 笔记本 手机 MP3 杀毒 QQ群 产品库 分类信息 编程网站
  立华软件园 - 安全技术中心 - 技术文档 - Delphi 技术文章 | 相关下载 | 电子图书 | 攻防录像 | 安全网站 | 在线论坛 | QQ群组 | 搜索   
 安全技术技术文档
  · 安全配制
  · 工具介绍
  · 黑客教学
  · 防火墙
  · 漏洞分析
  · 破解专题
  · 黑客编程
  · 入侵检测
 安全技术工具下载
  · 扫描工具
  · 攻击程序
  · 后门木马
  · 拒绝服务
  · 口令破解
  · 代理程序
  · 防火墙
  · 加密解密
  · 入侵检测
  · 攻防演示
 安全技术论坛
  · 安全配制
  · 工具介绍
  · 防火墙
  · 黑客入侵
  · 漏洞检测
  · 破解方法
 其他安全技术资源
  · 攻防演示动画
  · 电子图书
  · QQ群组讨论区
  · 其他网站资源
最新招聘信息

PC喇叭发声
发表日期:2003-05-28作者:[] 出处:  

: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;

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;

组合来发声, 效果还可以的.

我来说两句】 【发送给朋友】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 PC喇叭发声

 ■ [欢迎对本文发表评论]
用  户:  匿名发出:
您要为您所发的言论的后果负责,故请各位遵纪守法并注意语言文明。

最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放 / 友情链接  
Copyright ©2001-2006 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00205