Windows

 

 

Code:

uses

MMSystem;

 

function GetMasterMute(

Mixer: hMixerObj;

var Control: TMixerControl): MMResult;

// Returns True on success

var

Line: TMixerLine;

Controls: TMixerLineControls;

begin

ZeroMemory(@Line, SizeOf(Line));

Line.cbStruct := SizeOf(Line);

Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;

Result := mixerGetLineInfo(Mixer, @Line,

   MIXER_GETLINEINFOF_COMPONENTTYPE);

if Result = MMSYSERR_NOERROR then

begin

   ZeroMemory(@Controls, SizeOf(Controls));

   Controls.cbStruct := SizeOf(Controls);

   Controls.dwLineID := Line.dwLineID;

   Controls.cControls := 1;

   Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;

   Controls.cbmxctrl := SizeOf(Control);

   Controls.pamxctrl := @Control;

   Result := mixerGetLineControls(Mixer, @Controls,

     MIXER_GETLINECONTROLSF_ONEBYTYPE);

end;

end;

 

procedure SetMasterMuteValue(

Mixer: hMixerObj;

Value: Boolean);

var

MasterMute: TMixerControl;

Details: TMixerControlDetails;

BoolDetails: TMixerControlDetailsBoolean;

Code: MMResult;

begin

Code := GetMasterMute(0, MasterMute);

if Code = MMSYSERR_NOERROR then

begin

   with Details do

   begin

     cbStruct := SizeOf(Details);

     dwControlID := MasterMute.dwControlID;

     cChannels := 1;

     cMultipleItems := 0;

     cbDetails := SizeOf(BoolDetails);

     paDetails := @BoolDetails;

   end;

   LongBool(BoolDetails.fValue) := Value;

   Code := mixerSetControlDetails(0, @Details,

MIXER_SETCONTROLDETAILSF_VALUE);

end;

if Code <> MMSYSERR_NOERROR then

   raise Exception.CreateFmt('SetMasterMuteValue failure, '+

     'multimedia system error #%d', [Code]);

end;

 

// Example:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off

end;

 

 

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

 

Code:

procedure SetVolume(X: Word);

var

iErr : Integer;

i: integer;

a: TAuxCaps;

begin

for i := 0 to auxGetNumDevs do begin

   auxGetDevCaps(i,Addr(a),SizeOf(a));

   If a.wTechnology = AUXCAPS_CDAUDIO Then break;

end;

 

// Устанавливаем одинаковую громкость для левого и правого каналов.

// VOLUME := LEFT*$10000 + RIGHT*1

 

iErr:=auxSetVolume(i,(X*$10001));

if (iErr‹›0) then ShowMessage('No audio devices are available!');

end;

 

function GetVolume: Word;

var

iErr : Integer;

i: integer;

a: TAuxCaps;

vol: word;

begin

for i := 0 to auxGetNumDevs do begin

   auxGetDevCaps(i,Addr(a),SizeOf(a));

   If a.wTechnology = AUXCAPS_CDAUDIO Then break;

end;

iErr:=auxGetVolume(i,addr(vol));

GetVolume := vol;

if (iErr‹›0) then ShowMessage('No audio devices are available!');

end;

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

Автор: Alec Bergamini

Совместимость: Delphi 5.x (или выше)

11-го августа 2001 Microsoft объявила о выпуске SAPI 5.1 SDK. Данный продукт можно использовать в любом языке, который поддерживает OLE автоматизацию.

 

