盒子论坛 v2.1

找到一段让pc喇叭发声音的代码

PC喇叭发声

：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.

出自：
http://www.yzsoftware.com/bbs/show.asp?id=177&bd=2&totable=1

但是只能在98下面使用，2000下不行，怎么修改？？？

----------------------------------------------
青云论坛

信息

登陆以后才能回复