Форум на Исходниках.RU

type

TPlayToneThread = class(TThread) // Поток проигрывания тона

private

Frequency: integer; // Частота тона, Гц

Duration: integer; // Длительность выдачи тона, мс

Count: integer; // Кол-во выдаваемых тонов

protected

procedure Execute; override; // Исполняемая часть

end;

//----------------------------------- Выдать на динамик тон ----------------------------------------

procedure Sound(Frequency, Duration: Integer);

asm

push edx

push eax

mov eax, Win32Platform

cmp eax, VER_PLATFORM_WIN32_NT

jne @@9X

call Windows.Beep

ret

@@9X:

pop eax

pop edx

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;

//--------------------------------- Реализация потока проигрывания тона ----------------------------

procedure TPlayToneThread.Execute;

begin

FreeOnTerminate:=True; // По завершению работы освободить память

while Count>0 do

begin

Sound(Frequency,Duration);

sleep(Duration);

dec(Count);

end;

Terminate; // На всяк случай завершаем поток

end;

//--------------------------------- Процедура завершения потока ------------------------------------

procedure TfmOSC_Buzzer.end_thread(Sender: TObject);

begin

PlayToneThread:=nil; // На всяк случай уничтожаем объект

end;

//-------------------------------------- Проиграть звук --------------------------------------------

procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false);

const

Duration: integer = 75;

var

Frequency, Count: integer;

begin

if cbSound.ItemIndex=0 then exit; // Если нечего проигрывать то выходим

if cbSound.ItemIndex<0 then // Если это *.wav файл

try

sndPlaySound(PChar(cbSound.Text),SND_ASYNC); // то просто проигрываем его

except

end

else begin

Frequency:=StrToInt(Trim(Copy(cbSound.Text,1,4))); // Определили частоту и кол-во гудков

if Odd(cbSound.ItemIndex) then Count:=1 else Count:=2;

if IsWindowsNT then

begin

{

if PlayToneThread<>nil then // Если поток существует

if not PlayToneThread.Terminated then // Да он еще и не завершен

begin

if play then // Если нужно проиграть

PlayToneThread.Terminate // то завершили поток

else // Если событие

exit; // то выходим

end;

PlayToneThread:=TPlayToneThread.Create(true); // Создаем поток

PlayToneThread.OnTerminate:=end_thread; // Задали процедуру завершения

PlayToneThread.Priority:=tpNormal; // Задаем нормальный приоритет потоку

PlayToneThread.Frequency:=Frequency;

PlayToneThread.Duration:=Duration;

PlayToneThread.Count:=Count;

PlayToneThread.Resume; // Запускаем поток

}

{}

while Count>0 do

begin

Sound(Frequency,Duration);

sleep(Duration);

dec(Count);

end;

{}

end

else begin

while Count>0 do

begin

Sound(Frequency,Duration);

sleep(Duration);

dec(Count);

end;