В данной статье я постараюсь раасказать, как установить SAPI 5.1 SDK. Затем мы посмотрим, как использовать SDK в приложении Delphi для преобразования текста в синтезированную речь. Синтезированная речь будет проигрываться через спикер. Всё это тестировалось в Delphi 5 и 6.

 Чтобы скачать SAPI 5.1, необходимо зайти на сайт Microsoft's Speech.net Technologies по адресу https://www.microsoft.com/speech/ и кликнуть по ссылке download. Далее будет предложено прочитать комментарии к данному продукту. Если в Вашей системе, язык по умолчанию отличается от US English, то настоятельно рекомендую прочитать эти комментарии до конца.

 Если Вы используете beta версию операционной системы XP, то у Вас могут возникнуть некоторые проблемы. Проблемы связаны с тем, что большинство beta версий XP включают в себя ранние версии SAPI 5.1. Поэтому не пытайтесь инсталировать release версию SAPI 5.1 на XP, она не будет работать.

 После того как Вы прочитаете комментарии, то приступайте к скачиванию Speech SDK 5.1. Всё что для этого потребуется, это нажать на ссылку Speech SDK 5.1 (68 MB). В архиве содержится сам SDK, докумантация, а так же текты на английском для примера.

 Итак, после скачивания SAPI 5.1 SDK, запустите speechsdk51.exe для установки его на Ваш компьютер.

 

Теперь надо дать знать Delphi о новых объектах автоматизации SAPI. Для этого запустите Delphi 5 или 6 (Я не пробовал боле ранние версии) и откройте Project | Import Type Library. В диалоге Import Type Library выберите "Microsoft Speech Object Library (Version 5.1)". Если Вы не нашли его в списке, значит во время инсталяции SAPI 5.1 произошли какие-то ошибки.

 Delphi предложит поместить компоненты SAPI на станицу ActiveX. Я рекомендую разместить их в новой странице под названием "SAPI 5", так как количество компонент довольно большое (19). Так же рекомендую Вам выбрать "Unit dir name" отличающуюся от той, которая предлагается по умолчанию. Убедитесь, что на "Generate Component Wrapper" стоит галочка и нажмите кнопку >Install<.

 В диалоге Install выберите закладку "Into new package" и в поле "File name:" введите имя пакета наподобие "SAPI5.dpk", нажмите кнопку "Обзор..." (browse) и убедитесь, что dpk создан в той же директории, в которой были созданы компоненты. В диалоге Install в поле Description задайте какое-нибудь описание, например "SAPI 5 automation components". Нажмите OK

 В подтверждающем диалоге нажмите yes. После этого новые компоненты будут установлены.

 Теперь, если Вы посмотрите в директорию, которую указали для установки компонент, то обнаружите там файл SpeechLib_TLB.pas (и dcr) который содержит весь код компоненты (интерфайс, константы, типы, а так же другую полезную информацию). Эта директория так же содержит (если Вы следовали вышеприведённым инструкциям) SAPI5.dpk который является исходинком пакета.

 А теперь самая интересная часть.

 Давайте создадим приложение, которое будет синтезировать речь. В Delphi создайте новое приложение и поместите на форму кнопку. На странице компонент SAPI5 найдите SpVoice и перетащите его на форму.

 Теперь создайте событие onClick для Вашей кнопки, которое должно выглядеть примерно так:

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

SpVoice1.Speak('Hello world!', SVSFDefault);

end;

  Запустите программу и нажмите кнопку. Здорово?

 Метод Speak объекта SPVoice предоставляет довольно большие возможности. Эти возможности можно использовать если поиграться со вторым параметром. В вышеприведённом примере я использовал режим поумолчанию, который позволяет функции вернуть управление только после завершения проигрывания звука. Избежать этого можно путём внедрения в текст специальных тэгов XML.

 Документация по SDK содержит файл sapi.chm который можно найти в директории \Program Files\Microsoft Speech SDK 5.1\Docs\Help .

 Sapi.chm содержит довольно много информации. Вот основные, часто используемые возможности компоненты и, соответствующие им флаги, которые передаются во втором параметре:

• Воспроизведение текста находящегося в файле. (SVSFIsFilename)

• Асинхронный решим проигрывания звука. Позволяет функции вернуть управление немедленно, во время воспроизведения. (SVSFlagsAsync)

