if DirectSound.SetCooperativeLevel(Handle, DSSCL_NORMAL) <> DS_OK then Raise Exception.Create('Unable to set Cooperative Level');
end;
procedure TForm1.AppCreateWriteSecondary3DBuffer;
var
BufferDesc : DSBUFFERDESC;
Caps : DSBCaps;
PCM : TWaveFormatEx;
begin
FillChar(BufferDesc, SizeOf(DSBUFFERDESC), 0);
FillChar(PCM, SizeOf(TWaveFormatEx), 0);
with BufferDesc do begin
PCM.wFormatTag:=WAVE_FORMAT_PCM;
if isStereo then PCM.nChannels:=2
else PCM.nChannels:=1;
PCM.nSamplesPerSec:=SamplesPerSec;
PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;
PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
PCM.wBitsPerSample:=Bits;
PCM.cbSize:=0;
dwSize:=SizeOf(DSBUFFERDESC);
dwFlags:=DSBCAPS_STATIC or DSBCAPS_CTRL3D;
dwBufferBytes:=Time*PCM.nAvgBytesPerSec;
lpwfxFormat:[email protected];
end;
if DirectSound.CreateSoundBuffer(BufferDesc, Buffer, nil) <> DS_OK then Raise Exception.Create('Create Sound Buffer failed');
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:[email protected];
Move(Temp^, AudioPtr1^, AudioBytes1);
if AudioPtr2 <> nil then begin
Temp:[email protected];
Inc(Integer(Temp), AudioBytes1);
Move(Temp^, AudioPtr2^, AudioBytes2);
end;
if Buffer.UnLock(AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2) <> DS_OK then Raise Exception.Create('Unable to UnLock Sound Buffer');
end;
procedure TForm1.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);
until Chunk = '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;
var Pos : Single = -25;
procedure TForm1.AppSetSecondary3DBuffer;
begin
if Buffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then Raise Exception.Create('Failed to create IDirectSound3D object');
if _3DBuffer.SetPosition(Pos, 1, 1, 0) <> DS_OK then Raise Exception.Create('Failed to set IDirectSound3D Position');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyWAVToBuffer('xhe4.wav',SecondarySoundBuffer);
if SecondarySoundBuffer.Play(0, 0, DSBPLAY_LOOPING) <> DS_OK then ShowMessage('Can''t play the Sound');
Timer1.Enabled:=True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
SecondarySound3DBuffer.SetPosition(Pos,1,1,0);
Pos:=Pos + 0.1;
end;
end.
Аппаратное обеспечение
CD-ROM
Открытие и закрытие нескольких приводов CD-ROM
Что касается вопроса "Открытие и закрытие привода 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 *
* [email protected] *
* *
********************************************************************************
* Date last modified: May 22, 1999 *
*******************************************************************************)
unit DriveTools;
interface
uses Windows, SysUtils, MMSystem;
function CloseCD(Drive: Char): Boolean;
function OpenCD(Drive: Char): Boolean;
implementation
function OpenCD(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 or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;
function CloseCD(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 or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res:= mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;
end;
end.
Прислал Vadim Petrov.
Клавиатура
Переключение клавиатуры
Переключение языков из программы
Для переключения языка применяется вызов LoadKeyboardLayout:
var russian, latin: HKL;
russian:=LoadKeyboardLayout('00000419', 0);
latin:=LoadKeyboardLayout('00000409', 0); где то в программе
SetActiveKeyboardLayout(russian);
Прислал Igor Nikolaev aKa The Sprite.
Как отловить нажатия клавиш в системе
Для этого используется функция GetAsyncKeyState(KeyCode)
в качестве параметра используются коды клавиш(например A – 65).
GetAsyncKeyState возвращает ненулевое значение если во время ее вызова нажата указаная клавиша.
//----Этот пример отлавливает нажатие клавиши «A»
//Этот код необходимо поместить в процедуру обработки
//таймера с интервалом «1»
if getasynckeystate(65)<>0 then showmessage('A – pressed');
//----------
Прислал Igor Nikolaev aKa The Sprite.
Клавиша с кодом #0
Delphi 1
В действительности она служит флагом проверки нажатия клавиши, по соглашению, код #0 означает, что никакой клавиши нажато не было. В некоторых случаях событие может активизировать передачу этого кода (например, прямым вызовом), или предок, возможно, уже обработал нажатие клавиши, и Key был установлен в #0.
