Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

 procedure CloseMedia;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

var MyError,Flags: Longint;

procedure TForm1.OpenMedia;

var

 MyOpenParms: TMCI_Open_Parms;

 MyPChar: PChar;

 TextLen: Longint;

begin

 Flags:=mci_Wait or mci_Open_Element or mci_Open_Type;

 with MyOpenParms do begin

  dwCallback:=Handle; // TForm1.Handle

  lpstrDeviceType:=PChar('WaveAudio');

  lpstrElementName:=PChar('');

 end;

 MyError:=mciSendCommand(0, mci_Open, Flags, Longint(@MyOpenParms));

 if MyError = 0 then FDeviceID:=MyOpenParms.wDeviceID;

end;

procedure TForm1.RecordMedia;

var

 MyRecordParms: TMCI_Record_Parms;

 TextLen: Longint;

begin

 Flags:=mci_Notify;

 with MyRecordParms do begin

  dwCallback:=Handle;  // TForm1.Handle

  dwFrom:=0;

  dwTo:=10000;

 end;

 MyError:=mciSendCommand(FDeviceID, mci_Record, Flags,Longint(@MyRecordParms));

end;

procedure TForm1.StopMedia;

var MyGenParms: TMCI_Generic_Parms;

begin

 if FDeviceID <> 0 then begin

  Flags:=mci_Wait;

  MyGenParms.dwCallback:=Handle;  // TForm1.Handle

  MyError:=mciSendCommand(FDeviceID, mci_Stop, Flags,Longint(@MyGenParms));

 end;

end;

procedure TForm1.SaveMedia;

type    // не реализовано в Delphi

 PMCI_Save_Parms = ^TMCI_Save_Parms;

 TMCI_Save_Parms = record

  dwCallback: DWord;

  lpstrFileName: PAnsiChar;  // имя файла, который нужно сохранить

 end;

var MySaveParms: TMCI_Save_Parms;

begin

 if FDeviceID <> 0 then begin

  // сохраняем файл...

  Flags:=mci_Save_File or mci_Wait;

  with MySaveParms do begin

   dwCallback:=Handle;

   lpstrFileName:=PChar('c:\message.wav');

  end;

  MyError:=mciSendCommand(FDeviceID, mci_Save, Flags,Longint(@MySaveParms));

 end;

end;

procedure TForm1.CloseMedia;

var MyGenParms: TMCI_Generic_Parms;

begin

 if FDeviceID <> 0 then begin

  Flags:=0;

  MyGenParms.dwCallback:=Handle; // TForm1.Handle

  MyError:=mciSendCommand(FDeviceID, mci_Close, Flags,Longint(@MyGenParms));

  if MyError = 0 then FDeviceID:=0;

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 OpenMedia;

 RecordMedia;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 StopMedia;

 SaveMedia;

 CloseMedia;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 Application.OnException := AppException;

end;

procedure TForm1.AppException(Sender: TObject; E: Exception);

begin

 CloseMedia;

end;

end. 

Как реализовать регулятор громкости?

Nomadic советует:

Да всё пpосто. Даже, я бы сказал, тyпо. :-)

INT GetMasterVolumeControlID() {

 // get dwLineID

 MIXERLINE mxl;

 mxl.cbStruct = sizeof(MIXERLINE);

 mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;

 if (::mixerGetLineInfo((HMIXEROBJ)ghmx, &mxl, MIXER_OBJECTF_HMIXER | MIXER_GETLINEINFOF_COMPONENTTYPE) != MMSYSERR_NOERROR) return 34;

 // get dwControlID

 MIXERCONTROL mxc;

 MIXERLINECONTROLS mxlc;

 mxlc.cbStruct = sizeof(MIXERLINECONTROLS);

 mxlc.dwLineID = mxl.dwLineID;

 mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME;

 mxlc.cControls = 1;

 mxlc.cbmxctrl = sizeof(MIXERCONTROL);

 mxlc.pamxctrl = &mxc;

 if (::mixerGetLineControls((HMIXEROBJ)ghmx, &mxlc, MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE) != MMSYSERR_NOERROR) return 34;

 return mxc.dwControlID;

}