• Позволяет управлять воспроизведением через XML тэги (см. раздел под название "XML TTS Tutorial"). Тэги позволяют настроить тональность звучания, скорость воспроизведения и многое другое.( SVSFIsXML)

 Одна из интересных вещей (не документирована) заключается в том, что можно озвучивать заголовок веб страницы путём установки флага в SVSFIsFilenam а имени файла в URL. Если Вы соединены с интернетом, попробуйте запустить следующую строчку:

 SpVoice1.Speak('https://www.o2a.com', SVSFIsFilename);

 Так же при помощи этого флага можно проигрывать wav файлы:

 SpVoice1.Speak('C:\WINNT\MEDIA\Windows Logon Sound.wav', SVSFIsFilename);

 

На самом деле у этой SAPI намного больше возможностей, чем я здесь привёл. В следующий раз, мы подробнее рассмотрим другие возможности.

Взято из https://forum.sources.ru

 

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

  

Code:

// Works on NT, 2k, XP, Win9x with SAPI SDK

// reference & Further examples: See links below!

 

uses Comobj;

 

procedure TForm1.Button1Click(Sender: TObject);

var

voice: OLEVariant;

begin

voice := CreateOLEObject('SAPI.SpVoice');

voice.Speak('Hello World!', 0);

end;

 

 

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

Единственное, что удалось найти это компонент на Дельфи (с исходным кодом) на https://www.torry.net/mixer.htm компонент называется Vumeter v.1.0. Я его не разбирал, но похоже что он опрашивает Audio Mixer Driver (или что-то подобное). 

Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)

Взято с Vingrad.ru https://forum.vingrad.ru

 

Я построил диаграмму так:

 

Назначил F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead );

Затем считал заголовок Wav- SampleCount, SamplesPerSec, BitsPerSample, Channeles.

Затем считал данные- GetMem(buf, SampleCount * Channeles * BitsPerSample);

Описал массив Volume- SetLength(Volume, SampleCount);

Затем - F.Read(buf^, SampleCount*2); F.Free;

Затем заполнил массив -

Code:

buf16 := buf;

for h := 0 to SampleCount - 1 do

begin

   Volume[h] := abs(buf16^);

   inc(buf16);

end;

FreeMem(buf);

  

Затем строил график(в экранных координатах) - по горизонтальной оси откладывал значения SampleCount, по вертикальной значения Volume[h].

График получается точно такой же как в SoundForge.

Единственно, я писал программу для конкретного случая - у меня файлы по 10 минут, моно, 11025 Гц., 16 бит. Так что программа у меня не универсальная. Но работает нормально. По времени: обработка файла и построение графика около 4 -5 секунд.

Автор ответа: TPavel

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

WaveOutSetVolume()

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

Code:

{ ... }

if WaveOutGetNumDevs > 0 then

ShowMessage('Wave-Device present')

else

ShowMessage('No Wave-Device present');

{ ... }

 

 

 

Code:

function IsSoundCardInstalled: Boolean;

type

SCFunc = function: UInt; stdcall;

var

LibInst: LongInt;

EntryPoint: SCFunc;

begin

Result := False;

LibInst := LoadLibrary(PChar('winmm.dll'));

try

   if LibInst <> 0 then

   begin

     EntryPoint := GetProcAddress(LibInst, 'waveOutGetNumDevs');

     if (EntryPoint <> 0) then

       Result := True;

   end;

finally

   if (LibInst <> 0) then

     FreeLibrary(LibInst);

end;

end;

 Взято с Delphi Knowledge Base: https://www.baltsoft.com/

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

  

Code:

unit receiver;

interface

uses mmsystem, classes;

const

samp_per_sec = 44100;

samp_cnt = samp_per_sec div 5;

buf_len = samp_cnt * 2;

type

PSample16M = ^TSample16M;

TSample16M = SmallInt;

PArrayOfSample = ^TArrayOfSample;

TArrayOfSample = array[1..samp_cnt] of TSample16M;

TReceiver = class

private

hwi: Integer;

fmt: tWAVEFORMATEX;

whdr1: WAVEHDR;

buf1: TArrayOfSample;

whdr2: WAVEHDR;

buf2: TArrayOfSample;

FStoped: Boolean;

FOnChange: TNotifyEvent;

