[Glxtreem-commits] GLXtreem/Source GLXSound.pas,NONE,1.1

[Markus L?d. <dan...@us...>]

Update of /cvsroot/glxtreem/GLXtreem/Source
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16620/Source

Added Files:
	GLXSound.pas 
Log Message:
added GLXSound and GLXSoundEditor

--- NEW FILE: GLXSound.pas ---
unit GLXSound;

interface

uses
  SysUtils,Classes,Controls,GLXResource,
  fmod, fmodtypes, fmoderrors, fmodpresets;

type

  TGLXSound = class(TGLXResource,IEditor)
  private
    FName          : String;
    FData          : TMemoryStream;
    FSample        : PFSoundSample;
    FChannel       : Integer;
    FVolume        : Byte;
    FLoop          : Boolean;
    FSurround      : Boolean;
    FLoaded        : Boolean;
  protected
    procedure   CreateSample;
  public
    {@exclude}
    constructor Create; override;
    {@exclude}
    destructor  Destroy; override;

    procedure   LoadFromStream(Stream:TStream); override;
    procedure   SaveToStream(Stream:TStream); override;

    procedure   Load(FileName:String);
    procedure   Play;
    procedure   Stop;
    function    Name:String;
    function    Length:Integer;

    //IEditor
    function    Edit:Boolean;

    property    Volume   : Byte             read FVolume       write FVolume;
    property    Loop     : Boolean          read FLoop         write FLoop;

    {Sets a surround sound status. This surround sound is a fake dolby trick that
     effectively pans the channel to the center, but inverts the waveform in one speaker to
     make it sound fuller or spacier, or like it is coming out of space between the 2 speakers.
     Panning is ignored while surround is in effect.}
    property    Surround : Boolean          read FSurround     write FSurround;
  end;




implementation

uses
  GLXSoundEditor;

const
  BLOCKSIZE = 4096;

constructor TGLXSound.Create;
begin
  inherited Create;
  FName          := '';
  FData          := TMemoryStream.Create;
  FSample        := nil;
  FChannel       := -1;
  FVolume        := 255;
  FLoop          := false;
  FSurround      := false;
end;

destructor TGLXSound.Destroy;
begin
  if FSample<>nil then FSOUND_Sample_Free(FSample);
  FData.Free;
  inherited Destroy;
end;

procedure TGLXSound.CreateSample;
var
  Error      : TFModErrors;
begin
  if FLoaded then begin
    if FSample<>nil then FSOUND_Sample_Free(FSample);
    FSample := FSOUND_Sample_Load(FSOUND_FREE,FData.Memory,FSOUND_LOADMEMORY or FSOUND_2D or FSOUND_LOOP_OFF,0,FData.Size);
    Error   := FSOUND_GetError();
    case Error of
      FMOD_ERR_FILE_FORMAT: raise Exception.create('Unknown file format!');
    end;
  end;
end;

procedure TGLXSound.LoadFromStream(Stream:TStream);
var
  Reader : TReader;
  Size   : Integer;
begin
  inherited;
  Reader := TReader.Create(Stream,BLOCKSIZE);
  try
    FName         := Reader.ReadString;
    FVolume       := Reader.ReadInteger;
    FLoop         := Reader.ReadBoolean;
    FSurround     := Reader.ReadBoolean;
    Size          := Reader.ReadInteger;
    Reader.FlushBuffer;
    FData.Position:=0;
    FData.CopyFrom(Stream,Size);
    FLoaded       := Size>0;
    CreateSample;
  finally
    Reader.Free;
  end;
end;

procedure TGLXSound.SaveToStream(Stream:TStream);
var
  Writer : TWriter;
  Size   : Integer;
begin
  inherited;
  Writer:=TWriter.Create(Stream,BLOCKSIZE);
  try
    Writer.WriteString(FName);
    Writer.WriteInteger(FVolume);
    Writer.WriteBoolean(FLoop);
    Writer.WriteBoolean(FSurround);
    FData.Position := 0;
    Size           := FData.Size;
    Writer.WriteInteger(Size);
    Writer.FlushBuffer;
    Stream.CopyFrom(FData,Size);
//    FData.SaveToStream(Stream);
  finally
    Writer.Free;
  end;
end;

procedure TGLXSound.Load(FileName:String);
var
  FileStream : TFileStream;
begin
  if FileExists(FileName) then begin
    FName          := ExtractFilename(Filename);
    FileStream     := TFileStream.Create(FileName,fmOpenRead);
    FData.Clear;
    FData.Position := 0;
    try
      FData.CopyFrom(FileStream,FileStream.Size);
      FLoaded      := FData.Position>0;
    finally
      FileStream.Free;
    end;
    CreateSample;
  end else raise Exception.CreateFmt('File %s not found!',[FileName]);
end;

procedure TGLXSound.Play;
begin
  //Play sound paused
  FChannel := FSOUND_PlaySoundEx(FSOUND_FREE,FSample,nil,true);

  if FLoop then begin
    FSOUND_SetLoopMode(FChannel,FSOUND_LOOP_NORMAL);
  end else begin
    FSOUND_SetLoopMode(FChannel,FSOUND_LOOP_OFF);
  end;

  if FSurround then begin
    FSOUND_SetSurround(FChannel,true);
  end else begin
    FSOUND_SetSurround(FChannel,false);
  end;

  FSOUND_SetVolume(FChannel,FVolume);

  FSOUND_SetPaused(FChannel, False);
end;

procedure TGLXSound.Stop;
begin
  FSOUND_StopSound(FChannel)
end;

function TGLXSound.Name:String;
begin
  if FSample<>nil then begin
    result:=String(FSOUND_Sample_GetName(FSample));
    if result='' then result:=FName;
  end else begin
    result:='';
  end;
end;

function TGLXSound.Length:Integer;
begin
  if FSample<>nil then begin
    result:=FSOUND_Sample_GetLength(FSample);
  end else begin
    result:=0;
  end;
end;

function TGLXSound.Edit:Boolean;
var
  MyForm : TGLXSoundEditorForm;
begin
  MyForm:=TGLXSoundEditorForm.Create(Nil);
  MyForm.Sound:=Self;
  if MyForm.ShowModal=mrOK then begin
    result:=true;
  end else result:=false;
  MyForm.Free;
end;





initialization
  //Autodetect best output
  FSOUND_SetOutput(TFSoundOutputTypes(-1));

  //Take default sound driver
  FSOUND_SetDriver(0);

  //Autodetect Mixer
  FSOUND_SetMixer(FSOUND_MIXER_QUALITY_AUTODETECT);

  //Initialize fmod
  if not FSOUND_Init(44100,32,0) then begin
    FSOUND_Close();
    raise Exception.Create('Could not initialize FMOD!');
  end;
  RegisterResourceClass(TGLXSound);

finalization
  UnRegisterResourceClass(TGLXSound);
  FSOUND_Close();

end.