Форум: "Система";
Текущий архив: 2003.09.22;
Скачать: [xml.tar.bz2];
ВнизРабота с системным динамиком под любой 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;
Страницы: 1 вся ветка
Форум: "Система";
Текущий архив: 2003.09.22;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.012 c