VPF::Генерирование звука определённых частот

AndreySoft

Дата 11.10.2003, 18:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 8.10.2003
Где: Железногорск

Репутация: нет
Всего: нет

Чё-то я не понял. И что эта прога делает? По нажатию на Play происходит какой-то кратковременный хрип из колонок, и по нажатию на Stop тоже самое. В ListBox'ы заносится звуковая карта и всё. Может нужно что-то ещё сделать?

AndreySoft

Дата 11.10.2003, 19:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 8.10.2003
Где: Железногорск

Репутация: нет
Всего: нет

Всё OK! Разобрался, оказывается надо было трэкбар 2000 сделать. Всё понятно.

AndreySoft

Дата 11.10.2003, 19:28 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 8.10.2003
Где: Железногорск

Репутация: нет
Всего: нет

А как определить какие частоты соответствуют нотам : до, ре, ми, фа......

stab

Дата 11.10.2003, 22:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 1839
Регистрация: 1.1.2003

Репутация: нет
Всего: 48

Цитата

А теперь вопрос: как сделать двухтональную посылку (ака МКТТ или CCITT)?

а что это?

--------------------

6, 6, 6 - the number of the beast.

stab

Дата 11.10.2003, 23:09 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 1839
Регистрация: 1.1.2003

Репутация: нет
Всего: 48

Цитата

А как определить какие частоты соответствуют нотам : до, ре, ми, фа......

http://physics.nad.ru/rusboard/messages/15221.html

--------------------

6, 6, 6 - the number of the beast.

Shuricksoft

Дата 13.10.2003, 19:11 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 177
Регистрация: 27.3.2002
Где: Odessa, Ukraine

Репутация: нет
Всего: нет

Цитата(cully @ 11.10.2003, 19:02)

Цитата

А теперь вопрос: как сделать двухтональную посылку (ака МКТТ или CCITT)?

а что это?

А это такая система сигнализации у аппаратуры АОН. Подробней тут (читать про МКТТ, DTMF - другая истроия =) ): http://www.cnt.ru/users/radio/phone/doc/tone.htm

stab

Дата 14.10.2003, 18:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 1839
Регистрация: 1.1.2003

Репутация: нет
Всего: 48

Shuricksoft, тогда что-то типа этого, так, кажется, учили:

Код


procedure TForm1.FillBySin(var Buffer: array of Byte; const Freq,
 Amp: Integer; const Time: Cardinal);
var
 i: Cardinal;
 k1, k2: Single;
begin

 k1 := (freq1 * 2 * pi) / 22050;
 k2 := (freq2 * 2 * pi) / 22050;

 for i := 0 to  Cardinal(Length(Buffer)) - 1 do
   Buffer[i] := Round(2*Amp * Sin((Time + i) * ((k1 + k2) / 2)) *  Cos((Time + i) * ((k1 - k2) / 2))) + 128;

end;

--------------------

6, 6, 6 - the number of the beast.

Shuricksoft

Дата 14.10.2003, 20:03 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 177
Регистрация: 27.3.2002
Где: Odessa, Ukraine

Репутация: нет
Всего: нет

cully, не, что-то не то... Если убрать вторую частоту (поставить 0), то первая звучит прерывисто, а если наоборот - вообще фигня :-/ Оптимизировать не могу, так как не совсем понимаю, как высчитывать нужное нам значение... Может, приглядишься, найдёшь, что неправильно? =)

stab

Дата 15.10.2003, 10:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 1839
Регистрация: 1.1.2003

Репутация: нет
Всего: 48

много глюков иправил

и как все раньше работало? ;)

прикольно, что при близких частотах даже биения наблюдаются, т.е. все верно замоделированно.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  mmsystem, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    DevList: TListBox;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    OutList: TListBox;
    StaticText3: TStaticText;
    InList: TListBox;
    PlayBut: TButton;
    StaticText4: TStaticText;
    MixList: TListBox;
    FreqTrack1: TTrackBar;
    Freq1Text: TStaticText;
    StopBut: TButton;
    FreqTrack2: TTrackBar;
    Freq2Text: TStaticText;
    procedure FormCreate(Sender: TObject);
    procedure PlayButClick(Sender: TObject);
    procedure FreqTrack1Change(Sender: TObject);
    procedure StopButClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure FillByWave(var Buffer: array of Byte; Amp: Integer; const Time: Cardinal; freq1, freq2: Single);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
    buf1, buf2: array[0..2047] of Byte;
    hdr1, hdr2: WAVEHDR;
    DoIt: Boolean;
    ho: HWAVEOUT = 0;
    tm: Cardinal;    

