Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.09.08;
Скачать: CL | DM;

Вниз

Beep на спикер   Найти похожие ветки 

 
ruslanyd   (2003-06-26 17:05) [0]

Подскажите, плз, как в win2000 подать сигнал на спикер?


 
Skier ©   (2003-06-26 17:12) [1]

А эта...Beep ?


 
Игорь Шевченко ©   (2003-06-26 17:18) [2]

Skier © (26.06.03 17:12)

...на звуковую карту...


 
Skier ©   (2003-06-26 17:24) [3]

Мда...не туда...


 
Wizard_Ex ©   (2003-06-26 18:04) [4]


procedure Delay(msecs : Longint);
var
FirstTick:Longint;
begin
FirstTick:=GetTickCount;
repeat
Application.ProcessMessages;
{для того чтобы не "завесить" Windows}
until GetTickCount - FirstTick >= msecs;
end;

function IsNT : boolean;
begin
case Win32Platform of
VER_PLATFORM_WIN32_NT: Result:=True;
else Result:=False;
end;
end;
procedure myBeep(Freq, Duration: Integer);
begin
if IsNT then begin windows.Beep(Freq, Duration); exit end;
// ;---рарешение канала 2 установкой порта B
asm
IN AL, 61h //чтение его значения
OR AL,3 //установка двух младших битов
OUT 61h, AL //посылаем байт в порт B
//;---установка регистров ввода/вывода
MOV AL, 182 // для канала 2
OUT 43h, AL //засылка в командный регистр
//---засылка счетчика в задвижку
sub edx, edx
mov eax, 1190000
xor ecx, ecx //очистка от "мусора"
mov ecx, Freq
div ecx //счетчик = 1190000/Freq
OUT 42h, AL //посылаем младший байт
MOV AL, AH //сдвигаем младший байт в AL
OUT 42h, AL //посылаем старший байт
( Duration)

procedure Delay(msecs : Longint);
var
FirstTick:Longint;
begin
FirstTick:=GetTickCount;
repeat
Application.ProcessMessages;
{для того чтобы не "завесить" Windows}
until GetTickCount - FirstTick >= msecs;
end;

function IsNT : boolean;
begin
case Win32Platform of
VER_PLATFORM_WIN32_NT: Result:=True;
else Result:=False;
end;
end;
procedure myBeep(Freq, Duration: Integer);
begin
if IsNT then begin windows.Beep(Freq, Duration); exit end;
// ;---рарешение канала 2 установкой порта B
asm
IN AL, 61h //чтение его значения
OR AL,3 //установка двух младших битов
OUT 61h, AL //посылаем байт в порт B
//;---установка регистров ввода/вывода
MOV AL, 182 // для канала 2
OUT 43h, AL //засылка в командный регистр
//---засылка счетчика в задвижку
sub edx, edx
mov eax, 1190000
xor ecx, ecx //очистка от "мусора"
mov ecx, Freq
div ecx //счетчик = 1190000/Freq
OUT 42h, AL //посылаем младший байт
MOV AL, AH //сдвигаем младший байт в AL
OUT 42h, AL //посылаем старший байт
end;
Delay(Duration);
asm //выключение звука
IN AL, 61h //получаем байт из порта B
AND AL, 252 //сбрасываем два младших бита
OUT 61h, AL //посылаем байт обратно
end;
end;



 
Wizard_Ex ©   (2003-06-26 18:06) [5]

procedure Phone;
begin
MyBeep(560,25);
Delay(10);
MyBeep(800,55);
MyBeep(770,20);
Delay(5);
MyBeep(560,25);
Delay(10);
MyBeep(800,55);
MyBeep(770,20);
Delay(5);
MyBeep(560,25);
Delay(10);
MyBeep(800,55);
MyBeep(770,20);
Delay(5);
MyBeep(560,25);
Delay(10);
MyBeep(800,55);
MyBeep(770,20);
Delay(5);
end;


 
Wizard_Ex ©   (2003-06-26 18:09) [6]

MyBeep работает в W9x, NT, W2K, WXP
в любых окнах в общем


 
ruslanyd   (2003-06-26 18:42) [7]

Всем спасибо
Нашел тот же код, что предоставил Wizard_Ex :)
.... только без комментариев



Страницы: 1 вся ветка

Текущий архив: 2003.09.08;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.019 c
7-24717
lightix
2003-06-24 22:02
2003.09.08
Программно обновить список принтеров


6-24574
sasha1
2003-07-03 15:42
2003.09.08
Net


1-24545
Jineura
2003-08-26 16:44
2003.09.08
tSendMail в Delphi7


8-24554
Navi
2003-05-11 07:37
2003.09.08
Цветной TMetafile в черно-белый


14-24640
Прохожий
2003-08-21 08:32
2003.09.08
---|Ветка была без названия|---