PC Speaker

Искам да възпроизвеждам звук с различна честота през PC Speaker-a, а Beep-a и МеssageBeep-a не ми вършат работа...Някой може ли да помогне?

Ne znam tuk ima li ogranichenie na razmera na otgoworite (mai niama):

unit UtilsSpkBeep;

interface

const
flSoundEnabled: boolean = true;

{}procedure Music1;
{}procedure Music2;

{}procedure SoundErrKey;
{}procedure Sound(Frequency, Duration: Integer);
{}procedure SoundFl(Frequency, Duration: Integer);

Const
Music1_Len=66;
//частоты
Music1_Frec : array[1..Music1_Len] of word=(
82,82,78,82,
87,82,73,65,
62,65,62,55,
110,104,110,124,
110,104,110,124,0,
131,124,110,104,
124,110,110,98,
93,82,98,87,
82,98,87,82,
73,65,62,55,
55,0,
131,124,110,104,
124,110,110,98,
87,82,98,87,
82,98,87,82,
73,0,
65,62,55,55,0
);
//длительности
Music1_Time : array[1..Music1_Len] of word=(
240,240,250,250,
250,750,250,250,
250,250,250,750,
500,250,250,250,
250,250,250,750,250,
250,250,250,250,
250,750,250,250,
250,250,250,750,
500,250,250,250,
250,250,250,250,
500,250,
250,250,250,250,
250,750,250,250,
250,250,250,750,
500,250,250,250,
250,10,
250,250,250,500,250
);
const
Music2_Len = 88;
Music2_Frec : array[1..Music2_Len] of word=(294,262,233,233,262,233,175,147,156,
156,196,175,147,175,233,262,294,294,294,262,233,262,
294,262,262,294,262,233,233,262,233,175,147,156,
175,196,175,147,175,233,262,294,349,349,294,233,262,
294,262,233,294,349,294,349,349,
294,349,294,349,311,392,311,392,392,
311,392,311,392,466,466,349,349,
294,294,262,233,262,294,349,392,
349,294,233,262,294,262,233,0);
Music2_Time : array[1..Music2_Len] of word=(125,125,250,125,125,125,125,125,125,
125,125,125,125,250,125,125,250,250,125,125,125,125,
250,250,250,125,125,250,125,125,125,125,125,125,
125,125,125,125,250,125,125,250,250,125,125,125,125,
250,250,500,125,250,125,250,250,
125,250,125,500,125,250,125,250,250,
125,250,125,500,250,250,250,250,
250,250,250,125,125,125,250,125,
125,125,125,125,250,250,250,250);

implementation

uses
Windows, SysUtils;

{}procedure Music1;
var
i: integer;
begin
for i:=1 to Music1_Len do begin
Sound(4*Music1_Frec, Music1_Time div 2);
end;
end;
{}procedure Music2;
var
i: integer;
begin
for i:=1 to Music2_Len do begin
Sound(2*Music2_Frec, Music2_Time);
end;
end;

{}procedure SoundErrKey;
begin
SoundFl(2400,20);
SoundFl(1200,10);
SoundFl(2400,20);
end;
{}procedure SoundFl(Frequency, Duration: Integer);
begin
if flSoundEnabled then begin
Sound(Frequency, Duration);
end;
end;
{}procedure Sound(Frequency, Duration: Integer);
asm
cmp Win32Platform, VER_PLATFORM_WIN32_NT
jne @@9X
push edx
push eax
call Windows.Beep
ret
@@9X:
push ebx
push edx
mov bx, ax
mov ax, 34DDh
mov dx, 0012h
cmp dx, bx
jnc @@2
div bx
mov bx, ax
in al, 61h
test al, 3
jnz @@1
or al, 3
out 61h, al
mov al, 0B6h
out 43h, al
@@1:
mov al, bl
out 42h, al
mov al, bh
out 42h, al
call Windows.Sleep
in al, 61h
and al, 0FCh
out 61h, al
jmp @@3
@@2:
pop edx
@@3:
pop ebx
end;


end.

Мерси много...явно ще трябва да понауча малко руски барабар с асемблера

Няма нужда, ползвай паскалските функции, едва ли ще имаш проблем, но питай!

Ами функциите си бачкат, обаче на мен ми се иска да ми просвирва даден звук докато не натисна клавиш който възпроизвежда друг...обаче щом натисна първо някой клавиш и делфито тотално отказва да приеме натискането на следващите клавиши(резултатът е непрекъснато просвирване на първият избран звук).Отново някакви идеи..?

В примерчето
procedure Sound(Frequency, Duration: Integer);
се използва
call Windows.Sleep
а и приложението не получава msg от Windows.
Май трябва сериозна доработка. Няма да мога да ти помогна.

