AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

WINDOWS.BEEP für WINDOWS 7

Ein Thema von hathor · begonnen am 9. Jul 2010 · letzter Beitrag vom 11. Jul 2010
Antwort Antwort
Seite 1 von 2  1 2      
hathor
(Gast)

n/a Beiträge
 
#1

WINDOWS.BEEP für WINDOWS 7

  Alt 9. Jul 2010, 11:10
Delphi-Version: 2007
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.
Angehängte Dateien
Dateityp: zip WindowsBeep.zip (223,2 KB, 65x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#2

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 9. Jul 2010, 18:00
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 ?
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu
Online

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.139 Beiträge
 
Delphi 12 Athens
 
#3

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 9. Jul 2010, 18:39
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)
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu ( 9. Jul 2010 um 18:41 Uhr)
  Mit Zitat antworten Zitat
blackfin
(Gast)

n/a Beiträge
 
#4

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 9. Jul 2010, 22:54
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


Geändert von blackfin ( 9. Jul 2010 um 23:06 Uhr)
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#5

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 06:03
@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.
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#6

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 06:06
Wäre es so:
Delphi-Quellcode:
function Beep(Freq, Duration: cardinal): Bool;
begin
  Result := WindowsBeep(Freq, Duration) = S_OK;
  sleep(0);
end;
nicht besser ?
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; ?

Geändert von hathor (10. Jul 2010 um 06:15 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#7

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 11:01
"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.)
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#8

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 12:06
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';

Geändert von hathor (10. Jul 2010 um 12:34 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu
Online

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.139 Beiträge
 
Delphi 12 Athens
 
#9

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 17:04
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (10. Jul 2010 um 17:09 Uhr)
  Mit Zitat antworten Zitat
hathor
(Gast)

n/a Beiträge
 
#10

AW: WINDOWS.BEEP für WINDOWS 7

  Alt 10. Jul 2010, 17:38
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!

Geändert von hathor (10. Jul 2010 um 17:40 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:33 Uhr.
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