csoundalert.pas

TSoundAlert Component (1.0) -- by WeiYF, 2002. 27 该组件提供了控制蜂鸣器报警

unit CSoundAlert;
{*******************************************************

  TSoundAlert Component (1.0) -- by WeiYF, 2002.02.27
  该组件提供了控制蜂鸣器报警，以及5种报警音乐的组件

********************************************************}

interface

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

type
  TSoundModeType =(smAlert0,smAlert1,smAlert2,smAlert3,smAlert4,smAlert5);
  TSoundAlert = class(TComponent)
  private
    { Private declarations }
    sndTimer: TTimer;
    iTimeCnt: integer;
    bSndGoHigh: boolean;
    iFreqSnd: integer;
    FActive: boolean;
    FMode: TSoundModeType;

    procedure SetActive(value: boolean);
    procedure SetMode(value: TSoundModeType);
    procedure MkSndAlert0;
    procedure MkSndAlert1;
    procedure MkSndAlert2;
    procedure MkSndAlert3;
    procedure MkSndAlert4;
    procedure MkSndAlert5;

    procedure OnHandleTimer(Sender: TObject);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure PlaySound(iDelayTime: integer);
    procedure MakeSound(iFreq: integer);
    procedure StopSound;
  published
    { Published declarations }
    property Active: boolean read FActive write SetActive;
    property Mode: TSoundModeType read FMode write SetMode default smAlert0;
  end;

procedure Register;

implementation

uses U_PubFuncs;

procedure Register;
begin
  RegisterComponents('WeiYF', [TSoundAlert]);
end;

constructor TSoundAlert.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sndTimer := TTimer.Create(self);
  with sndTimer do begin
   Enabled := false;
   Interval := 50;
   OnTimer := OnHandleTimer;
  end;
  iTimeCnt := 0;
end;

destructor TSoundAlert.Destroy;
begin
  if (sndTimer<>nil) then begin
    sndTimer.Destroy;  sndTimer := nil;
  end;
  //sndTimer.Free;
  inherited Destroy;
end;

procedure TSoundAlert.PlaySound(iDelayTime: integer);
begin
  if IsOSPlatformNT then begin
    MessageBeep(iDelayTime);  exit;
  end;
  asm
    PUSH  EAX
    MOV   AL,0B6H
    OUT   43H,AL
    MOV   EAX,iDelayTime
    OUT   42H,AL
    MOV   AL,AH
    OUT   42H,AL
    IN    AL,61H
    OR    AL,03H
    OUT   61H,AL
    POP   EAX
  end;
end;

procedure TSoundAlert.StopSound;
begin
  if IsOSPlatformNT then exit;
  asm
    IN    AL,61H
    AND   AL,0FCH
    OUT   61H,AL
  end;
end;

procedure TSoundAlert.MakeSound(iFreq: integer);
begin
  if IsOSPlatformNT then begin
    case (iFreq mod 5) of
      0: PlaySound(MB_ICONASTERISK);
      1: PlaySound(MB_ICONEXCLAMATION);
      2: PlaySound(MB_ICONHAND);
      3: PlaySound(MB_ICONQUESTION);
      4: PlaySound(MB_OK);
      else PlaySound(-1);
    end;
    exit;
  end;
  PlaySound(1192567 div iFreq);
end;

procedure TSoundAlert.SetActive(value: boolean);
begin
  //if (FActive = value) then exit;
  if ((FActive) and (value)) then exit;
  FActive := value;
  if (FActive) then begin
    bSndGoHigh := true;
    iFreqSnd := 540;
    sndTimer.Enabled := true;
    MakeSound(iFreqSnd);
  end
  else begin
    sndTimer.Enabled := false;
    StopSound;
  end;
end;

procedure TSoundAlert.SetMode(value: TSoundModeType);
begin
  FMode := value;
end;

procedure TSoundAlert.OnHandleTimer(Sender: TObject);
begin
  sndTimer.Enabled := false;
  iTimeCnt := iTimeCnt+1;
  case FMode of
    smAlert0:  MkSndAlert0;
    smAlert1:  MkSndAlert1;
    smAlert2:  MkSndAlert2;
    smAlert3:  MkSndAlert3;
    smAlert4:  MkSndAlert4;
    smAlert5:  MkSndAlert5;
  end;
  sndTimer.Enabled := true;
end;

procedure TSoundAlert.MkSndAlert0;
begin
  MakeSound(iFreqSnd);
  if bSndGoHigh = true then begin
    iFreqSnd := iFreqSnd - 10;
    if iFreqSnd < 540 then begin
      bSndGoHigh := false;
    end;
  end
  else begin
    iFreqSnd := iFreqSnd + 10;
    if iFreqSnd > 1200 then begin
      bSndGoHigh := true;
    end;
  end;
end;

procedure TSoundAlert.MkSndAlert1;
var iTmp: integer;
begin
  iTmp := (iTimeCnt div 2) mod 16;
  case iTmp of
    0:   MakeSound(640);
    1:   MakeSound(840);
    2:   MakeSound(1040);
    3:   MakeSound(1240);
    4:   StopSound;//MakeSound(1240);
    5:   MakeSound(1040);
    6:   MakeSound(840);
    7:   MakeSound(640);
    8:   MakeSound(640);
    9:   MakeSound(840);
   10:   MakeSound(1040);
   11:   MakeSound(1240);
   12:   MakeSound(1240);
   13:   MakeSound(1040);
   14:   MakeSound(840);
   15:   StopSound;//MakeSound(640);//
  end;
end;

procedure TSoundAlert.MkSndAlert2;
var iTmp: integer;
begin
  iTmp := (iTimeCnt div 2) mod 16;
  case iTmp of
    0:   MakeSound(262);
    1:   MakeSound(294);
    2:   MakeSound(330);
    3:   MakeSound(349);
    4:   MakeSound(392);
    5:   MakeSound(440);
    6:   MakeSound(494);
    7:   MakeSound(494);
    8:   MakeSound(440);
    9:   MakeSound(440);
   10:   MakeSound(349);
   11:   MakeSound(392);
   12:   MakeSound(349);
   13:   MakeSound(330);
   14:   MakeSound(294);
   15:   MakeSound(262);
  end;
end;

procedure TSoundAlert.MkSndAlert3;
var iTmp: integer;
begin
  iTmp := (iTimeCnt div 4) mod 7;
  case iTmp of
    0:   MakeSound(262);
    1:   MakeSound(294);
    2:   MakeSound(330);
    3:   MakeSound(349);
    4:   MakeSound(392);
    5:   MakeSound(440);
    6:   MakeSound(494);
  end;
end;

procedure TSoundAlert.MkSndAlert4;
var iTmp: integer;
begin
  iTmp := (iTimeCnt div 8) mod 14;
  case iTmp of
    0:   MakeSound(262);
    1:   MakeSound(294);
    2:   MakeSound(330);
    3:   MakeSound(349);
    4:   MakeSound(392);
    5:   MakeSound(440);
    6:   MakeSound(494);
    7:   MakeSound(494);
    8:   MakeSound(440);
    9:   MakeSound(392);
   10:   MakeSound(349);
   11:   MakeSound(330);
   12:   MakeSound(294);
   13:   MakeSound(262);
  end;
end;

procedure TSoundAlert.MkSndAlert5;
var iTmp: integer;
begin
  iTmp := (iTimeCnt div 8) mod 5;
  case iTmp of
    0:   MakeSound(262*4);
    1:   MakeSound(294*4);
    2:   MakeSound(330*4);
    3:   StopSound;
    4:   StopSound;
  end;
end;


end.