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

Temp:=@SoundData;

Move(Temp^, AudioPtr1^, AudioBytes1);

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:

varrussian, latin: HKL;

russian:=LoadKeyboardLayout('00000419', 0);

latin:=LoadKeyboardLayout('00000409', 0); где то в программе

SetActiveKeyboardLayout(russian);

Прислал Igor Nikolaev aKa The Sprite.

Для этого используется функция GetAsyncKeyState(KeyCode)

в качестве параметра используются коды клавиш(например A – 65).

GetAsyncKeyState возвращает ненулевое значение если во время ее вызова нажата указаная клавиша.

//----Этот пример отлавливает нажатие клавиши «A»

//Этот код необходимо поместить в процедуру обработки

//таймера с интервалом «1»

ifgetasynckeystate(65)<>0 thenshowmessage('A – pressed');

//----------

Прислал Igor Nikolaev aKa The Sprite.

В действительности она служит флагом проверки нажатия клавиши, по соглашению, код #0 означает, что никакой клавиши нажато не было. В некоторых случаях событие может активизировать передачу этого кода (например, прямым вызовом), или предок, возможно, уже обработал нажатие клавиши, и Key был установлен в #0.

Nomadicотвечает:

A: ActivateKeyboardLayout(). Учтите, что использование этой функции – плохой тон.

Nomadicсоветует:

unitPortInfo;

interface

usesWindows, SysUtils, Classes, Registry;

functionEnumModems: TStrings;

implementation

functionEnumModems: TStrings;

var

R: TRegistry;

s: ShortString;

N: TStringList;

i: integer;

j: integer;

begin

Result:= TStringList.Create;

R:= TRegistry.Create;

try

withR do begin

RootKey:= HKEY_LOCAL_MACHINE;

ifOpenKey('\System\CurrentControlSet\Services\Class\Modem', False) then

ifHasSubKeys then begin

N:= TStringList.Create;

try

GetKeyNames(N);

fori:=0 toN.Count – 1 do begin

closekey; { + }

openkey('\System\CurrentControlSet\Services\Class\Modem',false); { + }