Звук
Это выключит спикеp:
SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
Это включит:
SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
Alexey Lesovik
Взято из FAQ:
Delphi and Windows API Tips'n'Tricks
https://www.chat.ru/~olmal
|
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
пример взят из рассылки "Мастера 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
|
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; |
Автор: 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
|
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
Единственное, что удалось найти это компонент на Дельфи (с исходным кодом) на 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
WaveOutSetVolume()
|
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/
|
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
|
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/
Страница 1 из 2