BOOL SetMasterVolume(DWORD dwVolume) {

 MIXERCONTROLDETAILS mxcd;

 MIXERCONTROLDETAILS_UNSIGNED mxcd_u;

 mxcd.cbStruct = sizeof(mxcd);

 mxcd.dwControlID = MasterVolumeControlID;

 mxcd.cChannels = 1;

 mxcd.cMultipleItems = 0;

 mxcd.cbDetails = 4;

 mxcd.paDetails = &mxcd_u;

 mmr = mixerGetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);

 if (MMSYSERR_NOERROR != mmr) return FALSE;

 mxcd_u.dwValue = dwVolume;

 mmr = mixerSetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);

 if (MMSYSERR_NOERROR != mmr) return FALSE;

 return TRUE;

}

Переписывать на Delphi, думаю, ни к чему. Надо лишь не забыть добавить uses MMSystem; Громкость отдельных каналов очень просто устанавливается через auxSetVolume и аналогичные.

Как использовать в своей программе API DirectSound и DirectSound3D?

Nomadic советует:

Пример 1

Представляю вашему вниманию рабочий пример использования DirectSound на Delphi + несколько полезных процедур. В этом примере создается один первичный SoundBuffer и 2 статических, вторичных; в них загружаются 2 WAV файла. Первичный буфер создается процедурой AppCreateWritePrimaryBuffer, а любой вторичный - AppCreateWritePrimaryBuffer. Так как вторичный буфер связан с WAV файлом, то при создании буфера нужно определить его параметры в соответствии со звуковым файлом, эти характеристики (Samples, Bits, IsStereo) задаются в виде параметров процедуры. Time — время WAV'файла в секундах (округление в сторону увеличения). При нажатии на кнопку происходит микширование из вторичных буферов в первичный. AppWriteDataToBuffer позволяет записать в буфер PCM сигнал. Процедура CopyWAVToBuffer открывает WAV файл, отделяет заголовок, читает чанк 'data' и копирует его в буфер (при этом сначала считывается размер данных, так как в некоторых WAV файлах существует текстовый довесок, и если его не убрать, в динамиках возможен треск).

PS. Если есть какие-нибудь вопросы, постараюсь на них ответить.

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;

type TForm1 = class(TForm)

 Button1: TButton;

 Timer1: TTimer;

 procedure FormCreate(Sender: TObject);

 procedure FormDestroy(Sender: TObject);

 procedure Button1Click(Sender: TObject);

private

  DirectSound: IDirectSound;

 DirectSoundBuffer: IDirectSoundBuffer;

 SecondarySoundBuffer: array[0..1] of IDirectSoundBuffer;

 procedure AppCreateWritePrimaryBuffer;

 procedure AppCreateWriteSecondaryBuffer(var Buffer: IDirectSoundBuffer; SamplesPerSec: Integer; Bits: Word; isStereo: Boolean; Time: Integer);

 procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer; OffSet: DWord; var SoundData; SoundBytes: DWord);

 procedure CopyWAVToBuffer(Name: PChar;

 var Buffer: IDirectSoundBuffer);

 { Private declarations }

public

 { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then Raise Exception.Create('Failed to create IDirectSound object');

 AppCreateWritePrimaryBuffer;

 AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[0], 22050, 8,False, 10);

 AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[1], 22050, 16, True, 1);

end;

procedure TForm1.FormDestroy(Sender: TObject);

var i: ShortInt;

begin

 if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;

 for i:=0 to 1 do if Assigned(SecondarySoundBuffer[i]) then SecondarySoundBuffer[i].Release;

 if Assigned(DirectSound) then DirectSound.Release;

end;

procedure TForm1.AppWriteDataToBuffer;

var

 AudioPtr1, AudioPtr2: Pointer;

 AudioBytes1, AudioBytes2: DWord;

 h: HResult;

 Temp: Pointer;

begin

 H:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0);

 if H = DSERR_BUFFERLOST  then begin

  Buffer.Restore;

  if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0) <> DS_OK then Raise Exception.Create('Unable to Lock Sound Buffer');

 end

 else if H <> DS_OK then Raise Exception.Create('Unable to Lock Sound Buffer');

 Temp:=@SoundData;

 Move(Temp^, AudioPtr1^, AudioBytes1);

 if AudioPtr2 <> nil then begin

  Temp:=@SoundData;

  Inc(Integer(Temp), AudioBytes1);

  Move(Temp^, AudioPtr2^, AudioBytes2);