Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi WINDOWS.BEEP für WINDOWS 7 (https://www.delphipraxis.net/152849-windows-beep-fuer-windows-7-a.html)

hathor 9. Jul 2010 11:10

Delphi-Version: 2007

WINDOWS.BEEP für WINDOWS 7
 
Liste der Anhänge anzeigen (Anzahl: 1)
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.

turboPASCAL 9. Jul 2010 18:00

AW: WINDOWS.BEEP für WINDOWS 7
 
Wäre es so:
Delphi-Quellcode:
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
  if (Freq = 0) and (Duration > 0) then
  begin
    Sleep(Duration);
    Result := S_OK;
  end else
  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
      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 else
      Result := E_FAIL;
  end;
end;

function Beep(Freq, Duration: cardinal): Bool;
begin
  Result := WindowsBeep(Freq, Duration) = S_OK;
  sleep(0);
end;
nicht besser ? :gruebel:

himitsu 9. Jul 2010 18:39

AW: WINDOWS.BEEP für WINDOWS 7
 
Es liegt nicht generell an Windows 7.

Beep
Windows Vista x64 and Windows XP 64-Bit Edition: This function is not supported.

Es liegt also am 64-Bit Windows.

PS: Unter einem 32-Bit Windows (seit Win2000) beept es nur, wenn der Beep-Service auch läuft.
Gibt es denn diesen Service unter Win64 nicht?

(OK und in Wine geht es auch nicht, da dieses diese Funktion nicht weiterleitet)

blackfin 9. Jul 2010 22:54

AW: WINDOWS.BEEP für WINDOWS 7
 
Unter Windows 7 (x32 UND x64) wird der Beep()-Sound auf die Lautsprecher umgeleitet, durch einen kleinen "Hack" (überschreiben der beep.sys durch eine alte aus XP) kann man den auch wieder zurück auf den PC Speaker leiten.
Nur Vista x64 und XP x64 betrifft das Problem des Threads direkt.

Es gibt dazu auch einen wirklich interessanten Blog-Eintrag von einem Microsoft-Entwickler, wie kompliziert so eine banale Sache wie der Beep-Spund sein kann :

http://blogs.msdn.com/b/larryosterma...windows-7.aspx

:)

hathor 10. Jul 2010 06:03

AW: WINDOWS.BEEP für WINDOWS 7
 
@blackfin:

Den Link kenne ich: am Lustigsten finde ich den Hinweis auf http://www.ada.gov/
Ich hielt das für eine amerikanische Übertreibung in Sachen "Umweltschutz"! Deshalb KEIN Beep.

hathor 10. Jul 2010 06:06

AW: WINDOWS.BEEP für WINDOWS 7
 
Zitat:

Zitat von turboPASCAL (Beitrag 1034592)
Wäre es so:
Delphi-Quellcode:
function Beep(Freq, Duration: cardinal): Bool;
begin
  Result := WindowsBeep(Freq, Duration) = S_OK;
  sleep(0);
end;
nicht besser ? :gruebel:

Das kann man zusätzlich definieren.
Aber bei meinen vorhandenen Sourcecodes muss ich nur den Punkt entfernen in "Windows.Beep" und eine Unit WBEEP einfügen.
Man könnte am Ende gleich das erforderliche Sleep(50); einfügen, dann erspart man sich das zwischen 2 Funktionsaufrufen.

Wenn Freq oder Duration =0, warum nicht gleich Exit; ?

turboPASCAL 10. Jul 2010 11:01

AW: WINDOWS.BEEP für WINDOWS 7
 
"sleep(0)" bringt also nichts ?

Wenn das so wäre könnte/muss, wenn man seine Programme nach x64 portiert, den kompletten Sound-Krams umschreiben.
(bezogen auf Melodien etc.) :(

hathor 10. Jul 2010 12:06

AW: WINDOWS.BEEP für WINDOWS 7
 
Ich habe es soeben mit WINDOWS 7 64Bit getestet: Sleep(0); funktioniert auch.
Ob das in der Realität auch einem Sleep(16) entspricht wie bei WIN XP werde ich noch untersuchen...

Ergebnis: Sleep(0); entspricht in WINDOWS 7 64Bit 0,0062 msec.

Zum Selbertesten:
Delphi-Quellcode:
var  a, b, c: Int64; r: real;

  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  Sleep(0);
  QueryPerformanceCounter(c);
  r:= (c - b) * 1000 / a;
  Label1.Caption:=FloatToStrF(r, ffFixed, 12, 5)+' msec';

himitsu 10. Jul 2010 17:04

AW: WINDOWS.BEEP für WINDOWS 7
 
Zitat:

Zitat von hathor (Beitrag 1034648)
Ergebnis: Sleep(0); entspricht in WINDOWS 7 64Bit 0,0062 msec.

Sleep(0) entspricht:
- hallo Windows, brich jetzt bitte die Verarbeitung meines Threads ab und arbeite erstmal mit allen anderen Threads weiter.

Je nach dem wie lange es nun dauert, bis der aktuelle Thread wieder dran ist, so lange ist dann auch die Pause.

Windows arbeitet (auf Singel-CPU-Basis) nicht paralell, sondern alle Thread werden für ein paar Millisekunden bearbeitet.

Je nachdem, wieviel ein Thread arbeitet und wie die Thread-/Prozessprioritäten eingestellt sind, hängt davon ab, wievie Zeit und in welchem Intervall, bzw. wie oft Windows den Threads dann verarbeitet.

hathor 10. Jul 2010 17:38

AW: WINDOWS.BEEP für WINDOWS 7
 
Mir ist klar, dass das keine Konstante ist.

Wer die Temperatur der Luft um 16.00 Uhr in Berlin misst, bekommt einen Wert. Man muss nicht immer angeben, womit gemessen worden ist. Ich muss auch nicht die Luftfeuchtigkeit und die Windgeschwindigkeit angeben.
Wenn ich ständig messe, bekomme ich immer einen anderen Wert, abhängig von der Auflösung.

Warum also glauben hier im Forum immer die gleichen Leute, etwas mit immer den gleichen Argumenten kommentieren zu müssen???

In Deinen Zeilen steht nichts Anderes, als dass Du andere Forumsmitglieder für doof hältst!


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:44 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz