Отправляет email-рассылки с помощью сервиса Sendsay

СообЧА. Программирование на Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Программирование в Delphi" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Сентябрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
26.09.2001
22:01:01
22:36:02
27
28
29
30
Автор
Сергей

Статистика

10.085 подписчиков
-9 за неделю
←   Все выпуски   →

СообЧА. Программирование на Delphi


Служба Рассылок Subscribe.Ru проекта Citycat.Ru
Subscribe.Ru : СообЧА. Программирование на Delphi
Служба Рассылок Subscribe.Ru проекта Citycat.Ru


 

Мир Delphi

PixelSoftware

  

Подписчиков: 3720

  
     

::: СообЧа - Программирование на Delphi :::

 

ї 2000 - 2001COOLer

  

Дизайн: Yoghurt

  
     

Оглавление

 

В выпуске

  

Рассылка СообЧА

  
     
  
Рассылки Subscribe.Ru
СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.

  Назад к оглавлению    
   
 

Конкурс и новости рассылки

  
 
   

  • Участвуйте в конкурсе "Статья месяца" и вы выиграете книгу по Delphi от магазина ОЗОН. В конце каждого месяца Вами будет выбран лучший автор, который и получит книгу. Присылайте ваши статьи на  pixel@novgorod.net . Авторов просим строго придерживаться тематики рассылки.

  • Хотите поучаствовать в нашем проекте, вы умеете работать с OpenGL или DX? Присоединяйтесь вместе мы напишем классную RPG ... подробности по адресу  pixel@novgorod.net или http://pixelsoft.narod.ru/ раздел Проект... Желательны(Хотя не обязательны , по ходу сами все поймете) знания Borland C++ Builder или Delphi в сфере графики(или просто кодеры).Все абсолютно свободно freewareно и бесплатно. ПОЛНЫЙ ДОСТУП К НАШИМ ИСХОДНИКАМ.

 

  • Нравится ли вам наша рассылка?

    • Да

    Нет

    Не успел оценить

      Назад к оглавлению    
       
     

    Выбор лучшего

    		  
     
       
    ув. Подписчики. пожалуйста оцените труд данных авторов отдав свой голос за того, кого вы считаете достойным. В конце месяца по итогам голосования лучшему автору будет подарена книга от магазина "ОЗОН". Если вы хотите увидить своё имя среди авторов - то прочитайте условия конкурса Выбери лучшего
    Pixel
    PILOT
    Art
      Назад к оглавлению    
       
     

    Винты и... Колеса

    		  
     
       
    Не знаю, зачем вам может понадобиться это, но все же:
    Вот эта процедура снимает с винчестера Всевозможные Данные.
     procedure TForm1.Button1Click(Sender: TObject);
var
VolumeName,
FileSystemName : array [0..MAX_PATH-1] of Char;
VolumeSerialNo : DWord;
MaxComponentLength,
FileSystemFlags : Integer;
begin
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,
MaxComponentLength,FileSystemFlags,
FileSystemName,MAX_PATH);
Memo1.Lines.Add('VName = '+VolumeName);
Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8));
Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength));
Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4));
Memo1.Lines.Add('FSName = '+FileSystemName);
end;

    Автор:Pixel(pixel@novgorod.net http://pixelsoft.narod.ru/)
    ї COOLer  

     
      Назад к оглавлению    
       
     

    Direct Sound

    		  
     
       

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

    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);

    end;

    if Buffer.UnLock(AudioPtr1, AudioBytes1,AudioPtr2, AudioBytes2) <> DS_OK

    then Raise Exception.Create('Unable to UnLock Sound Buffer');

    end;
    procedure TForm1.AppCreateWritePrimaryBuffer;
    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;

    PCM.nChannels:=2;

    PCM.nSamplesPerSec:=22050;

    PCM.nBlockAlign:=4;

    PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;

    PCM.wBitsPerSample:=16;

    PCM.cbSize:=0;

    dwSize:=SizeOf(DSBUFFERDESC);

    dwFlags:=DSBCAPS_PRIMARYBUFFER;

    dwBufferBytes:=0;

    lpwfxFormat:=nil;

    end;

    if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK

    then Raise Exception.Create('Unable to set Coopeative Level');

    if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK

    then Raise Exception.Create('Create Sound Buffer failed');

    if DirectSoundBuffer.SetFormat(PCM) <> DS_OK

    then Raise Exception.Create('Unable to Set Format ');

    if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK

    then Raise Exception.Create('Unable to set Coopeative Level');

    end;

    procedure TForm1.AppCreateWriteSecondaryBuffer;
    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;

    dwBufferBytes:=Time*PCM.nAvgBytesPerSec;

    lpwfxFormat:=@PCM;

    end;

    if DirectSound.CreateSoundBuffer(BufferDesc,Buffer,nil) <> DS_OK

    then Raise Exception.Create('Create Sound Buffer failed');

    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;
    procedure TForm1.Button1Click(Sender: TObject);
    begin

    CopyWAVToBuffer('1.wav',SecondarySoundBuffer[0]);

    CopyWAVToBuffer('flip.wav',SecondarySoundBuffer[1]);

    if SecondarySoundBuffer[0].Play(0,0,0) <> DS_OK

    then ShowMessage('Can''t play the Sound');

    if SecondarySoundBuffer[1].Play(0,0,0) <> DS_OK

    then ShowMessage('Can''t play the Sound');

    end;

    end.

    Автор:Pixel(pixel@novgorod.net http://pixelsoft.narod.ru/ )

    Zaluskiy Anton(COOLer)    - ведущий проекта    "Мир Delphi"

    -AdRiver-
    http://subscribe.ru/
    E-mail: ask@subscribe.ru     		Отписаться
    Убрать рекламу     		Рейтингуется SpyLog
    http://subscribe.ru/
    E-mail: ask@subscribe.ru     		Отписаться
    Убрать рекламу     		Рейтингуется SpyLog
    В избранное