probwaj wmesto sleep da polzwash

application.processmessages;sleep(345);

izobshto e dobra ideq da pozwash wtori thred kojto da komandrish ot VCL main threda... be izobshto...

------------------------------
I got a COMPILER, and I'm not afraid to use it!

S Applicaton.Processmessages se polu4awa po4ti kakto go iskam...obaче сега проблема е ...как да го спра този звук за бога!!...тоест програмата неиска да се затвори по нормалния начин а когато я насиля със CTRl+ALT+DEL тогава за фон си остава последният натрапчив звук от спийкъра..трябва още веднъж да я стартирам и да натисна друг клавиш за който съм указал да ми просвири определен тон за 1ms примерно и чак тогава спира, но иначе искам да кажа че Аpplication.Processmessages не разрешава основния проблем, а именно не се спира изпълнението на даден тон а той просто се замества с друг и най-накрая си остава за фон последния тон...как при натискането на друг клавиш не само да просвири друг тон ами и да се спре изпълнението на текущия????Съжалявам ако съм бил неясен..

За да ти помогна, покажи как си го променил.
Желаетлно е да проверяваш и да не допускаш многократно (реентрантно е термина) стартиране на фрагмента.

Ето я процедурата:

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin
if Key = '1' then begin
while(True) do begin Sound(F,80); // F = 50
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '2' then begin
while(True) do begin Sound(F+100,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '3' then begin
while(True) do begin Sound(F+200,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '4' then begin
while(True) do begin Sound(F+300,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '5' then begin
while(True) do begin Sound(F+400,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '6' then begin
while(True) do begin Sound(F+500,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '7' then begin
while(True) do begin Sound(F+600,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '8' then begin
while(True) do begin Sound(F+700,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '9' then begin
while(True) do begin Sound(F+800,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if Key = '0' then begin
while(True) do begin Sound(F+900,80);
Application.ProcessMessages;
Sleep(5);
end;
end;
if (Key <> '0') and (Key <> '1') and (Key <> '2') and (Key <> '3') and (Key <> '4') and (Key <> '5') and (Key <> '6') and (Key <> '7') and (Key <> '8') and (Key <> '9') then begin
Sound(20,1); // ето тука кодът вътре се игнорира от програмата незнам защо......
end;
end;

Промени в Sound правил ли си?

Не, не го разбирам асемблера...

Естествено, че няма да иска да излезе и че ще остава последният звук. While (true) знаеш ли какво означава?

Разкарай циклите while, както и Application.ProcessMessages и Sleep-овете.
Вместо много if-ове, можеш да използваш Case:

Case Key Of

  '1' : Sound(F, 80);

  '2' : Sound(F + 100, 80);

  .....

  Else Sound(20, 1); // това последното е с продължителност 1 ms 

// и едва ли можеш да го чуеш, да не говорим, 

// че 20Hz е много ниска честота

End;

Между другото, ако ще възпроизвеждаш ноти, те не са точно с кръгли честоти

Мерси за инфото за нотите....обаче с Case-овете няма да стане номера с продължителното просвирване на даден звук(всеки звук ще се просвирва за 80 ms, a ми трябва всеки звук да се възпроизвежда докато не натисна клавиша за друг).Между другото последното(Sound(20,1)) го сложих именно за да се прекрати просвирването на последният избран звук...иначе като излеза от програмата и PC Speaker-a ми свири за фон

Значи, ако не ползваш NT, изглежда, че това:

in al, 61h
and al, 0FCh
out 61h, al

(точно след Sleep-а) спира звука. Ако си направиш няколко експеримента, можеш да създадеш 2 процедури: Sound(Frequency : Integer) и NoSound, както в добрия стар Pascal.

OK..трия го това чудо и при натискане на клавиш различен от 0-9 викам новосъздадената по този начин NoSound(20,x) за да се просвири безкрайно дълъг никакъв звук...е да ама нищо не става...може ли да дадеш насоки че от асемблер нищо не разбирам

Въпроса не е толкова в разбирането на асемблер, колкото в познаването на управлението на Speaker-а чрез in/out през портовете. Не мога да ти кажа повече, без да направя няколко експеримента. Между другото, ти какво искаш всъщност да направиш? Да свириш ноти? Ако преполагаш наличие на звукова карта, чрез стандартното MIDI става много лесно. Мога да се поровя из архивите и да ти изпратя пример.

Ами не...просто да има PC Speaker...не предполагам наличието на звукова карта понеже в даскалото(и по-точно в залата в която сме ние) "такова животно нема"... а и ми беше интересно на паскал няма ли нещо подобно на C-функцията за звук.Наистина нямам никакви познания по въпроса за in\out но не ми трябват ноти...просто експериментирам.