У меня к вам такой вопрос: пишу программу, которая должна пищать системным динамиком и одновременно проигрывать музыкальный файл.
Проблема в том, что попытавшись добиться одновременности, использовал потоки, но, наверное, я чего-то в них недопонимаю.
Программа писалась на делфях.
Вот код:
beep.dpr
- Код: Выделить всё
uses
Thread in 'Thread.pas',
Windows, SysUtils, Classes, mmsystem;
var
frequency, duration, count, delay: Integer;
I: Integer;
procedure Play;
var
so: TSyncObj;
begin
so:=TSyncObj.Create(true);
so.Resume;
so.Priority:=tpNormal;
// so.Terminate;
end;
begin
//Если есть флаги частоты и длительности
if (FindCmdLineSwitch('f', ['-'], true) and FindCmdLineSwitch('d', ['-'], true)) then
begin
frequency:=StrToIntDef(ParamStr(2), 2400);
duration:=StrToIntDef(ParamStr(4), 2500);
//если есть флаги числа повторений и задержки
if (FindCmdLineSwitch('c', ['-'], true) and FindCmdLineSwitch('s', ['-'], true)) then
begin
count:=StrToIntDef(ParamStr(6), 1);
delay:=StrToIntDef(ParamStr(8), 0);
for I:=0 to count-1 do
begin
Windows.Beep(frequency, duration);
Play;
sleep(delay)
end;
end
else
begin
Windows.Beep(frequency, duration);
Play;
end;
end
else
begin
if FindCmdLineSwitch('o', ['-'], true) then
begin
Play;
end
else
if FindCmdLineSwitch('h', ['-'], true) then
begin
MessageBox(0, 'Beep ver. 0.1.5', 'About', MB_ICONINFORMATION);
end
else
Windows.Beep(2400, 2500);
end;
end.
Thread.pas
- Код: Выделить всё
unit Thread;
interface
uses
Classes;
type
TSyncObj = class(TThread)
private
{ Private declarations }
procedure Play;
protected
procedure Execute; override;
end;
implementation
uses
Play;
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TSyncObj.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TSyncObj }
procedure TSyncObj.Execute;
begin
{ Place thread code here }
Synchronize(Play);
if Terminated then exit;
end;
procedure TSyncObj.Play;
begin
PlayAlarm;
end;
end.
и Play.pas
- Код: Выделить всё
unit Play;
interface
uses
SysUtils, mmsystem;
procedure PlayAlarm;
implementation
procedure PlayAlarm;
begin
//если есть флаг на проигрывание файла
if FindCmdLineSwitch('o', ['-'], true) then
begin
//если при этом есть флаги на пищалку
if (FindCmdLineSwitch('-f', ['-'], true) and FindCmdLineSwitch('-d', ['-'], true)) then
begin
//и на распределение длительности
if (FindCmdLineSwitch('-c', ['-'], true) and FindCmdLineSwitch('-s', ['-'], true)) then
PlaySound(PChar(ParamStr(10)),0,SND_FILENAME)
else
//просто пищалка
PlaySound(PChar(ParamStr(6)),0,SND_FILENAME)
end
else
//просто проиграть файл
PlaySound(PChar(ParamStr(2)),0,SND_FILENAME)
end;
end;
end.
Заранее спасибо!
И если кто предложит альтернативный, причём кроссплатформенный метод, буду благодарен.
З.Ы.
Писал на fpc, запускалось, но на время исполнения на экране появлялось окно командной строки, что не есть гут.
