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

ifAudioPtr2 <> nil then begin

Temp:=@SoundData;

Inc(Integer(Temp), AudioBytes1);

Move(Temp^, AudioPtr2^, AudioBytes2);

end;

ifBuffer.UnLock(AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2) <> DS_OK then RaiseException.Create('Unable to UnLock Sound Buffer');

end;

procedureTForm1.CopyWAVToBuffer;

var

Data : PChar;

FName : TFileStream;

DataSize : DWord;

Chunk : String[4];

Pos : Integer;

begin

FName:=TFileStream.Create(Name,fmOpenRead);

Pos:=24;

SetLength(Chunk,4);

repeat

FName.Seek(Pos, soFromBeginning);

FName.Read(Chunk[1], 4);

Inc(Pos);

untilChunk = 'data';

FName.Seek(Pos+3, soFromBeginning);

FName.Read(DataSize, SizeOf(DWord));

GetMem(Data, DataSize);

FName.Read(Data^, DataSize);

FName.Free;

AppWriteDataToBuffer(Buffer, 0, Data^, DataSize);

FreeMem(Data, DataSize);

end;

varPos : Single = -25;

procedureTForm1.AppSetSecondary3DBuffer;

begin

ifBuffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then RaiseException.Create('Failed to create IDirectSound3D object');

if_3DBuffer.SetPosition(Pos, 1, 1, 0) <> DS_OK then RaiseException.Create('Failed to set IDirectSound3D Position');

end;

procedureTForm1.Button1Click(Sender: TObject);

begin

CopyWAVToBuffer('xhe4.wav',SecondarySoundBuffer);

ifSecondarySoundBuffer.Play(0, 0, DSBPLAY_LOOPING) <> DS_OK thenShowMessage('Can''t play the Sound');

Timer1.Enabled:=True;

end;

procedureTForm1.Timer1Timer(Sender: TObject);

begin

SecondarySound3DBuffer.SetPosition(Pos,1,1,0);

Pos:=Pos + 0.1;

end;

end.

Что касается вопроса "Открытие и закрытие привода CD-ROM", то при наличии более одного CD-ROMа в системе, рекомендую воспользоваться следующими функциями:

// ____ _ ______ __

// / __ \_____(_) _____/_ __/___ ____ / /____

// / / / / ___/ / | / / _ \/ / / __ \/ __ \/ / ___/

// / /_/ / / / /| |/ / __/ / / /_/ / /_/ / (__ )

// /_____/_/ /_/ |___/\___/_/ \____/\____/_/____/

//

(*******************************************************************************

* DriveTools 1.0 *

* *

* (c) 1999 Jan Peter Stotz *

* *

********************************************************************************

* *

* If you find bugs, has ideas for missing featurs, feel free to contact me *

* jpstotz@gmx.de *

* *

********************************************************************************

* Date last modified: May 22, 1999 *

*******************************************************************************)

unitDriveTools;

interface

usesWindows, SysUtils, MMSystem;

functionCloseCD(Drive: Char): Boolean;

functionOpenCD(Drive: Char): Boolean;

implementation

functionOpenCD(Drive : Char): Boolean;

Var

Res: MciError;

OpenParm: TMCI_Open_Parms;

Flags: DWord;

S: String;

DeviceID: Word;

begin

Result:=false;

S:=Drive+':';

Flags:=mci_Open_Type ormci_Open_Element;

WithOpenParm do begin

dwCallback := 0;

lpstrDeviceType := 'CDAudio';

lpstrElementName := PChar(S);

end;

Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));

IFRes<>0 Thenexit;

DeviceID:=OpenParm.wDeviceID;

try

Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);

IFRes=0 Thenexit;

Result:=True;

finally

mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));

end;

end;

functionCloseCD(Drive : Char) : Boolean;

Var

Res: MciError;

OpenParm: TMCI_Open_Parms;

Flags: DWord;

S: String;

DeviceID: Word;

begin

Result:=false;

S:=Drive+':';

Flags:=mci_Open_Type ormci_Open_Element;

WithOpenParm do begin

dwCallback := 0;lpstrDeviceType := 'CDAudio';

lpstrElementName := PChar(S);

end;

Res:= mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));

IFRes<>0 Thenexit;

DeviceID:=OpenParm.wDeviceID;

try

Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

IFRes=0 Thenexit;

Result:=True;

finally

mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));

end;

end;

end.

Прислал Vadim Petrov.

Переключение языков из программы

Для переключения языка применяется вызов LoadKeyboardLayout: