WINDOWS.BEEP für WINDOWS 7

[hathor]

Mein "geliebtes" WINDOWS.BEEP(freq,duration) gibt es in WINDOWS 7 nicht mehr.
Hier ist Ersatz mit der Function WINDOWSBEEP(freq,duration).
Wählt die Frequenz nicht zu niedrig (überträgt der Beeper/Lautsprecher nicht)
und nicht zu hoch (hört man im fortgeschrittenen Alter nicht mehr ).

Limits gefunden im C++--Code von 2000:
#define BEEP_FREQUENCY_MINIMUM 0x25
#define BEEP_FREQUENCY_MAXIMUM 0x7FFF

Ein Sleep(xx); zwischen 2 Functions-Aufrufen ist erforderlich: xx habe ich mit 50msec getestet.
Getestet mit WIN XP 32Bit und WIN 7 ULTIMATE 64Bit.

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button20: TButton;
    Button21: TButton;
    Button22: TButton;
    Button23: TButton;
    Button24: TButton;
    Button25: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
    procedure Button21Click(Sender: TObject);
    procedure Button22Click(Sender: TObject);
    procedure Button23Click(Sender: TObject);
    procedure Button24Click(Sender: TObject);
    procedure Button25Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

type  BEEP_SET_PARAMETERS= record
      Frequency,Duration:cardinal;
      end;

const IOCTL_BEEP_SET=$10000;
      FNStr:array [0..9] of char='\\.\piep'#0;     
      FN:PChar=@FNStr[0];
      DEVNAME : PChar=@FNStr[3];

var DEVPATH:array [0..MAX_PATH] of char;

implementation

{$R *.dfm}

function WindowsBeep(Freq,Duration:cardinal):longint;
var hBeep, bRET : cardinal;
    BSP : BEEP_SET_PARAMETERS;
    ODN : longbool;
begin
ODN:=false;
if QueryDosDevice(DEVNAME,DEVPATH,MAX_PATH)=0 then begin
   DefineDosDevice(DDD_RAW_TARGET_PATH,DEVNAME,'\Device\Beep');
   ODN:=true;
   end;
hBeep:=CreateFile (FN,GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,0,0);
if hBeep=INVALID_HANDLE_VALUE then  begin Result:=E_FAIL; exit; end;
BSP.Frequency:= Freq;
BSP.Duration:= Duration;
DeviceIOControl(hBeep,IOCTL_BEEP_SET,@Freq,sizeof(BSP),nil,0,bRET,nil);
if ODN then DefineDosDevice(DDD_REMOVE_DEFINITION,DEVNAME,nil);
Sleep(BSP.Duration);
CloseHandle(hBeep);
Result:=S_OK;
end;

Procedure DLAY;
BEGIN
 sleep(50);
END;

procedure TForm1.Button10Click(Sender: TObject);
begin
Button10.Hint:='5000,150';
WindowsBeep(5000,150);
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
Button11.Hint:='4000,100';
WindowsBeep(4000,100);
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
Button12.Hint:='3000,500';
WindowsBeep(3000,500);
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
Button13.Hint:='3000,100';
WindowsBeep(3000,100);
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
Button14.Hint:='2000,150';
WindowsBeep(2000,150);
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
Button15.Hint:='1000,200';
WindowsBeep(1000,200);
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
Button16.Hint:='440,200';
WindowsBeep(440,200);
end;

procedure TForm1.Button17Click(Sender: TObject);
begin
Button17.Hint:='4000,100,2000,100';
WindowsBeep(4000,100);
DLAY; //sleep(50);
WindowsBeep(2000,100);
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
Button18.Hint:='2000,100,1000,100';
WindowsBeep(2000,100);
DLAY;
WindowsBeep(1000,100);
end;

procedure TForm1.Button19Click(Sender: TObject);
begin
Button19.Hint:='1000,100,500,100';
WindowsBeep(1000,100);
DLAY;
WindowsBeep(500,100);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Hint:='3000,150';
WindowsBeep(3000,150);
end;

procedure TForm1.Button20Click(Sender: TObject);
var i:Integer;
begin
  for I := 1 to 10 do BEGIN
    WindowsBeep(I*500,100);
    DLAY;
  END;
end;

