| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Музыка через системный динамик

Yad ©   (2002-11-24 16:56:00) 

Ну неужели никто не знает, как работать с системным динамиком?

---

Холод   (2002-11-28 15:31:00) [1]

Можно использовать это:

procedure Sound(Key:Word);
begin
asm
mov ax,Key {Загрузили в AX сканкод клавиши}
mov bl,al
mov al,11111111b
out 43h,al
mov ah,bl
mov al,bl
shr ax,1
out 42h,al
mov al,ah
out 42h,al
in al,61h
or al,3
out 61h,al
end;
end;

как параметр KEY передается код клавиши.

Чтобы прекратить звук осылай 0 в порт $61

---

DarkStorm   (2002-11-26 20:46:00) [2]

Можно так:

// Вывод в порт внешнего устройства с адресом-ADR байта-data
procedure OutPort(adr: word; data: byte);
begin
asm
mov dx,adr
mov al,data
out dx,al
end;
end;

// Ввод из порта внешнего устройства с адресом-ADR
function InPort(adr: word):byte;
begin
asm
mov dx,adr
in al,dx
mov @result,al
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
b: byte;
n,m: word;
begin
b:=Inport($61);
for n:=1 to 200 do
begin
{n:=200 - длительность звучания}
{m:=700 - частота звучания}
for m:=1 to 700 do
Outport($61,b and not(2));
{установить 2-ой бит в 0}
for m:=1 to 700 do
Outport($61,b or 2);
{установить 2-ой бит в 1}
end;
end;

---

Владимир Михайлович   (2002-11-26 01:16:00) [3]

У меня тут компонентик завалялся, вроде все ясно...

unit PCSpk;
interface
uses
Classes, WinProcs, Forms;
type
TPCSpeaker = class(TComponent)
private
{ Private declarations }
procedure NoSound;
procedure Sound(Freq: Word);
procedure SetPort(address, value: Word);
function GetPort(address: Word): Word;
protected
{ Protected declarations }
public
{ Public declarations }
procedure Delay(MSecs: Integer);
procedure Play(Freq: Word; MSecs: Integer);
procedure Stop;
published
{ Published declarations }
end;
procedure Register;
implementation

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

procedure TPCSpeaker.Sound(Freq: Word);
var
B: Word;
begin
if Freq > 18 then begin
Freq := Word(1193181 div LongInt(Freq));

B := GetPort($61);

if (B and 3) = 0 then begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;

SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;

procedure TPCSpeaker.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages; {allowing access to other controls, etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;

procedure TPCSpeaker.Play(Freq: Word; MSecs: Integer);
begin
Sound(Freq);
Delay(MSecs);
NoSound;
end;

procedure TPCSpeaker.Stop;
begin
NoSound;
end;

procedure TPCSpeaker.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 TPCSpeaker.GetPort(address: Word): Word;
var
bValue: Byte;
begin
asm
mov DX, address
in AL, DX
mov bValue, AL
end;
result := bValue;
end;

procedure Register;
begin
RegisterComponents("MyLib", [TPCSpeaker]);
end;

end.

---

pasha676   (2002-11-25 10:03:00) [4]

В детстве я просто через определенное время посылал 0-1 в определенный порт. Читай книжки по аппаратке писюков. Что то было точно на эту тему у Джордейна. Для 2000 выньдоса способ впрочем точно не приемлимый.

---

Dimka Maslov   (2002-11-25 09:44:00) [5]

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

---

Крот   (2002-11-25 06:31:00) [6]

Может быть Windows.Beep?

---

Наверх