procedure TForm1.FormCreate(Sender: TObject);
var
  acaps: AUXCAPS;
  wocaps: WAVEOUTCAPS;
  wicaps: WAVEINCAPS;
  mcaps: MIXERCAPS;
  dev: Integer;
begin
  for dev := 0 to auxGetNumDevs() - 1 do begin
    auxGetDevCaps(dev, @acaps, SizeOf(AUXCAPS));
    with acaps do begin
      DevList.Items.Add(szPname);
    end;
  end;
  for dev := 0 to waveOutGetNumDevs() - 1 do begin
    waveOutGetDevCaps(dev, @wocaps, SizeOf(WAVEOUTCAPS));
    with wocaps do begin
      OutList.Items.Add(szPname);
    end;
  end;
  for dev := 0 to waveInGetNumDevs() - 1 do begin
    waveInGetDevCaps(dev, @wicaps, SizeOf(WAVEINCAPS));
    with wicaps do begin
      InList.Items.Add(szPname);
    end;
  end;
  for dev := 0 to mixerGetNumDevs() - 1 do begin
    mixerGetDevCaps(dev, @mcaps, SizeOf(MIXERCAPS));
    with mcaps do begin
      MixList.Items.Add(szPname);
    end;
  end;

  OutList.ItemIndex := 0;
  InList.ItemIndex := 0;

  Freq1Text.Caption := IntToStr(FreqTrack1.Position);
  Freq2Text.Caption := IntToStr(FreqTrack2.Position);
end;

function OutCallback(hwo, msg, inst, p1, p2: Integer): Integer; stdcall;
begin
  if msg = WOM_DONE then begin
    if DoIt then
      if p1 = Integer(@hdr1) then begin
        waveOutUnprepareHeader(hwo, @hdr1, SizeOf(WAVEHDR));
        Form1.FillByWave(buf1, 60, tm, Form1.FreqTrack1.Position, Form1.FreqTrack2.Position);
        Inc(tm, Length(buf1));        
        waveOutPrepareHeader(hwo, @hdr1, SizeOf(WAVEHDR));
        waveOutWrite(hwo, @hdr1, SizeOf(WAVEHDR));
      end
      else begin
        waveOutUnprepareHeader(hwo, @hdr2, SizeOf(WAVEHDR));
        Form1.FillByWave(buf2, 60, tm, Form1.FreqTrack1.Position, Form1.FreqTrack2.Position);
        Inc(tm, Length(buf2));
        waveOutPrepareHeader(hwo, @hdr2, SizeOf(WAVEHDR));
        waveOutWrite(hwo, @hdr2, SizeOf(WAVEHDR));
      end
    else begin
      waveOutUnprepareHeader(hwo, @hdr1, SizeOf(WAVEHDR));
      waveOutUnprepareHeader(hwo, @hdr2, SizeOf(WAVEHDR));
      waveOutReset(hwo);
      waveOutClose(hwo);
      ho := 0;
    end;
  end;
  Result := 0;
end;

procedure TForm1.PlayButClick(Sender: TObject);
var
  fmt: tWAVEFORMATEX;
begin
  DoIt := True;
  with fmt do begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 22050;
    nAvgBytesPerSec := 22050;
    nBlockAlign := 1;
    wBitsPerSample := 8;
  end;

  if waveOutOpen(@ho, OutList.ItemIndex, @fmt, Cardinal(@OutCallback), 5, CALLBACK_FUNCTION {or WAVE_ALLOWSYNC}) = MMSYSERR_NOERROR then begin
    tm := 0;
    Form1.FillByWave(buf1, 60, tm, Form1.FreqTrack1.Position, Form1.FreqTrack2.Position);
    Inc(tm, Length(buf1));
    with hdr1 do begin
      lpData := @buf1;
      dwBufferLength := Length(buf1);
      dwFlags := 0;
    end;
    waveOutPrepareHeader(ho, @hdr1, SizeOf(WAVEHDR));
    waveOutWrite(ho, @hdr1, SizeOf(WAVEHDR));

    Form1.FillByWave(buf2, 60, tm, Form1.FreqTrack1.Position, Form1.FreqTrack2.Position);
    Inc(tm, Length(buf2));
    with hdr2 do begin
      lpData := @buf2;
      dwBufferLength := Length(buf2);
      dwFlags := 0;
    end;
    waveOutPrepareHeader(ho, @hdr2, SizeOf(WAVEHDR));
    waveOutWrite(ho, @hdr2, SizeOf(WAVEHDR));
  end
  else
    Beep;