procedure SetStoped(const Value: Boolean);

public

Peak: Integer;

Buffer: PArrayOfSample;

destructor Destroy; override;

procedure Start;

procedure Stop;

property Stoped: Boolean read FStoped write SetStoped;

property OnChange: TNotifyEvent read FOnChange write FOnChange;

end;

var rec: TReceiver;

 

implementation

 

procedure waveInProc(const hwi, uMsg, dwInstance: Integer; var hdr: WAVEHDR; const dwP2: Integer); stdcall;

const divs = samp_cnt div 100;

var

i, p: Integer;

buf: PArrayOfSample;

begin

if rec.Stoped then Exit;

case uMsg of

WIM_OPEN: begin end;

WIM_DATA: begin

rec.Buffer := PArrayOfSample(hdr.lpData);

buf := PArrayOfSample(hdr.lpData);

p := 0;

for i := 0 to samp_cnt div divs do p := p + Abs(buf[i * divs]);

rec.Peak := p div (samp_cnt div divs);

if Assigned(rec.FOnChange) then rec.FOnChange(rec);

waveInUnprepareHeader(hwi, @hdr, SizeOf(WAVEHDR));

waveInPrepareHeader(hwi, @hdr, SizeOf(WAVEHDR));

waveInAddBuffer(hwi, @hdr, SizeOf(WAVEHDR));

end;

WIM_CLOSE: begin end;

end;

end;

 

{ TReceiver }

 

destructor TReceiver.Destroy;

begin

Stoped := True;

inherited;

end;

 

procedure TReceiver.SetStoped(const Value: Boolean);

begin

FStoped := Value;

if Value then

begin

waveInStop(hwi);

waveInUnprepareHeader(hwi, @whdr1, SizeOf(WAVEHDR));

waveInUnprepareHeader(hwi, @whdr2, SizeOf(WAVEHDR));

waveInReset(hwi);

waveInClose(hwi);

end

else

begin

with fmt do

begin

wFormatTag := WAVE_FORMAT_PCM;

nChannels := 1;

nSamplesPerSec := samp_per_sec;

nBlockAlign := 2;

nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;

wBitsPerSample := 16;

cbSize := 0;

end;

waveInOpen(@hwi, WAVE_MAPPER, @fmt, Cardinal(@waveInProc), hInstance, CALLBACK_FUNCTION);

with whdr1 do

begin

lpData := @buf1;

dwBufferLength := buf_len;

dwBytesRecorded := 0;

dwUser := 0;

dwFlags := 0;

dwLoops := 0;

lpNext := nil;

reserved := 0;

end;

waveInPrepareHeader(hwi, @whdr1, SizeOf(WAVEHDR));

waveInAddBuffer(hwi, @whdr1, SizeOf(WAVEHDR));

with whdr2 do

begin

lpData := @buf2;

dwBufferLength := buf_len;

dwBytesRecorded := 0;

dwUser := 0;

dwFlags := 0;

dwLoops := 0;

lpNext := nil;

reserved := 0;

end;

waveInPrepareHeader(hwi, @whdr2, SizeOf(WAVEHDR));

waveInAddBuffer(hwi, @whdr2, SizeOf(WAVEHDR));

waveInStart(hwi);

end;

end;

 

procedure TReceiver.Start;

begin

Stoped := False;

end;

 

procedure TReceiver.Stop;

begin

Stoped := True;

end;

 

initialization

rec := TReceiver.Create;

finalization

rec.Free;

end.

  

вот. отображать уровень можно через поле Peak при событии OnChange, там же (в этом событии) можно работать с полем Buffer в котором как раз содержется записанный сигнал.

Вся работа осуществляется через глобальную переменную rec . Возможно это не лучшая реализация с точки зрения ООП, но работает Запись происходит с глубиной 16 бит и частотой 44100 в режиме моно. После небольшой переделки все это может работать с любыми частотами и каналами и глубинами.

 

Автор cully

Взято с Vingrad.ru https://forum.vingrad.ru

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

Code:

