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

Вниз

Музыка через системный динамик   Найти похожие ветки 

 
Yad   (2002-11-24 16:56) [0]

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


 
Крот ©   (2002-11-25 06:31) [1]

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


 
Dimka Maslov ©   (2002-11-25 09:44) [2]

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


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

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


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

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

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.


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

Можно так:

// Вывод в порт внешнего устройства с адресом-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-28 15:31) [6]

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

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



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

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

Наверх




Память: 0.48 MB
Время: 0.023 c
14-15834
Новый на этоим форуме
2003-01-22 17:03
2003.02.06
Прелести php


3-15398
alex_bredin
2003-01-21 14:19
2003.02.06
Сохранение рез-тов запроса в новой базе


14-15836
Hohol
2003-01-22 16:33
2003.02.06
Справочники .....


3-15471
Calm
2003-01-20 14:42
2003.02.06
Пользователям IBExpress маленький вопросик


1-15628
Ihtiandr
2003-01-29 13:16
2003.02.06
dbEdit