end;

procedure TForm1.FreqTrack1Change(Sender: TObject);
begin
  Freq1Text.Caption := IntToStr(FreqTrack1.Position);
  Freq2Text.Caption := IntToStr(FreqTrack2.Position);
end;

procedure TForm1.FillByWave(var Buffer: array of Byte; Amp: Integer; const Time: Cardinal; freq1, freq2: Single);
var
  i: Cardinal;
  k1, k2: Single;
begin
  k1 := (freq1 * 2 * pi) / 22050;
  k2 := (freq2 * 2 * pi) / 22050;

  for i := 0 to Cardinal(Length(Buffer)) - 1 do
    Buffer[i] := Round(Amp * (Sin((Time + i) * k1) + Sin((Time + i) * k2))) + 128;
end;


procedure TForm1.StopButClick(Sender: TObject);
begin
  DoIt := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DoIt := False;
end;

end.

object Form1: TForm1
  Left = 298
  Top = 304
  BorderStyle = bsDialog
  Caption = 'WAVE'
  ClientHeight = 346
  ClientWidth = 489
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object DevList: TListBox
    Left = 8
    Top = 32
    Width = 153
    Height = 100
    ItemHeight = 13
    TabOrder = 0
  end
  object StaticText1: TStaticText
    Left = 16
    Top = 8
    Width = 64
    Height = 17
    Caption = 'aux devices:'
    TabOrder = 1
  end
  object StaticText2: TStaticText
    Left = 176
    Top = 8
    Width = 91
    Height = 17
    Caption = 'wave out devices:'
    TabOrder = 2
  end
  object OutList: TListBox
    Left = 168
    Top = 32
    Width = 153
    Height = 100
    ItemHeight = 13
    TabOrder = 3
  end
  object StaticText3: TStaticText
    Left = 336
    Top = 8
    Width = 84
    Height = 17
    Caption = 'wave in devices:'
    TabOrder = 4
  end
  object InList: TListBox
    Left = 328
    Top = 32
    Width = 153
    Height = 100
    ItemHeight = 13
    TabOrder = 5
  end
  object PlayBut: TButton
    Left = 207
    Top = 144
    Width = 75
    Height = 25
    Caption = 'Play'
    TabOrder = 6
    OnClick = PlayButClick
  end
  object StaticText4: TStaticText
    Left = 16
    Top = 144
    Width = 36
    Height = 17
    Caption = 'mixers:'
    TabOrder = 7
  end
  object MixList: TListBox
    Left = 8
    Top = 168
    Width = 153
    Height = 100
    ItemHeight = 13
    TabOrder = 8
  end
  object FreqTrack1: TTrackBar
    Left = 1
    Top = 280
    Width = 400
    Height = 25
    Max = 20000
    Min = 20
    Orientation = trHorizontal
    Frequency = 1
    Position = 1000
    SelEnd = 0
    SelStart = 0
    TabOrder = 9
    TickMarks = tmBottomRight
    TickStyle = tsNone
    OnChange = FreqTrack1Change
  end
  object Freq1Text: TStaticText
    Left = 416
    Top = 284
    Width = 16
    Height = 17
    Caption = '    '
    TabOrder = 10
  end
  object StopBut: TButton
    Left = 207
    Top = 176
    Width = 75
    Height = 25
    Caption = 'Stop'
    TabOrder = 11
    OnClick = StopButClick
  end
  object FreqTrack2: TTrackBar
    Left = 1
    Top = 312
    Width = 400
    Height = 25
    Max = 20000
    Min = 20
    Orientation = trHorizontal
    Frequency = 1
    Position = 1001
    SelEnd = 0
    SelStart = 0
    TabOrder = 12
    TickMarks = tmBottomRight
    TickStyle = tsNone
    OnChange = FreqTrack1Change
  end
  object Freq2Text: TStaticText
    Left = 416
    Top = 316
    Width = 13
    Height = 17
    Caption = '   '
    TabOrder = 13
  end
end

2 Vit, вроде настал тот момент когда это уже можно в faq засунуть

--------------------

6, 6, 6 - the number of the beast.

Shuricksoft

Дата 18.10.2003, 21:27 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 177
Регистрация: 27.3.2002
Где: Odessa, Ukraine

Репутация: нет
Всего: нет

cully, круто!!! =) Спасибо! =) Теперь буду организовывать непосредственно формирование кода МКТТ, но это уже проще =)

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »