Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.09.2014, 09:59   #1
JekaDefer
Форумчанин
 
Регистрация: 07.04.2009
Сообщений: 112
По умолчанию Помогите разобраться почему не играет...

Привет всем! Пытаюсь вывести звук при помощи DirectSound но почему не играет не соображу никак...
Что в этом коде не так делаю?
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MMSystem, DirectSound, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

type
  Int16 = SmallInt;

const Pi = 3.14159265359;
      BitsPerSample = 16;
      SamplesPerSec = 44100;
      MaxVol = 32767;

var
  DS: IDirectSound;
  DSBuffer: IDirectSoundBuffer;
  BufferSize: LongInt;
  wfx: tWAVEFORMATEX;

{$R *.dfm}

function InitiateDirectSound(hDlg: HWND): Boolean;
var
  DSBPrimary: IDirectSoundBuffer;
  DSBD: TDSBufferDesc;
begin
  DirectSoundCreate(nil, DS, nil);
  DS.SetCooperativeLevel(hDlg, DSSCL_PRIORITY);

  FillChar(DSBD, sizeof(TDSBufferDesc), 0);
  DSBD.dwSize := sizeof(TDSBufferDesc);
  DSBD.dwFlags := DSBCAPS_PRIMARYBUFFER;

  DS.CreateSoundBuffer(DSBD, DSBPrimary, nil);

  FillChar(wfx, sizeof(tWAVEFORMATEX), 0);
  with wfx do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := SamplesPerSec;
    wBitsPerSample := BitsPerSample;
    nBlockAlign := (wBitsPerSample shr 3) * nChannels; // = wBitsPerSample * nChannels / 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  end;

  DSBPrimary.SetFormat(@wfx);

  if Assigned(DSBPrimary) then DSBPrimary := nil;

  Result := True;
end;

procedure FreeDirectSound;
begin
  if Assigned(DSBuffer) then DSBuffer := nil;
  if Assigned(DS) then DS := nil;
end;

procedure CreateStaticBuffer(hDlg: HWND);
var
  DSBD: TDSBufferDesc;
begin
  if Assigned(DSBuffer) then DSBuffer := nil;

  FillChar(DSBD, sizeof(TDSBufferDesc), 0);
  DSBD.dwSize := sizeof(TDSBufferDesc);
  DSBD.dwFlags := DSBCAPS_STATIC;
  DSBD.dwBufferBytes := SamplesPerSec * 1; // 1 - 1 сек
  DSBD.lpwfxFormat := @wfx;

  DS.CreateSoundBuffer(DSBD, DSBuffer, nil);

  BufferSize := DSBD.dwBufferBytes;
end;

procedure FillBuffer(Frequency: Word);
var
  bufferBytes: array [0..SamplesPerSec - 1] of Int16;
  lockedSize: DWORD;
  i: Integer;
  pos, r, value: Double;
begin
  //Запираем буфер
  DSBuffer.Lock(0, BufferSize, @bufferBytes, @lockedSize, nil, nil, 0);

  for i := 0 to lockedSize - 1 do
  begin
    //Определяем цикл, в котором находимся
    pos := Frequency / SamplesPerSec * i;
    //Берём остаток и переводим в радианы
    r := (pos - Int(pos)) * 2 * Pi;
    value := sin(r);

    bufferBytes[i] := Round(value * MaxVol);
  end;

  //Отпираем буфер
  DSBuffer.Unlock(@bufferBytes, lockedSize, nil, 0);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  InitiateDirectSound(Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateStaticBuffer(Handle);
  FillBuffer(440);
  DSBuffer.Play(0, 0, DSBPLAY_LOOPING);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DSBuffer.Stop();
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeDirectSound;
end;

end.
Проект приложил...
Вложения
Тип файла: rar DirectSound.rar (6.9 Кб, 17 просмотров)
JekaDefer вне форума Ответить с цитированием
Старый 10.09.2014, 11:13   #2
JekaDefer
Форумчанин
 
Регистрация: 07.04.2009
Сообщений: 112
По умолчанию

Всё сам разобрался) Ошибка была при заполнении.
надо так было:
Цитата:
procedure FillBuffer(Frequency: Word);
var
bufferBytes: array [0..SamplesPerSec - 1] of Int16;
AudioPtr1: Pointer;
lockedSize: DWORD;
i: Integer;
pos, r, value: Double;
begin
//Запираем буфер
DSBuffer.Lock(0, BufferSize, @AudioPtr1, @lockedSize, nil, nil, 0);

for i := 0 to lockedSize - 1 do
begin
//Определяем цикл, в котором находимся
pos := Frequency / SamplesPerSec * i;
//Берём остаток и переводим в радианы
r := (pos - Int(pos)) * 2 * Pi;
value := sin(r);

bufferBytes[i] := Round(value * MaxVol);
end;
CopyMemory(AudioPtr1, @bufferBytes, lockedSize);
//Отпираем буфер
DSBuffer.Unlock(AudioPtr1, lockedSize, nil, 0);
end;
JekaDefer вне форума Ответить с цитированием
Старый 15.09.2014, 12:14   #3
megastatus
Новичок
Джуниор
 
Регистрация: 15.09.2014
Сообщений: 1
По умолчанию да

да ошибка там был
megastatus вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите разобраться почему не открывается файл?! Foxlin Помощь студентам 1 17.01.2014 14:14
Помогите разобраться почему Far Manager не преобразует файл asm в obj mamba757 Помощь студентам 17 07.11.2013 22:33
Помогите разобраться почему выводит не то.. (СИ) GroMkiY Общие вопросы C/C++ 10 16.10.2013 23:07
Не могу разобраться почему не работает justify F1ernandes HTML и CSS 2 28.01.2010 19:29
text-aling:justify , Не могу разобраться почему не работает F1ernandes HTML и CSS 0 28.01.2010 11:55