Форум: "Потрепаться";
Текущий архив: 2003.07.31;
Скачать: [xml.tar.bz2];

Вниз

Функция звука через динамик (тон+длительность) для W9x ?   Найти похожие ветки 

← →
Zezik   (2003-07-14 23:58) [0]

Может кто нить знает Функцию звука через динамик, но чтоб параметры были тон и длительность и чтоб в W9x работала? А то для NT есть, а для W9x нету ... я уже запарился, блин... хоть на асме пиши.
Всем ответившим заранее СПАСИБА!!!

---

← →
Vlad Oshin   (2003-07-15 08:02) [1]

procedure TForm1.mybeep(Tone: Word; Delay: Integer);
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;
sleep(Delay);
asm
in al, 61H
and al, 0fcH
out 61H, al
end;
end;

от Озерова

---

← →
Anatoly Podgoretsky   (2003-07-15 09:26) [2]

Это процедура немного с ошибкой, но в местном Чаво есть правильная или в Чаво из Фидо: http://podgoretsky.com/ftp/Language/nps/ru.delphi.html#N112

---

← →
Wizard_Ex   (2003-07-15 16:57) [3]

procedure Delay(msecs : Longint);
var
FirstTick:Longint;
begin
FirstTick:=GetTickCount;
repeat
Application.ProcessMessages;
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;

procedure Call;
begin
MyBeep(880,100);
Delay(10);
MyBeep(570,100);
Delay(20);
Delay(200);
MyBeep(880,100);
Delay(10);
MyBeep(570,100);
Delay(20);
end;

---

← →
Song   (2003-07-15 21:56) [4]


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(aFreq, aDelay: Integer);
Procedure DoSound(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 Delay(MSecs: Integer);
Var FirstTickCount: LongInt;
Begin
FirstTickCount := GetTickCount;
Repeat Sleep(1); Until ((GetTickCount - FirstTickCount) >= Longint(MSecs));
End;

Begin
IF Win32Platform=VER_PLATFORM_WIN32_NT then Windows.Beep(aFreq, aDelay) else
Begin
DoSound(aFreq);
Delay(aDelay);
End;
End;

procedure NoSound;
Var Value: Word;
Begin
IF not (Win32Platform=VER_PLATFORM_WIN32_NT) then
Begin
Value:=GetPort($61) and $FC;
SetPort($61,Value);
End;
end;

Procedure TNewSp5Form.MakeSound(Freq,Delay: Integer);
Begin
Sound(Freq,Delay);
NoSound;
End;


---

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

Форум: "Потрепаться";
Текущий архив: 2003.07.31;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.009 c