Искам да възпроизвеждам звук с различна честота през 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;