Работа с системным динамиком под любой Windows

← →
Overstep (2003-07-10 12:29) [0]

Подскаите пожалуйста,как я могу получить звук из системного динамика под любой windows. Я использовал messegebeep, а на новых материнках она не хочет работать. Beep, вообще не работает. Желательно регулировать тон и длительность и разумеется для delphi

← →
Dimka Maslov © (2003-07-10 14:41) [1]

http://delphibase.endimus.com/?action=viewfunc&topic=mediasound&id=10124

← →
Overstep (2003-07-10 15:03) [2]

Извините за то что вообще новичек, но я не понял куда эту procedure Sound(Frequency, Duration: Integer); надо вписать, чтобы по нажатию кнопки она пищала?

← →
Overstep (2003-07-10 16:01) [3]

Dimka Maslov, спасибо. Твоя функция у меня не заработала, но зато я рядом другую нашел-она заработала. Я заметил одну особенность, на новых матерях не хотят работать те функции о которых я написал выше.

Вот то что у меня заработало:

Под WinNT/2000/XP вы можете использовать Beep(Tone, Duration) (задавать тон и продолжительность звучания). А под 9.x/Me эта функция не реализована, но можно командовать железом через порты, и сделать универсальную:

unit BeepUnit;

procedure Beep(Tone, Duration: Word); // универсальная - версию виндовса проверяет

procedure Sound(Freq : Word);
procedure NoSound;

procedure SetPort(address, Value:Word);
function GetPort(address:word):word;

implementation

procedure 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 GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;

procedure Sound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(GetPort($61));
if (B and 3) = 0 then begin
SetPort($61, Word(B or 3));
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, Freq shr 8);
end;
end;

procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;

procedure Beep(Tone, Duration: Word);
begin
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT
then Windows.Beep(Tone, Duration)
else begin
Sound(Tone);
( Duration) Dimka Maslov, спасибо. Твоя функция у меня не заработала, но зато я рядом другую нашел-она заработала. Я заметил одну особенность, на новых матерях не хотят работать те функции о которых я написал выше.

Вот то что у меня заработало:

Под WinNT/2000/XP вы можете использовать Beep(Tone, Duration) (задавать тон и продолжительность звучания). А под 9.x/Me эта функция не реализована, но можно командовать железом через порты, и сделать универсальную:

unit BeepUnit;

procedure Beep(Tone, Duration: Word); // универсальная - версию виндовса проверяет

procedure Sound(Freq : Word);
procedure NoSound;

procedure SetPort(address, Value:Word);
function GetPort(address:word):word;

implementation

procedure 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 GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;

procedure Sound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(GetPort($61));
if (B and 3) = 0 then begin
SetPort($61, Word(B or 3));
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, Freq shr 8);
end;
end;

procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;

procedure Beep(Tone, Duration: Word);
begin
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT
then Windows.Beep(Tone, Duration)
else begin
Sound(Tone);
Windows.Sleep(Duration);
NoSound;
end;
end;

end.

← →
Overstep (2003-07-11 11:19) [4]

Извиняюсь, на счет новых матерей я обшибся. Сам не знаю и других запутываю.
И вот ещё я наше коротенький код для Win9x:
>> Издавание звука определённой тональностью и продолжительно

Зависимости: Windows, Forms
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: МИХАИЛ. Е-МЫЛО: klez@bk.ru
Дата: 3 ноября 2002 г.
***************************************************** }

procedure MyBeep(Tone: Word; ADelay: Integer);
{Издавание звука тональностью Tone и
продолжительностью ADelay миллисекунд
Автор: МИХАИЛ. Е-МЫЛО: klez@bk.ru}

procedure Delay(Milliseconds: DWORD);
var FirstTick: DWORD;
begin
FirstTick := GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-FirstTick >= Milliseconds;
end;

begin
asm
mov al, 0b6H
out 43H, al
mov ax, Tone
out 42h, al
ror ax, 8
out 42h, al
in al, 61H
or al, 03H
( ADelay) Извиняюсь, на счет новых матерей я обшибся. Сам не знаю и других запутываю.
И вот ещё я наше коротенький код для Win9x:
>> Издавание звука определённой тональностью и продолжительно

Зависимости: Windows, Forms
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: МИХАИЛ. Е-МЫЛО: klez@bk.ru
Дата: 3 ноября 2002 г.
***************************************************** }

procedure MyBeep(Tone: Word; ADelay: Integer);
{Издавание звука тональностью Tone и
продолжительностью ADelay миллисекунд
Автор: МИХАИЛ. Е-МЫЛО: klez@bk.ru}

procedure Delay(Milliseconds: DWORD);
var FirstTick: DWORD;
begin
FirstTick := GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-FirstTick >= Milliseconds;
end;

begin
asm
mov al, 0b6H
out 43H, al
mov ax, Tone
out 42h, al
ror ax, 8
out 42h, al
in al, 61H
or al, 03H
out 61H, al
end;
Delay(ADelay);
asm
in al, 61H
and al, 0fcH
out 61H, al
end;
end;

Работа с системным динамиком под любой Windows Найти похожие ветки