VrAudio.pas
上传用户:hbszzs
上传日期:2008-08-20
资源大小:628k
文件大小:6k
- {*****************************************************}
- { }
- { Varian Component Workshop }
- { }
- { Varian Software NL (c) 1996-2000 }
- { All Rights Reserved }
- { }
- {*****************************************************}
- unit VrAudio;
- {$I VRLIB.INC}
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- VrControls;
- type
- TVrAudioData = class(TPersistent)
- private
- FSize: Integer;
- FData: Pointer;
- procedure SetSize(Value: Integer);
- procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
- procedure LoadStream(Stream: TStream; ReadSize: Boolean); virtual;
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- function Empty: Boolean;
- procedure Clear; virtual;
- procedure LoadFromStream(Stream: TStream); virtual;
- procedure SaveToStream(Stream: TStream); virtual;
- procedure LoadFromFile(const FileName: string); virtual;
- procedure SaveToFile(const FileName: string); virtual;
- property Size: Integer read FSize write SetSize;
- property Data: Pointer read FData;
- end;
- TVrWaveOption = (vwoAsync, vwoNoDefault, vwoLoop, vwoNoStop, vwoNoWait);
- TVrWaveOptions = set of TVrWaveOption;
- TVrWave = class(TVrComponent)
- private
- FSound: TVrAudioData;
- FFlags: Integer;
- FOptions: TVrWaveOptions;
- procedure SetSound(Value: TVrAudioData);
- procedure SetOptions(Value: TVrWaveOptions);
- protected
- procedure UpdatePlayOptions;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Play;
- procedure Stop;
- published
- property Sound: TVrAudioData read FSound write SetSound;
- property Options: TVrWaveOptions read FOptions write SetOptions default [vwoASync, vwoNoDefault];
- end;
- implementation
- uses
- MMSystem;
- const
- AudioId = $99200;
- ufWavePlay: array[TVrWaveOption] of Integer =
- (SND_ASYNC, SND_NODEFAULT, SND_LOOP, SND_NOSTOP, SND_NOWAIT);
- { TVrWave }
- constructor TVrWave.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FSound := TVrAudioData.Create;
- FOptions := [vwoASync, vwoNoDefault];
- UpdatePlayOptions;
- end;
- destructor TVrWave.Destroy;
- begin
- FSound.Free;
- inherited Destroy;
- end;
- procedure TVrWave.Play;
- var
- OldCursor: TCursor;
- begin
- if not Sound.Empty then
- begin
- OldCursor := Screen.Cursor;
- try
- Screen.Cursor := crHourGlass;
- PlaySound(FSound.Data, 0, FFlags);
- finally
- Screen.Cursor := OldCursor;
- end;
- end;
- end;
- procedure TVrWave.Stop;
- begin
- PlaySound(nil, 0, FFlags);
- end;
- procedure TVrWave.UpdatePlayOptions;
- var
- I: TVrWaveOption;
- begin
- FFlags := SND_MEMORY;
- for I := Low(TVrWaveOption) to High(TVrWaveOption) do
- if I in Options then FFlags := FFlags or ufWavePlay[I];
- if not (vwoAsync in Options) then
- FFlags := FFlags or SND_SYNC;
- end;
- procedure TVrWave.SetSound(Value: TVrAudioData);
- begin
- FSound.Assign(Value);
- end;
- procedure TVrWave.SetOptions(Value: TVrWaveOptions);
- begin
- if FOptions <> Value then
- begin
- FOptions := Value;
- UpdatePlayOptions;
- end;
- end;
- { TVrRawData }
- destructor TVrAudioData.Destroy;
- begin
- SetSize(0);
- inherited Destroy;
- end;
- function TVrAudioData.Empty: Boolean;
- begin
- Result := FSize = 0;
- end;
- procedure TVrAudioData.Clear;
- begin
- SetSize(0);
- end;
- procedure TVrAudioData.SetSize(Value: Integer);
- begin
- if FSize <> Value then
- begin
- Reallocmem(FData, Value);
- FSize := Value;
- end;
- end;
- procedure TVrAudioData.DefineProperties(Filer: TFiler);
- begin
- Filer.DefineBinaryProperty('Audio', LoadFromStream, SaveToStream, not Empty);
- end;
- procedure TVrAudioData.Assign(Source: TPersistent);
- begin
- if (Source is TVrAudioData) then
- begin
- SetSize(TVrAudioData(Source).Size);
- Move(TVrAudioData(Source).Data^, FData^, Size);
- Exit;
- end;
- inherited Assign(Source);
- end;
- procedure TVrAudioData.WriteStream(Stream: TStream; WriteSize: Boolean);
- var
- Id: Integer;
- begin
- if not Empty then
- begin
- if WriteSize then
- begin
- Id := AudioId;
- Stream.Write(Id, Sizeof(Integer));
- Stream.Write(FSize, Sizeof(Integer));
- end;
- Stream.Write(FData^, FSize);
- end;
- end;
- procedure TVrAudioData.LoadStream(Stream: TStream; ReadSize: Boolean);
- var
- Id: Integer;
- NewSize: Integer;
- begin
- NewSize := Stream.Size;
- if ReadSize then
- begin
- Stream.Read(Id, Sizeof(Integer));
- if AudioId <> Id then
- raise Exception.Create('Unknown audio streaming format.');
- Stream.Read(NewSize, Sizeof(Integer));
- end;
- SetSize(NewSize);
- Stream.Read(FData^, FSize);
- end;
- procedure TVrAudioData.LoadFromStream(Stream: TStream);
- begin
- LoadStream(Stream, True);
- end;
- procedure TVrAudioData.SaveToStream(Stream: TStream);
- begin
- WriteStream(Stream, True);
- end;
- procedure TVrAudioData.LoadFromFile(const FileName: string);
- var
- Stream: TFileStream;
- begin
- Stream := TFileStream.Create(FileName, fmOpenRead);
- try
- LoadStream(Stream, false);
- finally
- Stream.Free;
- end;
- end;
- procedure TVrAudioData.SaveToFile(const FileName: string);
- var
- Stream: TFileStream;
- begin
- Stream := TFileStream.Create(FileName, fmCreate);
- try
- WriteStream(Stream, false);
- finally
- Stream.Free;
- end;
- end;
- end.