procedure GetVolume(var volL, volR: Word);

var

hWO: HWAVEOUT;

waveF: TWAVEFORMATEX;

vol: DWORD;

begin

volL := 0;

volR := 0;

// init TWAVEFORMATEX

FillChar(waveF, SizeOf(waveF), 0);

// open WaveMapper = std output of playsound

waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);

// get volume

waveOutGetVolume(hWO, @vol);

volL := vol and $FFFF;

volR := vol shr 16;

waveOutClose(hWO);

end;

 

procedure SetVolume(const volL, volR: Word);

var

hWO: HWAVEOUT;

waveF: TWAVEFORMATEX;

vol: DWORD;

begin

// init TWAVEFORMATEX

FillChar(waveF, SizeOf(waveF), 0);

// open WaveMapper = std output of playsound

waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);

vol := volL + volR shl 16;

// set volume

waveOutSetVolume(hWO, vol);

waveOutClose(hWO);

end;

  

Взято с Delphi Knowledge Base: https://www.baltsoft.com/

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

пример взят из рассылки "Мастера DELPHI. Новости мира компонент, FAQ, статьи..."

Code:

procedure TForm1.btRecordClick(Sender: TObject);

begin

with Media do

begin

{ Set FileName to the test.wav file to }

{ get the recording parameters. }

FileName := 'd:\test.wav';

{ Open the device. }

Open;

{ Start recording. }

Wait := False;

StartRecording;

end;

end;

 

procedure TForm1.btStopClick(Sender: TObject);

begin

with Media do

begin

{ Stop recording. }

Stop;

{ Change the filename to the new file we want to write. }

FileName := 'd:\new.wav';

{ Save and close

the file. }

Save;

Close;

end;

end;

 

Взято с Vingrad.ru https://forum.vingrad.ru

 

 

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук

 

Эта программа увеличивает громкость выбранного канала на 1000.

Code:

uses MMSystem;

 

procedure TForm1.Button1Click(Sender: TObject);

var

vol: longint;

LVol, RVol: integer;

begin

AuxGetVolume(ListBox1.ItemIndex, @Vol);

LVol := Vol shr 16;

if LVol < MaxWord - 1000

   then LVol := LVol + 1000

   else LVol := MaxWord;

RVol := (Vol shl 16) shr 16;

if RVol < MaxWord - 1000

   then RVol := RVol + 1000

   else RVol := MaxWord;

AuxSetVolume(ListBox1.ItemIndex, LVol shl 16 + RVol);

end;

 

procedure TForm1.FormCreate(Sender: TObject);

var

i: integer;

cap: TAuxCaps;

begin

for i := 0 to auxGetNumDevs - 1 do begin

   auxGetDevCaps(i, Addr(cap), SizeOf(cap));

   ListBox1.Items.Add(cap.szPname)

end;

end;

 

 

Второй вариант:

Code:

uses mmsystem;

 

function GetWaveVolume: DWord;

var

Woc : TWAVEOUTCAPS;

Volume : DWord;

begin

result:=0;

if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then

if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then

begin

WaveOutGetVolume(WAVE_MAPPER, @Volume);

Result := Volume;

end;

end;

 

procedure SetWaveVolume(const AVolume: DWord);

var Woc : TWAVEOUTCAPS;

begin

if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then

if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then WaveOutSetVolume(WAVE_MAPPER, AVolume);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Beep;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

var

LeftVolume: Word;

RightVolume: Word;

begin

LeftVolume := StrToInt(Edit1.Text);

RightVolume := StrToInt(Edit2.Text);

SetWaveVolume(MakeLong(LeftVolume, RightVolume));

end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

Caption := IntToStr(GetWaveVolume);

end;

 

Автор MMM

Добавить комментарий
Подробности
Родительская категория: Windows
Категория: Звук
  1. Как управлять спикером под 9х из Дельфи?
  2. Программирование Sound Blaster
  3. Сыграть звуковой файл без компонентов

Hooks

Ярлыки, файловые ассоциации, расширения