Вопрос для опытных от чайника, начинающего изучать Delphi (надеюсь, не сложный ) : как реализовать простой звук определённой частоты и длительности с выводом на колонки [и на динамик], а также простую задержку на нужное время. Смотрел во всяких книгах и хелпах - нашёл лишь стандартные, воспр-е wav и beep. Узнал, что beep - две, но ту, что с параметрами, не смог использовать
Member
Статус: Не в сети Регистрация: 03.01.2004 Откуда: Питер
vis11 писал(а):
как реализовать простой звук определённой частоты и длительности с выводом на колонки
Код:
uses MMSystem;
type TVolumeLevel = 0..127;
procedure MakeSound(Frequency {Hz}, Duration {mSec}: Integer; Volume: TVolumeLevel); {writes tone to memory and plays it} var WaveFormatEx: TWaveFormatEx; MS: TMemoryStream; i, TempInt, DataCount, RiffCount: integer; SoundValue: byte; w: double; // omega ( 2 * pi * frequency) const Mono: Word = $0001; SampleRate: Integer = 11025; // 8000, 11025, 22050, or 44100 RiffId: string = 'RIFF'; WaveId: string = 'WAVE'; FmtId: string = 'fmt '; DataId: string = 'data'; begin if Frequency > (0.6 * SampleRate) then begin ShowMessage(Format('Sample rate of %d is too Low to play a tone of %dHz', [SampleRate, Frequency])); Exit; end; with WaveFormatEx do begin wFormatTag := WAVE_FORMAT_PCM; nChannels := Mono; nSamplesPerSec := SampleRate; wBitsPerSample := $0008; nBlockAlign := (nChannels * wBitsPerSample) div 8; nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; cbSize := 0; end; MS := TMemoryStream.Create; with MS do begin {Calculate length of sound data and of file data} DataCount := (Duration * SampleRate) div 1000; // sound data RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) + SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; // file data {write out the wave header} Write(RiffId[1], 4); // 'RIFF' Write(RiffCount, SizeOf(DWORD)); // file data size Write(WaveId[1], Length(WaveId)); // 'WAVE' Write(FmtId[1], Length(FmtId)); // 'fmt ' TempInt := SizeOf(TWaveFormatEx); Write(TempInt, SizeOf(DWORD)); // TWaveFormat data size Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // WaveFormatEx record Write(DataId[1], Length(DataId)); // 'data' Write(DataCount, SizeOf(DWORD)); // sound data size {calculate and write out the tone signal}// now the data values w := 2 * Pi * Frequency; // omega for i := 0 to DataCount - 1 do begin SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate)); // wt = w * i / SampleRate Write(SoundValue, SizeOf(Byte)); end; {now play the sound} sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC); MS.Free; end; end;
// How to call the function:
procedure TForm1.Button1Click(Sender: TObject); begin MakeSound(1200, 1000, 60); end;
(c) DelphiWorld
vis11 писал(а):
а также простую задержку на нужное время.
sleep({msec});
_________________ Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)
Lord_of_Darkness , _SGK , спасибо огромное! Работоет всё. Может ещё подскажете нормальный справочник, чтобы мне не соваться с вопросами, ответ на которые может оказаться вида " Windows.Beep(5000, 100); " ?
Всё бы хорошо, да возникла одна проблема при исполнении следующего:
Код:
Procedure TForm1.k ; Begin MakeSound(1200, 100, 60); End;
procedure TForm1.Button1Click (Sender: TObject); begin k; k; k; k end;
В результате звучат 4 отдельных сигнала с приличной паузой. Можно ли от неё избавиться, чтобы задавать интервал между сигналами самому с высокой точностью?
В результате звучат 4 отдельных сигнала с приличной паузой.
Понятие приличного всегда было очень относительно. Некоторые и публичное ковыряние в носу приличным считают , ессно, если костюмчик сидит. В вашем вопросе, на мой взгляд, лучше оперировать цифрами.
Пауза будет в любом случае.
Вы хоть интереса ради посмотрите на реализацию sndPlaySound.
Или сохраните MemoryStream в wav-файл и проиграйте любым доступным проигрывателем, хоть тем же Winamp или WMP к примеру в режиме включенного повторения. Обратите внимание на паузы и будете сильно удивлены.
Да и вообще неясно, зачем четырежды повторять один и тот же звук, если можно просто увеличить продолжительность звучания.
Зато, если проигрывать разные звуки то, можно получить ожидаемый эффект.
Код:
procedure TForm1.Button1Click(Sender: TObject); var i: Integer; begin for i:= 1 to 50 do MakeSound(i * 50, 50, 80); end;
_SGK там просто мемористрим создается и убивается и если так повторять, то будет задержка, т.к. на эти операции требуется время.
ИМХО не все так просто. Если слегка видоизменить (разнести) код приведенной вами процедуры, то пауза никуда не девается - разрыв при воспроизведении слышен явно. Смотрите сами:
Код:
unit SndUtl; // Слегка модифицированный вариант от Lord_of_Darkness
function SndCreate(MS: TMemoryStream; Frequency, Duration: Integer; Volume: TVolumeLevel): Boolean; var WaveFormatEx: TWaveFormatEx; i, TempInt, DataCount, RiffCount: integer; SoundValue: byte; w: double; const SampleRate: Integer = 44100; resourcestring RiffId = 'RIFF'; WaveId = 'WAVE'; FmtId = 'fmt '; DataId = 'data'; begin Result:= True; if Frequency > (0.6 * SampleRate) then begin Result:= False; Exit; end; with WaveFormatEx do begin wFormatTag:= WAVE_FORMAT_PCM; nChannels:= $0001; //Mono nSamplesPerSec:= SampleRate; wBitsPerSample:= $0008; nBlockAlign:= (nChannels * wBitsPerSample) div 8; nAvgBytesPerSec:= nSamplesPerSec * nBlockAlign; cbSize:= 0; end; DataCount:= (Duration * SampleRate) div 1000; RiffCount:= Length(WaveId) + Length(FmtId) + SizeOf(DWORD) + SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; TempInt:= SizeOf(TWaveFormatEx); w:= 2 * Pi * Frequency; with MS do begin Write(RiffId[1], 4); Write(RiffCount, SizeOf(DWORD)); Write(WaveId[1], Length(WaveId)); Write(FmtId[1], Length(FmtId)); Write(TempInt, SizeOf(DWORD)); Write(WaveFormatEx, SizeOf(TWaveFormatEx)); Write(DataId[1], Length(DataId)); Write(DataCount, SizeOf(DWORD)); for i:= 0 to DataCount - 1 do begin SoundValue:= 127 + trunc(Volume * sin(i * w / SampleRate)); Write(SoundValue, SizeOf(Byte)); end; end; end;
procedure SndPlay(MS: TMemoryStream); begin sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC); end;
end.
Собсно ниже, за счет лишних телодвижений - циклов и происходит разделение задач - сначала создается, потом проигрывается, цель которого показать шо слитный звук при воспроизведении фиг получишь.
Код:
procedure TForm1.Button1Click(Sender: TObject); var arrSnd: array of TMemoryStream; i: Integer; begin SetLength(arrSnd, 5); for i:= low(arrSnd) to High(arrSnd) do // только Создаем и заполняем. begin arrSnd[i]:= TMemoryStream.Create; SndCreate(arrSnd[i], 1000, 500, 85); end; arrSnd[0].SaveToFile('C:\1.wav'); // Можно погонять на внешнем проигрывателе в цикле. ;) for i:= low(arrSnd) to High(arrSnd) do // только Воспроизводим SndPlay(arrSnd[i]); for i:= low(arrSnd) to High(arrSnd) do // только Освобождаем arrSnd[i].Free; // Дурь конечно, но наглядно. :))) end;
неясно, зачем четырежды повторять один и тот же звук
Всё просто. Существует много простых программ - генераторов кода Морзе. Но везде имеются какие-либо недостатки. Вот я и решил попробовать создать такую прогу сам. Конечно, на совершенство она не будет претендовать, при моём-то опыте (вернее, его отсутствии ). Но мне показалось, что это не так уж сложно, тем более что такое я делал ранее на паскале, но с системным динамиком.
_SGK писал(а):
Понятие приличного всегда было очень относительно.
Порядка 30 мс. или около того (на глазок ) . Если бы это было в пределах 5 мс., я бы не беспокоился.
А можно как-нибудь измерить эту паузу? Я бы тогда подогнал всё как надо.
var
Form1: TForm1;
x, // êîøêè
n, // ìûøêè/êîøêè
m: integer; //êîøêè è ìûøêè âìåñòå
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
x := random(11);
n := random(51);
m := x*(n+1);
Edit1.Text := IntToStr(n);
Edit2.Text := IntToStr(m);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
x := random(11);
n := random(51);
m := x*(n+1);
Edit1.Text := IntToStr(n);
Edit2.Text := IntToStr(m);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ck, // kolichestvo koshek
cm, // kolichestvo mishek
code1, code2: integer; // vspomogatelnie peremennie v val
begin
Val(Edit3.Text, ck, code1); // chtenie ck.
Val(Edit4.Text, cm, code2); // chtenie cm.
if (code1<>0) or (code2<>0) then//Åñëè õîòü îäíà ïîïûòêà ÷òåíèÿ è ïðåîáðàç. íåóäà÷íàÿ, òî
Label9.Caption := 'Âåäèòå öåëûå ÷èñëà!'
else begin
if (ck = x) and (cm = n*x) then // ïðîâåðÿåì ïðàâèëüíîñòü îòâåòà è
else Label9.Caption := 'à âîò è íåò!'
end;
end;
end. Добавлено спустя 1 минуту, 12 секунд Блин русские буквы не пописались , но это неважно
_________________ - Что-то дурно мне, пойду-ка я к окну
- Ну иди, какни немного, я подожду..
Member
Статус: Не в сети Регистрация: 05.01.2003 Откуда: Москва Фото: 2
NachinaushiyOver Что именно за пустой экран? Просто абсолютно пустая форма или что? Судя по описанию у тебя должны быть кнопки, тексты и строки для редактирования.
_________________ Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!
Member
Статус: Не в сети Регистрация: 17.11.2006 Откуда: Нижний Новгород
Вот в том то и прикол. Там кнопки строки и тд. А когда компилируешь только серый фон и даже названия сверху нету! такое появилось когда добавил:
procedure TForm1.Button2Click(Sender: TObject);
var
ck, // kolichestvo koshek
cm, // kolichestvo mishek
code1, code2: integer; // vspomogatelnie peremennie v val
begin
Val(Edit3.Text, ck, code1); // chtenie ck.
Val(Edit4.Text, cm, code2); // chtenie cm.
if (code1<>0) or (code2<>0) then//Åñëè õîòü îäíà ïîïûòêà ÷òåíèÿ è ïðåîáðàç. íåóäà÷íàÿ, òî
Label9.Caption := 'Âåäèòå öåëûå ÷èñëà!'
else begin
if (ck = x) and (cm = n*x) then // ïðîâåðÿåì ïðàâèëüíîñòü îòâåòà è
else Label9.Caption := 'à âîò è íåò!'
end;
end;
_________________ - Что-то дурно мне, пойду-ка я к окну
- Ну иди, какни немного, я подожду..
Member
Статус: Не в сети Регистрация: 05.01.2003 Откуда: Москва Фото: 2
NachinaushiyOver А ты попробуй текст убрать и посмотреть что получиться. Просто что-то тут мягко говоря не так - код нормальный и не должно из-за него глючить
_________________ Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!
Member
Статус: Не в сети Регистрация: 17.11.2006 Откуда: Нижний Новгород
Я переписал программу в новой форме и юните, терь работает Спасибо всем! Это моя первая программа полезная! Добавлено спустя 4 минуты, 47 секунд По ходу деля вопрос появился: сильно ли отличается Borland Delphi 2006 от Delphi 6? я имею ввиду по качеству готовой программы, ну там работоспособность, совместимость с новыми ОСями.
_________________ - Что-то дурно мне, пойду-ка я к окну
- Ну иди, какни немного, я подожду..
Member
Статус: Не в сети Регистрация: 05.01.2003 Откуда: Москва Фото: 2
NachinaushiyOver Начиная с 2005 Дельфи уж очень стал тормознутый интерфейс. А потом просто бесит, что палитру компонентов сделали так же парашно, как в визуал студио.
_________________ Устав традиций нужно соблюдать, Хоть и не раз ответят вам отказом: Конечно, баба может и не дать, Но предложить ты ей всегда обязан!
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2
Вы не можете начинать темы Вы не можете отвечать на сообщения Вы не можете редактировать свои сообщения Вы не можете удалять свои сообщения Вы не можете добавлять вложения