procedure TForm1.Button21Click(Sender: TObject);
var i:Integer;
begin
  for I := 10 downto 1 do BEGIN
    WindowsBeep(I*500,100);
    Sleep(100);
  END;
end;

procedure TForm1.Button22Click(Sender: TObject);
begin
WindowsBeep(554,200); DLAY;
WindowsBeep(587,200); DLAY;
WindowsBeep(622,200); DLAY;
WindowsBeep(659,200); DLAY; sleep(800);
WindowsBeep(740,200); DLAY;
WindowsBeep(784,200); DLAY; sleep(800);
WindowsBeep(622,200); DLAY;
WindowsBeep(659,200); DLAY;
WindowsBeep(740,200); DLAY;
WindowsBeep(784,200); DLAY;
WindowsBeep(1046,200); DLAY;
WindowsBeep(988,200); DLAY;
WindowsBeep(659,200); DLAY;
WindowsBeep(783,200); DLAY; 
WindowsBeep(988,200); DLAY;
WindowsBeep(932,1000); DLAY;
WindowsBeep(880,200); DLAY;
WindowsBeep(783,200); DLAY;
WindowsBeep(659,200); DLAY;
WindowsBeep(587,200); DLAY;
WindowsBeep(659,200); DLAY;
end;


procedure TForm1.Button23Click(Sender: TObject);
begin
DLAY; WindowsBeep(262, 300);
DLAY; WindowsBeep(349, 300);
DLAY; WindowsBeep(440, 300);
DLAY; WindowsBeep(349, 300);
DLAY; WindowsBeep(392, 600);

DLAY; WindowsBeep(467, 150);
DLAY; WindowsBeep(440, 150);
DLAY; WindowsBeep(392, 150);
DLAY; WindowsBeep(349, 150);

DLAY; WindowsBeep(330, 300);
DLAY; WindowsBeep(392, 300);
DLAY; WindowsBeep(262, 300);
DLAY; WindowsBeep(330, 300);
DLAY; WindowsBeep(349, 600);
DLAY; WindowsBeep(440, 600);

DLAY; WindowsBeep(262, 300);
DLAY; WindowsBeep(349, 300);
DLAY; WindowsBeep(440, 300);
DLAY; WindowsBeep(349, 300);
DLAY; WindowsBeep(392, 600);

DLAY; WindowsBeep(467, 150);
DLAY; WindowsBeep(440, 150);
DLAY; WindowsBeep(392, 150);
DLAY; WindowsBeep(349, 150);

DLAY; WindowsBeep(330, 300);
DLAY; WindowsBeep(392, 300);
DLAY; WindowsBeep(262, 300);
DLAY; WindowsBeep(330, 300);
DLAY; WindowsBeep(349, 600);
end;

procedure TForm1.Button24Click(Sender: TObject);
begin
  DLAY; WindowsBeep(523,600); //C2
  DLAY; WindowsBeep(587,600); //D
  DLAY; WindowsBeep(659,600); //E
  DLAY; WindowsBeep(698,600); //F
  DLAY; WindowsBeep(784,600); //G
  DLAY; WindowsBeep(880,600); //H
  DLAY; WindowsBeep(987,600); //A
  DLAY; WindowsBeep(1046,600);//C3
end;

procedure TForm1.Button25Click(Sender: TObject);
begin
WindowsBeep(659,120); DLAY;
WindowsBeep(622,120); DLAY;
WindowsBeep(659,120); DLAY;
WindowsBeep(622,120); DLAY;
WindowsBeep(659,120); DLAY;
WindowsBeep(494,120); DLAY;
WindowsBeep(587,120); DLAY;
WindowsBeep(523,120); DLAY;
WindowsBeep(440,120); DLAY;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Button2.Hint:='2500,100';
WindowsBeep(2500,100);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Button3.Hint:='2000,200';
WindowsBeep(2000,200);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Button4.Hint:='1500,300';
WindowsBeep(1500,300);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Button5.Hint:='1000,100';
WindowsBeep(1000,100);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Button6.Hint:='750,150';
WindowsBeep(750,150);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
Button7.Hint:='500,120';
WindowsBeep(500,120);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
Button8.Hint:='440,100';
WindowsBeep(440,100);
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
Button9.Hint:='4000,100';
WindowsBeep(4000,100);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsBeep(3000,150);
end;

end.